mirror of
https://github.com/forth-ev/VolksForth.git
synced 2024-06-01 06:41:37 +00:00
256 lines
16 KiB
Plaintext
256 lines
16 KiB
Plaintext
Screen 0 not modified
|
||
0 \\ *** Graphic - Demonstrationen *** 26may86we
|
||
1
|
||
2 Dieses File enth„lt einige Graphic-Demos, die von den Line-A
|
||
3 Routinen Gebrauch machen.
|
||
4
|
||
5 Hier bietet sich auch dem Anf„nger ein weites Feld f<>r eigene
|
||
6 Versuche. Mit CHECKING ON kann man die gr”bsten Fehler abfan-
|
||
7 gen, alledings auf Kosten der Geschwindigkeit.
|
||
8
|
||
9
|
||
10
|
||
11
|
||
12
|
||
13
|
||
14
|
||
15
|
||
Screen 1 not modified
|
||
0 \ Demo Loadscreen 21sep86we
|
||
1
|
||
2 \needs Graphics include line_a.scr
|
||
3
|
||
4 Onlyforth Graphics also definitions
|
||
5 1 &11 +thru
|
||
6
|
||
7 moire
|
||
8 kaleidos
|
||
9 lines
|
||
10 boxes
|
||
11 rechtecke
|
||
12 rechtecke1
|
||
13
|
||
14
|
||
15
|
||
Screen 2 not modified
|
||
0 \ patterns 18sep86we
|
||
1
|
||
2 1 ?head !
|
||
3 : !pattern ( d -- ) Create , , ;
|
||
4
|
||
5 $C000.C000 !pattern p1 $CCCC.3333 !pattern p2
|
||
6 $C0C0.3030 !pattern p3 $0303.0C0C !pattern p4
|
||
7 $C003.300C !pattern p5 $C3C3.3C3C !pattern p6
|
||
8 $FFFF.8001 !pattern p7 $40A0.8040 !pattern p8
|
||
9 $4444.0000 !pattern p9 $FFFF.2222 !pattern p10
|
||
10 $4444.8282 !pattern p11 $8080.8888 !pattern p12
|
||
11 $0000.1010 !pattern p13 $0101.8080 !pattern p14
|
||
12 $7777.8888 !pattern p15 $7E7E.8181 !pattern p16
|
||
13 $E640.FFFF !pattern p17 $3838.C6C6 !pattern p18
|
||
14
|
||
15 0 ?head !
|
||
Screen 3 not modified
|
||
0 \ patterns 21may86we
|
||
1
|
||
2 Create patterns p1 , p2 , p3 , p4 , p5 , p6 ,
|
||
3 p7 , p8 , p9 , p10 , p11 , p12 ,
|
||
4 p13 , p14 , p15 , p16 , p17 , p18 ,
|
||
5
|
||
6
|
||
7
|
||
8
|
||
9
|
||
10
|
||
11
|
||
12
|
||
13
|
||
14
|
||
15
|
||
Screen 4 not modified
|
||
0 \ diamonds 20sep86we
|
||
1
|
||
2 | : yscale &400 &640 */ ;
|
||
3
|
||
4 : diamond ( size -- )
|
||
5 >r cur_x @ cur_y @
|
||
6 2dup swap r@ - swap 2swap 2over set
|
||
7 2dup r@ yscale - draw
|
||
8 2dup swap r@ + swap draw
|
||
9 2dup r> yscale + draw
|
||
10 2swap draw set ;
|
||
11
|
||
12 : big_diamond 2 wr_mode !
|
||
13 &319 0 &639 &200 &319 &399 0 &200 4 polygon ;
|
||
14
|
||
15
|
||
Screen 5 not modified
|
||
0 \ some usefull definitions 20sep86we
|
||
1
|
||
2 : overwrite 0 wr_mode ! ;
|
||
3 : exorwrite 2 wr_mode ! ;
|
||
4
|
||
5 | : home get_res scr_res ! 0 0 set ;
|
||
6 | : center &320 &200 set ;
|
||
7
|
||
8 | : wait BEGIN pause key? UNTIL &25 0 at
|
||
9 getkey $FF and #esc = abort" stopped" ;
|
||
10
|
||
11 | : logo &117 0 DO ." volksFORTH 83 " LOOP ;
|
||
12
|
||
13 | : titel
|
||
14 &21 &24 at ." *** v o l k s F O R T H *** "
|
||
15 &22 &31 at ." Line-A Graphic " ;
|
||
Screen 6 not modified
|
||
0 \ patterns example 18sep86we
|
||
1
|
||
2 : muster
|
||
3 page overwrite 1 pat_mask !
|
||
4 $10 0 DO patterns I 2* + @ pattern !
|
||
5 $10 I $10 * + dup $80 $80 rectangle LOOP
|
||
6 6 pat_mask !
|
||
7 $10 0 DO patterns I 2* + @ pattern !
|
||
8 $110 I $10 * dup >r + $110 r> - $80 $80 rectangle LOOP
|
||
9 1 pat_mask ! wait ;
|
||
10
|
||
11
|
||
12
|
||
13
|
||
14
|
||
15
|
||
Screen 7 not modified
|
||
0 \ kaleidoskop 20sep86we
|
||
1
|
||
2 | : kaleid exorwrite home center
|
||
3 patterns &30 + @ pattern !
|
||
4 2 0 DO
|
||
5 $40 1 DO $140 0 DO I diamond J +LOOP LOOP
|
||
6 LOOP ;
|
||
7
|
||
8 : kaleidos page big_diamond kaleid wait ;
|
||
9 : kaleid1 page logo kaleid wait ;
|
||
10
|
||
11 : diamonds 1 pat_mask !
|
||
12 $10 0 DO patterns I 2* + @ pattern !
|
||
13 page big_diamond wait LOOP ;
|
||
14
|
||
15
|
||
Screen 8 not modified
|
||
0 \ polygon example 18sep86we
|
||
1
|
||
2 | : (poly ( x y -- )
|
||
3 2dup >r &100 + r> &10 +
|
||
4 2dup >r &10 + r> &90 +
|
||
5 2dup >r &30 - r> &20 +
|
||
6 2dup >r &50 - r> &35 -
|
||
7 2dup >r &30 - r> &85 - 6 polygon ;
|
||
8
|
||
9 : poly page
|
||
10 &10 0 DO patterns I 5 + 2* + @ pattern !
|
||
11 I I * &5 * I &30 * (poly LOOP
|
||
12 &10 0 DO patterns I 5 + 2* + @ pattern !
|
||
13 &510 I I * &5 * - I &30 * (poly LOOP
|
||
14 wait ;
|
||
15
|
||
Screen 9 not modified
|
||
0 \ moire
|
||
1
|
||
2 : moire page curoff exorwrite titel
|
||
3 &400 1 DO
|
||
4 &640 0 DO I &399 &639 I - 0 line J +LOOP
|
||
5 &400 0 DO &639 &398 I - 0 I line J +LOOP
|
||
6 LOOP
|
||
7 1 &399 DO
|
||
8 &640 0 DO I &399 &639 I - 0 line J +LOOP
|
||
9 &400 0 DO &639 &398 I - 0 I line J +LOOP
|
||
10 -1 +LOOP wait ;
|
||
11
|
||
12
|
||
13
|
||
14
|
||
15
|
||
Screen 10 not modified
|
||
0 \ boxes 17sep86we
|
||
1
|
||
2 : boxes exorwrite page
|
||
3 &162 0 DO I I set I dup box
|
||
4 &639 I 2* - I set I dup box
|
||
5 I &399 I 2* - set I dup box
|
||
6 &639 I 2* - &399 I 2* - set I dup box 2 +LOOP
|
||
7 wait ;
|
||
8
|
||
9 | Code a>r 4 SP D) D0 move D0 SP ) sub
|
||
10 6 SP D) D0 move D0 2 SP D) sub Next end-code
|
||
11
|
||
12 : abox ( x1 y1 x2 y2 -- ) a>r 2swap set box ;
|
||
13
|
||
14
|
||
15
|
||
Screen 11 not modified
|
||
0 \ Rechtecke 17sep86we
|
||
1
|
||
2 : rechtecke exorwrite page
|
||
3 0 BEGIN stop? not WHILE
|
||
4 8 + dup >r r@ &640 mod r@ &400 mod
|
||
5 &639 r@ - &640 mod &399 r> - &400 mod
|
||
6 abox REPEAT drop ;
|
||
7
|
||
8 : rechtecke1 page exorwrite fullpattern pattern !
|
||
9 BEGIN stop? not WHILE
|
||
10 &99 3 DO &300 0 DO
|
||
11 I dup dup J + dup a>r rectangle J +LOOP
|
||
12 LOOP
|
||
13 3 &98 DO &300 0 DO
|
||
14 I dup dup J + dup a>r rectangle J +LOOP
|
||
15 -1 +LOOP REPEAT ;
|
||
Screen 12 not modified
|
||
0 \ linien punkte 18sep86we
|
||
1
|
||
2 | : (lines ( abstand -- ) exorwrite
|
||
3 &640 0 DO &640 0 DO I &399 J 0 line dup +LOOP
|
||
4 dup +LOOP drop ;
|
||
5
|
||
6 : lines page home curoff &45 (lines &90 (lines
|
||
7 BEGIN &45 (lines stop? UNTIL &25 0 at ;
|
||
8
|
||
9 : kreis_moire page &320 0 DO
|
||
10 &199 0 DO I dup * J dup * + &300 / 1 and
|
||
11 IF &320 J + &200 I + 1 put_pixel
|
||
12 &320 J - &200 I + 1 put_pixel
|
||
13 &320 J - &200 I - 1 put_pixel
|
||
14 &320 J + &200 I - 1 put_pixel
|
||
15 THEN 2 +LOOP LOOP wait ;
|
||
Screen 13 not modified
|
||
0 \ Sprites 20sep86we
|
||
1
|
||
2 \needs q : q ;
|
||
3 forget q : q ;
|
||
4
|
||
5 : Sprite: Create 5 0 DO 4 I - roll , LOOP
|
||
6 $10 0 DO $FFFF , $0F I - roll , LOOP ;
|
||
7
|
||
8
|
||
9 Create spritebuf &74 allot
|
||
10
|
||
11
|
||
12
|
||
13
|
||
14
|
||
15 -->
|
||
Screen 14 not modified
|
||
0 %0000000000000000 \ 20sep86we
|
||
1 %0111111111111100
|
||
2 %0100000000000000
|
||
3 %0100000000000000
|
||
4 %0100000000000000
|
||
5 %0100000000000000
|
||
6 %0100000000000000
|
||
7 %0111111111110000
|
||
8 %0100000000000000
|
||
9 %0100000000000000
|
||
10 %0100000000000000
|
||
11 %0100000000000000
|
||
12 %0100000000000000
|
||
13 %0100000000000000
|
||
14 %0100000000000000
|
||
15 %0000000000000000 0 0 1 0 1 Sprite: test
|