aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

Initial data commit

Browse source
This commit is contained in:
Ingy döt Net 2023-07-01 11:58:00 -04:00
parent 72d218235f
commit f23f22d71c
199087 changed files with 3378941 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

29
Task/Bitmap-Midpoint-circle-algorithm/Forth/bitmap-midpoint-circle-algorithm.fth Normal file
View file

@ -0,0 +1,29 @@
: circle { x y r color bmp -- }
1 r - 0 r 2* negate 0 r { f ddx ddy dx dy }
color x y r + bmp b!
color x y r - bmp b!
color x r + y bmp b!
color x r - y bmp b!
begin dx dy < while
f 0< 0= if
dy 1- to dy
ddy 2 + dup to ddy
f + to f
then
dx 1+ to dx
ddx 2 + dup to ddx
f 1+ + to f
color x dx + y dy + bmp b!
color x dx - y dy + bmp b!
color x dx + y dy - bmp b!
color x dx - y dy - bmp b!
color x dy + y dx + bmp b!
color x dy - y dx + bmp b!
color x dy + y dx - bmp b!
color x dy - y dx - bmp b!
repeat ;
12 12 bitmap value test
0 test bfill
6 6 5 blue test circle
test bshow cr