Bresenham Kreis-Algorithmus

[p. specht]

Solang der Müll nicht in Entwicklungsländern verklappt wird, bitteschön.
Leider käselt er furchtbar, wie auch das nachstehende Versatzteil:

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 für 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

Wird auch keinen Preis mehr gewinnen.