crc/konilo-extensions
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Compare commits

base: crc:2ad825803f0060a965d93da5a7165cba6968f16e
Branches Tags
crc:main
...
compare: crc:fca79f67d3a7ca9741371710c255d5514227d257
Branches Tags
crc:main

2 commits
2ad825803f ... fca79f67d3

Author SHA1 Message Date
Charles Childers
fca79f67d3 add graphica blocks 2024-07-06 12:25:46 -04:00
Charles Childers
e44c81cd9a remove old drawing blocks 2024-07-06 12:23:47 -04:00
2 changed files with 155 additions and 155 deletions
Show stats Expand all files Collapse all files

310
exported/drawing.txt → exported/graphica.txt
View file

@ -1,14 +1,48 @@
0 ilo + graphics extensions
0 (graphica) (level-0)
1
2 ilo/g is an ilo with support for simple monochrome graphics.
3
4 This provides a monochrome, bitmap display with support for
5 the (termina) vocabulary. The extensions here provide a word
6 for drawing pixels, and later other shapes.
7
8 To load:
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 * crc:drawing
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
@ -32,80 +66,97 @@ save next new
14
15
save next new
0 (crc:drawing) (interface-to-framebuffer)
0 (graphica) (level-0) (hline,_vline)
1
2 :pixel (xyc-) #33 io ;
3 :get-pixel (xy-c) #34 io ;
2 :hline (pw-) &g:unpoint dip
3 [ dup-pair g:point g:pixel &n:inc dip ] times drop-pair ;
4
5 :mouse (-xyb) #35 io ;
5 &hline #0 g:register
6
7
8
7 :vline (ph-) &g:unpoint dip
8 [ dup-pair g:point g:pixel n:inc ] times drop-pair ;
9
10
10 &vline #1 g:register
11
12
13
14
15
save next new
0 (crc:drawing) (simple-lines)
0 (graphica) (level-0) (line)
1
2 #1 'Color var-n
3 :set-color (n-) !Color ;
4
5 :hline (xyw-)
6 [ dup-pair @Color pixel &n:inc dip ] times drop-pair ;
7
8 :vline (xyh-)
9 [ dup-pair @Color pixel n:inc ] times drop-pair ;
10
11 :dline\ (xyl-)
12 [ dup-pair @Color pixel &n:inc bi@ ] times drop-pair ;
13
14 :dline/ (xyl-)
15 [ dup-pair @Color pixel &n:dec &n:inc bi* ] times drop-pair ;
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 (crc:drawing) (rect)
0 (graphica) (level-0) (line)
1
2 'X var 'Y var 'H var 'W var
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 (xyhw-) !W !H !Y !X
5 @X @Y @W hline @X @Y @H n:add @W hline
6 @X @Y @H vline @X @W n:add @Y @H vline
7 ;
8
9
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
11 &rect #3 g:register
12
13
14
15
save next new
0 (crc:drawing) (circles)
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 @Color pixel
7 @XC @X n:sub @YC @Y n:add @Color pixel
8 @XC @X n:add @YC @Y n:sub @Color pixel
9 @XC @X n:sub @YC @Y n:sub @Color pixel
10 @XC @Y n:add @YC @X n:add @Color pixel
11 @XC @Y n:sub @YC @X n:add @Color pixel
12 @XC @Y n:add @YC @X n:sub @Color pixel
13 @XC @Y n:sub @YC @X n:sub @Color pixel ;
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 (crc:drawing) (circles)
0 (graphica) (level-0) (circle)
1
2 'XC var 'YC var 'X var 'Y var 'D var 'R var
3
4 :circle (xyr-)
5 !R !YC !XC #0 !X @R [ !Y ] [ !D ] bi
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?
@ -114,51 +165,17 @@ save next new
11 @XC @YC @X @Y octant
12 @Y @X gteq? ] while ;
13
14
14 &circle #4 g:register
15
save next new
0 (crc:drawing) (line)
0 (graphica) (level-0) (triangle)
1
2 'X var 'Y var 'DX var 'DY var 'SX var 'SY var 'ROT var
3 'T var 'S var 'A var 'E var 'B 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 @Y2 @Y1 n:sub n:abs !DY
9 @X2 @X1 n:sub n:sign !SX
10 @Y2 @Y1 n:sub n:sign !SY
11 @DY @DX gt? n:abs !ROT
12 @ROT [ @DX !T @DY !S ] [ @DY !T @DX !S ] choose
13 @T #1 shift-left !A @A @S n:sub !E
14 @T @S n:sub #1 shift-left !B ;
15
save next new
0 (crc:drawing) (line)
1
2 :line (x1,y1,x2,y2-)
3 ~setup @X @Y @Color 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 @Color pixel
9 ] times ;
10
11
12
13
14
15
save next new
0 (crc:drawing) (triangle)
1
2 :triangle (x1,y1,x2,y2,x3,y3-)
3 'abcdef 'abcdefabcd reorder line
4 'abcdef 'abcdefefcd reorder line
5 'abcdef 'abef reorder line ;
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
7 &triangle #5 g:register
8
9
10
@ -168,43 +185,9 @@ save next new
14
15
save next new
0 (crc:turtle)
0
1
2 'X var 'Y var 'C var 'D var 'R var
3
4 :t:raise #0 !C ;
5 :t:lower #1 !C ;
6
7 :t:left [ &X v:dec ] !D ;
8 :t:right [ &X v:inc ] !D ;
9 :t:up [ &Y v:dec ] !D ;
10 :t:down [ &Y v:inc ] !D ;
11 :t:at (xy-) !Y !X ;
12 :t:forward (n-) [ @X @Y @C pixel @D call ] times ;
13
14 #320 #240 t:at t:lower t:right
15
save next new
0 (crc:turtle)
1
2 :t:down-right [ &Y v:inc &X v:inc ] !D ;
3 :t:down-left [ &Y v:inc &X v:dec ] !D ;
4 :t:up-left [ &Y v:dec &X v:dec ] !D ;
5 :t:up-right [ &Y v:dec &X v:inc ] !D ;
6
7 'Rotations d:create #8 comma
8 &t:right comma &t:down-right comma &t:down comma
9 &t:down-left comma &t:left comma &t:up-left comma
10 &t:up comma &t:up-right comma
11
12 :t:rotate
13 &R v:inc @R #8 eq? [ #0 !R ] if &Rotations @R a:fetch call ;
14
15
save next new
0 '(LOAD:crc:turtle)
1
2 '(crc:turtle) needs
2
3
4
5
@ -219,43 +202,60 @@ save next new
14
15
save next new
0 (ilo/x)
0 (graphica) (extras) (diagonal-lines)
1
2 #20 [ #0 #0 #300 #300 I #10 n:mul n:sub line ] indexed-times
3 #20 [ #639 #0 #300 #300 I #10 n:mul n:sub line ] indexed-times
2 :dline\ (pl-) &g:unpoint dip
3 [ dup-pair g:pixel &n:inc bi@ ] times drop-pair ;
4
5 #300 #240 #100 circle
5 &dline\ #30 g:register
6
7
8
7 :dline/ (pl-) &g:unpoint dip
8 [ dup-pair g:pixel &n:dec &n:inc bi* ] times drop-pair ;
9
10
10 &dline/ #31 g:register
11
12
13
14
15
save next new
0 (ilo/x)
0
1
2 #300 'X var-n #200 'Y var-n #50 'R var-n
3 :test
4 [ c:get #0 set-color
5 @X @Y @R circle
6 dup $c eq? [ &X v:dec ] if
7 dup $t eq? [ &X v:inc ] if
8 dup $h eq? [ &Y v:dec ] if
9 dup $n eq? [ &Y v:inc ] if
10 dup $. eq? [ restart ] if
11 dup $p eq? [ &R v:inc ] if
12 dup $y eq? [ &R v:dec ] if
13 drop #1 set-color @X @Y @R circle ] forever
14 ;
15
save next new
0 (LOAD:crc:drawing)
1
2 '(crc:drawing) needs
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

BIN
drawing.blocks → graphica.blocks
View file

Binary file not shown.