TF, camel, FB Forth fun

[+TheBF]

As the year is drawing to a close you might want to know that Forth is more popular that Scheme and in the same league as Haskell and ML, in the year 2023.

 

TIOBE Index - TIOBE

 

Merry Christmas an a Happy New Year to all.

🎅

[GDMike]

2 hours ago, TheBF said:

As the year is drawing to a close you might want to know that Forth is more popular that Scheme and in the same league as Haskell and ML, in the year 2023.

 

TIOBE Index - TIOBE

 

Merry Christmas an a Happy New Year to all.

🎅

Merry Christmas and happy New Year 2024!

 

[+TheBF]

Here is a word you can tuck away on a TURBO Forth block somewhere.

 

POSTPONE replaces COMPILE and [COMPILE] and so it can make translating ANS Forth code a bit easier.

 

I tried it on TF and it seems to work.

 

: POSTPONE ( <name> -- )
 \ replaces COMPILE and [COMPILE]
    BL WORD FIND DUP 0= ABORT" POSTPONE can' find"
    0< IF COMPILE COMPILE
    THEN , ; IMMEDIATE

 

You use POSTPONE like COMPILE or [COMPILE] but it knows the difference between compiling an IMMEDIATE word or a normal word. 

 

Example:  > is normal,  IF is immediate.  No problem

: >IF      POSTPONE >  POSTPONE IF ; IMMEDIATE 

 

 

Test 

: TEST   >IF  ." bigger" ELSE   ." less than"  THEN ; 

 

[+TheBF]

I am doing some New Year cleanup on my Git repository Demos. 

I had made an X,Y reversal in the sprite library which I fixed last year but that meant that sprite demos didn't work. 

 

I found this one and thought I would use it to demonstrate how you don't get good Forth programs

if you try to translate directly from BASIC. 

It can be done but it's ugly and hard as hell to debug.

 

Here is the BASIC program. 

 1 ! Smart Programming Guide for Sprites
 2 !      by Craig Miller
 3 ! (c) 1983 by Miller Graphics
 100 CALL CLEAR
 110 CALL SCREEN(2)
 120 CALL CHAR(46,"0000001818")
 130 CALL SPRITE(#2,94,16,180,1,0,5)
 140 FOR N=0 TO 25
 150     X=RND*192+1
 160     Y=RND*255+1
 170     CALL SPRITE(#3,65+N,16,Y/2+1,X+1)
 180     CALL SOUND(-60,660,8)
 190     CALL POSITION(#3,Y,X,#2,R,C)
 200     CALL SPRITE(#1,46,16,R,C,(Y-R)*.49,(X-C)*.49)
 210     CALL SOUND(476,-3,14)
 220     CALL SOUND(120,110,6)
 230     CALL DELSPRITE(#1)
 240     CALL PATTERN(#3,35)
 250     CALL SOUND(100,220,6)
 260 NEXT N
 270 GOTO 140

 

Here is a more literal translation to Forth. (Camel99 specific ) It has a few changes like named sprites and named colors.

But the main program loop is full of stuff like the BASIC version. 

Spoiler

NEEDS .S     FROM DSK1.TOOLS
NEEDS MOTION FROM DSK1.AUTOMOTION
NEEDS RND    FROM DSK1.RANDOM
NEEDS DB     FROM DSK1.SOUND

VARIABLE X   VARIABLE Y
VARIABLE RR  VARIABLE CC

CREATE ABULLET HEX 0000 , 0018 , 1800 , 0000 ,

: DELSPRITE ( spr# -- ) 0 SWAP SP.PAT VC! ;

DECIMAL
\ name sprites and colors for convenience
 1 CONSTANT AMMO    2 CONSTANT TURRET   3 CONSTANT TARGET
 2 CONSTANT BLACK   5 CONSTANT BLUE    16 CONSTANT WHITE

\ functions to assist translation from BASIC 
: (Y-RR)/2  ( -- n)  Y @ RR @ -  2/ ;
: (X-CC)/2  ( -- n)  X @ CC @ -  2/ ;
: SOUND1   ( t Hz db -- ) GEN1  DB  HZ  MS  MUTE  ;
: ?BREAK   ?TERMINAL IF  STOPMOTION CR ." BREAK"  ABORT  THEN ;


: RUN
( 100) CLEAR
( 110) BLUE SCREEN  10 0 AT-XY ." Camel99 Forth"
( 120) ABULLET [CHAR] . CHARDEF
( 130) [CHAR] ^ WHITE 1 180 TURRET SPRITE   
       5 0 TURRET MOTION
       AUTOMOTION

( 140) BEGIN 
        25 0 DO
( 150)    192 RND 1+ Y !
( 160)    255 RND 1+ X !
( 170)    [CHAR] A I +  WHITE   X @ 1+  Y @ 2/   TARGET SPRITE
( 180)    660 8 50 SOUND1
( 190)    TARGET POSITION X ! Y !    TURRET POSITION  CC !  RR ! 
( 200)    [CHAR] . WHITE RR @ CC @  AMMO SPRITE  
          (Y-RR)/2 (X-CC)/2 AMMO MOTION
( 210)    2 NOISE -14 DB 430 MS MUTE
( 220)    120 110 -6 SOUND1 
( 230)    AMMO DELSPRITE
( 240)    [CHAR] # 3 PATTERN
( 250)    100 220 -6 SOUND1
          ?BREAK 
( 260)   LOOP
( 270) AGAIN ;

 

 

And here is something that is more Forth style.  Notice it has NO  variables. 

Once you know that all the sprite information is stored in VDP RAM already

and that the sprite functions just read and write that memory then variables

become duplicated data storage. Pointless.

 

For example to create sprite #3 in the same position as sprite #2,  we just

replace the X,Y parameters of the SPRITE creator with the POSITION function.  

 

\ ascii    color    x  y       Spr#
 [CHAR] .   15    2 POSITION   3  SPRITE  

 

Random number example. 

If we know we will need random x and y values we don't need variables. 

We just put them on the data stack when we need them. 

\ return random coordinates 
: RNDX  ( -- x) 255 RND 1+ ;
: RNDY  ( -- y) 192 RND 1+ ;

 

So here is the end result where we have factored out parts of the original program in to easier to debug pieces. 

This would make BASIC more complicated but allows Forth programs to be easier to understand IMHO. 

Spoiler

\ Camel99 kernel is bare-bones. 
\ Extras must be compiled into system
NEEDS .S     FROM DSK1.TOOLS
NEEDS MOTION FROM DSK1.AUTOMOTION
NEEDS RND    FROM DSK1.RANDOM
NEEDS DB     FROM DSK1.SOUND

\ character definition for the bullet 
CREATE ABULLET HEX 0000 , 0018 , 1800 , 0000 ,

DECIMAL
\ name the sprites 
 1 CONSTANT AMMO    2 CONSTANT TURRET   3 CONSTANT TARGET

\ Name the colors
 2 CONSTANT BLACK   5 CONSTANT BLUE    16 CONSTANT WHITE

\ words to make it more like BASIC 
: SOUND1   ( t Hz db -- ) GEN1  DB  HZ  MS  MUTE ;
: ?BREAK   ?TERMINAL IF  STOPMOTION CR ." BREAK"  ABORT  THEN ;

\ return random coordinates 
: RNDX  ( -- x) 255 RND 1+ ;
: RNDY  ( -- y) 192 RND 1+ ;

: TURRET-SPRITE 
\    ascii    colr x  y   spr# 
    [CHAR] ^ WHITE 1 180 TURRET SPRITE   
    5 0 TURRET MOTION ;

: TARGET-SPRITE ( char --) 
\   colr     x       y        spr# 
    WHITE  RNDX 1+  RNDY 2/  TARGET SPRITE ;    

\ function computes motion vector between 2 SPRITES x,y
: DELTA ( x y x2 y2  -- x' y')  
        ROT  - 2/  >R   \ delta Y pushed to Rstack 
        SWAP - 2/       \ delta X    
        R> ;            \ bring back delta Y  

: DELSPRITE ( spr# -- ) 0 SWAP SP.PAT VC! ;

: SHOOT 
\ next line sets the motion vector for the AMMO sprite
\ by reading the sprite positions and computing the delta
    TURRET POSITION  TARGET POSITION DELTA  AMMO MOTION

\ generate noise using sound chip API
    2 NOISE -14 DB 430 MS MUTE

    120 110 -6 SOUND1 
    AMMO DELSPRITE
    [CHAR] # TARGET PATTERN
    100 220 -6 SOUND1    
;

: RUN 
    CLEAR  
    BLUE SCREEN 
    10 0 AT-XY ." Camel99 Forth"
    ABULLET [CHAR] . CHARDEF
    TURRET-SPRITE 
    AUTOMOTION
    BEGIN 
        25 0 
        DO
        \ put target sprite on the screen with a sound     
            [CHAR] A  I +  TARGET-SPRITE 
            50 660 8 SOUND1

        \ put the AMMO sprite at the turret position 
            [CHAR] . WHITE  TURRET POSITION AMMO SPRITE  
            SHOOT 
           
            ?BREAK 
        LOOP
    AGAIN ;

 

 

[+TheBF]

Looking at my demos on GitHub I came across a program from the TI BASIC manual that

I translated to Forth to demonstrate how it could be done for the Forth student. 

 

The program puts random colored squares on the screen with a musical note. 

The code to compute the note uses exponential floating point math.

That's a lot of compute to just make a tone.

 

In my first version, I just punted and made a sound with a random frequency

but it's not a "legal" note from the western music chromatic scale. 

 

Now that I am a member of a community orchestra I could not let that stand.

 

The code to compute a random note in BASIC is:

160 N=INT(24*RND+1)
170 FREQ=110*(2^(1/12))^N 

 

It's not hard to generate N in Forth.

: N   ( -- n)  24 RND 1+ ; 

 

But without floating point I was scratching my head for a bit on how to do line 170. 

 

Turns out 1/12= .0833333  repeated

and 2^1/12 ~=1.059463 

 

This means that given a frequency all we have to do is multiply by 1.059463 to raise the frequency by one semi-tone.

 

For the non-music student every note on a piano keyboard is one semitone apart, if you press white and black keys in order. 

 

So now we have a multiplier to move up note by note on the keyboard.

That's something we can handle with integer math. 

 

How?  With the Forth's magic */  operator. 

 

Star-slash, as it is called, takes 3 arguments:  an input, a multiplier and a divisor.

The multiplication in */  generates a 32 bit result so up to 4,294,967,296.

This means it does not overflow easily.  The divisor is then used to "scale" that result back to the range we need for our little 16 bit integers. 

 

So this simple word takes a note and bumps to the next semitone.

At least that's the theory.

: NOTE+   ( freq -- freq')   10595 10000 */ ;  

 

When I compared the output of NOTE+ to a table of note frequencies this version of NOTE+ begins to run flat (notes are lower than correct) after the first octave. 

This version is closer to the correct pitch but still not perfect.

: NOTE+ ( freq -- ) 10570 10000 */ 1+ ;

 

Then we need a way to get any semitone.  If we put NOTE+ in a loop and start at the lowest note TI-99 can play we get this. 

: NOTE ( n -- freq) 110  SWAP 0 ?DO  NOTE+ LOOP  ;   

  However if you really want proper tuning it is probably better to use a table and look up the frequency like this: 

Spoiler

\ NOTES.FTH gives you a table of note frequencies     Feb 1 2024  B Fox 

\ these are as accurate to pitch as TI-99 can produce
CREATE NOTES[]   \ create a name for the data
\ put the number into memory with the comma operator
\ FREQ    MIDI Note 
\ ----    ---- ----
  110 , \  45	A2   
  117 , \  46	A#2/Bb2
  123 , \  47	B2
  131 , \  48	C3
  139 , \  49	C#3/Db3
  147 , \  50	D3
  156 , \  51	D#3/Eb3
  165 , \  52	E3
  175 , \  53	F3
  185 , \  54	F#3/Gb3
  196 , \  55	G3
  208 , \  56	G#3/Ab3
  220 , \  57	A3
  233 , \  58	A#3/Bb3
  247 , \  59	B3
  262 , \  60	C4 (middle C)
  277 , \  61	C#4/Db4
  294 , \  62	D4
  311 , \  63	D#4/Eb4
  330 , \  64	E4
  349 , \  65	F4
  370 , \  66	F#4/Gb4
  392 , \  67	G4
  415 , \  68	G#4/Ab4
  440 , \  69	A4 concert pitch
  466 , \  70	A#4/Bb4
  494 , \  71	B4
  523 , \  72	C5
  554 , \  73	C#5/Db5
  587 , \  74	D5
  622 , \  75	D#5/Eb5
  659 , \  76	E5
  698 , \  77	F5
  740 , \  78	F#5/Gb5
  784 , \  79	G5
  831 , \  80	G#5/Ab5
  880 , \  81	A5
  932 , \  82	A#5/Bb5
  988 , \  83	B5
  1047 , \  84	C6
  1109 , \  85	C#6/Db6
  1175 , \  86	D6
  1245 , \  87	D#6/Eb6
  1319 , \  88	E6
  1397 , \  89	F6
  1480 , \  90	F#6/Gb6
  1568 , \  91	G6
  1661 , \  92	G#6/Ab6
  1760 , \  93	A6
  1865 , \  94	A#6/Bb6
  1976 , \  95	B6
  2093 , \  96	C7
  2217 , \  97	C#7/Db7
  2349 , \  98	D7
  2489 , \  99	D#7/Eb7
  2637 , \ 100	E7
  2794 , \ 101	F7
  2960 , \ 102	F#7/Gb7
  3136 , \ 103	G7
  3322 , \ 104	G#7/Ab7
  3520 , \ 105	A7
  3729 , \ 106	A#7/Bb7
  3951 , \ 107	B7
  4186 , \ 108	C8

\ make word that indexes into the table and fetches the frequency
: ]NOTE ( n -- freq) CELLS NOTES[] +  @ ;

 

 

The final program is here: 

CAMEL99-ITC/DEMO/RNDCOLOR.FTH at master · bfox9900/CAMEL99-ITC · GitHub

 

 

Edited February 2 by TheBF
typo

[+TheBF]

Over in the Assembly Language thread @Retrospect asked for a translation of his bouncing ball program into Assembler.

 

Well... we could not leave it up to the ALC coders to have all the fun around here now could we?  

 

Here is a Forth version with all the BASIC lines removed. It is not completely "idiomatic" Forth. There are more variables than would be typically used but I tried to demonstrate the typical way we use Forth by factoring things into small pieces. 

 

The delay here uses the word TICKS which delays based on "ticks" of the 9901 timer.  My MS word limits the smallest delay to 32mS which is too big to see speed. 

 

I was a bit cheeky and used @Retrospect 's comment text to name the Forth words, to show how well named code requires less comments. 

 

 

Spoiler

\ ###################
\ #                 #
\ #  BOUNCING BALL  #
\ #                 #
\ #  BY RETROSPECT  #
\ #                 #
\ ###################

\ Translated to Camel99 Forth by @theBF

\ We need to compile some TI-99 words into the standard Forth
\ INCLUDE DSK1.TOOLS   \ for debugging 
INCLUDE DSK1.GRAFIX  \ Graphics 1 mode with TI BASIC look-alike commands 
INCLUDE DSK1.SOUND   \ sound chip contolr 
INCLUDE DSK1.INPUT   \ gives us an input statement 

\ Variables are declared instead of commented. Changed names for clarity
    VARIABLE X     \ x position 
    VARIABLE Y     \ y position 
    VARIABLE DX    \ x vector 
    VARIABLE DY    \ y vector  
    VARIABLE T     \ delay between movements  	
    VARIABLE SOUND \ sound flag   
    VARIABLE VOL   \ volume 

\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
\ Forth does not translate from BASIC in straight line like Assembler.
\ In Forth it's better to create the parts we need as named sub-routines
\ then put them all together at the end as a final program

: DEFINE_THE_BALL
    S" 3C7EFFFFFFFF7E3C" 42 CALLCHAR 
    42 SET# 5 1 COLOR   
;

: VARS_TO_START  
  1 DUP X !  Y ! 
  1 DUP DX !  DY ! 
  SOUND ON 
; 

: ASK_DELAY 
   CLEAR 
   0 0 AT-XY ." DELAY VAL?"
   0 1 AT-XY   T #INPUT 
;

: DISPLAY_BALL ( x y -- ) X @ Y @  AT-XY  42 EMIT ; 

: ADD_DIRECTION ( dx dy --) 
   Y @ +   Y !   
   X @ +   X ! 
;

\ reverse a direction variable with one command 
: REVERSE  ( var -- ) DUP @ NEGATE SWAP !  ;

\ no need to duplicate these statements. Give them a name. 
: RESET_SOUND     SOUND ON   0 VOL !  ;

\ eliminate some if statements with a system function 
: BETWEEN  ( n lo hi -- ?) 1+ WITHIN ;

\ return true if we are out of range 
: HORZLIMIT? ( n -- ?)  1 30 BETWEEN 0= ;
: VERTLIMIT? ( n -- ?)  1 21 BETWEEN 0= ;

: ?BOUNCE  ( x y -- ) 
    VERTLIMIT? IF  DY REVERSE  RESET_SOUND  THEN 
    HORZLIMIT? IF  DX REVERSE  RESET_SOUND  THEN ; 

\ logic built in: if SOUND is on do the sound 
: PING ( -- ) 
    SOUND @ TRUE =   
    IF 
      GEN1 900 HZ  VOL @ DB  
      GEN2 901 HZ  VOL @ DB 
      4 VOL +!
      VOL @ 30 > 
      IF  
        SOUND OFF  
        SILENT  
      THEN 
    THEN 
;

\ TICKS delays in video frames (16ms)
: KILL_SOME_TIME   T @ TICKS ;  

: ERASE_BALL     ( x y --) AT-XY  SPACE ;

: RUN 
    DEFINE_THE_BALL 
    VARS_TO_START 
    ASK_DELAY
    CLEAR 
    BEGIN 
      X @  Y @ ERASE_BALL           \ erase current position 
      DX @ DY @ ADD_DIRECTION       \ compute next location  
      DISPLAY_BALL                 
      X @ Y @ ?BOUNCE               \ test new x y for walls 
      PING                          
      KILL_SOME_TIME                \ self explanatory name 

      ?TERMINAL                     \ check for break key 
    UNTIL  
    SILENT 
;

 

 

Here is the program with the BASIC lines left in for comparison.

Spoiler

\ ! ###################
\ ! #                 #
\ ! #  BOUNCING BALL  #
\ ! #                 #
\ ! #  BY RETROSPECT  #
\ ! #                 #
\ ! ###################

\ Translated to Camel99 Forth by @theBF

\ * We need to compile some TI-99 words into the standard Forth
INCLUDE DSK1.TOOLS   \ for debugging 
INCLUDE DSK1.GRAFIX  \ Graphics 1 mode with TI BASIC look-alike commands 
INCLUDE DSK1.SOUND   \ sound chip contolr 
INCLUDE DSK1.INPUT   \ gives us an input statement 

\ ! ------------------------------------------------------------------
\ ! VARIABLES USED;
\ !
\ Variables are declared instead of comments. changed names for clarity
    VARIABLE X    \ x position 
    VARIABLE Y    \ y position 
    VARIABLE DX   \ x vector 
    VARIABLE DY   \ y vector  
    VARIABLE T    \ delay between movements  	
    VARIABLE SOUND   \ sound flag   
    VARIABLE VOL  \ volume 
\ ! -------------------------------------------------------------------

\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
\ Forth does not translate from BASIC in straight line like Assembler.
\ In Forth it's better to  create the parts we need as named sub-routines
\ then put them all together at the end as a final program

\ 100 ! BOUNCING BALL PROGRAM
\ 110 !
\ 120 !
\ 130 !
\ 140 ! CLEAR THE SCREEN
\ 150 CALL CLEAR

\ 160 !
\ 170 !
\ 180 ! DEFINE THE BALL & COLORS
\ 190 CALL CHAR(42,"3C7EFFFFFFFF7E3C")
\ 200 CALL COLOR(2,5,1,3,5,1,4,5,1)

\ GRAFIX library provides some words like TI BASIC 
: DEFINE_THE_BALL
    S" 3C7EFFFFFFFF7E3C" 42 CALLCHAR 
\ set no.s are different than BASIC. 
\ SET# word means I don't need to remember that stuff 
    42 SET# 5 1 COLOR   
;

\ 210 !
\ 220 !
\ 230 !
\ 240 ! VARIABLES TO START
\ 250 X,Y=2
\ 260 DX,DY=1
\ 270 SOUND=0

: VARS_TO_START  
  1 DUP X !  Y ! 
  1 DUP DX !  DY ! 
  SOUND ON 
; 

\ 280 !
\ 290 !
\ 300 !
\ 310 ! ASK USER DELAY VAL
\ 320 DISPLAY AT(1,1):"DELAY VAL?"
\ 330 ACCEPT AT(3,1):T
\ 340 CALL CLEAR

: ASK_DELAY 
   CLEAR 
   0 0 AT-XY ." DELAY VAL?"
   0 1 AT-XY   T #INPUT 
;

\ 350 !
\ 360 !
\ 370 !
\ 380 ! DISPLAY THE BALL
\ 390 CALL HCHAR(X,Y,42)

: DISPLAY_BALL ( x y -- ) X @ Y @  AT-XY  42 EMIT ; 

\ 400 !
\ 410 !
\ 420 !
\ 430 ! KEEP THE OLD COORDS
\ 440 TEMPX=X
\ 450 TEMPY=Y
( Don't need TEMPX TEMPY. keep copies on the DATA stack )


\ 460 !
\ 470 !
\ 480 !
\ 490 ! ADD DX & DY
\ 500 X=X+DX
\ 510 Y=Y+DY

: ADD_DIRECTION ( dx dy --) 
   Y @ +   Y !   
   X @ +   X ! 
;


\ Here is where we can use "words" to simplify all this logic
\ 520 !
\ 530 !
\ 540 !
\ 550 ! IF AT BOUNDARIES, ADD DX AND DY 
\ 560 IF X>23 THEN DX=-DX :: SOUND=1 :: VOL=0
\ 570 IF X<2 THEN DX=-DX :: SOUND=1 :: VOL=0
\ 580 IF Y>30 THEN DY=-DY :: SOUND=1 :: VOL=0
\ 590 IF Y<2 THEN DY=-DY :: SOUND=1 :: VOL=0 


\ reverse a direction variable with one command 
: REVERSE  ( var -- ) DUP @ NEGATE SWAP !  ;

\ no need to duplicate these statements. Give them a name. 
: RESET_SOUND     SOUND ON   0 VOL !  ;

\ eliminate some if statements with a system function 
: BETWEEN  ( n lo hi -- ?) 1+ WITHIN ;

\ return true if we are out of range 
: HORZLIMIT? ( n -- ?)  1 30 BETWEEN 0= ;
: VERTLIMIT? ( n -- ?)  1 21 BETWEEN 0= ;

: ?BOUNCE  ( x y -- ) 
    VERTLIMIT? IF  DY REVERSE RESET_SOUND  THEN 
    HORZLIMIT? IF  DX REVERSE RESET_SOUND  THEN ; 
    

\ 600 !
\ 610 !
\ 620 !
\ 630 ! IS SOUND"ON"?
\ 640 IF SOUND=0 THEN 710
\ 650 VOL=VOL+4 :: IF VOL<30 THEN 670
\ 660 SOUND=0 :: CALL SOUND(-1,110,30):: GOTO 710
\ 670 CALL SOUND(-150,900,VOL,901,VOL)

: PING ( -- ) 
    SOUND @ TRUE =    \ logic built in: if SOUND is on do the sound 
    IF 
    \ Camel99 has sound words for generator, frequency & volume 
    \ we use Standard Forth's MS for milliseconds of sound delay 
      GEN1 900 HZ  VOL @ DB  
      GEN2 901 HZ  VOL @ DB 
      4 VOL +!
      VOL @ 30 > 
      IF  
        SOUND OFF  
        SILENT  
      THEN 
    THEN 
;

\ 680 !
\ 690 !
\ 700 !
\ 710 ! KILL SOME TIME
\ 720 FOR DELAY=1 TO T
\ 730 NEXT DELAY

\ TICKS delays in video frames (16ms)
: KILL_SOME_TIME   T @ TICKS ;  

\ 740 !
\ 750 !
\ 760 !
\ 770 ! DISPLAY NEW BALL
\ 780 CALL HCHAR(TEMPX,TEMPY,32,1)
\ 781 CALL HCHAR(X,Y,42,1)

: ERASE_BALL ( x y --) AT-XY  SPACE ;

\ 790 !
\ 800 !
\ 810 !
\ Make the final program loop 
: RUN 
    DEFINE_THE_BALL 
    VARS_TO_START 
    ASK_DELAY
    CLEAR 
    BEGIN 
      X @  Y @ ERASE_BALL           \ erase current position 
      DX @ DY @ ADD_DIRECTION       \ compute next location  
      DISPLAY_BALL                 
      X @ Y @ ?BOUNCE               \ test new x y for walls 
      PING                          
      KILL_SOME_TIME                \ self explanatory name 

      ?TERMINAL                     \ check for break key 
    UNTIL  
    SILENT 
;
\ 820 ! REPEAT THE LOOP
\ 830 GOTO 440

 

 

Edited February 14 by TheBF
Updated code

[Retrospect]

Love it   

[+TheBF]

I have been going through my demo programs to make sure they still work with the latest version of Camel99 Forth.

I found this BASIC program that I think was written by @sometimes99er but I am not sure about the source.

 

 1 ! TILTED BOXES ILLUSION 
 100 call clear
 102 call screen(6)
 103 call char(33,"30C0030C30C0030C0C03C0300C03C03")
 110 call box(4,9,29,11,33)
 111 call box(10,13,23,18,34)
 112 goto 112
 1120 sub box(x1,y1,x2,y2,c)
 1130     for y=y1 to y2
 1140         call hchar(y,x1,c,x2-x1+1)
 1150     next y
 1160 subend

 

I had originally avoided doing the general purpose BOX function because it's harder to manage 5 arguments on the stack.

The BASIC program using a SUB program makes it very simple. 

I decided to try to make the BOX function but I had to resort to one variable. 

 

This would be very simple if we use local variables or 4 more global variables, but here is my solution.

I resorted to simplifying the x,y coordinates to a VDP address, a height and length. 

This allowed the use of VFILL which is like HCHAR but uses a VDP address rather than x,y coordinates. 

This was harder than I thought it would be. 

 

NEEDS DUMP       FROM DSK1.TOOLS
NEEDS GRAPHICS   FROM DSK1.GRAFIX

DECIMAL
S" 30C0030C30C0030C0C03C0300C03C030" 126 CALLCHAR

\ convert x,y coordinates to VDP address, height and length 
: HEIGHT   ( x1 y1 x2 y2 -- x1 y1 x2 y2 n) DUP  3 PICK - 1+ ;
: LENGTH   ( x1 y1 x2 y2 -- x1 y1 x2 y2 n) OVER 4 PICK -  ;
: VADDR   ( x1 y1 x2 y2 --  Vaddr) 2DROP >VPOS ;

\ resorted to 1 temp variable :-(
VARIABLE CHR 

: BOX   ( x1 y1 x2 y2 char -- ) 
      CHR !
      HEIGHT >R   
      LENGTH >R
      VADDR  R> R>  ( -- Vaddr len hgt)
      0 DO  
          2DUP CHR @ VFILL 
          SWAP C/L @ + SWAP 
      LOOP 
      2DROP
;  

: RUN
    PAGE ." * Tilted Boxes Illusion *"
    6 SCREEN
    BEGIN  
\       x  y    x  y   char      
        6  3   16  7   127 BOX
        4 10   20 15   126 BOX
        2000 MS 

        6  3   16  7   31 BOX
        4 10   20 15   31 BOX
        2000 MS 
       ?TERMINAL
    UNTIL
;

 

[sometimes99er]

30 minutes ago, TheBF said:

I found this BASIC program that I think was written by @sometimes99er but I am not sure about the source.

Yes, I wrote that one. 😉

 

[sometimes99er]

34 minutes ago, TheBF said:

... because it's harder to manage 5 arguments on the stack.

Never thought that would be a problem for Forth ... 🤨
But ain't that kind of your solution anyway !? 🥸

[+TheBF]

1 hour ago, sometimes99er said:

Never thought that would be a problem for Forth ... 🤨
But ain't that kind of your solution anyway !? 🥸

To be honest I didn't think it would be hard either, until I tried to make it.  

In Forth circles it is considered bad form to reach down below the 3rd item on the data stack. 

If you want to use a stack machine it becomes a game to organize things so data arrives at the CPU in the correct order or close to it. 

 

It's the classic issue of registers vs stacks. 

If you need to get at 5 arguments in random order then registers (or locals) are simpler. 

But stacks have the advantage of not requiring loading into registers and saving registers later, so sub-routine and interrupt handling is faster.

No free lunches in this world. 

 

In this case I resorted to one variable for the character and then I used the word PICK to reach into the stack to compute the height and length of the box.

This could be argued to be bad form, but on the 9900 the number of instructions to do OVER  ( copy the 2nd item to the top of the stack) is the same as

getting any item in the stack onto the top. 

 

At the end of the day modern Standard Forth has local variables like other languages which you can use when you have complex math.

But locals take up memory to implement so on small machines I survive without them. 

It just requires a bit more thought sometimes.

 

 

 

[+TheBF]

I was reading some discussions on GROM and SAMS in another thread and realized that I had not extended my DUMP utility to dump GROM.

Here is some code to read and write GROM using only Forth.  It's transportable to other systems I think.

 

><  is SWPB in FbForth. 

SPLIT is code word that splits and integer into 2 bytes. Easy to make one in FbForth but it is a name conflict with SPLIT screen mode. 

HEX 
: SPLIT    ( AABB -- BB AA ) DUP  FF AND  SWAP  SWPB  FF AND ; 

 

I don't have a GRAM device so I have not tested the write words but I think they are correct. 

HEX
\ GROM access port addresses 
9800 CONSTANT Gread  \ read data (GROM base)
9C00 CONSTANT Gwrite \ write data
9C02 CONSTANT Gaddr  \ write address 

: GROM   ( addr -- ) DUP Gaddr ! Gaddr C! ; \ set GROM address

\ read GROM 
: GC@+   ( -- c)  Gread C@ ; \ read char, auto-incr. address
: GC@    ( addr -- c)  GROM GC@+ ;             \ fetch grom character 
: G@     ( addr -- n)  GROM GC@+ ><  GC@+ OR ; \ fetch grom integer 

\ write GROM 
: GC!+   ( c --) Gwrite C! ;
: GC!    ( c addr --) GROM GC!+ ;
: G!     ( n addr --) GROM SPLIT GC!+ GC!+ ; 

 

In Camel99 Forth the DUMP utility uses deferred words MEM@ and MEMC@ to read memory. 

This means we can change them to access any type of memory in the system. (RAM, VDP, SAMS and now GROM) 

: GROMDUMP ( addr len -- ) 
    ['] G@  IS MEM@    
    ['] GC@ IS MEMC@ 
    (DUMP) ;

 

According to nouspikel the BASIC keywords are at address GROM >285C.

Let's see if it works. 

 

[+TheBF]

@Retrospect is kicking the tires on the latest and greatest RXB 2024.  Lots of speed ups in the Rich's new system.

 

The bouncing ball was re-written using CALL IO which gives you background sound lists. 

 

I could not let that go unanswered so here is how you would do it Camel99 Forth. 

The library file ISRSOUND gives you tools to make sound lists in VDP RAM and ISRPLAY will play them.

Spoiler

\ ###################
\ #                 #
\ #  BOUNCING BALL  #
\ #                 #
\ #  BY RETROSPECT  #
\ #                 #
\ ###################

\ Translated to Camel99 Forth by @theBF
\ V2  Adds ISR driven sound player 

INCLUDE DSK1.GRAFIX  \ Graphics 1 mode with TI BASIC look-alike commands 
INCLUDE DSK1.INPUT   \ gives us an input statement 
INCLUDE DSK1.ISRSOUND 

\ make a sound list in VDP RAM 
HEX 
VCREATE EXPLODE
  VBYTE 7,9F,BF,DF,E7,F0,C0,07,5
  VBYTE 1,F1,6
  VBYTE 1,F2,7
  VBYTE 1,F3,8
  VBYTE 1,F4,9
  VBYTE 1,F5,10
  VBYTE 1,F6,11
  VBYTE 1,F7,12
  VBYTE 1,F8,13
  VBYTE 1,F9,14
  VBYTE 1,FA,15
  VBYTE 1,FB,16
  VBYTE 1,FC,17
  VBYTE 1,FD,18
  VBYTE 1,FE,30
  VBYTE 1,FF,0
/VEND
DECIMAL 

  VARIABLE X     \ x position 
  VARIABLE Y     \ y position 
  VARIABLE DX    \ x vector 
  VARIABLE DY    \ y vector  
  VARIABLE T     \ delay between movements  	

: DEFINE_THE_BALL
    S" 3C7EFFFFFFFF7E3C" 42 CALLCHAR 
    42 SET# 5 1 COLOR   
;

: VARS_TO_START  
  1 DUP X !  Y ! 
  1 DUP DX !  DY ! 
; 

: ASK_DELAY 
   CLEAR 
   0 0 AT-XY ." DELAY VAL?"
   0 1 AT-XY   T #INPUT 
;

: ADD_DIRECTION ( dx dy --) 
   Y @ +   Y !   
   X @ +   X ! 
;

: MOVE_BALL 
  X @  Y @ AT-XY  SPACE          \ erase current position 
  DX @ DY @ ADD_DIRECTION       \ compute next location  
  X @ Y @  AT-XY  42 EMIT 
;   

: REVERSE  ( var -- ) DUP @ NEGATE SWAP !  ;
: BETWEEN  ( n lo hi -- ?) 1+ WITHIN ;
: HORZLIMIT? ( n -- ?)  1 30 BETWEEN 0= ;
: VERTLIMIT? ( n -- ?)  1 21 BETWEEN 0= ;

: ?BOUNCE  ( x y -- ) 
  VERTLIMIT? IF EXPLODE ISRPLAY   DY REVERSE   THEN 
  HORZLIMIT? IF EXPLODE ISRPLAY   DX REVERSE   THEN ; 

: RUN 
    DEFINE_THE_BALL 
    VARS_TO_START 
    ASK_DELAY
    CLEAR 
    BEGIN 
      MOVE_BALL          
      X @ Y @ ?BOUNCE 
      T @ TICKS 
      ?TERMINAL
    UNTIL  
;

 

 

Edited February 17 by TheBF
fixed comment

[+Lee Stewart]

Here is a bouncing ball I wrote for fbForth a few years ago.

Spoiler

\ Bouncing Ball
HEX                                      
0 CONSTANT SPDY  
0 CONSTANT SPDX  
0B6 VARIABLE SPY              
07F VARIABLE SPX  
0 VARIABLE SPYWAIT  
0 VARIABLE SPXWAIT        
: SPRESET   
   3 RND 1+  ( delta)
   02 RND IF
      MINUS ' SPDY !
      1 ' SPDX !                             
   ELSE
      ' SPDX !
      -1 ' SPDY !
   THEN                           
   2 RND IF
      SPDX MINUS ' SPDX !
   THEN                       
   SPDY ABS SPYWAIT !
   SPDX ABS SPXWAIT !
   0B6 SPY !  ;         
: WALL?   
   SPX @ DUP 0F9 <
   SWAP 0> AND
   0= IF
      BEEP  
      SPDX MINUS ' SPDX !
      1 SPXWAIT  !
   THEN  ;       
: UPDN?   
   SPY @ -DUP IF
      0B7 < 0=  IF
         HONK  SPRESET
      THEN      
   ELSE
      BEEP  
      SPDY MINUS ' SPDY !
      1 SPYWAIT !  
   THEN  ;       
: MVX   
   -1 SPXWAIT +!  
   SPXWAIT @ 0= IF
      SPDX DUP ABS SPXWAIT !  
      SGN SPX +!  
   THEN  ;                                          
: MVY   
   -1 SPYWAIT +!  
   SPYWAIT @ 0= IF  
      SPDY DUP ABS 
      SPYWAIT !  
      SGN SPY +! 
   THEN ;
: BOUNCE   
   VDPMDE @ 
   GRAPHICS  
   8 SCREEN  CLS  
   1 83D6 !           
   0000 2030 7A7F FFFF 1 CHAR                                  
   3C7E FFFF FFFF 7E3C 0 SPCHAR                                
   0B 0 SPRCOL                                                 
   0 17 20 1 HCHAR                                             
   SPRESET                                                     
   SPX @ SPY @ 0B 0 0 SPRITE                                   
   BEGIN                                                       
      MVX                                                     
      MVY                                                     
      SPX @ SPY @ 0 SPRPUT                                    
      WALL?                                                   
      UPDN?                                                   
      ?TERMINAL                                               
   UNTIL
   TEXT  VMODE  ;

 

I hesitated posting it because I could not find a commented version and don’t want to take the time away from my DSRLNK mods to do it at the moment.

 

After loading it, just type BOUNCE to start it. You can stop it with <break> (FCTN+4). You will notice that it reflects from the bottom at a random angle and speed.

 

...lee

[+TheBF]

That's fancy using the sprite. The motion is much smoother  with pixel level resolution. 

[Retrospect]

That's a lovely explosion sound very reminiscent of the parsec ship explosion noise

[+TheBF]

2 hours ago, Retrospect said:

That's a lovely explosion sound very reminiscent of the parsec ship explosion noise

Well... actually it is the Parsec ship explosion. I stole it from the Parsec source code.  

 

 

[+FarmerPotato]

On 2/17/2024 at 1:33 PM, TheBF said:

To be honest I didn't think it would be hard either, until I tried to make it.  

In Forth circles it is considered bad form to reach down below the 3rd item on the data stack. 

I kept thinking about this...

 

If reaching down more than 3 levels into the stack is bad form, then maybe  the BOX  interface 

BOX  ( x1 y1 x2 y2 chr -- )

 

is not Forthlike.  Influenced too much by BASIC or another language. 

 

I came up with a 3 word interface:

CHAR ( chr -- chr )
ORIGIN  ( x y -- vaddr )
BOX ( chr vaddr width height -- )

 

Example:

42 CHAR 12 5 ORIGIN  10 10 BOX 

 

Char is a do-nothing word for now, but part of the interface. 

 

32 VALUE COLUMNS
0 CONSTANT SIT

: CHAR ;
: ORIGIN COLUMNS * + SIT + ;

: BOX ( chr vaddr width height  -- )
COLUMNS * ROT ( chr width h' vaddr )
TUCK + SWAP ( or SWAP OVER + SWAP )
DO ( loop on vaddr )
( chr width )
2DUP I -ROT VFILL
COLUMNS +LOOP ;

 

optimization: a word COLUMNS* that uses a shortcut to multiply by 32, 40, 80 depending on graphics mode. 

 

[+TheBF]

You may be onto something.  It makes as much sense to a low level programmer as x,y coordinates. 

It doesn't translate as well to an ANSI terminal I suppose but I am probably the only crazy person who runs a VT100 emulator to control a TI-99.

 

Thanks for putting that together.  I will take a run at translating to Camel99 words and see what we get. 

 

 

 

[+TheBF]

I don't know why I never thought of this before but here is something for people to play with.

The ideas work for any program doing sprites. 

 

I have a sprite demo that I was never totally happy with. The sprites fly around the screen and they all are supposed to bounce off the 4 sides of the screen.

Because I am monitoring 6 sprites sometimes a sprite gets well past the limits before the program can reverse its direction.

Now when the program tests that sprite next time around, it sees that the sprite is still outside the limits and reverses the direction driving the sprite farther outside the limits.

I was noodling on the most efficient way to prevent that. I thought some kind of hysteresis was needed. Maybe a counter for each time a sprite was tested. ??

 

The answer was simple. Force the sprite back within the limits BEFORE you reverse the direction. 

DOH! 

 

This was a perfect application for a little word I created long ago called CLIP.

As in clipping a signal. 

 

: CLIP ( n lo hi -- n')  ROT MIN MAX ; 

 

A while back I broke out x and y coordinates as VDP arrays and I have the same thing now for the motion table.

This makes manipulating the sprite values as easy as using RAM. 

 

Here is the business end of the wall bouncing code. 

: CLIP   ( n lo hi -- n)  ROT MIN MAX ;

\ clip x,y sprite positions to within the 4 walls 
: CLIPX  ( spr# -- ) SP.X  DUP VC@  4 238 CLIP  SWAP VC! ;
: CLIPY  ( spr# -- ) SP.Y  DUP VC@  4 180 CLIP  SWAP VC! ;

: REVERSE ( Vaddr -- ) DUP VC@ NEGATE  SWAP VC! ;

: BOUNCE.X  ( spr# --)  DUP CLIPX  ]SMT.X REVERSE ; 
: BOUNCE.Y  ( spr# --)  DUP CLIPY  ]SMT.Y REVERSE ; 

: BOUNCE    ( spr# --) DUP BOUNCE.X BOUNCE.Y  ;

 

The entire program is here

CAMEL99-ITC/DEMO/COINC-DEMO-FEB2024.FTH at master · bfox9900/CAMEL99-ITC · GitHub

 

 

[+FarmerPotato]

19 hours ago, TheBF said:

You may be onto something.  It makes as much sense to a low level programmer as x,y coordinates. 

It doesn't translate as well to an ANSI terminal I suppose but I am probably the only crazy person who runs a VT100 emulator to control a TI-99.

 

Thanks for putting that together.  I will take a run at translating to Camel99 words and see what we get. 

 

 

 

OK, to be more device-independent, without implementing the whole CURSES package, you can DEFER a set of output words like GOTOXY, HCHAR, VCHAR.  (I would replace the BASIC-style HCHAR too.)

 

Make a cursor position variable and set it:  12 5 GOTOXY.  
 

If the device is a terminal, GOTOXY sends the escape sequence, otherwise it computes a VDP address.

 

Other decisions to man include:  how to store current position, whether to optimize GOTOXY as a delta to the current position...

 

A little farther down this road and you need a "graphics context" to cache settings.

 

 

Edited February 24 by FarmerPotato

[+FarmerPotato]

19 hours ago, TheBF said:

noodling on the most efficient way to prevent that. I thought some kind of hysteresis was needed. Maybe a counter for each time a sprite was tested. ??

I too hit this wall, in my BASIC days.  My answer was not to reverse the velocity, but to force its sign to point away from that wall. Prior to that , I had a lot of balls sticking to the wall, or climbing it stair-step  fashion. 

V=1

IF X>30 THEN DX=-V

IF X<3 THEN DX=V

Another way is to test both conditions: 

IF X>30 AND DX>0 THEN DX=-DX

 

Yet another approach was to rotate the velocity vector by 90'

IF X>30 AND DX>0 THEN A=DX::DX=-Y::DY=A

This only works going clockwise, something that stumped me until I got enough algebra-not to mention the physics is weird. 

 

 

 

 

[+TheBF]

7 minutes ago, FarmerPotato said:

I too hit this wall, in my BASIC days.  My answer was not to reverse the velocity, but to force its sign to point away from that wall. Prior to that , I had a lot of balls sticking to the wall, or climbing it stair-step  fashion. 

V=1

IF X>30 THEN DX=-V

IF X<3 THEN DX=V

 

I think the difference in my case is the loop speed in Forth. I was doing exactly that math but I was servicing the status of 6 sprites at once using automotion. 

The math looks considerably different in my Forth code.   This takes a VDP address, fetches the byte value, negates it and puts it back.

: REVERSE ( Vaddr -- ) DUP VC@ NEGATE  SWAP VC! ;

 

The entire comparison and bouncing is this:

: CLIPX  ( spr# -- ) SP.X  DUP VC@  4 238 CLIP  SWAP VC! ;
: CLIPY  ( spr# -- ) SP.Y  DUP VC@  4 180 CLIP  SWAP VC! ;

: REVERSE ( Vaddr -- ) DUP VC@ NEGATE  SWAP VC! ;

: BOUNCE.X  ( spr# --)  DUP CLIPX  ]SMT.X REVERSE ; 
: BOUNCE.Y  ( spr# --)  DUP CLIPY  ]SMT.Y REVERSE ; 

: BOUNCE    ( spr# --) DUP BOUNCE.X BOUNCE.Y  ;

\ flag=true if x or y are outside limits 
: XLIMIT? ( x -- ?) 239 3 WITHIN ;
: YLIMIT? ( Y -- ?) 182 3 WITHIN ;

: TRAPX ( spr# -- )
      DUP SP.X VC@
      XLIMIT? IF  BOUNCE.X  TINK   EXIT 
      THEN  DROP  ;

: TRAPY ( spr# -- )
      DUP SP.Y VC@
      YLIMIT? IF  BOUNCE.Y  TINK  EXIT 
      THEN  DROP  ;

\ keep a sprite inside 4 walls 
: TRAP ( spr# -- ) DUP TRAPX TRAPY   ;

So I would service spite #0 and then check the other five. 

When I came back to sprite 0, It could well be still past the boundary because it has been given a slow random speed.

Now I test it and see it is past the boundary and reverse it again.  Oops. That was the wrong thing to do. 

By forcing them just back inside the limits before reversing I prevented that. 

 

Here is the demo in action so it makes more sense. 

 

[+TheBF]

46 minutes ago, FarmerPotato said:

OK, to be more device-independent, without implementing the whole CURSES package, you can DEFER a set of output words like GOTOXY, HCHAR, VCHAR.  (I would replace the BASIC-style HCHAR too.)

 

Make a cursor position variable and set it:  12 5 GOTOXY.  
 

If the device is a terminal, GOTOXY sends the escape sequence, otherwise it computes a VDP address.

 

Other decisions to man include:  how to store current position, whether to optimize GOTOXY as a delta to the current position...

 

A little farther down this road and you need a "graphics context" to cache settings.

 

 

You are correct about changing HCHAR. Forth handles that type of function with FILL ( addr len char --)

So the TI-99 needs VFILL ( Vaddr len char --). I think we all have one.

I have a CODE word call >VPOS ( x y - Vaddr)  to convert (x,y) to VDP address using the current screen size and line length. 

[+FarmerPotato]

Just now, TheBF said:

You are correct about changing HCHAR. Forth handles that type of function with FILL ( addr len char --)

So the TI-99 needs VFILL ( Vaddr len char --). I think we all have one.

I have a CODE word call >VPOS ( x y - Vaddr)  to convert (x,y) to VDP address using the current screen size and line length. 

Oops.  I understood VFILL to mean VDP fill and that it went horizontal. Like I'd think of 0 768 32 VFILL to clear the screen.

 

I also found it annoying that vaddr is below len and char.  If I'm iterating on vaddr, it requires a nasty 2DUP I -ROT to prepare the stack for FILL/VFILL.

I imagine a ! order: 

: VFILL! ( char len vaddr -- )

  SETVWA

  0 DO DUP VDPWD ! LOOP ;