XProfan

Windowtitle "Umkreis berechnen und zeigen"
' (CL) Copyleft 2012-08 P. Specht
' {z.B. zur Vorbereitung für die Flip-Operation der Delauney-Triangulation }
Declare x!,y!,x0!,y0!,x1!,y1!,x2!,y2!,xu!,yu!,error%,nenn!,r!
Declare y01!,yy2!,yy0!,xx0!,yy1!,xx1!,xx2!,x10!,x02!,x21!
Declare xu0!,yu0!,xxu0!,yyu0!
Font 2 : Randomize : var xm!=%maxx/2:var ym!=%maxy/2
Window 0,0 - %maxx,%maxy
Cls rgb(246,246,246)
AppendMenuBar 10,"Bitte mit Maus Dreieckspunkte klicken..."
nochmal:
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!
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!
y01!=y0!-y1!
yy2!=y2!*y2!
yy0!=y0!*y0!
xx0!=x0!*x0!
yy1!=y1!*y1!
xx1!=x1!*x1!
xx2!=x2!*x2!
x10!=x1!-x0!
x02!=x0!-x2!
x21!=x2!-x1!
nenn!=(2*(x10!*y2!+x02!*y1!+(x21!)*y0!))

ifnot (nenn!=0) or (y01!=0)

    xu!=(y01!*yy2!-(yy0!-yy1!+xx0!-xx1!)*y2!-y0!*yy1!+\
    (xx0!+yy0!-xx2!)*y1!+(xx2!-xx1!)*y0!) / nenn!
    'xu!=((y0!-y1!)*y2!*y2!-(y0!*y0!+x0!*x0!-y1!*y1!-x1!*x1!)*y2!-y0!*y1!*y1!+\
    '(x0!*x0!+y0!*y0!-x2!*x2!)*y1!+(x2!*x2!-x1!*x1!)*y0!) / \
    '(2*((x1!-x0!)*y2!+(x0!-x2!)*y1!+(x2!-x1!)*y0!))
    yu!=x10!/y01!*(xu!-(x0!+x1!)/2)+(y0!+y1!)/2
    usepen 0,5,255
    point xu!,yu!
    xu0!=xu!-x0!
    xxu0!=xu0!*xu0!
    yu0!=yu!-y0!
    yyu0!=yu0!*yu0!
    r!=sqrt(xxu0!+yyu0!)

    if r!<10000

        usepen 0,1,255
        circle xu!,yu!,r!

    endif

endif

goto "nochmal"

proc point

    parameters x!,y!
    rectangle x!+2,(y!+2) - (x!-2),y!-2

endproc

proc circle : parameters cx%,cy%,radius%

    declare x%,y%,error%
    error% = -1*radius%
    x% = radius%
    y% = 0

    while (x% >= y%)

        plot8points(cx%,cy%,x%,y%)
        inc error%,y%
        inc y%
        inc error%,y%

        if (error% >= 0)

            dec error%,x%
            dec x%
            dec error%,x%

        endif

    endwhile

endproc

proc plot8points : parameters cx%,cy%,x%,y%

    plot4points(cx%,cy%,x%,y%)
    case x%-y%: plot4points(cx%,cy%,y%,x%)

endproc

proc plot4points : parameters cx%,cy%,x%,y%

    setPixl cx%+x%, cy%+y%
    case x%: setPixl cx% - x%, cy% + y%
    case y%: setPixl cx% + x%, cy% - y%
    case x%*y%: setPixl cx%-x%,cy%-y%

endproc

proc setpixl

    parameters x%,y%
    setpixel x%,y%,255

endproc