Camel99 Forth Information goes here

[+TheBF]

I messed up my ticker.

 

In my last version of the kernel I thought I could make a single timer that ran with 1mS resolution and save some space.

That was a mistake.  In order to not block any other processes the timer always called PAUSE to give other tasks a turn while waiting.

If the time to get back from servicing all the tasks is greater than 1MS which it almost always is, this messes up the delays.

They become way longer than they should be. 

 

To prevent this I have decided it is best to reduce the resolution of the timer to 32mS so that even under the worst circumstances when multitasking the MS delays will be closer to real time . 

I will post new version of the kernel and the super-cart kernel after I am satisfied with the result. It should be ok since 16mS was used in the distance past. 

The upside I guess is that I invented a little code word that makes the loop faster so we are wasting less time in the delay loop itself. 

 

For the curious here is the code

\ TICKTOCK.HSF  TMS9901 hardware timer interface for Camel 99 Forth

\ credit to: http://www.unige.ch/medecine/nouspikel/ti99/tms9901.htm#Timer
\ improvements based on code from Tursi Atariage
\ TMR! now loads from the Forth stack
\ Apr 2023  Went back to a new TICKS word that is more efficient. 
\           MS min= 32 milliseconds

\ timer resolution:  64 clock periods, thus 64*333 = 21.3 microseconds
\ Max Duration    :  ($3FFF) 16383 *64*333 ns = 349.2 milliseconds

[CC] DECIMAL
TARGET-COMPILING
CODE TMR!   ( n -- )         \ load TMS9901 timer from stack
             0 LIMI,
             R12 CLR,        \ CRU addr of TMS9901 = 0
             0   SBO,        \ SET bit 0 to 1, Enter timer mode
             R12 INCT,       \ CRU Address of bit 1 = 2 , I'm not kidding
             TOS 14 LDCR,    \ Load 14 BITs from TOS into timer
            -1  SBZ,         \ reset bit 0, Exits clock mode, starts decrementer
             2 LIMI,
             TOS POP,
             NEXT,
             ENDCODE

CODE TMR@   ( -- n)         \ read the TMS9901 timer
             0 LIMI,
             TOS PUSH,
             R12 2 LI,      \ cru = 1 (honest, 2=1)
            -1 SBO,         \ SET bit 0 TO 1, Enter timer mode
             TOS 14 STCR,   \ READ TIMER (14 bits)
            -1 SBZ,         \ RESET bit 1, exit timer mode
             2 LIMI,
             NEXT,
             ENDCODE

[PRIVATE]
CODE DT ( T1 T2 -- n)  
 *SP TOS SUB,  \ t1-t2  
     TOS ABS,     
 *RP TOS SUB,  \ subtract from value on Return stack
  NEXT, 
ENDCODE 
[PUBLIC]


: TICKS ( n -- ) \ ** n(max) = 4000 ~= 100 ms ** 
  >R
  TMR@
  BEGIN  
    TMR@ DT 0<
  WHILE
    PAUSE
  REPEAT
  R> 2DROP
;
\ 1500 TICKS ~= to 32mS 
: MS ( n -- )  5 RSHIFT 0 ?DO  1500 TICKS  LOOP ; 

 

[+TheBF]

Had a lot of guests at home the last few days.

Here is a test of this new timer that let's us see the round trip time (I call it pulse) on 42 tasks that each do a simple fill up the stack and collapse the stack job. 

We can see that with 42 tasks the PULSE in in the 8..10 millisecond range and this task is not stealing large blocks of time. It is very "cooperative". 

Even when we have all the tasks asleep, we can see that just reading through the list of 42 sleeping tasks took 1.6 milliseconds. 

So clearly my 1mS timer before was a big mistake. 

This 32 mS version has a good margin for safety. 

 

Here is the SPAWN code used in the test. 

Spoiler

\ mtask spawn tasks demo  updated for V2.5 Feb 2020

 

NEEDS DUMP   FROM DSK1.TOOLS

NEEDS MALLOC FROM DSK1.MALLOC

NEEDS FORK   FROM DSK1.MTASK99

NEEDS .TASKS FROM DSK1.MTOOLS

 

INIT-MULTI

 

\ create a task in heap, fork it, assign Execution token and run it

: SPAWN  ( xt -- ) USIZE MALLOC DUP >R FORK  R@ ASSIGN  R> WAKE ;

 

HEX 10 CONSTANT STKSIZE  \ each task has ONLY 20 cells for each stack

 

VARIABLE X   \ used to test if tasks are running

 

: DROPS   ( n --)  0 DO DROP PAUSE LOOP ; \ drop items from the stack

 

: STKTHING   \ fill and clear data stack so it can be seen in debugger

          BEGIN

            STKSIZE 0 DO PAUSE DEAD  LOOP

            STKSIZE DROPS

 

            STKSIZE 0 DO PAUSE BEEF  LOOP

            STKSIZE DROPS

            1 X +!

          AGAIN ;

 

\ create and wake n tasks.

VARIABLE #TASKS

 

: TASKS  ( n -- )

         DUP #TASKS !

         0 DO  ['] STKTHING SPAWN  LOOP ;

 

: KILLALL

         SINGLE

         USIZE #TASKS @ *  MFREE

         INIT-MULTI  ;

 

DECIMAL

 

CR .( Commands to RUN  the demo)

CR .( type: DECIMAL 42 TASKS)

CR .( 42 is the maximum number using LOW RAM)

CR

CR .( MULTI to start tasker)

CR .( .TASKS  to see task list)

CR .(  X ?  to see X increment)

CR .( MONITOR  to see round-robin time)

CR .( Hold FCTN 4 to stop MONITOR)

 

 

Edited April 9, 2023 by TheBF
typo

[+TheBF]

So here are replacement files for CAMEL99 and the super-cart version renamed to CAMEL99SC with the new MS word that has a resolution of 32mS.

This is fine for a general purpose delay in the 200 mS to 65000 mS range. 

 

We have also put back TICKS (n --)  where n is in 21.3 micro-second "ticks"  and the maximum reliable number is decimal 4700 which will be about 100 mS. 

Low values of n, below 500 are probably not linear because the overhead of the Forth code gets in the way.  And TICKS call PAUSE so if you use it as a multi-tasking delay

keep the value higher the the maximum "pulse" time (round-trip time) of all your tasks. 

 

<Removed files>

 

 

[+TheBF]

My grandkids showed me a web based game that looked like something I could handle on TI-99.

I thought I would show the user group how I make use of Magellan for Camel99 Forth.

I use the Assembly language output files and I "extend" Forth to handle the data in a similar format with the DATABYTE library.

 

So here are the characters and sprites that I have made so far exported as "ASSEMBLY DATA" right out of Magellan.

 

Spoiler

****************************************
* Character Patterns                    
****************************************
PAT128 DATA >0000,>0000,>FF00,>0000    ;
PAT129 DATA >0000,>1E61,>8000,>0000    ;
PAT130 DATA >0000,>609E,>0100,>0000    ;
PAT131 DATA >0000,>0000,>C040,>3E00    ;
PAT132 DATA >0000,>0000,>0304,>F800    ;
PAT133 DATA >0000,>0000,>FF00,>3800    ;
PAT134 DATA >0000,>0000,>FF00,>6060    ;
PAT135 DATA >0000,>0000,>FF00,>0400    ;
PAT136 DATA >0000,>0000,>FF00,>1010    ;
PAT137 DATA >0000,>0000,>FF00,>7004    ;
****************************************
* Sprite Patterns                       
****************************************
SPR0   DATA >0000,>0101,>0181,>81C1    ; Color 1
       DATA >E377,>7F3F,>1F06,>0406    ; 
       DATA >00FE,>FFBF,>FFF0,>FEE0    ; 
       DATA >E0F8,>E8E0,>C040,>6000    ; 
SPR1   DATA >0000,>0101,>0181,>81C1    ; Color 1
       DATA >E377,>7F3F,>1F04,>0600    ; 
       DATA >00FE,>FFBF,>FFF0,>FEE0    ; 
       DATA >E0F8,>E8E0,>C0C0,>80C0    ; 
SPR2   DATA >0000,>0001,>1E20,>4048    ; Color 1
       DATA >8700,>0000,>0000,>0000    ; 
       DATA >0000,>E010,>1C22,>0201    ; 
       DATA >FF00,>0000,>0000,>0000    ; 
SPR3   DATA >0001,>0303,>3333,>3333    ; Color 1
       DATA >333F,>1F0F,>0303,>0303    ; 
       DATA >0080,>C0C0,>C0C0,>CCCC    ; 
       DATA >CCFC,>F0C0,>C0C0,>C0C0    ; 
SPR4   DATA >0000,>0000,>0000,>0001    ; Color 1
       DATA >0109,>0907,>0101,>0101    ; 
       DATA >0000,>0000,>0000,>0080    ; 
       DATA >80A0,>A0A0,>E080,>8080    ; 
SPR5   DATA >0103,>3333,>3333,>333B    ; Color 1
       DATA >1F03,>0303,>0303,>0303    ; 
       DATA >0080,>8080,>8098,>9898    ; 
       DATA >9898,>98F0,>E080,>8080    ; 

 

 

And here is the edited version that allows you to compile it under Forth.  A bit of search and replace and add the word CREATE for labels. 

Notice all the > characters are removed from the DATA but you must preface everything with HEX. 

 

Spoiler

\ ****************************************
\ * Character Patterns
\ ****************************************
INCLUDE DSK1.DATABYTE 

HEX
CREATE PAT128 DATA 0000,0000,FF00,0000    \
CREATE PAT129 DATA 0000,1E61,8000,0000    \
CREATE PAT130 DATA 0000,609E,0100,0000    \
CREATE PAT131 DATA 0000,0000,C040,3E00    \
CREATE PAT132 DATA 0000,0000,0304,F800    \
CREATE PAT133 DATA 0000,0000,FF00,3800    \
CREATE PAT134 DATA 0000,0000,FF00,6060    \
CREATE PAT135 DATA 0000,0000,FF00,0400    \
CREATE PAT136 DATA 0000,0000,FF00,1010    \
CREATE PAT137 DATA 0000,0000,FF00,7004    \

\ ****************************************
\ * Sprite Patterns
\ ****************************************
HEX
CREATE SPR0   
       DATA 0000,0101,0181,81C1    \ Color 1
       DATA E377,7F3F,1F06,0406    \
       DATA 00FE,FFBF,FFF0,FEE0    \ 
       DATA E0F8,E8E0,C040,6000    \ 

CREATE SPR1   
       DATA 0000,0101,0181,81C1    \ Color 1
       DATA E377,7F3F,1F04,0600    \
       DATA 00FE,FFBF,FFF0,FEE0    \ 
       DATA E0F8,E8E0,C0C0,80C0    \ 

CREATE SPR2   
       DATA 0000,0001,1E20,4048    \ Color 1
       DATA 8700,0000,0000,0000    \
       DATA 0000,E010,1C22,0201    \
       DATA FF00,0000,0000,0000    \

CREATE SPR3   
       DATA 0001,0303,3333,3333    \ Color 1
       DATA 333F,1F0F,0303,0303    \
       DATA 0080,C0C0,C0C0,CCCC    \
       DATA CCFC,F0C0,C0C0,C0C0    \

CREATE SPR4   
       DATA 0000,0000,0000,0001    \ Color 1
       DATA 0109,0907,0101,0101    \
       DATA 0000,0000,0000,0080    \
       DATA 80A0,A0A0,E080,8080    \

CREATE SPR5   
       DATA 0103,3333,3333,333B    \ Color 1
       DATA 1F03,0303,0303,0303    \
       DATA 0080,8080,8098,9898    \ 
       DATA 9898,98F0,E080,8080    \

 

 

But remember, this code has only compiled the data into CPU RAM.

To use these things these chunks of data must be written into VDP RAM to redefine the character patterns. 

 

Something like this will work. 

NEEDS CHARDEF FROM DSK1.GRAFIX  \ load graphics 1 mode stuff
DECIMAL
: DEFINE-CHARS
    PAT128 128 CHARDEF
    PAT129 129 CHARDEF
    PAT130 130 CHARDEF
    PAT131 131 CHARDEF
    PAT132 132 CHARDEF
    PAT133 133 CHARDEF
    PAT134 134 CHARDEF
    PAT135 135 CHARDEF
    PAT136 136 CHARDEF
;

\ for magnified 4 character sprites 
: SPRITE-DEF (  addr char -- ) ]PDT 64 VWRITE ;

: DEFINE-SPRITES
      SPR0  142 SPRITE-DEF
      SPR1  146 SPRITE-DEF
      SPR2  150 SPRITE-DEF
      SPR3  154 SPRITE-DEF
      SPR4  160 SPRITE-DEF
      SPR5  164 SPRITE-DEF 
;

\ change the patterns now and set all the colors to green 
128 SET#  168 SET#  3 1 COLORS 
DEFINE-CHARS   DEFINE-SPRITES 

EDIT:  Well after I tried to use this I found out that 16 bytes x 4 = 64 bytes. Changed the 32 in SPRITE-DEF. 

 

There are three kinds of people. Those who get math and those who don't.   

 

 

 

[+TheBF]

Over on Reddit /Forth a post was made about making random number generators in Forth for fun. 

The poster was new to Forth and the code was not ideal so I took a run a trying what he wanted to do. 

 

The task is to produce thousands of random letters between A and Z and count them.

The original version just printed letters to the GForth screen and piped the output to a sort program to count the number of unique letters.

 

I couldn't let that stand so I wrote a way to do it in Forth and in this version I created a fuller report to do some analysis.

We generate 32000 letters and count them in a little array. The PRNG is a variation of the GForth code that I use in Camel99. 

It takes about 40 seconds on TI99.

In GForth, on my old Dell PC,  to do 2,600,000 letters, it is done when you press enter.

 

Of note to people who are learning Forth:

• lack of variables in the report code (replaced with functions) 
• Use of */ operator to compute the percentage value
• Forth formatting words (<#  #S #> ) to print a percentage value with a decimal.

 

** I am curious if there is a better way to analyze the output. (Lee?) 

 

Spoiler

\ Random character test of PRNG 

INCLUDE DSK1.UDOTR 
INCLUDE DSK1.MARKER 

MARKER REMOVE 

: ERASE  0 FILL ;

DECIMAL
28645 CONSTANT PRIME#

CREATE SEED  7 , 

DECIMAL 
: RNDW  ( -- n ) PRIME# SEED @ *  1+ DUP SEED ! ; 
: RND   ( n -- 0..n-1 ) RNDW UM* NIP ;

\ generates a letter between A and Z
: RNDCHAR ( --c)  [CHAR] A  [CHAR] Z 1+  OVER -  RND  SWAP +  ;


CREATE LETTERS   100 CELLS ALLOT  
: ]LETTER ( n -- addr)  CELLS LETTERS +  ;  \ index into LETTERS 

: CLEARALL   LETTERS 100 CELLS ERASE ;

: .RECORD  ( n --) SPACE DUP ]LETTER @ 5 .R  SPACE   EMIT ; 

: RANGE  ( -- last 1st) [CHAR] Z 1+ [CHAR] A ;
: ?CR      VCOL @  30 > IF CR THEN  ;
: .COUNTS  CR RANGE DO  I .RECORD ?CR LOOP ;

\ : 1+! ( addr --)  1 SWAP +! ; \ inc. value in address

32000 CONSTANT SIZE 

: RNDCHARS  SIZE 0 DO   RNDCHAR ]LETTER 1+!  LOOP  ;

\ analysis 
: OUTMAX ( -- n)   0  RANGE DO  I ]LETTER @ MAX  LOOP ;
: OUTMIN ( -- n) SIZE RANGE DO  I ]LETTER @ MIN  LOOP ;
: SPREAD ( -- n) OUTMAX OUTMIN - ;

: IDEAL  ( -- n) SIZE 26 / ;
: .%     ( n --) 0 <#  # # [CHAR] . HOLD  #S  #> TYPE ." %" ; 
: DEVIATION   ( -- n) SPREAD 10000 IDEAL */ ; 

: .SPREAD     CR ." Spread   = " SPREAD . ;
: .DEVIATION  CR ." Deviation= " DEVIATION .%  ;
: .IDEAL      CR ." Ideal    = " IDEAL . ;
: .MIN        CR ." Min      = " OUTMIN . ;
: .MAX        CR ." Max      = " OUTMAX . ;

: .REPORT  CR .COUNTS .IDEAL .MIN .MAX .SPREAD .DEVIATION  ;

: RUNTEST   CLEARALL  RNDCHARS .REPORT ; 

 

[+TheBF]

And yet another update

 

I am pretty sure I was not drunk when I posted the last update but I mistakenly posted ver 2.68 of the normal kernel that resides at >A000. 

I did have a bad cold so that'll be my excuse. 

 

You can dispose of V2.68 

 

Here are the latest kernels with the new MS and TICKS as before.

 

There is also a new EVALUATE that properly saves/restores >IN. 

( Standard says >IN is set to TRUE when EVALUATE runs. Done here by 'ON')

: EVALUATE ( c-addr u -- j*x)
      SOURCE-ID DUP @ >IN @ 2>R  ON 
      SOURCE 2>R
      INTERPRET
      2R> 'SOURCE 2!
      2R> >IN ! SOURCE-ID !
;

 

These are fresh off the compiler and converted to TIFILES.

 

CAMEL99 CAMEL99SC

[+Lee Stewart]

On 4/20/2023 at 11:47 AM, TheBF said:

** I am curious if there is a better way to analyze the output. (Lee?) 

 

Well, I suppose you could also report the mean (μ = (Σx_i)/n = 32000/26 = 1230.77) and standard deviation (σ = √(Σ(x_i–μ)²/(n–1)) = 23.86). Since σ accentuates variations from the mean, you might also include the average deviation for comparison: D = Σ|x_i–μ|/n = 19.85.

 

...lee

[+TheBF]

8 hours ago, Lee Stewart said:

 

Well, I suppose you could also report the mean (μ = (Σx_i)/n = 32000/26 = 1230.77) and standard deviation (σ = √(Σ(x_i–μ)²/(n–1)) = 23.86). Since σ accentuates variations from the mean, you might also include the average deviation for comparison: D = Σ|x_i–μ|/n = 19.85.

 

...lee

 That looks great. 

How do you enter the greek symbols so nicely? 

[+Lee Stewart]

9 hours ago, TheBF said:

 That looks great. 

How do you enter the greek symbols so nicely? 

 

I open LibreOffice Writer and get Greek characters from the “Insert Special Characters” menu. Then I copy what I need to here. I also change the font to Georgia or Times New Roman, italicizing variables. [Note: I just noticed that I missed italicizing ‘n’—oops.]

 

...lee

[+TheBF]

As one who has not played games much I have a much greater respect for the masters of this art after trying to make one or two.

 

Here is "Rainbow Buster" (you know the real name) made in Forth.

I wanted to see how hard it would be to make something similar to the old game. 

 

It took longer than I thought to get it to be mostly reliable. 

It still has an occasional bug where you get a free pass into the upper atmosphere so let's call that a feature.  

 

Anyway for anybody wanting to see how you "could" glue stuff together in Camel99 to make a game here is the code.

I am using DSK1.MOTION which lets you set a sprite motion vector with MOTION like in automotion,

but to move the sprite you use the SP.MOVE command. 

 

There is also the binary program consisting of two files, that are loaded with E/A Option 5.

 

Spoiler

\ BREAKOUT.FTH  on Camel99 Forth     Aug 2022 Brian Fox

\ Uses DSK1.MOTION library. 
\ MOTION sets SPRITE motion vector. SP.MOVE moves sprite 1 increment.
\ See the file for more details

\ NEEDS DUMP   FROM DSK1.TOOLS
\ FAST#S
NEEDS HCHAR  FROM DSK1.GRAFIX
NEEDS SPRITE FROM DSK1.DIRSPRIT
NEEDS MOTION FROM DSK1.MOTION
NEEDS DATA   FROM DSK1.DATABYTE
NEEDS RND    FROM DSK1.RANDOM
NEEDS FORK   FROM DSK1.MTASK99
NEEDS HZ     FROM DSK1.SOUND
NEEDS MALLOC FROM DSK1.MALLOC
NEEDS MARKER FROM DSK1.MARKER
NEEDS CASE   FROM DSK1.CASE
NEEDS JOYST  FROM DSK1.JOYST 

: EMPTY S" REMOVE MARKER REMOVE" EVALUATE ;

 MARKER REMOVE

 EMPTY

\ Extensions to MOTION 
\ Access the VECTOR table in dsk1.motion, via x and y separately
: VECT.Y ( n -- addr) POSTPONE ]VECTOR ; IMMEDIATE 
: VECT.X ( n -- addr) POSTPONE ]VECTOR POSTPONE CELL+ ; IMMEDIATE 

\ ***************************
\ the variables
\ ***************************
VARIABLE BALL#
VARIABLE SCORE
VARIABLE 'BALL      \ record the position so we don't calculate it twice
VARIABLE REMAINING  \ # squares left to win


\ ***************************
\ handy primitives
\ ***************************

: CLIP    ( n lo hi -- n')  ROT MIN MAX ;
: FGCOLOR ( set# fg -- ) 1 COLOR ;
: BALLS   ( n -- )  BALL# ! ;
\ ***************************
\ named colors
\ ***************************
: ENUM  ( 0 <text> -- n) DUP CONSTANT  1+ ;

1 ENUM TRANS
  ENUM BLACK
  ENUM MEDGRN
  ENUM LTGRN
  ENUM DKBLU
  ENUM LTBLU
  ENUM DKRED
  ENUM CYAN
  ENUM MEDRED
  ENUM LTRED
  ENUM DKYEL
  ENUM LTYEL
  ENUM DKGRN
  ENUM MAGENTA
  ENUM GRAY
  ENUM WHITE
DROP

\ ***************************
\ named SPRITES
\ ***************************
1 CONSTANT BALL
0 CONSTANT PADDLE  

\ ***************************
\ sounds for the game
\ ***************************
DECIMAL
: CLINK ( freq -- )
    GEN1 HZ
     0 DB 600 TICKS
     6 DB 400 TICKS
    10 DB 400 TICKS
    MUTE ;

: BONK 
    GEN1 120 HZ 
     0 DB 1000 TICKS
     6 DB 800 TICKS
    12 DB 600 TICKS
    MUTE ;

\ ***************************
\ random numbers
\ ***************************
: RNDV     ( -- -1|0|1 )  3 RND 1- ;
: NON-0    ( -- n)  BEGIN  RNDV ?DUP UNTIL ;
: SERVING  ( -- dx dy)  NON-0 1  ;

\ ***************************
\ number patterns
\ ***************************
HEX
CREATE NUMERALS
  DATA 0000,7E66,6666,7E00     \ 48
  DATA 0000,1818,1818,1800     \ 49
  DATA 0000,7E06,7E60,7E00     \ 50
  DATA 0000,7E06,3E06,7E00     \ 51
  DATA 0000,6666,7E06,0600     \ 52
  DATA 0000,7C60,7C0C,7C00     \ 53
  DATA 0000,6060,7E62,7E00     \ 54
  DATA 0000,7E06,0606,0600     \ 55
  DATA 0000,7E66,7E66,7E00     \ 56
  DATA 0000,7E66,7E06,7E00     \ 57

DECIMAL
: DEF-NUMBERS    NUMERALS 48 ]PDT 10 8* VWRITE ;

\ ****************************************
\ * Character Patterns
\ ****************************************
HEX
CREATE SQUARE DATA FFFF,FFFF,FFFF,FFFF


\ ****************************************
\ * Sprite Patterns                       
\ ****************************************
CREATE PADDLE-PATTERN    
    DATA 0000,0000,00FF,00FF  
    DATA 00FF,00FF,0000,0000   
    DATA 0000,0000,00FF,00FF   
    DATA 00FF,00FF,0000,0000   

CREATE BALL-PATTERN
    DATA 0000,0000,0307,0F0F 
    DATA 0F07,0300,0000,0000
    DATA 0000,0000,80C0,E0E0 
    DATA E0C0,8000,0000,0000


\ ***************************
\ Name the characters & put in different character sets
\ ***************************
DECIMAL
      128   CONSTANT BORDER  \ start past ASCII chars
BORDER  8 + CONSTANT MAGBAR
MAGBAR  8 + CONSTANT REDBAR
REDBAR  8 + CONSTANT YELBAR
YELBAR  8 + CONSTANT GRNBAR
GRNBAR  8 + CONSTANT BLUBAR
BLUBAR  8 + CONSTANT VIOBAR
VIOBAR  8 + CONSTANT BLKSQR
BLKSQR  8 + CONSTANT BALLCHARS
BALLCHARS 8 + CONSTANT PADDLECHARS

: SPRITE-DEF (  addr char -- ) ]PDT 64 VWRITE ;

: DEF-SHAPES
    SQUARE BORDER CHARDEF
    SQUARE MAGBAR CHARDEF
    SQUARE REDBAR CHARDEF
    SQUARE YELBAR CHARDEF
    SQUARE GRNBAR CHARDEF
    SQUARE BLUBAR CHARDEF
    SQUARE VIOBAR CHARDEF
    SQUARE BLKSQR CHARDEF
    BALL-PATTERN   BALLCHARS   SPRITE-DEF
    PADDLE-PATTERN PADDLECHARS SPRITE-DEF
;

: SETCOLORS
     BORDER SET#  GRAY    FGCOLOR
     MAGBAR SET#  MAGENTA FGCOLOR
     REDBAR SET#  DKRED   FGCOLOR
     YELBAR SET#  DKYEL   FGCOLOR
     GRNBAR SET#  DKGRN   FGCOLOR
     BLUBAR SET#  DKBLU   FGCOLOR
     VIOBAR SET#  LTBLU   FGCOLOR
     BALLCHARS SET# WHITE   FGCOLOR
     PADDLECHARS SET# MAGENTA FGCOLOR
     [CHAR] 0 SET# WHITE FGCOLOR
     [CHAR] 9 SET# WHITE FGCOLOR
;

: DRAW.BORDER
       0 2 BORDER 32 HCHAR
       0 3 BORDER 32 HCHAR
       0 3 BORDER 21 VCHAR
       1 3 BORDER 21 VCHAR
      30 3 BORDER 21 VCHAR
      31 3 BORDER 21 VCHAR
;

: RAINBOW
       2  7 MAGBAR 28 HCHAR
       2  8 REDBAR 28 HCHAR
       2  9 YELBAR 28 HCHAR
       2 10 GRNBAR 28 HCHAR
       2 11 BLUBAR 28 HCHAR
       2 12 VIOBAR 28 HCHAR
;

: BALL.HOME          ( X   Y ) 
    BALLCHARS  WHITE  127 104  BALL SPRITE 
    SERVING BALL MOTION ;

: .###    ( n -- ) 0 <#  # # #  #> TYPE ;
: .SCORE  ( -- ) 6 0 AT-XY SCORE @ .### ;
: .BALLS  ( -- ) 20 0 AT-XY BALL# @ .  ;

: .PADDLE ( -- ) PADDLECHARS MAGENTA 127 176 PADDLE SPRITE ;

: CLIP  ( n LO HI -- n) ROT MIN MAX ;

: PADDLE-LOC+! ( n -- ) 
    PADDLE SP.X VC@ +  10 230 CLIP   PADDLE  SP.X VC! ;

: START-POSITIONS    BALL.HOME  .SCORE  .BALLS   .PADDLE ;

: DRAW.SCR    
  SETCOLORS  BLACK SCREEN  DRAW.BORDER  
  .SCORE  .BALLS  RAINBOW  ;


\ ***************************
\ coordinate conversion
\ ***************************
\ : PIX>CHAR ( pixel -- n) 1- 3 RSHIFT 1+ ;
\ : CHAR>PIX ( n -- pixel) 8*  7 - ;
HEX                   ( TOS DEC,  TOS 3 SRA,  TOS INC, )
CODE PIX>CHAR ( pixel -- n) 0604 , 0834 , 0584 , NEXT, ENDCODE 

DECIMAL
: BALLADDR ( -- vaddr)
  BALL SP.Y V@ SPLIT 
  PIX>CHAR SWAP PIX>CHAR SWAP >VPOS
  DUP 'BALL ! ;

: UNDERBALL ( pix piy -- c) BALLADDR VC@ ;
: BOUNCE.X  ( -- )  BALL VECT.X  DUP @ NEGATE SWAP ! BALL SP.MOVE ;
: BOUNCE.Y  ( -- )  BALL VECT.Y  DUP @ NEGATE SWAP ! BALL SP.MOVE ;
: FALLING?  BALL VECT.Y @ 0> ;
: RISING?   BALL VECT.Y @ 0< ;


: RICOCHET ( points freq --)
    BL 'BALL @ VC! 
    BOUNCE.Y CLINK  SCORE +!  .SCORE 300 TICKS 
    REMAINING 1-! ;

: OFFSET ( -- n)  
  PADDLE SP.X VC@  
  BALL SP.X VC@ -  
  2 /  -1 1 CLIP ;    

\ ***************************
\ move away after collision
\ ***************************
: WALL-CLR 
    BEGIN UNDERBALL BL <>
    WHILE BALL SP.MOVE 
    REPEAT ;

: PADDLE-CLR 
    BEGIN BALL PADDLE 9 COINC
    WHILE BALL SP.MOVE 
    REPEAT
;    

: WALL-BOUNCE 
    BALL SP.Y VC@ 24 > 
    IF   BOUNCE.X  WALL-CLR EXIT THEN 
    BOUNCE.Y WALL-CLR ;

: PADDLE-HIT ( -- ) BOUNCE.Y  600 CLINK  PADDLE-CLR ;

\ ***************************
\ keyboard control
\ ***************************

\ HEX 83C8 CONSTANT REPEATING
\ DECIMAL
\ : PADDLE-CTRL
\    REPEATING ON
\    KEY?
\    CASE
\     83 OF  -3 PADDLE-LOC+!  ENDOF \ 'S'
\     68 OF   3 PADDLE-LOC+!  ENDOF \ 'D'
\    ENDCASE
\ ;

\ ***************************
\ Joystick control (faster)
\ ***************************
HEX
: PADDLE-CTRL
    0 JOYST
    CASE
     2 OF  -3 PADDLE-LOC+!  ENDOF
     4 OF   3 PADDLE-LOC+!  ENDOF 
    ENDCASE
;

DECIMAL 
: .REPLAY 
   DELALL 
   10 21 AT-XY ." GAME OVER"
    5 22 AT-XY ." TYPE GO TO PLAY AGAIN"
   ABORT ;

: ?WIN  
   REMAINING @ IF  EXIT THEN    
   DELALL 
   10 5 AT-XY ." HEY YOU WON !!" 
    4 7 AT-XY ." WITH " BALL# @ . ." BALLS REMAINING"
   .REPLAY  
;

\ for debugging
: ?BREAK     ?TERMINAL IF CYAN SCREEN TRUE ABORT" BREAK" THEN ;

: BALLINPLAY
    BEGIN
      ?BREAK
      ?WIN 
      BALL SP.MOVE
      PADDLE-CTRL
      BALL PADDLE 9 COINC IF PADDLE-HIT THEN 
      UNDERBALL ( char)
      CASE      \ points Freq.
        MAGBAR   OF 6   1500 RICOCHET    ENDOF
        REDBAR   OF 5   1400 RICOCHET    ENDOF
        YELBAR   OF 4   1300 RICOCHET    ENDOF
        GRNBAR   OF 3   1200 RICOCHET    ENDOF
        BLUBAR   OF 2   1100 RICOCHET    ENDOF
        VIOBAR   OF 1   1000 RICOCHET    ENDOF
        BORDER   OF WALL-BOUNCE 200 CLINK  ENDOF
      ENDCASE
      130 TICKS 
      1 SP.Y VC@ 200 >
    UNTIL
    BONK 
;

: SETUP ( -- ) 
  DEF-NUMBERS  DEF-SHAPES  SETCOLORS  SCORE OFF ;
  
: WAIT-FIRE   BEGIN 0 JOYST 1 = UNTIL ;

: ERASEAT  ( x y -- )  >VPOS 20 BL VFILL ;

: .PRESS-FIRE
    6 20 AT-XY ." PRESS FIRE TO SERVE" 
    WAIT-FIRE
    6 20 ERASEAT ;

: .CREDITS 
   9 14 AT-XY ." RAINBOW BUSTER" 
   9 15 AT-XY ."   FOR TI-99"
   6 16 AT-XY ." BY BRIAN FOX 2023" ;    

: ERASE-CREDITS 
   9 14 ERASEAT
   9 15 ERASEAT
   6 16 ERASEAT ;

: GO
    DECIMAL
    [CHAR] A SET#  12  GRAY 1 COLORS 
    SETUP CLEAR 
    10 BALLS 
    28 6 * REMAINING ! \ # blocks to remove
    DRAW.SCR
    2 MAGNIFY 
    .CREDITS
    .PRESS-FIRE
    ERASE-CREDITS 
    BEGIN
     BALL# @
    WHILE
       SERVING BALL MOTION 
       START-POSITIONS
       WAIT-FIRE 
       BALLINPLAY
       BALL# 1-! .BALLS
    REPEAT
    .REPLAY
;

: STARTER   WARM GRAPHICS GO ;

LOCK 
INCLUDE DSK1.SAVESYS
' STARTER SAVESYS DSK3.BREAKOUT

 

BREAKOUT BREAKOUU

[+TheBF]

O.M.G!

 

Now I know why I don't play games much. 😱

 

But now I know it is possible to win that damned thing. 

(But only because I got the free ride to the upper screen)

 

 

[+TheBF]

I might have a little bit of "Missouri" in me because I don't like believing things until I see 'em.

 

Over on Reddit /Forth  in the PRNG thread, Albertthemagician (could be Albert VanderHorst)  mentioned a web site with a highly researched PRNG.

 

https://forth-ev.de/wiki/pfw:random_generators_xorshift  (It's a German site but the code is mostly English)

 

VARIABLE SEED   2345 SEED !   \ START THE SEED WITH ANY NUMBER BUT 0
 
: RANDOM16 ( address_seed -- rndm_val )
  DUP >R @
  DUP  8 LSHIFT XOR
  DUP  9 RSHIFT XOR
  DUP  7 LSHIFT XOR
  DUP R> ! ;

: RNDW  ( -- n) SEED RANDOM16 ;  

 

I wondered how much better this is than what I am using and how could I tell?

 

So I took some of the ideas from my previous testing and used SAMS memory to create a 32K integer DATA array. 

I had each PRNG run 32K times and whatever number they output was used as the index to the array and we increment that cell. 

I ran the operation 10 times so a perfect PRNG would give us 10 in every cell of the array. (I think)

 

Then I created a "tally" array of just 50 cells (in case I really want to let the thing run 50 times) 

 

Then the TALLY word steps through data array and "tallies" how many of each number from 1 to 10 was counted in the array. 

 

(I was going to implement Lee's "Stats 101" routines but I got lazy and thought I could get this working faster but I intend to make those as well)

 

Here is the code

Spoiler

\ MARSAGLIA PRNG using Shifts and XOR 2003  for CAMEL99 Forth
\ Source: https://forth-ev.de/wiki/pfw:random_generators_xorshift
\ 16bit version with 1 seed in a variable
\ The actual number of bits used for the 3 shifts is critical. 
\ For 16bit generators only a few valid combinations exist: (7, 9, 13) and (7, 9, 8).

INCLUDE DSK1.TOOLS
INCLUDE DSK1.SAMS 
INCLUDE DSK1.UDOTR 

DECIMAL 
VARIABLE SEED

2345 SEED !             \ START THE SEED WITH ANY NUMBER BUT 0
 
: RANDOM16 ( address_seed -- rndm_val )
  DUP >R @
  DUP  8 LSHIFT XOR
  DUP  9 RSHIFT XOR
  DUP  7 LSHIFT XOR
  DUP R> ! ;

: RNDW  ( -- n) SEED RANDOM16 ;  

\ un-comment these 2 lines to use the libary PRNG
\ INCLUDE DSK1.RANDOM
\ 2345 SEED !             \ reload SEED variable in library version

HEX 
1000 CONSTANT 4K 
83D6 CONSTANT ALWAYS 

DECIMAL
32767 CONSTANT SIZE    \ elements in the data array 

1 SEGMENT 
\ use the entire 64K segment as our 32k array of integers
: ]DATA ( ndx -- sams_addr) CELLS PAGED ;

: CLEARDATA   16 0 DO   I 4K * PAGED 4K 0 FILL  LOOP  ;
: COUNTRND    SIZE 0 DO  RNDW ]DATA 1+!  LOOP ;

: TESTS ( n --)  0 ?DO  I . COUNTRND  LOOP ;  
  
\ analysis 
VARIABLE RMAX 
VARIABLE RMIN 
: OUTMAX ( -- n)   0    SIZE 1+ 0 DO  I ]DATA @ MAX  LOOP DUP RMAX ! ;
: OUTMIN ( -- n) SIZE   SIZE 1+ 0 DO  I ]DATA @ MIN  LOOP DUP RMIN ! ;
: SPREAD ( -- n) OUTMAX OUTMIN - ;

: .SPREAD     CR ." Spread   = " SPREAD . ;
: .MIN        CR ." Min      = " RMIN @ . ;
: .MAX        CR ." Max      = " RMAX @ . ;

: .REPORT  CR .SPREAD  .MIN .MAX ;

10 CONSTANT RUNCOUNT 

: RUNTEST   
  ALWAYS ON 
  CR ." Erasing..."  CLEARDATA 
  CR ." Counting..." RUNCOUNT TESTS 
  .REPORT   
;

\ count quantity of each value in the array ( RUNCOUNT=50MAX)
CREATE []X   50 CELLS ALLOT 
: ]X   CELLS []X +  ;

: CLEARX   []X   50 CELLS 0 FILL ;

: TALLY-SAMS   ( addr len --) 1+ BOUNDS ?DO  I PAGED @ ]X 1+!  LOOP ; 

: .TALLY   
   CR  
   RUNCOUNT 2* 1+ 0 
   DO 
      CR  I DUP 3 .R  ."  -> "  I ]X @ 5 U.R  
   LOOP  ;

: UNIQUE    
    CLEARX 
    CR ." Counting unique..."  
    0 ]DATA SIZE TALLY-SAMS .TALLY ;


RUNTEST  UNIQUE  

 

 

And it turns out the fancy pants version is slightly better. But not that much.  

 

Fancy Pants Results

 

My PRNG modded from GForth ( I converted this to CODE, but it's the same calculation)

HEX
: RNDW  ( -- n ) 6FE5 SEED @  *  1+ DUP SEED ! ;

[+TheBF]

Ah!  When I used the other set of valid shift numbers (7,9,13) it's better?

 

So the score stands at:

 Academics 2, theBF 0  

 

: RANDOM16 ( address_seed -- rndm_val )
  DUP >R @
  DUP  13 LSHIFT XOR
  DUP   9 RSHIFT XOR
  DUP   7 LSHIFT XOR
  DUP R> ! ;

 

 

[+TheBF]

[+TheBF]

I finally got around to doing standard deviation in Forth.

(I have been busy learning to play the Viola to join a community orchestra. I forgot how old I am)

 

As a stats tools go this one kind of sucks for accuracy using only integers.  

To make it useful I should scale by at least 10 and use 32bit intermediate calculations but this code provides a framework.

 

Once I got my head back into what I needed to do from Lee's input earlier, I thought it would be cool to use the MAP, REDUCE system that I made earlier.

Of course when forced to use my own code I had to fix it a bit. The arrays now return the number of items rather than the size in bytes.

And the ]] operator at the end returns the array address and number of items to the data stack. 

This makes more sense for this practical application. 

 

Using MAP, SUM and MEAN and some pre-made functions for square root, iterative subtraction and squaring we can write the standard deviation function like this, which is kind of neat.

 

: STD.DEV ( addr #items -- n) 
\  σ = √(Σ(Xi–μ)^2 /(n–1)) 
   DUP >R          \ save length on R stack for later 
   2DUP MEAN -ROT  ( -- mean addr len )
   ['] [-] MAP   
   ['] ^2  MAP SUM  R> 1- /  
   SQRT 
   NIP             ( remove the mean value)
;

 

Here is the full code.  The SIGMA function returns 5 on the data given and the correct answer is 5.76 so we it needs improvement. 

Spoiler

\ STATS101.FTH     senior adivsor Lee Stewart     B Fox 2023

\ "Well, I suppose you could also report the mean:  (μ = (Σxi)/n = 32000/26 = 1230.77) 
\ and standard deviation  (σ = √(Σ(xi–μ)2/(n–1)) = 23.86). 
\ Since σ accentuates variations from the mean, you might also include the 
\ average deviation for comparison: D = Σ|xi–μ|/n = 19.85."

\ MAP, REDUCE and FILTER for integer data

INCLUDE DSK1.TOOLS
INCLUDE DSK1.VALUES
INCLUDE DSK1.DEFER


DECIMAL
\  ** EXPERIMENTAL DATA STRUCTURE ***
\    COUNTED ARRAYS IN FREE MEMORY

VARIABLE OLDDP
VARIABLE LAST[]

\ creator for counted arrays in empty memory
\ Data structure has a 2 cell header
\ Cell 1: LINK - to previous array or zero
\ Cell 2: size - SIZE in bytes of this array

\ DATA .....
: DLINK,    HERE LAST[] @ , LAST[] ! ;

: CLEAN    LAST[] @ IF  LAST[] @ DP !  THEN ;

\ create header, return the address
: [[   ( -- addr ) HERE OLDDP ! DLINK,  HERE  0 ,  ; 

: SIZE[] ( addr -- addr size)   DUP CELL+ SWAP @ ;
: #ITEMS ( addr -- addr items)  SIZE[] 2/ ; 

: CELL-  ( n -- n') POSTPONE 2- ; IMMEDIATE  \ TMs9900 specific
: LINK[] ( addr -- 'array[] | 0) CELL- @ ;

\ end array, fill in size, return addr,#items 
: ]]   ( -- addr len )  HERE OVER - 2- OVER !  #ITEMS ; 

\ a word to name a counted array and return the (addr,len) pair
: DATA:   CREATE  ,  ,   DOES> 2@ ( -- addr size)  ;

\ Explanation:
\ ACTOR holds the execution token (XT) for the operation that will be done
\ to each data element. The XT is passed to ACTOR by the programmer.
VARIABLE ACTOR

\ ACTION is vector that holds code that does the ACTOR XT  and it also
\ runs EXTRA code that makes the difference between REDUCE, MAP or FILTER
DEFER ACTION

\ this code is run in a loop by FOREACH
: REDUCER    ( initial n -- n)  ACTOR PERFORM ; \ reduce and return a value
: MAPPER     ( initial n -- )   REDUCER  ,  ;   \ reduce and compile value
: FILTRATION ( initial n -- ) \ reduce with conditional Compilation of value
     2DUP SWAP REDUCER ( -- n ? )
     IF  ,       \ if true compile n into array
     ELSE DROP   \ otherwise throw it away
     THEN  ;

\ primary iterator
DECIMAL
: FOREACH  ( inital addr items xt-- n) 
         OVER 0= ABORT" REDUCE: size=0"
         ACTOR @ >R  \ allow variable to be re-entrant
         ACTOR !     \ set the XT of action on each cell
         CELLS BOUNDS DO  I @ ACTION  2 +LOOP
         R> ACTOR !
;

: REDUCE ( inital addritemsxt-- n) ['] REDUCER IS ACTION  FOREACH  ;

\ MAP returns a new array as output 
: MAP ( initial addr items xt-- addr' size')
  [[ >R  ['] MAPPER IS ACTION  FOREACH  R> ]]  ;

\ filter creates a temp counted array that might be a different size
: FILTER ( initial addr items xt-- addr' size')
 [[  >R  ['] FILTRATION IS ACTION  FOREACH  DROP R> ]]  ;

 \ print array 
: ..  ( addr items -- )  ['] .  REDUCE ; \ print array signed
: U.. ( addr items -- )  ['] U. REDUCE ; \ print array un-signed


\ ==========================================================
\ STATS Utility words

: SUM   ( addr len ) 0 -ROT  ['] + REDUCE ;

\ μ = (Σxi)/n
: MEAN  ( addr items -- n) DUP >R  SUM  R> / ;

: U/  ( u1 u2 -- u3 )  0 SWAP UM/MOD NIP ;


\ Albert VanderHorst square root 
DECIMAL
: INIT-SEED ( n -- n n') DUP 10 RSHIFT 8 MAX ; \ for 16 bits only

: SQRT ( n -- )
  DUP
  IF
     DUP>R
     INIT-SEED   ( optimized seed value)    \ 64516 SQRT : 5000x 16.4 seconds
\      1   ( default seed value )           \ 64516 SQRT : 5000x 31.1 seconds
     R@ OVER U/ OVER + 2/ NIP ( DUP . )     \ debug viewing
     BEGIN
        R@ OVER U/ OVER + 2/  ( DUP .)
        2DUP >
     WHILE
        NIP
     REPEAT
     DROP
     NIP
     R> DROP
  THEN ;

\ iteratable functions for MAP and REDUCE
: [-]   ( x n -- x n')  OVER -  ;
: [+]   ( x n -- x n')  OVER +  ;
: [*]   ( x n -- x n')  OVER *  ;
: [/]   ( x n -- x n')  OVER /  ;
: [MOD] ( x n -- x n')  OVER MOD ;

: ^2    ( n -- n') DUP * ;

: STD.DEV ( addr len -- n) 
\  σ = √(Σ(Xi–μ)^2 /(n–1)) 
   DUP >R          \ save length on R stack for later 
   2DUP MEAN -ROT  ( -- mean addr len )
   ['] [-] MAP   
   ['] ^2  MAP SUM  R> 1- /  
   SQRT 
   NIP             ( remove the mean value)
;

: AVG.DEV 
\ D = Σ|xi–μ|/n
   DUP >R 
   2DUP MEAN -ROT  ['] [-] MAP SUM  
   R> 1- /  NIP        
;


\ ==========================================================
\ TEST DATA 
PAGE
\ Example 
[[  17 , 15 , 23 , 7 , 9 , 13 , ]] DATA: A[]


A[] ..
A[] SUM .
A[] MEAN .
A[] ' ^2 MAP .. 
A[] STD.DEV .
A[] AVG.DEV .

 

 

 

The screen capture shows the operation on some test data

 

 

[+TheBF]

Over on comp.lang.forth there is a discussion about keeping local variables on the data stack.

 

It made me take another look at my cheap local variables for our small memory footprint machine. 

 

It dawned on me that it would be pretty simple to make the local variable act like a Forth VALUE and return their contents.

All I needed was a way to assign a number to a local.  That took only three instructions using the return stack local variable.

This is the same number of instructions as making an optimized "to" word to assign to a value. 

 

So here is the code for local-values:

Spoiler

\ localvalue.fth for Camel99 Forth                     May 2023 Brian Fox
\ non-standard but TINY for TI-99.
\ Not compatible DO/LOOP in Camel99

\ creates a stack frame on the return stack
\ Uses pre-named local variables that hold an index into the stack frame
\ Each local returns the *contents* of a cell on Rstack onto the data stack 
\ PREFIX -> operator used to assign to local variable 

NEEDS MOV,  FROM DSK1.LOWTOOLS 

HERE
HEX
CODE LOCALS: ( n --) \ build a stack-frame n cells deep
  RP R0 MOV,  ( DUP return stack pointer in R0)
  TOS 1 SLA,  ( TOS 2* )
  TOS RP SUB, ( allocate TOS cells )
  RP DECT,    ( make room on the Rstack)
  R0 RPUSH,   ( push old RP onto top of frame )
  TOS POP,
  NEXT,
ENDCODE
 
\ collapse stack frame: 
CODE /LOCALS  ( -- )  *RP RP MOV,  NEXT, ENDCODE

: LOCAL: ( n -- ) \ name some local variables
  CREATE  CELLS ,  \ record the cell offset for this local
  ;CODE  ( -- n)
         TOS PUSH, \ make toom on the data stack      
    RP   TOS MOV,  \ get the Rstack base address
    *W   TOS ADD,  \ add the local offset 
    *TOS TOS MOV,  \ fetch the value from the address          
    NEXT,
  ENDCODE

CODE LOCAL! ( n offset -- )
    RP   TOS ADD,  \ add Rstack base address to offset in TOS
   *SP+ *TOS MOV,  \ pop 2nd item into address in TOS 
         TOS POP,  \ refill TOS register
    NEXT,
ENDCODE     

: ->  ( n -- <local> ) \ assign n to a local value 
    ?COMP 
    ' >BODY @   ( get the offset for this local value )
    POSTPONE LITERAL  POSTPONE LOCAL!
; IMMEDIATE

DECIMAL
HERE SWAP - SPACE . .( bytes )

 

 

Here is a couple of demos of what it looks like. Notice the local names are pre-defined. But they can be used in any definition without affecting each other.

This is way simpler that dynamically creating a list of names and destroying it every time. 

\ ** test code ** 
\ Local names are pre-defined
 1 LOCAL: X1
 2 LOCAL: X2
 3 LOCAL: X3
 4 LOCAL: X4
 5 LOCAL: X5

 DECIMAL
: ADD ( n n -- n) 
  2 LOCALS: -> X1 -> X2 
       X1 X2 +
  /LOCALS
;

: ROT  
    3 LOCALS: -> X3  -> X2 -> X1 
      X1  X3  X2 
   /LOCALS
;

 

But there is no free lunch.  Here is the BENCHIE benchmark replacing the the one VALUE, BVAR  with a local. 

The results surprised me.  Using a value the code runs in 25.5 seconds. 

Replacing the VALUE with one of these locals took 48 seconds.  Why?

Because you have to build the stack-frame on entry and then destroy it on exit .

Even though it's just two extra Forth CODE words they are significant inside this little loop. 

 

5 CONSTANT FIVE
HEX
100 CONSTANT MASK

1 LOCAL: BVAR

: BENCHIE 
         MASK 0
         DO
            1 LOCALS:
            1
            BEGIN
              DUP SWAP DUP ROT DROP 1 AND
              IF FIVE +
              ELSE 1-
              THEN -> BVAR
              BVAR DUP MASK AND
            UNTIL
            DROP
            /LOCALS 
         LOOP ;  \ 48 seconds 

 

 

Edited May 12, 2023 by TheBF
fixed comment

[Willsy]

Nice! Locals in Forth is a bit of a conundrum. The Forth die-hards insist they aren't necessary - and of course they are correct - you can indeed write any definition without recourse to locals, but locals make the code soooo much more readable. And just about every other language has them. It's interesting that in the Forth community there is a lot of interest in adding modern language concepts to Forth, such as OOP, currying, lambdas etc., but when locals are discussed there is a prevailing sense of snobbery on the issue!

 

As you know, I've done quite a bit of work on locals in TF over the years, the latest one being this one, which provides both named inputs and local variables - I pinched the concept off of Pelc's excellent VFX forth. But I keep coming back to this one, both for it's simplicity of implementation (I think it's elegant and Forthy (or should that be Forthright?!)) and really simple to use. As written, it provides any definition with 3 local variables (or one could think of them as registers, I suppose) with fixed names. So useful. A very small change (make the lsp (local stack pointer) a variable instead of a value) would permit easy conversion of the implementation into machine code. It would be interesting to benchmark the two implementations.

 

I must check back into CLF at some point. I kind of gave up with it as it is quite acerbic and even toxic at times. 

[+TheBF]

 this one is nice and small which was why I have avoided the ANS way of doing things. It's enormous to implement.

 

You could make a local definers with CREATE DOES> on that one.  If the DOES> section was replaced with ;CODE it would be super fast as well.

: GETTER:   CREATE   CELLS ,  DOES>  @ LSP + @ ; 
: SETTER:   CREATE   CELLS ,  DOES>  @ LSP + ! ;

 

[+TheBF]

Real Iron Forth on RS232

 

This should not have taken me this long to do but I am easily distracted. 

 

Attached is a version of Camel99 Forth V2.69 kernel that connects to the TI-99 over RS232/1.

 

It is built with the same sources a the VDP/console version but the I/O code is separated out into a CONSOLE file or a TTY-IO file.

Compiler switches control if the kernel is built with VDP or RS232 I/O. 

 

The configuration for your terminal can be shown in the Forth words that set it up for the program.  

 

      RS232 /TTY1 BA=19200 8,N,1 OPEN-TTY         

 

Bug list:

 

The ?TERMINAL word is different on a terminal. 

Control C  is the traditional key command so and of the program (WORDS, DUMP etc.) that let you break out, will be looking for ^C. 

I notice that my space bar to stop printouts is not working over RS232. I think the I/O is too fast.

 

The regular START file works and loads a new font, and then tries to print the TI logo on the screen but of course the characters are invisible on the terminal. 

 

COLD stopped working after I loaded TOOLS. ??

 

From what I can tell most Forth specific things work like with the TI console.  Loading VDP graphics requires a word that's not in the kernel.

If somebody really want access to VDP graphics we can "do the needful" for you. 

 

But the purpose of this kernel is mostly so I can test concepts on real iron without using the TI-99 keyboard.  

Somebody else might want to play around.  The speed of the text output at 19.2Kbps is faster than VDP text.

 

I have VT100 color controls and a bunch of stuff I made earlier for TTY control so if anybody really wants to explore this let me know. 

I can even get VIBE99 running on here if people want an editor.  (VI99 would be a major re-write)

 

I think I also have  BETTY  (Block Editor for TTY) on a disk here as well which is more conventional. 

 

Edit: Updated the code to include C/L! which is used to set the chars/line and also calculates and store C/SCR (chars per screen)

Also provide the super-cart version.

 

This version will now load GRAFIX and let you draw on the VDP screen for testing. 

BETTY is not working and I still want a text file editor that can operate over TTY.

 

 

 

CAMELTTY CMLTTYSC

[+TheBF]

I have read that the best way to write a compiler is to throw the first one away!  

 

I started looking at what it would take to put vi99 on RS232. duh!  I had over complicated a lot of stuff on the VDP version.

I have the structure of the command interface completed. 

 

I see someone downloaded the TTY version. 

If you want a faster boot up you can replace the DSK1.START file with the script below. (SAVE THE OLD ONE IF YOU ARE NOT MAKING A NEW DSK1.) 

\ V2.1 START file loads DSK1.SYSTEM to add ANS extensions

S" DSK1.SYSTEM" INCLUDED
NEEDS AT-XY  FROM DSK1.VT100

HEX 83D6 ON \ stop screen saver

DECIMAL 80 C/L!

: VTYPE ( addr len --) SWAP VWRITE ;

S" VT100 on RS232/1 19.2Kbps 8,n,1" 32 VTYPE

PAGE ." ** CAMEL99 FORTH " .VER ." **"
CR RP0 64 +  HERE - . .( bytes free)
CR ." Ready"
CR
HEX

 

For that one brave soul it is possible to make a bigger system by compiling tools and stuff you want in your Forth and then "saving" it as a binary program.

I am just making one for myself using the supercart version. 

 

Here is a short video showing this "faster" boot process from floppy disk on real iron and me fooling around on the terminal. 

The old TI-99 feels like proper Mini-computer.  

 

[GDMike]

Less than 30 seconds too.

[+TheBF]

2 hours ago, GDMike said:

Less than 30 seconds too.

On the video reboot is about 10 seconds.

From the E/A menu you have to add another 5 seconds from floppy-disk.

It would be quicker with TIPI.

 

[+TheBF]

Here is a script to make your own custom version of Camel99 Forth with various tools pre-compiled. 

 

I just ran this on real iron with floppy drives and it took 3.5 mins to complete. 🙂

 

But after it runs you can load FORTHTTY and the whole thing is live in 10 seconds. 

 

edit: Found a bug in WORDLISTS.  The Assembler vocabulary words are not visible when we load the binary program.

I thought I had that fixed. Hmmm.

Problem solved.  See next post

 

\ myforthmak.fth    May 2023 Brian Fox
\ script to make a custom Camel99 Forth system

\ Load this file onto one of the Camel99 kernels
\            RAM     Supercart
\          -------   ---------
\ Console: CAMEL99 | CAMEL99SC 
\ RS232:  CAMELTTY | CMLTTYSC 

\ put the files you want in the system here 
NEEDS DUMP        FROM DSK1.TOOLS
NEEDS DIR         FROM DSK1.DIR 
NEEDS CAT         FROM DSK1.CATALOG 
NEEDS -TRAILING   FROM DSK1.TRAILING
NEEDS ELAPSE      FROM DSK1.ELAPSE 
NEEDS MARKER      FROM DSK1.MARKER

\ get fancy and add vocabularies 
NEEDS WORDLIST    FROM DSK1.WORDLISTS 

\ put the Assembler in a vocabulary 
VOCABULARY ASSEMBLER 
ONLY FORTH ALSO ASSEMBLER DEFINITIONS 
INCLUDE DSK1.ASM9900 

\ set search path to look in Assembler and Forth
ONLY FORTH ALSO ASSEMBLER ALSO FORTH DEFINITIONS

\ ** NEED INIT-WORDLISTS at boot-up if we include WORDLISTS **
: START  WARM  INIT-WORDLISTS  ABORT ;

LOCK  ( saved system will end here)

\ for CAMELTTY in hi ram
INCLUDE DSK1.SAVESYS
' START SAVESYS DSK2.FORTHTTY  ( choose your path & name)

\ for CMLTTYSC in Supercart RAM
\ INCLUDE DSK1.SUPERSAVE
\ ' START SUPERSAVE DSK2.FORTHTTY

 

[+TheBF]

Lol.  Source code management with floppy disks is not much fun.

 

The version of tools I had on my old TTY Forth floppy disk predated me writing WORDLISTS.

So of course "WORDS" started traversing the dictionary from LATEST @   not  CONTEXT @ @ 

 

So if you put one of these TTY Forths on your Camel99 system disk, the system builder script would make FORTHTTY and it would work fine.  

 

Just me sitting here in 1984 had a problem.  

 

 

[+TheBF]

A while back I took a run at using the Forth multitasker for the Breakout game clone.

I worked pretty well. The paddle now moves smoothly regardless of what the ball is crashing into up above. 

I still have an occasional bug where the ball enters the surround wall and bounces around inside, but when I fix that I will release this version.

 

I thought @Retrospect might want to see a real example of a game using the multitasker. 

(full program source: CAMEL99-ITC/BREAKOUT-MTASK.FTH at master · bfox9900/CAMEL99-ITC · GitHub  )

 

The original game had a big loop in it called BALLINPLAY 

: BALLINPLAY
    BEGIN
      ?BREAK
      ?WIN 
      BALL SP.MOVE
      PADDLE-CTRL  ( <<< removed this line ) 
      
      BALL PADDLE 8 COINC IF PADDLE-HIT THEN 
      UNDERBALL ( char)
      CASE      \ points Freq.
        MAGBAR   OF 6   1500 RICOCHET    ENDOF
        REDBAR   OF 5   1400 RICOCHET    ENDOF
        YELBAR   OF 4   1300 RICOCHET    ENDOF
        GRNBAR   OF 3   1200 RICOCHET    ENDOF
        BLUBAR   OF 2   1100 RICOCHET    ENDOF
        VIOBAR   OF 1   1000 RICOCHET    ENDOF
        BORDER   OF WALL-BOUNCE 200 CLINK  ENDOF
      ENDCASE
      SPEED @ TICKS 
      BALL SP.Y VC@ 200 > ( off screen test)
    UNTIL 
    BONK 
;

 

I took out the line called PADDLE-CTRL and made this. It just moves the paddle. 

\ ********************************************
\ Joystick control runs as a background task
\ ********************************************
:NONAME
    BEGIN 
        PAUSE 
        0 JOYST
        CASE
          2 OF  -1 PADDLE+!  ENDOF
          4 OF   1 PADDLE+!  ENDOF 
        ENDCASE
        5 TICKS 
    AGAIN    \ never stops because it is a separate task 
; CONSTANT PADDLE-TASK

 

Then in the startup word GO  I just added the commands to SPAWN a new workspace in low RAM and WAKE it up.

(In UNIX circles they say that if a computer wants to create a new task it has to FORK.)  

 

: SPAWN  ( xt -- pid)  USIZE MALLOC DUP >R FORK  R@ ASSIGN  R> ;

: GO
    DECIMAL
    QUIT-ON
    PADDLE-TASK SPAWN WAKE ( <<< line added ) 
    MULTI                  ( <<< line added ) 
    BEGIN 
      SETUP  
      DRAW.SCR
      .CREDITS 
      LEVEL-MENU
      .PRESS-FIRE
      CLS
      BEGIN
      \ etc ...