0 (graphica) (level-0) 1 2 :g:query/level (-n) #0 #12 io ; 3 :g:query/max-colors (-n) #1 #12 io ; 4 :g:query/font (-hw) #2 #12 io ; 5 :g:query/screen (-hw) #3 #12 io ; 6 :g:set-color (n-) #4 #12 io ; 7 :g:pixel (p-) #5 #12 io ; 8 :g:get-pixel (P-) #6 #12 io ; 9 10 :g:point (xy-p) [ #16 shift-left ] dip or ; 11 :g:unpoint (p-xy) [ #16 shift-right ] [ #65535 and ] bi ; 12 13 14 15 save next new 0 (graphica) (drawing-words) 1 2 'g:Functions d:create #32 allot 3 4 :g:hline (pw-) #00 &g:Functions n:add fetch call ; 5 :g:vline (ph-) #01 &g:Functions n:add fetch call ; 6 :g:line (pp-) #02 &g:Functions n:add fetch call ; 7 :g:rect (pp-) #03 &g:Functions n:add fetch call ; 8 :g:circle (pr-) #04 &g:Functions n:add fetch call ; 9 :g:triangle (ppp-) #05 &g:Functions n:add fetch call ; 10 11 :g:dline\ (pl-) #30 &g:Functions n:add fetch call ; 12 :g:dline/ (pl-) #31 &g:Functions n:add fetch call ; 13 14 :g:register (an-) &g:Functions n:add store ; 15 save next new 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 save next new 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 save next new 0 (graphica) (level-0) (hline,_vline) 1 2 :hline (pw-) &g:unpoint dip 3 [ dup-pair g:point g:pixel &n:inc dip ] times drop-pair ; 4 5 &hline #0 g:register 6 7 :vline (ph-) &g:unpoint dip 8 [ dup-pair g:point g:pixel n:inc ] times drop-pair ; 9 10 &vline #1 g:register 11 12 13 14 15 save next new 0 (graphica) (level-0) (line) 1 2 'X var 'Y var 'DX var 'DY var 'SX var 'SY var 'ROT var 3 'T var 'S var 'E var 'B var 'A var 4 'X1 var 'Y1 var 'X2 var 'Y2 var 5 6 :~setup (xy,xy-) 7 !Y2 !X2 !Y1 !X1 @X1 !X @Y1 !Y 8 @X2 @X1 n:sub n:abs !DX 9 @Y2 @Y1 n:sub n:abs !DY 10 @X2 @X1 n:sub n:strictly-positive? [ #1 ] [ #0 ] choose !SX 11 @Y2 @Y1 n:sub n:strictly-positive? [ #1 ] [ #0 ] choose !SY 12 @DY @DX gt? n:abs !ROT 13 @ROT [ @DX !T @DY !S ] [ @DY !T @DX !S ] choose 14 @T #1 shift-left dup !A @S n:sub !E 15 @T @S n:sub #1 shift-left !B ; save next new 0 (graphica) (level-0) (line) 1 2 :draw-line (xyxy-) 3 ~setup @X @Y g:point g:pixel 4 @S [ 5 @E n:positive? [ @B ] [ @A ] choose @E n:add !E 6 @E n:positive? @ROT or [ @SY ] [ #0 ] choose @Y n:add !Y 7 @E n:positive? @ROT not or [ @SX ] [ #0 ] choose @X n:add !X 8 @X @Y g:point g:pixel 9 ] times ; 10 11 :line (pp-) &g:unpoint bi@ draw-line ; 12 13 &line #2 g:register 14 15 save next new 0 (graphica) (level-0) (rect) 1 2 'X1 var 'Y1 var 'X2 var 'Y2 var 3 4 :rect (pp-) 5 &g:unpoint bi@ !Y2 !X2 !Y1 !X1 6 @X1 @Y1 g:point @X2 @Y1 g:point line (top) 7 @X1 @Y2 g:point @X2 @Y2 g:point line (bottom) 8 @X1 @Y1 g:point @X1 @Y2 g:point line (left) 9 @X2 @Y1 g:point @X2 @Y2 g:point line (right) ; 10 11 &rect #3 g:register 12 13 14 15 save next new 0 (graphica) (level-0) (circle) 1 2 'XC var 'YC var 'X var 'Y var 3 4 :octant (xc,yc,x,y) 5 !Y !X !YC !XC 6 @XC @X n:add @YC @Y n:add g:point g:pixel 7 @XC @X n:sub @YC @Y n:add g:point g:pixel 8 @XC @X n:add @YC @Y n:sub g:point g:pixel 9 @XC @X n:sub @YC @Y n:sub g:point g:pixel 10 @XC @Y n:add @YC @X n:add g:point g:pixel 11 @XC @Y n:sub @YC @X n:add g:point g:pixel 12 @XC @Y n:add @YC @X n:sub g:point g:pixel 13 @XC @Y n:sub @YC @X n:sub g:point g:pixel ; 14 15 save next new 0 (graphica) (level-0) (circle) 1 2 'XC var 'YC var 'X var 'Y var 'D var 'R var 3 4 :circle (pr-) 5 !R g:unpoint !YC !XC #0 !X @R [ !Y ] [ !D ] bi 6 @XC @YC @X @Y octant 7 [ &X v:inc 8 @D n:strictly-positive? 9 [ &Y v:dec @X @Y n:sub @R n:mul #2 n:mul @D n:add !D ] 10 [ #2 @R n:mul @X n:mul @D n:add !D ] choose 11 @XC @YC @X @Y octant 12 @Y @X gteq? ] while ; 13 14 &circle #4 g:register 15 save next new 0 (graphica) (level-0) (triangle) 1 2 :triangle (ppp-) &g:unpoint tri@ 3 'abcdef 'abcdefabcd reorder draw-line 4 'abcdef 'abcdefefcd reorder draw-line 5 'abcdef 'abef reorder draw-line ; 6 7 &triangle #5 g:register 8 9 10 11 12 13 14 15 save next new 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 save next new 0 (graphica) (extras) (diagonal-lines) 1 2 :dline\ (pl-) &g:unpoint dip 3 [ dup-pair g:pixel &n:inc bi@ ] times drop-pair ; 4 5 &dline\ #30 g:register 6 7 :dline/ (pl-) &g:unpoint dip 8 [ dup-pair g:pixel &n:dec &n:inc bi* ] times drop-pair ; 9 10 &dline/ #31 g:register 11 12 13 14 15 save next new 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 save next new 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 save next new 0 (LOAD:g) 1 2 '(graphica) needs 3 4 5 6 7 8 9 10 11 12 13 14 15 save next new