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