XProfan

'la base XProfan11.2a free de https://XProfan.de/start.htm
Windowtitle "BRESENHAM-Algorithmus"
'Schnarch-lente, seulement pour Lernzwecke geproggd de P. Specht
Windowstyle 31
Fenêtre %maxx*.81,%maxy*.81
Cls @Rgb(221,221,221)
var w%=@width(%hWnd)/2
var h%=@height(%hWnd)/2
brline(0,0, 2*w%,2*h%, @rgb(255,0,0))
brline(0,1, w%-1,2*h%, @rgb(0,255,0))
brline(3,0, 2*w%,h%-3, @rgb(0,0,255))
var i%=0
var j!=0

tandis que i%<360

    j!=i%*@pi()/180
    brline(w%,h%,w%+240*cos(j!),h%+240*sin(j!),46603*i%)
    inc i%,1

endwhile

Imprimer "OK, avec LINE statt Einzelpixel mettons wär´s plus rapide gegangen..."
WaitInput
Fin

proc brline

    ' Bresenham-Algorithmus pour ligne number dans beliebigem Oktanten
    parameters xstart%,ystart%,xend%,yend%,c%
    declare i%,el%,pdx%,pdy%,ddx%,ddy%,es%,faute%
    var x% = xstart%
    var y% = ystart%
    var dx% = xend%-xstart%
    var dy% = yend%-ystart%
    var adx% = ABS(dx%)
    var ady% = ABS(dy%)' Absolutbetraege
    var sdx% = int((dx%>0)-(dx%<0))' Signum-Funktion
    var sdy% = int((dy%>0)-(dy%<0))

    IF adx% > ady%

        pdx% = sdx%
        pdy% = 0
        ddx% = sdx%
        ddy% = sdy%
        es%  = ady%
        el%  = adx%

    ELSE

        pdx% = 0
        pdy% = sdy%
        ddx% = sdx%
        ddy% = sdy%
        es%  = adx%
        el%  = ady%

    ENDIF

    faute% = el%/2' el% gibt aussi Nombre de trop zeichnenden Pixel à
    i%=1

    tandis que i% <= el%

        faute% = faute% - es%

        IF faute% < 0

            faute% = faute% + el%
            x% = x% + ddx%
            y% = y% + ddy%

        ELSE

            x% = x% + pdx%
            y% = y% + pdy%

        ENDIF

        SETPIXEL x%,y%, x%*Y%*3' ou bien c%, wäre Punktfarbe
        inc i%

    endwhile

endproc