RosettaCodeData/Task/Bitmap-Midpoint-circle-algo.../ERRE/bitmap-midpoint-circle-algo...

38 lines
785 B
Plaintext

PROGRAM BCircle
!$INCLUDE="PC.LIB"
PROCEDURE BCircle(cx%,cy%,r%)
local f%,x%,y%,ddx%,ddy%
f%=1-r% y%=r% ddy%=-2*r%
PSET(cx%,cy%+r%,1)
PSET(cx%,cy%-r%,1)
PSET(cx%+r%,cy%,1)
PSET(cx%-r%,cy%,1)
WHILE x%<y% DO
IF f%>=0 THEN
y%=y%-1
ddy%=ddy%+2
f%=f%+ddy%
END IF
x%=x%+1
ddx%=ddx%+2
f%=f%+ddx%+1
PSET(cx%+x%,cy%+y%,1)
PSET(cx%-x%,cy%+y%,1)
PSET(cx%+x%,cy%-y%,1)
PSET(cx%-x%,cy%-y%,1)
PSET(cx%+y%,cy%+x%,1)
PSET(cx%-y%,cy%+x%,1)
PSET(cx%+y%,cy%-x%,1)
PSET(cx%-y%,cy%-x%,1)
END WHILE
END PROCEDURE
BEGIN
SCREEN(1)
! Draw circles
BCircle(100,100,40)
BCircle(100,100,80)
END PROGRAM