XProfan

'In XProfan 11.2a free geschrieben zu Lernzwecken
Windowstyle 31
Windowtitle "Bresenham-Circles"
Window %maxx*.81,%maxy*.81
Cls @Rgb(231,231,221)
'  Kreise in Abstand ab%
var r%= sqrt((@width(%hWnd)/2)^2 + (@height(%hWnd)/2)^2 )
var ab%=14

while r%>0

    brCircle( @width(%hWnd)/2, @height(%hWnd)/2 , r% , \
    @rgb(rnd(100)+155,rnd(155)+100,r% and 255) )
    r% = r% - ab%
    case %MousePressed : break

endwhile

WaitInput
End

proc brCircle

    ' Bresenham-Algorithmus per einen (Achtel-)Kreis
    parameters xmittel%,ymittel%,r%,c%
    var x% = r%
    var y% = 0
    var fehler% = r%
    declare dy%,dx%
    Gosub "DrawPixels"' JAWOLL, EIN GOSUB! DA STAUNSTE, WAS?

    WHILE y% < x%

        dy% = y%*2+1 : REM bei Assembler-Implementierung *2 per Shift
        inc y%
        fehler% = fehler% - dy%

        IF fehler%<0

            dx% = 1 - x%*2
            x% = x% - 1
            fehler% = fehler% - dx%

        ENDIF

        ' Da es um den Bildschirm und nicht ums Plotten geht,
        ' kann man die anderen Oktanten hier mit abdecken:
        Gosub "DrawPixels"

    ENDWHILE

    RETURN
    DrawPixels:
    SETPIXEL xmittel%+x%, ymittel%+y%,c%
    SETPIXEL xmittel%-x%, ymittel%+y%,c%
    SETPIXEL xmittel%-x%, ymittel%-y%,c%
    SETPIXEL xmittel%+x%, ymittel%-y%,c%
    SETPIXEL xmittel%+y%, ymittel%+x%,c%
    SETPIXEL xmittel%-y%, ymittel%+x%,c%
    SETPIXEL xmittel%-y%, ymittel%-x%,c%
    SETPIXEL xmittel%+y%, ymittel%-x%,c%
    Return

EndProc