remove old drawing blocks
This commit is contained in:
parent
2ad825803f
commit
e44c81cd9a
2 changed files with 0 additions and 272 deletions
BIN
drawing.blocks
BIN
drawing.blocks
Binary file not shown.
|
|
@ -1,272 +0,0 @@
|
|||
0 ilo + graphics extensions
|
||||
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:
|
||||
9
|
||||
10 * crc:drawing
|
||||
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 (crc:drawing) (interface-to-framebuffer)
|
||||
1
|
||||
2 :pixel (xyc-) #33 io ;
|
||||
3 :get-pixel (xy-c) #34 io ;
|
||||
4
|
||||
5 :mouse (-xyb) #35 io ;
|
||||
6
|
||||
7
|
||||
8
|
||||
9
|
||||
10
|
||||
11
|
||||
12
|
||||
13
|
||||
14
|
||||
15
|
||||
save next new
|
||||
0 (crc:drawing) (simple-lines)
|
||||
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 ;
|
||||
save next new
|
||||
0 (crc:drawing) (rect)
|
||||
1
|
||||
2 'X var 'Y var 'H var 'W 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
|
||||
10
|
||||
11
|
||||
12
|
||||
13
|
||||
14
|
||||
15
|
||||
save next new
|
||||
0 (crc:drawing) (circles)
|
||||
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 ;
|
||||
14
|
||||
15
|
||||
save next new
|
||||
0 (crc:drawing) (circles)
|
||||
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
|
||||
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
|
||||
15
|
||||
save next new
|
||||
0 (crc:drawing) (line)
|
||||
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 ;
|
||||
6
|
||||
7
|
||||
8
|
||||
9
|
||||
10
|
||||
11
|
||||
12
|
||||
13
|
||||
14
|
||||
15
|
||||
save next new
|
||||
0 (crc:turtle)
|
||||
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
|
||||
3
|
||||
4
|
||||
5
|
||||
6
|
||||
7
|
||||
8
|
||||
9
|
||||
10
|
||||
11
|
||||
12
|
||||
13
|
||||
14
|
||||
15
|
||||
save next new
|
||||
0 (ilo/x)
|
||||
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
|
||||
4
|
||||
5 #300 #240 #100 circle
|
||||
6
|
||||
7
|
||||
8
|
||||
9
|
||||
10
|
||||
11
|
||||
12
|
||||
13
|
||||
14
|
||||
15
|
||||
save next new
|
||||
0 (ilo/x)
|
||||
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
|
||||
3
|
||||
4
|
||||
5
|
||||
6
|
||||
7
|
||||
8
|
||||
9
|
||||
10
|
||||
11
|
||||
12
|
||||
13
|
||||
14
|
||||
15
|
||||
save next new
|
||||
Loading…
Reference in a new issue