Kaleidoscope in TurboForth

[Willsy]

Thought I would show some of the programming concepts in TurboForth. Most people will be able to follow this, I hope

 

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

[sometimes99er]

Very nice.

 

The "normal" Clear (Fctn 4) and Quit (Ftcn =) function as I expect in Classic99 where appropriate, but not with TurboForth v1.0. Anyone else got the same "challenge" ?

 

[Willsy]

That's by design. You can only "break" a program in TF if the program designer allows it

 

There are two words associated with breaking a program:

 

BREAK? ( -- )

Scans for FCTN+4 and terminates the program immediately if detected.

(So, with BREAK? TF will stop the program for you)

 

TERMINAL? ( -- true|false )

Scans for FCTN+4 and pushes TRUE if detected, else FALSE.

(So, you can *detect* a break condition, and then decide what to do in your code)

 

: BREAK-TEST
 0 BEGIN  DUP . 1+ BREAK? AGAIN ;

 

: TERM-TEST
 0 BEGIN  DUP . 1+ TERMINAL? ABORT" Break was pressed - see ya!" AGAIN ;

(in this code, the true/false pushed by TERMINAL? is fed into ABORT" - look up ABORT" in the gloassary

 

FCTN+QUIT is disabled, because it is evil!

 

You can test for it though. KEY? returns 5 when you press QUIT... So...

KEY? ( -- keycode )

: TEST 0 BEGIN DUP . 1+ KEY? 5 = ABORT" Quit was pressed" AGAIN ;

 

[sometimes99er]

Okay. I'm emulator only, so when things get stuck, I'll just reset the emulator. And then I didn't know/expect having to hold the "break" for a while. All good.

 

[Willsy]

Okay. I'm emulator only, so when things get stuck, I'll just reset the emulator. And then I didn't know/expect having to hold the "break" for a while. All good.

 

 

No problem - the only reason you have to hold break for a while is that I am only testing the break key at the end of the loop

[rocky007]

it looks so easy...when it's already done