CR .( lineto moveto and DRAW ) DECIMAL 0 VALUE startx 0 VALUE endx 0 VALUE starty 0 VALUE endy 0 VALUE delta-x 0 VALUE delta-y 0 VALUE sign-x 0 VALUE sign-y VARIABLE error 0 VALUE rx 0 VALUE ry 0 VALUE currentx 0 VALUE currentY 0 VALUE centerx 0 VALUE centery 0 VALUE xincrement 0 VALUE yincrement 0 VALUE xsquare 0 VALUE ysquare ' 4PLOT VALUE ARC4PLOT : x-draw ( -- ) startx starty delta-x FOR AFT 2DUP PLOT delta-y error +! delta-x error @ < IF sign-y + delta-x NEGATE error +! THEN >R sign-x + R> THEN NEXT DROP endy PLOT ; : y-draw ( -- ) startx starty delta-y FOR AFT 2DUP PLOT sign-y + >R delta-x error +! delta-y error @ < IF sign-x + delta-y NEGATE error +! THEN R> THEN NEXT >R DROP endx R> PLOT ; : draw ( --, from startx starty endx endy ) endx startx - DUP 0< IF -1 ELSE 1 THEN TO sign-x ABS TO delta-x endy starty - DUP 0< IF -1 ELSE 1 THEN TO sign-y ABS TO delta-y delta-x delta-y < IF delta-y 2/ error ! y-draw ELSE delta-x 2/ error ! x-draw THEN ; : lineto ( endx endy -- ) TO endy TO endx draw ; : moveto ( startx starty -- ) TO starty TO startx ; : DRAW ( startx starty endx endy -- ) TO endy TO endx TO starty TO startx draw ; cr .( ellipse, 20dec03cht ) : PLOT-+ centerx currentx - centerY currenty + plot ; : PLOT++ centerx currentx + centerY currenty + plot ; : PLOT-- centerx currentx - centerY currenty - plot ; : PLOT+- centerx currentx + centerY currenty - plot ; : 4PLOT PLOT++ PLOT+- PLOT-+ PLOT-- ; cr .( ellipse ) : x-ellipse xsquare TO yincrement rx 2* 1- ysquare * TO xincrement 0 TO currenty 0 error ! rx FOR R@ TO currentx xincrement negate error +! ysquare 2* negate xincrement + TO xincrement BEGIN ARC4PLOT EXECUTE error @ 0< WHILE yincrement error +! xsquare 2* yincrement + TO yincrement currenty 1 + TO currenty REPEAT NEXT ; : y-ellipse ysquare TO xincrement ry 2* 1- xsquare * TO yincrement 0 TO currentx 0 error ! ry FOR R@ TO currenty yincrement negate error +! xsquare 2* negate yincrement + TO yincrement BEGIN ARC4PLOT EXECUTE error @ 0< WHILE xincrement error +! ysquare 2* xincrement + TO xincrement currentx 1 + TO currentx REPEAT NEXT ; : init-ellipse ( startx starty endx endy -- ) rot 2dup + 2/ TO centery - abs 2/ dup TO ry dup * TO ysquare 2dup + 2/ TO centerx - abs 2/ dup TO rx dup * TO xsquare ; : ELLIPSE ( startx starty endx endy -- ) init-ellipse ['] 4PLOT TO ARC4PLOT rx ry < IF y-ellipse ELSE x-ellipse THEN ; ( 10 10 630 470 ellipse ) cr .( arc 15feb04cht ) : x-extend ( x1 y1 -- x2 y2 ) TO yincrement TO xincrement 0 0 8 for xincrement 2/ TO xincrement yincrement 2/ TO yincrement over xincrement + dup * over yincrement + dup * xsquare ysquare */ + xsquare < if yincrement + >r xincrement + r> then next ; : y-extend ( x1 y1 -- x2 y2 ) TO yincrement TO xincrement 0 0 8 for xincrement 2/ TO xincrement yincrement 2/ TO yincrement over xincrement + dup * ysquare xsquare */ over yincrement + dup * + ysquare < if yincrement + >r xincrement + r> then next ; : 4PLOT++> ( starty>0 endy>0 startx>endx ) currentx negate dup >r startx > r> endx < OR if PLOT-+ then currentx dup >r startx > r> endx < OR if PLOT++ then PLOT-- PLOT+- ; : 4PLOT++< ( starty>0 endy>0 startxr startx > r> endx < AND if PLOT-+ then currentx dup >r startx > r> endx < AND if PLOT++ then ; : 4PLOT+- ( starty>0 endy<0 ) currentx negate startx > if PLOT-+ then currentx startx > if PLOT++ then currentx negate endx > if PLOT-- then currentx endx > if PLOT+- then ; : 4PLOT-+ ( starty>0 endy<0 ) currentx negate startx < if PLOT-+ then currentx startx < if PLOT++ then currentx negate endx < if PLOT-- then currentx endx < if PLOT+- then ; : 4PLOT--> ( starty<0 endy<0 startx>endx ) currentx negate dup >r startx < r> endx > AND if PLOT-- then currentx dup >r startx < r> endx > AND if PLOT+- then ; : 4PLOT--< ( starty<0 endy<0 startxr startx < r> endx > OR if PLOT-- then currentx dup >r startx < r> endx > OR if PLOT+- then ; : ARC ( xUL yUL xLR yLR startx starty endx endy ) >R >R >R >R init-ellipse rx ry > if R> centerx - R> centery - x-extend TO starty TO startx R> centerx - R> centery - x-extend TO endy TO endx else R> centerx - R> centery - y-extend TO starty TO startx R> centerx - R> centery - y-extend TO endy TO endx then starty 0< if endy 0< if startx endx < if ['] 4PLOT--< else ['] 4PLOT--> then else ['] 4PLOT-+ then else endy 0< if ['] 4PLOT+- else startx endx < if ['] 4PLOT++< else ['] 4PLOT++> then then then TO ARC4PLOT rx ry < IF y-ellipse ELSE x-ellipse THEN ; : arcdemo clear2 \ rectangle box startxy endxy 10 10 630 470 0 0 0 480 ARC 20 20 620 460 0 480 0 0 ARC 30 30 610 450 0 0 640 0 ARC 40 40 600 440 640 0 0 0 ARC 50 50 590 430 0 0 640 480 ARC 60 60 580 420 640 480 0 0 ARC 70 70 570 410 0 480 640 0 ARC 80 80 560 400 640 0 0 480 ARC 90 90 550 390 0 480 640 480 ARC 100 100 540 380 640 480 0 480 ARC 110 110 530 370 640 480 640 0 ARC 120 120 520 360 640 0 640 480 ARC 0 0 640 480 draw 0 480 640 0 draw ;