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 fr 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                   
