From fca79f67d3a7ca9741371710c255d5514227d257 Mon Sep 17 00:00:00 2001 From: Charles Childers Date: Sat, 6 Jul 2024 12:25:46 -0400 Subject: [PATCH] add graphica blocks --- exported/graphica.txt | 272 ++++++++++++++++++++++++++++++++++++++++++ graphica.blocks | Bin 0 -> 65536 bytes 2 files changed, 272 insertions(+) create mode 100644 exported/graphica.txt create mode 100644 graphica.blocks diff --git a/exported/graphica.txt b/exported/graphica.txt new file mode 100644 index 0000000..ceeeb45 --- /dev/null +++ b/exported/graphica.txt @@ -0,0 +1,272 @@ + 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 diff --git a/graphica.blocks b/graphica.blocks new file mode 100644 index 0000000000000000000000000000000000000000..d692df706e17eec96c134ebe6f58e2a22a72db68 GIT binary patch literal 65536 zcmeI4&2JpX5ykbV6d@oq4F_T**@x(mkt636z=7;T0y_xSvLyzHlGynYFZtW^e#kta zF_@X%`Ex%BjGQ?55m9u zU-CZ}t_8O%rGw+p!7pVi?9cCy!oLLU3m@R1{??~o^uKivznjSaUh`N99|UA$T`*Vl!Y{h|hfuT}mI5{MZ(oV`tU|Ko>QFIr*P8?UyJ&av~cxp5l3_ZVt$gZs>2@ z(;j)B3#7pk{}dDxU5w7M}gn(1==%y z3EpE#?>jbV~n(+p@KfV<6V~*cs%5=hh5+@fro zn5UJWcbc2Z&-16`_j{gWlYgD;=+^cpMxK)2YyQ~ew=aWJQ~qfa`SE)t9Gm>e&Duu~ zq~XKR2UvdEOxgdr>Pk2^`LQ{2p#yx1O z=mWnU=*RY_-5CE_`*5IyW3c}^`JeQ%AP?9?{$twzEZ4dIw)Xe_N6dx~B;Lm-vIkIC z0`^}C_{Jgs_sMrZ+hY%Njri-+}U-_9>a$dio9jo*4c4p1bwM zS}S3wFaJ#+`lRi9fpy3Is1j(;ywLsJoO5q#oPXG2ivPaPTWVvQqHFX|9((wn8fE53 zDIFY#4)A|t`w{lD|AQaxUB~#p|No87UH#vb?~AXy|1|@br}&Tm^Ih)vzx%gMN&i7~ z5DtU`hvEP+4!)h(btSN;6Ymh)?sEPgp8c;hUImNO!KG~S`^GNB0`S0R8S4MArv8=c zJ;qpn>OIC-{a0)HQ$N@Lwd%hVz7|RtK7+C;AfNluX4sc{o=+VZtN)^}o2vhOP5sN6 zdd55?Y=6gjWAdTw4dix|Ec;z%9gR$bBFWqe+AxS@D79bOn(1WO0z%k{_0lX z{jJmOdAL-5?6{B&@Z3Bl-}2h^UI(ss9{IbzkIUSKI?xI2TJo6GJv2Jap_SKp%i=RT zJb@qlkFgS5zUs@UryN`e?cPAyQqgH{t^J+fhy09N3kUM`0zC@K*4< zbly|bmNwM$%btPn`IS(D-^I7@AN+2pt-J2qyN-C3*p+AaIgDGvh47Vtj5UHzWxLq_ zSmdALBJ#I!n)BAzJJn+^+h}gxm)Zez{#s~bGs>5UPV*Yh)m)>l^<&8OwNOGQw0ffs zo|Rx;4#%+##>TO}$HtlCH_zJzo%&m*cHO~ip9kM64F_1utZUYm%S!3*g*J9ThL=JK zonXC~JB;1#CA9xSs0To&XIg&J>*jh_9U#&;fB% z_30^n*vITcA0BH?A8y0Ej818nleW%I$=8+S8p1lqPOS0w!Vdy#zJw*jYRn_puMXJ1 zr(zxaK4{-{ZgcnNJN1Q2olwH2aaOptUmK(QDPYer`?Ci=F>$s8x&t_jzB4Y}U=CFry3=j=I=M<(YT1HlQ-v&27~ zEq$)-lx}4vzfJ$K7z_?FKF{O1hulLtjopc8iC?^OR??T>F}t-+rgp^c?-PTYMj!tbMF zIObTjl;-^ROd##G>vrU^NzQ+}>mU6F(Lp%yFdR74`5#}3kHlw^_C9{7{k!yxV0#^0 zN^itHzwY%nb$*|#r+*1keaGr33m#qvoc}prutte3S3-NP!#{iwsQ*N`ZPJvx?AX`! zg=FEpQUYmn+U4fI>zt?kDWH=a$ZWZsFO^MwL#7QnYx`J-Q+*suPrXNI>)Aix7_m9~ zM;#EI#$G2s@qT+>kv``n|4Q<wh2i-?#jE=XcmRpdOvq_&NWdm%WGlz7*fvxOeId?-+lq z-adb<&OUUk?p43m#_C>A)D7pK{BHc^{QpKE)*imAL$~+`&T7=P_aIC8Q^JMhG3Okk zaMmM^ojR-12Y!2PkZ;#gDgRiw7D&6EH0T6B^Bbj0ppDmz?tPk`H4_GI4;^-uwIp#AQF)Z%}@d4-pJ&@;} z%&mZ5@EV~lZK&rL-_H9R|J`sYy=1gJFvpPr9`NqN--(f-6U-ITZr|!{_`b;N-EFwb zK^wo{!e2ZUN|__@a;yx*8n(% z9qIt+H0C+_LF6`nt%Fh-dm(EXeg7zU9h+19y(qR}t;1p4<%QA}EM5ofcdRe$hkqyC z+7UnSTqwbD5$&)udHQ*Opp3c-jz$NEI{)J{-~#+u3G4~*#oW45x`GGS0ddVbTVW@k z1BvrMdltlp*f*>@Gqum^)UOtTOU(nGa-PBm5=Y_B-U=nm)erm8-ae9eg|x@Be69*mEP9+@&(Lp#64uk{YKsXQ%gahF~I1mnm1K~h85DtU`;XpVL4uk{Y zKsc}&2e$qG&$q7+g1?#Yy@dN8{+`cxeB1PQf4+_I4U}&xwB`Fh-;VjE4dsm4j#0`7 z_oD;fYaH6++ujEL?r*!<&e&(0@BZclcL(UZH2B^l^W+YL?>O)aZ{aH6`%3WlKk6uF zJ-}gfR04W|*XY(9=i7J*zOUW&dEcXBJ<*o?pk5E9wC@S9hUVs!@5FcG6t+UgQ~c+< z?=#_AD8aVRx8J+z8yzkQQ~vKsKhOBT-TWVG3x8(+w~253xYvDramT?f?9L z9pnEFZ!hvug90&)(fp8!k2nWJ} za3CBA2f~4HARGt>!hvug90&*IIKchJ-wIy}FNIeEcOtpxbtP1A(mJ@5ec=H1=1%iU z;GX%7z!hvug90&)(fyHy+f3e+z AX#fBK literal 0 HcmV?d00001