XProfan

Windowtitle "Erster Bezierschrift-Versuch (missglückt)"
WindowStyle 24:font 5:Window 0,0-%maxx,%maxy-40:cls rgb(rnd(56)+200,rnd(56)+200,rnd(56)+200)
declare x0!,y0!,x1!,y1!,x2!,y2!,x3!,y3!,xa!,ya!,xb!,yb!,xc!,yc!,xD!,yD!,xE!,yE!,x!,y!,p!,i&
declare xold!,yold!
Print "\n Bitte jeweils 4 Steuerpunkte eingeben (auch Z-förmig)"

REPEAT

    usepen 0,10,rgb(0,0,255):waitmouse :x0!=%mousex:y0!=%mousey:line x0!,y0! - x0!+1,y0!
    usepen 0,2 ,rgb(255,0,0):waitmouse :x1!=%mousex:y1!=%mousey:line x1!,y1! - x0!+1,y0!
    waitmouse :x2!=%mousex:y2!=%mousey:line x2!,y2! - x1!+1,y1!
    waitmouse :x3!=%mousex:y3!=%mousey:line x3!,y3! - x2!+1,y2!
    usepen 0,10,rgb(0,0,255):moveto x0!,y0!
    i&=0 : xold!=y0! : yold!=-x0!

    whileloop 0,100,1 : p!=&Loop/100

        xa!=(x1!-x0!)*p!+x0! : ya!=(y1!-y0!)*p!+y0!
        xb!=(x2!-x1!)*p!+x1! : yb!=(y2!-y1!)*p!+y1!
        xc!=(x3!-x2!)*p!+x2! : yc!=(y3!-y2!)*p!+y2!
        xD!=(xb!-xa!)*p!+xa! : yD!=(yb!-ya!)*p!+ya!
        xE!=(xc!-xb!)*p!+xb! : yE!=(yc!-yb!)*p!+yb!
        x! =(xE!-xD!)*p!+xD! : y!=(yE!-yD!)*p!+yD!

        if &Loop=0:xold!=x!:yold!=y!:continue :endif

            ifnot &Loop mod 5

                Set("Orientation",-1800/pi()*Arctan4(x!-xold!,y!-yold!) )
                UseFont "Arial",45,20,0,0,0
                TextColor rgb(0,200,0),-1
                inc i&
                drawtext x!,y!,substr$("FROHES SCHAFFEN!",i&)

            endif

            'lineto x!,y!
            xold!=x!:yold!=y!

        endwhile

    UNTIL %key=27

    end

    proc ArcTan4 :parameters x!,y!:var pi!=3.1415926535897932:var w!=0'(CL)2014-01 P.Specht§gmx.at

        if x!=0:if y!>0:w!=pi!*0.5:elseif y!<0:w!=pi!*1.5:else :w!=0:endif :return w!:elseif x!>0

            if y!=0:w!=0:return w!:elseif y!>0:if x!>y!:w!=arctan(y!/x!):else :w!=pi!/2-arctan(x!/y!):endif

                return w!:else :if x!<-y!:w!=pi!*1.5+arctan(x!/-y!):else :w!=2*pi!-arctan(-y!/x!):endif :return w!
                endif :else :if y!>0:if x!>-y!:w!=pi!/2+arctan(-x!/y!):return w!:else :w!=pi!-arctan(y!/-x!)
                return w!:endif :elseif y!<0:if x!<y!:w!=pi!+arctan(-y!/-x!):else :w!=pi!*1.5-arctan(-x!/-y!)
                endif :return w!:else :w!=pi!:return w!:endif :endif :Print " ArcTan4 ERROR":waitinput:waitinput

            endproc