XProfan

Windowtitle "Bilineare Bézierkurven"
' (X) Experimentalware 2013-09 by P. Specht, vienne. aucun Gewähr!
Fenêtre 0,0-%maxx,%maxy
Appendmenubar 10,"Endpunkte pour jeweils 2 Linien klicken. entre wird ensuite qui Kurve gemalt."
declare x0!,y0!,x1!,y1!,x2!,y2!
declare x!,y!,xa!,ya!,xb!,yb!,xc!,yc!,L!
WaitMouse
x0!=%mousex:y0!=%mousey
usepen 0,2,0
point x0!,y0!
WaitMouse
x1!=%mousex:y1!=%mousey
usepen 0,2,0
point x1!,y1!
usepen 0,1,0
line x0!,y0! - x1!,y1!

repeat

    WaitMouse
    x2!=%mousex:y2!=%mousey
    usepen 0,2,0
    point x2!,y2!
    usepen 0,1,0
    'line x0!,y0! - x2!,y2!
    line x1!,y1! - x2!,y2!
    xa!=(x0!+x1!)/2:ya!=(y0!+y1!)/2
    xb!=x1!:yb!=y1!
    xc!=(x1!+x2!)/2:yc!=(y1!+y2!)/2
    usepen 0,12,rgb(0,200,0)
    moveto xa!,ya!

    whileloop 0,100

        L!=&Boucle/100
        ' Bernstein-Polynome:
        x!=(xc!-2*xb!+xa!)*sqr(L!)+2*L!*(xb!-xa!)+xa!
        y!=(yc!-2*yb!+ya!)*sqr(L!)+2*L!*(Yb!-ya!)+ya!
        lineto x!,y!

    endwhile

    x0!=x1!:y0!=y1!
    x1!=x2!:y1!=y2!

until %clé=27

end

proc point

    parameters x!,y!
    usepen 0,2,rgb(255,0,0)
    rectangle x!-3,(y!-3) - x!+3,y!+3

endproc