[TurboForth] Kaleidoscope

Crossposted from http://tech.groups.y...rth/message/457 by willsy

A merry little ditty... You need two disk blocks for this one...

1 GMODE  1 SCREEN : HATCH DATA 4 $AAAA $5555 $AAAA $5555 ;
: SET-HATCH  248 144 DO  HATCH I DCHAR 8 +LOOP ; SET-HATCH
CREATE COLORS  2 C, 3 C, 4 C, 5 C, 6 C, 7 C, 8 C, 9 C,  10 C,
  11 C, 12 C,  13 C,  14 C,  15 C,   0 CONSTANT TRANSPARENT
: SET-COLORS 14 0 DO  I 18 +  COLORS I + C@  TRANSPARENT COLOR 
  LOOP ;  SET-COLORS   FORGET HATCH
0 CONSTANT LEFT  2 CONSTANT RIGHT  4 CONSTANT UP    
6 CONSTANT DOWN  $8379 C@ VALUE SEED 
: RND SEED 31421 * 6927 @ +  $8379 C@ TO SEED ;
0 VALUE X   0 VALUE Y   144 VALUE CHR
: WIPE  16 0 DO 0  0 16 12 PANEL   LEFT SCROLL
  16  0 16 12 PANEL  RIGHT SCROLL  0 12 16 12 PANEL UP SCROLL
  16 12 16 12 PANEL   DOWN SCROLL  LOOP ;  -->

  
  

: KSCOPE  PAGE
  BEGIN
    RND 300 MOD 1+  0 DO
      RND 16 MOD TO X   RND 11 MOD TO Y    
      Y X CHR 1 HCHAR          23 Y -  X CHR 1 HCHAR
      Y  31 X -  CHR 1 HCHAR   23 Y -  31 X -  CHR 1 HCHAR
      8 +TO CHR  CHR 248 > IF 144 TO CHR THEN
    LOOP  WIPE  TERMINAL? 
  UNTIL  PAGE ." Thanks for watching!" CR ;
KSCOPE