XProfan

WindowTitle "BRESENHAM-ELLIPSEN IN HORIZONTALLAGE"
' Q: https://de.wikipedia.org/wiki/Bresenham-Algorithmus
' Auf XProfan gequält von P. Specht 2012-06. Demo, keine Gewähr!
WindowStyle 16 | 64
Font 2:randomize
Window 0,0 - %maxx,%maxy
var xm&=%maxx\2 : var ym&=%maxy\2:var cnt&= 0
var a&=300:var b&=160:var co&=rgb(255,0,0)
var bco&= rgb(210,210,210)+rgb(rnd(46),rnd(46),rnd(46))
Begin:
inc cnt&:ifnot cnt& mod 200:cls bco&:print " Abbruch mit ESC ";:endif
BrEllipse 2*xm&*rnd(),2*ym&*rnd(), a&*rnd(),b&*rnd(), rnd(8^8)
WaitInput 100
case %key=27:End
goto "Begin"

proc BrEllipse : parameters xm&, ym&, a&, b&,co&

    var dx& = 0: var dy& = b&' im I. Quadranten von links oben nach rechts unten
    var a2! = a&*a&: var b2! = b&*b&
    var err! = b2!-(2*b&-1)*a2! : var e2!=0' Fehler im 1. Schritt

    Repeat

        setPixel xm&+dx&, ym&-dy&, co&'  I. Quadrant
        setPixel xm&-dx&, ym&-dy&, co&' II. Quadrant
        setPixel xm&-dx&, ym&+dy&,co&'III. Quadrant
        setPixel xm&+dx&, ym&+dy&, co&'IV. Quadrant
        e2! = 2*err!

        if e2! < ((2*dx&+1)*b2!) : inc dx& : err! = err! + (2*dx&+1)*b2! : endif

            if e2! > (-(2*dy&-1)*a2!) : dec dy&: err! = err! - (2*dy& -1)*a2! : endif

            Until  dy& < 0

            While dx& <= a&

                inc dx&' Gegen den fehlerhaften Abbruch bei flachen Ellipsen mit b=1:
                setPixel xm&+dx&, ym&,co&' -> Spitze der Ellipse vollenden
                setPixel xm&-dx&, ym&,co&

            EndWhile

        EndProc