0
1 GMODE 1 SCREEN \ 32 column mode, black screen
\ define a hatch shape...
: HATCH DATA 4 $AAAA $5555 $AAAA $5555 ;
\ set up characters 144 to 248 with hatch pattern...
: SET-HATCH 248 144 DO HATCH I DCHAR 8 +LOOP ;
SET-HATCH \ execute SET-HATCH
\ define a list of colours for our patterns
CREATE COLORS \ this creates a dictionary entry called COLORS
\ if you *execute* colors, it returns an address to the stack
\ we will now compile a list of color values (bytes) directly
\ to memory...
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,
\ at this point, we have effectively created an array called
\ COLORS. COLORS returns an address, which is the start of the
\ list of data compiled above.
\ now we will set up the colors using the list...
0 CONSTANT TRANSPARENT
: SET-COLORS 14 0 DO
I 18 + \ color set number
COLORS I + C@ \ fetch a color from the list
TRANSPARENT COLOR \ set the color with transparent BG
LOOP ;
SET-COLORS \ execute SET-COLORS
\ we can now remove ALL of the above code and data from memory.
\ we dont need it any more...
FORGET HATCH
\ the above removes everything from HATCH downwards from
\ memory, by resetting the dictionary pointers appropriately.
\ the code below will compile over the top. This is a nice
\ 'overlay' technique to save memory.
\ scroll directions...
0 CONSTANT LEFT 2 CONSTANT RIGHT
4 CONSTANT UP 6 CONSTANT DOWN
\ random number generator...
$8379 C@ VALUE SEED
: RND SEED 31421 * 6927 @ + $8379 C@ TO SEED ;
\ initialise screen coordinates and character code...
0 VALUE X 0 VALUE Y 144 VALUE CHR
\ clear the screen in a fancy way...
: 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 \ clear the screen
BEGIN
RND 300 MOD 1+ 0 DO \ random repeat loop
\ get random x & y for upper left quarter of screen:
RND 16 MOD TO X RND 11 MOD TO Y
\ display character CHR at x and y:
Y X CHR 1 HCHAR
\ display in lower left quarter:
23 Y - X CHR 1 HCHAR
\ display in upper right:
Y 31 X - CHR 1 HCHAR
\ display in lower right:
23 Y - 31 X - CHR 1 HCHAR
\ add 8 to CHR. if CHR>248 then reset to 144:
8 +TO CHR CHR 248 > IF 144 TO CHR THEN
LOOP \ go back to BEGIN until finished
WIPE \ clear the screen
TERMINAL? UNTIL \ repeat, unless FCTN 4 is pressed
PAGE ." Thanks for watching!" CR ;
Just paste into TF and type KSCOPE. Press FCTN 4 to break.
A more compact version of the code, with comments removed follows. Note how the first section of the program is essentially a 'script', and we only retain the second half in memory.
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 ;
Enjoy
