Camel99 Forth Information goes here

+TheBF · July 25, 2020

6 hours ago, DavidC said:

Hey man, I have been dabbling with CAMEL99 and I like it! I have been reading through your instruction manual/tutorial and messing with the demos on .dsk 3. Pretty cool stuff! I like how you have made "modules" I guess I would call them...INCLUDE DSK.1 BASICHLP or whatever...AWESOME! It it obvious you put a lot of thought and work into this. I am still thoroughly confused about a lot of things FORTH but thats just me. CAMEL99 is fantastic. Thanks for all your hard work.

I am very happy that you enjoy it. It has been a lot of work but I wanted to do 35 years ago and life got in the way.

Ask any questions you want. I am happy to explain whatever you need. It's a pretty big jump from BASIC, but it can be a little easier than Assembler once you get the concepts.

B

+TheBF · July 25, 2020

Here is something called Forth in 5 Minutes which I modified for Camel99 Forth and corrected a few errors in the original.

It's a tutorial that is written in Forth.

Spoiler


( The basis of this file came from https://learnxinyminutes.com/docs/forth/ )
( It has been edited,corrected and expanded for ANS/ISO FORTH )

( NOTE: this file is written in Forth and can be read by a compliant system)

\ --------------------------------- Preamble --------------------------------
( This is the original Forth comment. Notice the required 1st space!)
\ This is the full line comment. This file is to get you started with CAMEL99 V2

\  ***  All Forth commands are separated by a SPACE ***

\ Forth commands are called WORDS. They are like sub-routines in other languages.
\ WORDs are kept in the Forth Dictionary.
\ In Forth, everything is either a WORD in the dictionary or a number.
\ All programming in Forth is done by using existing WORDs to make new WORDs.
\ FORTH is one of the first "CONCATENTIVE" languages which means you can
\ string words together end to end to make more powerful words.

\ Numbers and math are typically performed on the data stack
( commonly called "the stack")

\ Typing numbers pushes them onto the stack. 1st number is on the bottom.
5 2 3 56 76 23 65    \ ok

( .S prints the stack contents but DOES NOT remove them)
\   5 2 3 56 76 23 65
.S

\ The `.` word pops the top item from the stack and prints it:
. . . . . . .

\ ------------------------------ Basic Arithmetic ------------------------------
\ set the interpreter to DECIMAL arithimetic with:
DECIMAL    \ ok

\ Arithmetic operators (+,-,*,/ etc) are also just Forth WORDs
\ They operate on numbers sitting on the stack
\ '+' takes two inputs, adds them and leaves the answer on the stack

5 4 +    \ ok  ( looks like nothing happened but 9 is on the stack)

\ print the answer on the stack with "dot"
.

\ More examples of arithmetic:
6 7 * .        \ 42 ok
1360 23 - .    \ 1337 ok
12 12 / .      \ 1 ok
13 2 MOD .     \ 1 ok
99 NEGATE .    \ -99 ok
-99 ABS .      \ 99 ok
52 23 MAX .    \ 52 ok
52 23 MIN .    \ 23 ok

\ HEXADECIMAL arithmetic and other BASEs
\ Forth can switch to HEX numbers with the word HEX
\ AND performs a logical AND so we can mask bits like this

HEX
1234 00FF AND . \ 34

 DECIMAL  ( changes the system back to BASE 10 arithmetic)
\ ----------------------------- Stack Manipulation -----------------------------
\ Naturally, as we work with the stack, we'll need these WORDs:
\                                                              -----
3 DUP            \ duplicate the top item (1st now equals 2nd): 3 3
4 0 DROP .S      \ remove the top item :                        4
1 2 3 NIP .S     \ remove the second item (similar to drop):    1 3
2 5 SWAP .S      \ swap the top with the second element:        5 2
6 4 5 ROT .S     \ rotate the 3rd item to top:                  4 5 6
6 4 5 -ROT .S    \ rotate top item to 3rd position              5 6 4

\ clean the stack the hard way
DROP DROP DROP DROP DROP DROP DROP DROP DROP DROP DROP DROP DROP

\ ---------------------- More Advanced Stack Manipulation ----------------------
( duplicate the top item below the second slot:)
1 2 3 4 TUCK  .S

DROP DROP DROP DROP DROP

\ duplicate the second item to the top:    
1 2 3 4 OVER  .S

DROP DROP DROP DROP DROP

\ *duplicate* the item from position "2" onto the top:
1 2 3 4   2 PICK

DROP DROP DROP DROP DROP

\ PICK use "0" based indexing. ( ie: 0 PICK = DUP)

\ ------------------------------ Creating Words --------------------------------
\ The `:` word puts Forth into compile mode until it sees the `;` word.

: SQUARE ( n -- n ) DUP * ;    \ ok

5 SQUARE .                     \ 25 ok

\ WORDs that we create are just added to the dictionary
\ WORDs can be combined with other words to any depth

: 2(X^2) ( n -- n) SQUARE  2 * ; \ returns  2(n^2)

\ Printing text is unusual but workable.
\ ANS Forth has ." to print a text string inside a compiled word.
\ There are two unusual things about "dot-quote", as it is called.
\ 1. You must put a space after ."
\    Do you understand why? Because it is a Forth word like all the rest.

\ 2. "dot-quote"is a state-smart word. This means it does one thing in compiling mode
\     and something else in immediate mode (interpreting)

\ In compile mode it has to "compile" strings of text into a new word definition.
\ CR (carriage return) is the word for a new line

: HELLO
         CR ." Hello World!"
	 CR ." uses 'dot-quote' in the word HELLO" ;

HELLO

\ In IMMEDIATE mode "dot-quote" simply has to type a string to the output device.
." Print this now!"

\ You can also print text in the interpret mode ONLY using .(  
\ This is called a talking comment.

CR .( This message will print from the interpreter)
CR .( This is also called a "talking comment")
CR .( It is used to inform the programmer while a file is compiling)

\ Remember to put space between ." or .( and the text!

\ -------------------------------- Conditionals ------------------------------
\ TRUE and FALSE are constants in CAMEL99. TRUE returns -1  FALSE returns 0
( However, any non-zero value is also treated as being true)

TRUE .     \ -1 ok
FALSE .    \ 0 ok
42 42 = .   \ -1 ok
12 53 = .   \ 0 ok

\ `IF` is a compile-only word that does stuff if top of stack is TRUE
\ Forth's IF/THEN will confuse you if you think it's the same as other languages.
\ It is best understood if we consider the sentence:

\  Looks like rain?   IF so,   Get your umbrella   THEN go outside.

\ Syntax: `IF` <stuff to do when TOS is true> `THEN` <do the rest of program>.

: ?>64 ( n -- n ) DUP 64 > IF ." Greater than 64!" THEN ; \ ok

100 ?>64     \ Greater than 64! ok

\ 'ELSE'

: ?>64 ( n -- n ) DUP 64 > IF ." Greater than 64!" ELSE ." Less than 64!" THEN ;

100 ?>64
20 ?>64

\ ------------------------------------ Loops ------------------------------
\ looping words are compile-only. (must be inside a colon defintion)

: MYLOOP ( -- ) 5 0 DO ." Hello!  " LOOP ; \ ok

\       Hello!  Hello!  Hello!  Hello!  Hello!
MYLOOP

\ `DO` expects two numbers on the stack: the end number and the start number.
\ (the loop limit and the loop index)
\ We can get the value of the index as we loop with `I`:

: ONE-TO-12 ( -- ) 12 0 DO I . LOOP ;     \ ok
\         0 1 2 3 4 5 6 7 8 9 10 11 ok
ONE-TO-12

\ Notice the loop stops when the limit and index are equal.
\ We printed 12 numbers... 0 to 11

\ `?DO` works similarly, except it will skip the LOOP if the end and start
\ numbers are equal on the parameter stack. This is used if there is a chance
\ that limit=index as input arguments and you want to prevent a run-away loop.

( We defined SQUARE earlier so we can use it now)

: SQUARES ( n -- ) 0 ?DO I SQUARE . LOOP ;   \ ok
\            0 1 4 9 16 25 36 49 64 81 ok
10 SQUARES   
0 SQUARES

\ Change the looping "step" with `+LOOP`:

: THREES ( n n -- ) 3 ?DO  I .   3 +LOOP ;  \ ok
\          3 6 9 12 15 18 ok
20 THREES 

\ Indefinite loops with `BEGIN` <stuff to do>  `AGAIN`:
( **DONT' RUN THIS. YOU CAN'T STOP IT ***)
: FOREVER ( -- ) BEGIN ." Are we there yet?" AGAIN ;

\ Conditional loops use 'BEGIN' <stuff to do> <condition> 'UNTIL'

: DECREMENTER ( n -- ) BEGIN 1-  DUP  0= UNTIL ;

99 DECREMENTER \ OK

\ Breaking out of a loop from the keyboard is possible by testing for a
\ key with KEY? which reads any key and returns 0 if no key is pressed

: KEYLOOP   BEGIN  ." Press a key to stop me..."  KEY? UNTIL ;

\ WHILE loops use 'BEGIN'  <condition> 'WHILE' <stuff to do> 'REPEAT'

: UPTO10  ( -- )  0 BEGIN  1+  DUP 10 < WHILE  ." NOT YET!  "  REPEAT DROP ;

\ ---------------------------- Variables and Memory ----------------------------
\ Use `VARIABLE` to create an integer variable.

VARIABLE AGE    \ ok

\ VARIABLEs do not return their value!
\ They simply give us an address in memory where we can store numbers
( like a "pointer" but simpler language)

\ We write 21 to AGE with the word `!` (pronounced "store")

21 AGE !    \ ok

\ We can read the value of our variable using the `@` word called "fetch"
\ '@' just reads the value from an address and puts in the stack

AGE @     \ 21 is sitting on the top of the stack now

\ to print the value on the top of the stack use the '.' command
 .

\ A common tool to fetch and print is '?' which combines @ and .
: ?   ( addr -- )  @  . ;

AGE ?      \ 21 ok

\ We can work in a new RADIX by changing the system variable BASE
\ Binary...
 HEX F0  2 BASE ! .  \ 11110000 ok

\ Octal...
8 BASE !   7 1 + .   \ 10 ok

DECIMAL
\ Constants work as expected and return their value to the top of stack

100 CONSTANT WATER-BOILING-POINT    \ ok
WATER-BOILING-POINT .               \ 100 ok

\ ----------------------------------- Arrays -----------------------------------
\ Like Assembly language Forth has no standard way to make arrays.
\ We can create arrays by naming a block of memory with the WORD CREATE
\ and allocating memory space with ALLOT.

\ A CELL in Forth is the memory size of a native integer on the CPU
\ For 16 bit machine, a CELL is 2 bytes
\ For 32 bit computer, it would be 4 bytes etc.

\ 'CELLS' calculates memory size for n CELLS of memory on your computer
CR ." Your computer's CELLs take"  1 CELLS .  ." bytes"


\ All together it looks like this:
CREATE MYNUMBERS   10 CELLS ALLOT    \ ok

\ Initialize all the values to 0
MYNUMBERS 10 CELLS 0 FILL   \ ok

\ If we needed to do this a lot, we would define ERASE
: ERASE  ( addr len -- ) 0 FILL ;

\ ... and do this...
MYNUMBERS 10 CELLS ERASE

\ or we can CREATE an array initialized with specific values
\ using the 'comma' number compiler. (puts 1 integer in next available CELL)
CREATE MYNUMBERS    64 , 9001 , 1337 , \ ok (the last `,` is important!)

\ ...which is equivalent to manually writing values to each index:
  64 MYNUMBERS 0 CELLS + !    \ ok
9001 MYNUMBERS 1 CELLS + !    \ ok
1337 MYNUMBERS 2 CELLS + !    \ ok

\ Reading values from our array at indexes, the hard way:
MYNUMBERS 0 CELLS + ?    \ 64 ok
MYNUMBERS 1 CELLS + ?    \ 9001 ok

\ Normally we would extend the language and make a helper word for
\ accessing arrays for example we could create '[]'
( FORTH lets us use any characters except space as identifiers)

: [] ( n array -- addr[n] ) SWAP CELLS + ;    \ ok

\ Now we created an array syntax that works like this:
20 1 MYNUMBERS [] !    \ ok
   1 MYNUMBERS [] ?    \ 20 ok

\ If you don't like this syntax you are free to change it!
\ *Notice there is no index checking. You could add it if you need it.

\ ------------------------------ The Return Stack ------------------------------
\ Just like a sub-routine stack, the Forth return stack holds the address (pointer)
\ of the word that called the currently running word.  This lets a Forth Word'return'
\ to the word that called it. (ie: where it came from)
\ In CAMEL99 the return stack also holds the limit and index of any running DO LOOP.

\ The programmer is free to use the return stack BUT be very careful.
\ You can easily crash the system if you make a mistake.

\ Example: Print 4 numbers starting from the bottom of the DATA stack
: .INORDER ( n1 n2 n3 n4 -- )
		>R >R >R               \ push 3 #s onto return stack
		.                      \ print n1,
		R> . R> . R> .  ;      \ pop each and print

1 2 3 4 .INORDER
\ NOTE: Because Forth uses the return stack internally, `>R` should
\ always be matched by `R>` inside of your word definitions or expect a crash!

PAGE
\ --------------------------------- Final Notes --------------------------------
\ Typing a non-existent word will empty the stack because it calls the word ABORT
\ which resets the data stack and the return stack

\ Clear the screen:
\ PAGE

\ Loading Forth files into the system:
\ INCLUDE MYFILE.FTH

\ you can list every word that's in Forth's dictionary with WORDS
\ BUT YOU NEED THE TOOLS TO DO IT. We will include the TOOLS file first.
\ Press any key to continue

KEY DROP

INCLUDE DSK1.TOOLS

WORDS

+Lee Stewart · July 25, 2020

9 hours ago, TheBF said:

Here is something called Forth in 5 Minutes which I modified for Camel99 Forth and corrected a few errors in the original.

It's a tutorial that is written in Forth.

Reveal hidden contents



( The basis of this file came from https://learnxinyminutes.com/docs/forth/ )
( It has been edited,corrected and expanded for ANS/ISO FORTH )

( NOTE: this file is written in Forth and can be read by a compliant system)

\ --------------------------------- Preamble --------------------------------
( This is the original Forth comment. Notice the required 1st space!)
\ This is the full line comment. This file is to get you started with CAMEL99 V2

\  ***  All Forth commands are separated by a SPACE ***

\ Forth commands are called WORDS. They are like sub-routines in other languages.
\ WORDs are kept in the Forth Dictionary.
\ In Forth, everything is either a WORD in the dictionary or a number.
\ All programming in Forth is done by using existing WORDs to make new WORDs.
\ FORTH is one of the first "CONCATENTIVE" languages which means you can
\ string words together end to end to make more powerful words.

\ Numbers and math are typically performed on the data stack
( commonly called "the stack")

\ Typing numbers pushes them onto the stack. 1st number is on the bottom.
5 2 3 56 76 23 65    \ ok

( .S prints the stack contents but DOES NOT remove them)
\   5 2 3 56 76 23 65
.S

\ The `.` word pops the top item from the stack and prints it:
. . . . . . .

\ ------------------------------ Basic Arithmetic ------------------------------
\ set the interpreter to DECIMAL arithimetic with:
DECIMAL    \ ok

\ Arithmetic operators (+,-,*,/ etc) are also just Forth WORDs
\ They operate on numbers sitting on the stack
\ '+' takes two inputs, adds them and leaves the answer on the stack

5 4 +    \ ok  ( looks like nothing happened but 9 is on the stack)

\ print the answer on the stack with "dot"
.

\ More examples of arithmetic:
6 7 * .        \ 42 ok
1360 23 - .    \ 1337 ok
12 12 / .      \ 1 ok
13 2 MOD .     \ 1 ok
99 NEGATE .    \ -99 ok
-99 ABS .      \ 99 ok
52 23 MAX .    \ 52 ok
52 23 MIN .    \ 23 ok

\ HEXADECIMAL arithmetic and other BASEs
\ Forth can switch to HEX numbers with the word HEX
\ AND performs a logical AND so we can mask bits like this

HEX
1234 00FF AND . \ 34

 DECIMAL  ( changes the system back to BASE 10 arithmetic)
\ ----------------------------- Stack Manipulation -----------------------------
\ Naturally, as we work with the stack, we'll need these WORDs:
\                                                              -----
3 DUP            \ duplicate the top item (1st now equals 2nd): 3 3
4 0 DROP .S      \ remove the top item :                        4
1 2 3 NIP .S     \ remove the second item (similar to drop):    1 3
2 5 SWAP .S      \ swap the top with the second element:        5 2
6 4 5 ROT .S     \ rotate the 3rd item to top:                  4 5 6
6 4 5 -ROT .S    \ rotate top item to 3rd position              5 6 4

\ clean the stack the hard way
DROP DROP DROP DROP DROP DROP DROP DROP DROP DROP DROP DROP DROP

\ ---------------------- More Advanced Stack Manipulation ----------------------
( duplicate the top item below the second slot:)
1 2 3 4 TUCK  .S

DROP DROP DROP DROP DROP

\ duplicate the second item to the top:    
1 2 3 4 OVER  .S

DROP DROP DROP DROP DROP

\ *duplicate* the item from position "2" onto the top:
1 2 3 4   2 PICK

DROP DROP DROP DROP DROP

\ PICK use "0" based indexing. ( ie: 0 PICK = DUP)

\ ------------------------------ Creating Words --------------------------------
\ The `:` word puts Forth into compile mode until it sees the `;` word.

: SQUARE ( n -- n ) DUP * ;    \ ok

5 SQUARE .                     \ 25 ok

\ WORDs that we create are just added to the dictionary
\ WORDs can be combined with other words to any depth

: 2(X^2) ( n -- n) SQUARE  2 * ; \ returns  2(n^2)

\ Printing text is unusual but workable.
\ ANS Forth has ." to print a text string inside a compiled word.
\ There are two unusual things about "dot-quote", as it is called.
\ 1. You must put a space after ."
\    Do you understand why? Because it is a Forth word like all the rest.

\ 2. "dot-quote"is a state-smart word. This means it does one thing in compiling mode
\     and something else in immediate mode (interpreting)

\ In compile mode it has to "compile" strings of text into a new word definition.
\ CR (carriage return) is the word for a new line

: HELLO
         CR ." Hello World!"
	 CR ." uses 'dot-quote' in the word HELLO" ;

HELLO

\ In IMMEDIATE mode "dot-quote" simply has to type a string to the output device.
." Print this now!"

\ You can also print text in the interpret mode ONLY using .(  
\ This is called a talking comment.

CR .( This message will print from the interpreter)
CR .( This is also called a "talking comment")
CR .( It is used to inform the programmer while a file is compiling)

\ Remember to put space between ." or .( and the text!

\ -------------------------------- Conditionals ------------------------------
\ TRUE and FALSE are constants in CAMEL99. TRUE returns -1  FALSE returns 0
( However, any non-zero value is also treated as being true)

TRUE .     \ -1 ok
FALSE .    \ 0 ok
42 42 = .   \ -1 ok
12 53 = .   \ 0 ok

\ `IF` is a compile-only word that does stuff if top of stack is TRUE
\ Forth's IF/THEN will confuse you if you think it's the same as other languages.
\ It is best understood if we consider the sentence:

\  Looks like rain?   IF so,   Get your umbrella   THEN go outside.

\ Syntax: `IF` <stuff to do when TOS is true> `THEN` <do the rest of program>.

: ?>64 ( n -- n ) DUP 64 > IF ." Greater than 64!" THEN ; \ ok

100 ?>64     \ Greater than 64! ok

\ 'ELSE'

: ?>64 ( n -- n ) DUP 64 > IF ." Greater than 64!" ELSE ." Less than 64!" THEN ;

100 ?>64
20 ?>64

\ ------------------------------------ Loops ------------------------------
\ looping words are compile-only. (must be inside a colon defintion)

: MYLOOP ( -- ) 5 0 DO ." Hello!  " LOOP ; \ ok

\       Hello!  Hello!  Hello!  Hello!  Hello!
MYLOOP

\ `DO` expects two numbers on the stack: the end number and the start number.
\ (the loop limit and the loop index)
\ We can get the value of the index as we loop with `I`:

: ONE-TO-12 ( -- ) 12 0 DO I . LOOP ;     \ ok
\         0 1 2 3 4 5 6 7 8 9 10 11 ok
ONE-TO-12

\ Notice the loop stops when the limit and index are equal.
\ We printed 12 numbers... 0 to 11

\ `?DO` works similarly, except it will skip the LOOP if the end and start
\ numbers are equal on the parameter stack. This is used if there is a chance
\ that limit=index as input arguments and you want to prevent a run-away loop.

( We defined SQUARE earlier so we can use it now)

: SQUARES ( n -- ) 0 ?DO I SQUARE . LOOP ;   \ ok
\            0 1 4 9 16 25 36 49 64 81 ok
10 SQUARES   
0 SQUARES

\ Change the looping "step" with `+LOOP`:

: THREES ( n n -- ) 3 ?DO  I .   3 +LOOP ;  \ ok
\          3 6 9 12 15 18 ok
20 THREES 

\ Indefinite loops with `BEGIN` <stuff to do>  `AGAIN`:
( **DONT' RUN THIS. YOU CAN'T STOP IT ***)
: FOREVER ( -- ) BEGIN ." Are we there yet?" AGAIN ;

\ Conditional loops use 'BEGIN' <stuff to do> <condition> 'UNTIL'

: DECREMENTER ( n -- ) BEGIN 1-  DUP  0= UNTIL ;

99 DECREMENTER \ OK

\ Breaking out of a loop from the keyboard is possible by testing for a
\ key with KEY? which reads any key and returns 0 if no key is pressed

: KEYLOOP   BEGIN  ." Press a key to stop me..."  KEY? UNTIL ;

\ WHILE loops use 'BEGIN'  <condition> 'WHILE' <stuff to do> 'REPEAT'

: UPTO10  ( -- )  0 BEGIN  1+  DUP 10 < WHILE  ." NOT YET!  "  REPEAT DROP ;

\ ---------------------------- Variables and Memory ----------------------------
\ Use `VARIABLE` to create an integer variable.

VARIABLE AGE    \ ok

\ VARIABLEs do not return their value!
\ They simply give us an address in memory where we can store numbers
( like a "pointer" but simpler language)

\ We write 21 to AGE with the word `!` (pronounced "store")

21 AGE !    \ ok

\ We can read the value of our variable using the `@` word called "fetch"
\ '@' just reads the value from an address and puts in the stack

AGE @     \ 21 is sitting on the top of the stack now

\ to print the value on the top of the stack use the '.' command
 .

\ A common tool to fetch and print is '?' which combines @ and .
: ?   ( addr -- )  @  . ;

AGE ?      \ 21 ok

\ We can work in a new RADIX by changing the system variable BASE
\ Binary...
 HEX F0  2 BASE ! .  \ 11110000 ok

\ Octal...
8 BASE !   7 1 + .   \ 10 ok

DECIMAL
\ Constants work as expected and return their value to the top of stack

100 CONSTANT WATER-BOILING-POINT    \ ok
WATER-BOILING-POINT .               \ 100 ok

\ ----------------------------------- Arrays -----------------------------------
\ Like Assembly language Forth has no standard way to make arrays.
\ We can create arrays by naming a block of memory with the WORD CREATE
\ and allocating memory space with ALLOT.

\ A CELL in Forth is the memory size of a native integer on the CPU
\ For 16 bit machine, a CELL is 2 bytes
\ For 32 bit computer, it would be 4 bytes etc.

\ 'CELLS' calculates memory size for n CELLS of memory on your computer
CR ." Your computer's CELLs take"  1 CELLS .  ." bytes"


\ All together it looks like this:
CREATE MYNUMBERS   10 CELLS ALLOT    \ ok

\ Initialize all the values to 0
MYNUMBERS 10 CELLS 0 FILL   \ ok

\ If we needed to do this a lot, we would define ERASE
: ERASE  ( addr len -- ) 0 FILL ;

\ ... and do this...
MYNUMBERS 10 CELLS ERASE

\ or we can CREATE an array initialized with specific values
\ using the 'comma' number compiler. (puts 1 integer in next available CELL)
CREATE MYNUMBERS    64 , 9001 , 1337 , \ ok (the last `,` is important!)

\ ...which is equivalent to manually writing values to each index:
  64 MYNUMBERS 0 CELLS + !    \ ok
9001 MYNUMBERS 1 CELLS + !    \ ok
1337 MYNUMBERS 2 CELLS + !    \ ok

\ Reading values from our array at indexes, the hard way:
MYNUMBERS 0 CELLS + ?    \ 64 ok
MYNUMBERS 1 CELLS + ?    \ 9001 ok

\ Normally we would extend the language and make a helper word for
\ accessing arrays for example we could create '[]'
( FORTH lets us use any characters except space as identifiers)

: [] ( n array -- addr[n] ) SWAP CELLS + ;    \ ok

\ Now we created an array syntax that works like this:
20 1 MYNUMBERS [] !    \ ok
   1 MYNUMBERS [] ?    \ 20 ok

\ If you don't like this syntax you are free to change it!
\ *Notice there is no index checking. You could add it if you need it.

\ ------------------------------ The Return Stack ------------------------------
\ Just like a sub-routine stack, the Forth return stack holds the address (pointer)
\ of the word that called the currently running word.  This lets a Forth Word'return'
\ to the word that called it. (ie: where it came from)
\ In CAMEL99 the return stack also holds the limit and index of any running DO LOOP.

\ The programmer is free to use the return stack BUT be very careful.
\ You can easily crash the system if you make a mistake.

\ Example: Print 4 numbers starting from the bottom of the DATA stack
: .INORDER ( n1 n2 n3 n4 -- )
		>R >R >R               \ push 3 #s onto return stack
		.                      \ print n1,
		R> . R> . R> .  ;      \ pop each and print

1 2 3 4 .INORDER
\ NOTE: Because Forth uses the return stack internally, `>R` should
\ always be matched by `R>` inside of your word definitions or expect a crash!

PAGE
\ --------------------------------- Final Notes --------------------------------
\ Typing a non-existent word will empty the stack because it calls the word ABORT
\ which resets the data stack and the return stack

\ Clear the screen:
\ PAGE

\ Loading Forth files into the system:
\ INCLUDE MYFILE.FTH

\ you can list every word that's in Forth's dictionary with WORDS
\ BUT YOU NEED THE TOOLS TO DO IT. We will include the TOOLS file first.
\ Press any key to continue

KEY DROP

INCLUDE DSK1.TOOLS

WORDS

I will probably have to steal this for fbForth at some point!

...lee

+TheBF · July 26, 2020

Source code must be related to rabbits. It replicates prolifically.

I have been building different verisons of Camel99. Indirect threaded, direct threaded and supercart versions. It starts to get overwhelming with all these different files and dependencies.

I finally completed something that I should have done a long time ago. I made a single source file for the indirect threaded Camel99 Forth system that compiles to either a regular expansion ram version or a supercart version base on a value in the source code that can be changed.

For the curious out their this is done similar to the way 'C' uses the pre-processor and the #define #if etc directives. In Forth of course the interpreter is just extended to give it the ability to do the job. ANS Forth and my homebrew cross-compiler use the ANS Forth words [IF] [ELSE] [THEN] for logic control. There are also the words [DEFINED] and [UNDEFINED] to interrogate the system for the presence of some names as well. I chose to create a VALUE that is a flag to make a supercart version or not.

Here the section of CODE at the top of the program that makes the magic work.


   0 VALUE <PROG-ORG>  \ holds origin address for primitives

\ ********************************************************
\ **** Set  SUPERCART to false to build regular system ***
\ ********************************************************

    FALSE VALUE SUPERCART

SUPERCART [IF]   HEX 6000 TO <PROG-ORG> ( make a supercart)
          [ELSE] HEX A000 TO <PROG-ORG> ( make Expansion RAM version)
          [THEN]

INCLUDE CC9900\SRC.ITC\9900FAS3.HSF
INCLUDE CC9900\SRC.ITC\TI99PRIM.HSF

The VALUE <PROG-ORG> is used in the Assembly language file 9900FAS2.HSF to set the program origin.

SUPERCART determines the address that is assigned to <PROG-ORG>

And then the Forth Assembly language files for the Forth low level code and TI99 i/o primitives (VDP and KEY stuff) are loaded.

I have streamlined some of the code involved in branching and looping and when I am happy with it and confirm everything works on real iron I will release it.

I hope that will be soon.

B

+TheBF · July 30, 2020

On 7/15/2020 at 10:12 PM, TheBF said:
*NEW* Camel99 Update V2.62c

I have changed the ZIP file with a correction to the "USER" word in this Version. This version runs on real iron. I am still working on the Supercart version.

Thanks to the expert interpretation by Tursi of an error I created in patching my cross-compiler we have what I believe it is now the most solid Camel99 kernel in this long history of my journey to cross-compile a Forth system for myself and the greater TI-99 community.

We have CAMEL99 for conventional 32K RAM machines ~~and CAMEL99SC for Supercart users~~ and Classic99.

I have touched the DEMO programs on DSK3. and found a few warts that were fixed. Notably the SNAKE game now works correctly. Try it. It is a little bit addictive.

( After starting Forth type: INCLUDE DSK3.SNAKE )

I will update the previous post and remove the older version. I also will rebuild the TTY version next week with these changes to the code base.

Release Notes:
Reveal hidden contents
Camel99 Forth V2.62b, System Release Notes  July 15, 2020
------------------------------------------------------------------------
This kernel version is 2.62b re-build of 2.62 with important corrections made 
to the cross-compiler. It was tested on the Classic99 emulator.

System Requirements
-----------------------
1. TI-994A 32K Expansion RAM or SAMS 1M card.

2. TI-99 RS232 Card or equivalent, with CRU address HEX 1300

3. DSK1. required  DSK2. is nice to have. DSK3 optional
=======================================================
CONTENTS of the ZIP file
------------------------
This release notes file and three(3) disk images.

Disk 1:  Forth kernel program for Expansion RAM and SUPERCART+Expansion RAM.
	 Libraries in source code (DV80 format)
         The best way to learn the libraries is to read the files and
         the demonstration programs on DSK3.
         
	PROGRAM NAME: CAMEL99, CAMEL99SC 
		      Start with editor/Assembler option 5.	

DISK 2:  Text editors for program development
         EDIT40 3.0 E/A5 program
         EDIT80 3.0 E/A5 program  (Classic99 or F18 card only)
	
DISK 3: Various demonstration programs
                                                
DSK3.ITC  
                              
10TASKS      1TASK        BEERS         
BGSOUND      COLORBARS    COOLSPRIT2    
COOLSPRITE   DENILE       DIJKSTRA      
FACE         FACTORIAL    GG_BASS       
GOODNILE     GROMLOGO     GUESS         
ILLUSION2    MATRIXMOVE   QUASIV2       
RNDCOLOR     SEVENS       SMPTE         
SNAKE        SOUNDS       STRINGCASE    
THEFLY       VDPBGSND     XBDEMOAUTO    
                                        
                           
                    
CAMEL99.262.zip 168.27 kB · 0 downloads

I have corrected this version. It is now 2.62c.

The supercart version is not behaving yet.

+TheBF · July 30, 2020

Beery motivated me to try something that I was wanting to make anyway.

In the past I have been using the TI editor as simple way to convert a PC text file to DV80. It's not great but it works.

I realized that I had a pretty good set of utilities in my SHELL program so I tried adding something called WAITFOR that accepts text from the keyboard and saves it to a file when you press BREAK (FCTN 4).

The videos show it working and how you use the COPY command to take TI files back to the windows clipboard. All of this is made easy because of Classic99.

Shell utility code with WAITFOR added at the end

Spoiler


\ CAMEL99 Forth shell for disk file management

NEEDS DUMP       FROM DSK1.TOOLS
NEEDS OPEN-FILE  FROM DSK1.ANSFILES
NEEDS VALUE      FROM DSK1.VALUES
NEEDS CASE       FROM DSK1.CASE
NEEDS BUFFER:    FROM DSK1.BUFFER
NEEDS MALLOC     FROM DSK1.MALLOC
NEEDS COMPARE    FROM DSK1.COMPARE
NEEDS U.R        FROM DSK1.UDOTR   \ right justified printing
HERE

\ busy spinner to show activity
VARIABLE SPIN#
CREATE SCHARS   CHAR | C, CHAR / C, CHAR - C, CHAR \ C,
: GETXY    ( -- col row) VROW 2@ ;
: SPINCHAR ( -- char ) SPIN# @ 1+ 3 AND DUP SPIN# ! SCHARS + C@  ;
: SPINNER  ( -- )      SPINCHAR GETXY >VPOS VC! ;

\ simplified file language
\ Usage example:  S" DSK2.MYFILE" R/W OPEN AS: #1
HEX
0 VALUE #1   0 VALUE #2   0 VALUE #3

: AS:  ( n -- <value> )  POSTPONE TO ;  IMMEDIATE

: OPEN  ( addr len -- ior ) OPEN-FILE ?FILERR ;
: CLOSE ( hndl -- )         CLOSE-FILE ?FILERR ;
: READH ( hndl -- )         READ-LINE ?FILERR 2DROP ;

DECIMAL
\ CR if near end of screen
: ?CR     ( n -- ) LINES @ 3 MOD 0= IF CR THEN ;

HEX
\ string helpers
 : ARG$     ( -- addr len ) BL PARSE-WORD DUP ?FILE ;
 : $.       ( $addr -- ) COUNT TYPE ;
 : $.LEFT   ( $ width -- ) OVER C@ - >R $.  R> SPACES ;
 : NEXT$    ( addr len -- addr' len') + COUNT ;
\  : +PLACE  ( addr n $ -- ) 2DUP 2>R  COUNT +  SWAP CMOVE 2R> C+! ;

\ screen control
: SPACE?   ( -- ?) KEY? BL = ;
: SPACEBAR ( -- ) SPACE? IF   BEGIN  SPACE?  UNTIL  THEN ;

: ?BREAK-FILE ( hndl -- )
          ?TERMINAL
          IF CLOSE-FILE
             CR CR ." *BREAK*" ABORT
          ELSE
            DROP
          THEN ;

: OPEN-CATFILE ( adr len -- hndl) RELATIVE 100 FIXED R/O BIN OPEN ;

\ 3 DIGIT BCD to int convertor. Limited to 999
HEX
: F>INT   ( addr len -- addr len n)
          OVER C@  ( -- mantissa)
          CASE
            0 OF  0                    ENDOF
           40 OF  OVER 1+ C@           ENDOF
           41 OF  OVER 1+ C@ 64 * >R
                  OVER 2+ C@  R> +     ENDOF
           ( default)  -1  \ bad # indicator
           ENDCASE ;

DECIMAL
: DIR.TYPE  ( addr -- )
          F>INT
          CASE
             1 OF ." Txt/Fix"  ENDOF
             2 OF ." Txt/Var"  ENDOF
             3 OF ." Bin/Fix"  ENDOF
             4 OF ." Bin/Var"  ENDOF
             5 OF ." Program"  ENDOF
             ." ????"
          ENDCASE ;

: HEAD.REC ( addr -- )
          DECIMAL
          DUP  7 $.LEFT SPACE COUNT ( addr len)
          NEXT$
          ."  Size " NEXT$ F>INT 5 U.R   ."  Used " NEXT$ F>INT 5 U.R
          2DROP ;

: DIR.REC ( addr -- )
          DUP  11 $.LEFT SPACE COUNT ( addr len)
          NEXT$ DIR.TYPE
          NEXT$ F>INT 7 U.R
          NEXT$ F>INT 7 U.R
          2DROP ;

\ ========================================
\ *
\ * User commands: CAT DIR MORE DEL COPY
\ *

: CAT  ( <DSK?.> )   \  needs the '.' ONLY shows file name
          BASE @ >R DECIMAL
          ARG$ OPEN-CATFILE >R  \ store file handle

          PAD 80 R@ READH
          CR PAD HEAD.REC
          CR 13 SPACES  ." -type-  -sect- -b/rec-"

          LINES OFF
          BEGIN
             PAD DUP 80 R@ READH
           ( PAD)  C@   \ do while length > 0
          WHILE
             CR PAD DIR.REC
             1 LINES +!
             SPACEBAR
             R@ ?BREAK-FILE
          REPEAT
          R> CLOSE
          CR LINES @ . ." files" CR
          R> BASE ! ;

HEX
: DIR  ( <DSK?.> )
          ARG$
          OPEN-CATFILE >R  \ push handle
          PAD 50 R@ READH
          CR PAD HEAD.REC
          CR

          LINES OFF
          BEGIN
            PAD DUP 80 R@ READH
          ( PAD) C@   \ do while length <> 0
          WHILE
             PAD 0D $.LEFT ?CR
             1 LINES +!
             SPACEBAR
             R@ ?BREAK-FILE
          REPEAT
          R> CLOSE
          DECIMAL
          CR LINES @ . ." files" CR
          HEX ;

: MORE  ( <filename>)
          ARG$ DV80 R/O OPEN >R
          BEGIN
             PAD DUP 50 R@ READ-LINE ?FILERR ( adr len flag)
          WHILE
             CR TYPE
             SPACEBAR
             R@ ?BREAK-FILE
          REPEAT
          R> CLOSE
          2DROP ;

: DEL   ( <filename>) ARG$ DELETE-FILE ?FILERR  ;

: MOVE-FILE ( buff-size -- buff-size)
        DUP MALLOC >R
        LINES OFF
        SPACE
        BEGIN
          R@  50  #1 READ-LINE ?FILERR ( -- #bytes eof?)
        WHILE
          R@ SWAP #2 WRITE-LINE ?FILERR
          LINES 1+!
          SPINNER
        REPEAT
        R> DROP                 \ DROP buffer address from rstack
        MFREE
;

: COPY  ( <file1> <file2> )
        ARG$ ARG$
        DV80 W/O OPEN AS: #2
        DV80 R/O OPEN AS: #1
        52 MOVE-FILE
        #2 CLOSE
        #1 CLOSE
        BASE @ >R
        DECIMAL
        CR ." Copy complete. " LINES @ . ." records"
        R> BASE ! ;

: W/O+  ( -- fam ) APPEND FAM @  ;  \ TI-99 file access mode: write/append

HEX
: APND  ( <file1> <file2> )
        ARG$  ARG$
        DV80 W/O+ OPEN AS: #2
        DV80 R/O  OPEN AS: #1
        52 MOVE-FILE
        #2 CLOSE
        #1 CLOSE
        BASE @ >R
        DECIMAL
        CR ." Append complete. " LINES @ . ." records"
        R> BASE ! ;

: CLS   PAGE ;

: HELP  CR
        CR ." Forth Shell Commands"
        CR ." --------------------"
        CR ." DIR  <DSK?.> show file names"
        CR ." CAT  <DSK?.> show files and types"
        CR ." MORE <path>  show contents of DV80 file"
        CR ." DEL  <path>  delete file at path"
        CR ." COPY <path1> <space> <path2> "
        CR ."      Copy file at path1 to path2"
        CR ." APND <file1> <space> <file2"
        CR ."      Append file1 to file2"
        CR ." WAITFOR <file> Copies text to <file>"
        CR ." CLS  Clear screen"
        CR ." BYE  Return to E/A Menu"
        CR ." HELP Show command list" CR
        CR ." Any key will stop scrolling"
        CR ." FNCT 4 halts operation"
;

HEX
: ?BREAK&SAVE ( -- )
          ?TERMINAL
          
          IF  #1 CLOSE-FILE ?FILERR
              CR ." File saved" CR  ABORT
          THEN ;

\ Modify key to allow it to break and save file
: FKEY      ( -- char)
           BEGIN                  \ start the loop
              ?BREAK&SAVE
              CURS @              \ fetch 2 char cursor (space & _ )
              TMR@ 1FFF <         \ compare hardware timer to 1FFF
              IF >< THEN VPUT     \ swap cursor bytes & write
              KEY?                \ check the keyboard
              ?DUP                \ DUP IF <> 0
            UNTIL                 \ loop until a key pressed
            BL VPUT ;             \ put the space char on screen

\ re-write accept to use new KEY. ( could patch it but this is clearer)
: FACCEPT     ( c-addr +n -- +n')
             OVER + OVER
             BEGIN
               FKEY DUP 0D <>
             WHILE
                DUP EMIT
                DUP 8 =
                IF   DROP 1-  3 PICK  UMAX  \ changed to use: 3 PICK   B.F.
                ELSE OVER C!  1+ OVER UMIN
                THEN
             REPEAT
             DROP NIP SWAP - ;

: RCV  ( caddr len --  )
      DV80 W/O OPEN AS: #1
      BEGIN
        PAD DUP 50 FACCEPT ( addr len) #1 WRITE-LINE ?FILERR
      AGAIN ;

\ USED WITH Classic99. Pastes text into DV80 FILE
: WAITFOR  ( <PATH> )
        ARG$
        CR ." Waiting for file " 2DUP TYPE
        CR ." Press FCTN 4 to halt"
        CR RCV ;

Edited July 30, 2020 by TheBF
typo

+TheBF · July 31, 2020

I finally got around to formalizing support for an inverted font in Camel99 Forth.

A nice out-growth of the effort was the creation of VCMOVE which allows VDP to VDP movement using a dynamic buffer in low RAM.

This makes copying a font from the default position to a new position in VDP RAM very easy although it does use a lot of return stack juggling.

With your font in VDP RAM you must first run INVERTFONT which copies the font to >80+ASCII value and then inverts all the bits in VDP RAM for the copied patterns.

You can then use HITYPE to type an inverse colored stack string (addr,len),

or HILITE an area of the screen

or NORMAL an area of the screen.

Edit: ANS Forth has the word INVERT which is faster than -1 XOR. DUH!

Spoiler


\ HILITE.FTH   create reverse color character
NEEDS MALLOC  FROM DSK1.MALLOC
HEX
: ]PDT   ( char# -- 'pdt[n] ) 8* 800 + ; \ VDP pattern Descriptor table

: VCMOVE ( vaddr1 vaddr2 n --) \ VDP2VDP mem. move
        DUP 2>R                  \ save 2 copies of n
        SWAP                     \ reverse addresses
        R> DUP MALLOC 2DUP 2>R   ( R-- n heap n)
        SWAP VREAD               \ copy vaddr1 to heap
        2R> -ROT  VWRITE         \ copy heap to vaddr2
        R> MFREE                 \ restore heap
;
HEX
: INVERTFONT ( -- )
         0 ]PDT  80 ]PDT  400 VCMOVE   \ copy font higher up
        [CHAR] ~ 80 + 1+ ]PDT  BL 80 + ]PDT   \ all ASCII chars
         DO
           I DUP VC@ INVERT SWAP VC!  \ invert char patterns
         LOOP ;

: HITYPE ( addr len --)  BOUNDS DO   I  C@ 80 OR (EMIT)  LOOP ;
: HILITE ( Vaddr len --) BOUNDS DO   I VC@ 80 OR I VC!   LOOP ;
: NORMAL ( Vaddr len --) BOUNDS DO   I VC@ 7F AND I VC!  LOOP ;

Edited July 31, 2020 by TheBF
Replaced -1 XOR with INVERT

+Lee Stewart · July 31, 2020

7 hours ago, TheBF said:

With your font in VDP RAM you must first run INVERTFONT which copies the font to >80+ASCII value and then inverts all the bits in VDP RAM for the copied patterns.

Perhaps less convenient code, but would it not be faster to invert characters in the RAM buffer before copying back to VRAM?

...lee

+9640News · July 31, 2020

16 hours ago, TheBF said:

Beery motivated me to try something that I was wanting to make anyway.

Not exactly sure what I may have said/mentioned as I do seem to throw out a number of ideas and thoughts at times.

I do throw out a number of thoughts hoping it may tickle someone's fancy to follow through...….

Beery

+TheBF · July 31, 2020

3 hours ago, Lee Stewart said:

Perhaps less convenient code, but would it not be faster to invert characters in the RAM buffer before copying back to VRAM?

...lee

I did have a word to do that but removed it. Unless I go to code words the speed difference is not that great between C@ C! and VC@ VC!. The Forth overhead swamps the difference on short strings.

I should to go there in ED99 to select (hilight) an entire file however. I think I will do some experiments on a 4K buffer in ALC.

+TheBF · July 31, 2020

1 hour ago, BeeryMiller said:

Not exactly sure what I may have said/mentioned as I do seem to throw out a number of ideas and thoughts at times.

I do throw out a number of thoughts hoping it may tickle someone's fancy to follow through...….

Beery

LOL. You mentioned you wanted a way to convert PC text files to DV80 source fiels.

This was my simple solution but you wanted something for entire directories and I bet you would want full REGEX selecting as well.

(I would)

+9640News · July 31, 2020

3 minutes ago, TheBF said:

LOL. You mentioned you wanted a way to convert PC text files to DV80 source fiels.

This was my simple solution but you wanted something for entire directories and I bet you would want full REGEX selecting as well.

(I would)

OK, now I know what you are talking about....

+TheBF · August 1, 2020

Revisiting INLINE[] (A Poor Man's JIT)

A few years back I explored stealing code fragments from the Forth kernel and compiling them inline. The idea is that each Forth primitive has a three instruction overhead called the "inner-interpreter". If we remove those three instructions between each primitive code routine things run much faster; as much as 2X faster.

The ideal is to be able to just put an inline command in a normal definition and compile the machine code for the primitives inline.

Inlining machine code is a great strategy in a sub-routine threaded system or even a direct threaded system but in the classical indirect threaded system the overhead is rather large, so much so, that I found if I wanted to use INLINE[] it made more sense to make a new CODE word like this:

CODE DUP>R   INLINE[ DUP >R ]  NEXT, ENDCODE

Then I would use this new word as a replacement for the words DUP >R where ever the phrase appeared in the code. This save space by calling DUP>R everywhere in the code so it's not all bad but I wanted the freedom to eliminate that extra step.

It occurred to me that with empty memory in LOW-RAM at >2000, I could compile the new word as a "header-less" CODE word in low-RAM and then compile the address of that word directly into my Forth definitions. It's a temporary piece of code that is built at compile time and the address of the code is compiled into a new definition. It's sort of a poor mans JIT (just in time compiler)

I was surprised to see that with a few HEAP support words it didn't take too much to add it to the code I already had.

INLINE2.FTH

Spoiler


\ inline2.fth Compiles inline code as headless word in HEAP  July 31 2020
\ Problem:
\  The preamble overhead to compile an ITC word as inline machine code is too big.
\  You need 8 bytes for the header and 8 bytes to correct the IP.
\  This meant it was easier make new code words that combined other code
\  words.
\ *NEW CONCEPT*
\  INLINE[ ] in this version uses HEAP memory to compile a headless version
\  of the new code word. That XT is compiled into your Forth definition.

\ **not portable Forth code**  Uses TMS9900/CAMEL99 CARNAL Knowledge
MARKER /INLINE

HERE
HEX
\ CFA of a code word contains the address of the next cell
: ?CODE ( cfa -- )  DUP @ 2- - ABORT" Not code word" ;

\ Heap management words
: HEAP    ( -- addr) H @ ;
: HALLOT  ( n -- )   H +! ;
: HEAP,  ( n -- )   HEAP ! 2 HALLOT ;

\ scan MACHINE code looking for the NEXT, routine.
\ Abort if NEXT is not found after 256 bytes. This is an arbitrary size
\ but most Forth code words are much smaller than 256 bytes.
: TONEXT ( adr --  adr2 )
           0                \ flag that falls thru if we don't succeed
           SWAP
         ( ADR) 80          \ max length of code word is $80 CELLS
           BOUNDS
           DO
             I @ 045A  =   \ test each CELL for CAMEL99 NEXT (B *R10)
             IF   DROP I LEAVE
             THEN
           2 +LOOP
           DUP 0= ABORT" NEXT not found" ;

CREATE WORDBUFF  50 ALLOT  \ parsing buffer

: INLINE[ ( -- addr)  \ Returns address where code has been copied
           HEAP DUP 2+ HEAP,  \ create the ITC header for CODE word
           BEGIN
             BL PARSE-WORD WORDBUFF PLACE
             WORDBUFF CHAR+ C@ [CHAR] ] <>
           WHILE
             WORDBUFF FIND 0= ABORT" INLINE can't find word"
             DUP ?CODE
           \ calc. start and len. of code
             >BODY DUP TONEXT OVER  -   ( -- PFA addr len)
             HEAP OVER HALLOT SWAP CMOVE   \ transcribe the code to HEAP
           REPEAT
           045A HEAP,   \ compile NEXT at end of HEAP code
           COMPILE,       \ compile XT into current colon definition
           ;  IMMEDIATE

\ need NORMAL copies of words that are WEIRD in the Camel99 kernel
CODE @      C114 ,                  NEXT,  ENDCODE
CODE C@     D114 , 0984 ,           NEXT, ENDCODE
CODE DROP   C136 ,                  NEXT, ENDCODE
CODE LIT    0646 , C584 ,  C139 ,   NEXT, ENDCODE

HERE SWAP - SPACE DECIMAL . .( bytes) HEX CR

To see what difference it makes, here is the Sieve of Erathosenes which normally runs in 7.8 seconds in Camel99 Forth V2.6

With a few key phrases of code primitives put inline the time got down to 4.65 seconds.

An improvement of 40%. The code in this example used 168 bytes of the HEAP to hold the machine code routines.

Limitations

(Some primitives like ">" don't work because of the way they were coded in the kernel. Tricks were used to save space, so don't include them inline.

You cannot INLINE[ ] a high level Forth word. Only CODE words (primitives) work with this simple system.

Improvements

An actual JIT could be made by modifying the Forth compiler loop to look for patterns of CODE primitives and compiling them inline automatically.

Something to think about for the future.

Sieve program with INLINE[ ] code.

Spoiler


\ Sieve of Erathosenes in Forth

NEEDS ELAPSE FROM DSK1.ELAPSE
NEEDS INLINE[ FROM DSK1.INLINE2

: ERASE  ( addr n -- ) 0 FILL ;

HEX
: FREEMEM  ( -- n) FF00 HERE - ;
: ?MEM     ( n -- )  FREEMEM OVER < ABORT" Out of memory" ;

: SEEPRIMES ( -- )
        CR ." Primes: "
        2 DO
            I INLINE[ HERE + C@ ] 0= IF I . THEN
            ?TERMINAL ABORT" Primes halted"
        LOOP ;

\ byte array uses unallocated memory at HERE
DECIMAL
: PRIMES ( n -- )
        ?MEM
        CR ." Running " DUP U. ." primes"
        HERE OVER ERASE
        1 0 INLINE[ HERE + C! ]    \ mark as prime like 'C' version
        1 1 INLINE[ HERE + C! ]
        2                          \ start at 2
        BEGIN
           INLINE[ 2DUP DUP * ]  >
        WHILE
           INLINE[ DUP HERE + C@ ]
           0= IF  INLINE[ 2DUP DUP * ]
               DO  1  INLINE[ I HERE + C! DUP ]  +LOOP
           THEN
           1+
        REPEAT
        CR ." Complete."
       .ELAPSED
        CR
        DROP
        CR ." Press ENTER to see primes:" KEY 13 =
        IF   SEEPRIMES   THEN
;

DECIMAL
: RUN      10000 TICKER OFF PRIMES ;

\ ELAPSE timings on Classic99
\ Turbo Forth      7.7

\ Camel99
\ V2.62c           7.8
\ V2.62C w/inline[] 4.65

+TheBF · August 3, 2020

I couldn't sleep so I thought I would finalize something I started a long while back.

Having never written an adventure game I thought it would be fun to re-work Oregon Trail by Majestyx and try and create a game language in Forth.

It turned out the game language made adding game features and decisions so easy that I kept adding things to it.

It's now over 1000 lines.

Some of the game language features are:

." is re-written so it compiles strings to VDP RAM to save CPU RAM for program logic.
PRINT." is the same as ." but adds the new-line first like BASIC Print.
IF etc. has been replaced by: DOTHIS <CODE> OTHERWISE <CODE> ENDTHIS
... prints a small random number of dots at 1/4 second intervals to make it look like time is passing
%CHANCE lets you alter the game chances of things happening. Used with DOTHIS
Vector tables provide a way to run random blocks of code to select random diseases, animals and body-parts.

Enhancements:

It could be further enhanced to make the scripting even simpler I suppose, but I didn't feel the need to go further.

The game itself needs tweaking to make it more challenging.

Another natural enhancement would be to replace the menus with game commands that are interpreted by Forth.

I started the process of making the calendar accurate for the actual year of the game, but lost interest.

To Run:

Unzip OREGON.ZIP onto a TI99 DISK.
Start CAMEL99 V2.62 from DSK1. with E/A 5 menu
wait for the start file to complete
Type : INCLUDE DSK?.OREGON
Wait for it to compile. It will auto start

*NEW* Source code for V1.5 the curious

Spoiler


\ ORGEGON TRAIL BY  majestyx on Atariage
\ RE-WRITE for  CAMEL99 Forth. Game specific language demonstration
\ Brian Fox  Dec 12, 2019

\ INCLUDE DSK1.TOOLS
NEEDS RANDOM FROM DSK1.RANDOM
NEEDS INPUT  FROM DSK1.INPUT
NEEDS CASE:  FROM DSK1.FASTCASE
NEEDS CASE   FROM DSK1.CASE
NEEDS ENUM   FROM DSK1.ENUM
NEEDS VCOUNT FROM DSK1.VDPMEM

MARKER /OREGON

CR .( Compiling Oregon Trail )
\ ====================================================
\ VDP STRING and PRINT
\ compile stack string into VDP memory
: VS,     ( $adr len-- )  VHERE OVER CHAR+  VALLOT VPLACE ;

\ Print a VDP stack string
: VTYPE   ( vdp_addr len -- ) BOUNDS ?DO   I VC@ EMIT   LOOP ;

\ Compile a VDP string, that types itself.
\ >>>  Overides regular ." word <<<
: ."   ( <text> )
        ?COMP                 \ for compiling only
\ Do these compile time actions "immediately"
        VHERE [CHAR] " PARSE VS,

\ later, when we run the word, do these things
        POSTPONE LITERAL
        POSTPONE VCOUNT
        POSTPONE VTYPE ; IMMEDIATE
.( .)
: PRINT."  POSTPONE CR  POSTPONE ." ; IMMEDIATE

\ Print a stack string centered on the screen
: CENTERTYPE  ( addr len -- ) DUP C/L@ SWAP - 2/ 1- SPACES TYPE ;

\ Compile text string and print on a newline centered on the screen
: CENTER."
        ?COMP
        POSTPONE CR
        POSTPONE S"
        POSTPONE CENTERTYPE ;  IMMEDIATE

\ =========================================
\ helpers for choice tables....
: CLIP     ( n lo hi -- n') ROT MIN MAX ;   \ clip input to lo/hi

DECIMAL
\ RANDOM is used to select random actions range= 0 .. n
\ Usage:  7 RANDOM DISEASES
: RANDOM   ( n -- n )  DUP RND  0 ROT CLIP ;

 : TESTRAND  BEGIN   10 RANDOM  .  ?TERMINAL UNTIL ;

\ random#  returns 1 .. n
: RANDOM#   ( n -- n ) DUP 1+ RND  1 ROT CLIP ;

 : TESTRAND#   BEGIN   10 RANDOM#  .  ?TERMINAL UNTIL ;

\ =========================================
\ G A M E  L A N G U A G E
DECIMAL
: 3RD     ( a b c -- a b c a ) 2 PICK ;  \ get a copy of 3rd item on the stack

\ text game language extensions
: BETWEEN ( n lo hi -- ?) 1+ WITHIN ;

: %CHANCE     ( n -- ? )  100 RND >  ;
.( .)
\ control structure replaces if else then
: DOTHIS      POSTPONE IF   ; IMMEDIATE
: OTHERWISE   POSTPONE ELSE ; IMMEDIATE
: ENDTHIS     POSTPONE THEN ; IMMEDIATE

\ syntax sugar for creating vector tables
: CHOICE:  :NONAME ;

: CHOICES,  ( addr... addr[n] n -- ) 0 ?DO  COMPILE, LOOP ;  \ compile addresses

\ read #input into a variable and test for limits
: VALID-INPUT ( variable  lo  hi  -- n )
          BEGIN
             3RD DUP #INPUT
             @ 3RD 3RD BETWEEN  \ fetch from variable, check limits
          UNTIL
          2DROP @ ;  \  drop limits, fetch variable value

HEX
: TOUPPER  ( c -- c') 5F AND ;

DECIMAL
: YES?    ( -- ?) PRINT." Y/N?"  KEY TOUPPER [CHAR] Y = ;

: .R      ( n width -- )  \ print n right justified
          >R DUP ABS 0 <# #S ROT SIGN #> R> OVER - SPACES  TYPE ;

: DEBIT     ( n variable -- ) DUP >R @ SWAP NEGATE + 0 MAX  R> ! ;
: CREDIT    ( n variable -- ) +! ;
.( .)
\ set screen color with black letters
HEX
: CYAN   ( -- ) 17 7 VWTR ;
: GREEN  ( -- ) 13 7 VWTR ;
: YELLOW ( -- ) 1B 7 VWTR ;

DECIMAL
: ROLL-DICE  ( -- n ) 12 RANDOM#  ;  \ Random # 1..12
: TESTDICE   BEGIN   ROLL-DICE .   ?TERMINAL UNTIL ;

\ random delay with dot printing
: ...  ( n -- ) 8 RANDOM#   0 ?DO  [CHAR] . EMIT  250 MS   LOOP ;


\ ==============================================
\ **********************************************
\ ==============================================
\ O R E G O N   C O D E   S T A R T S   H E R E

DECIMAL
\ game data
 700 CONSTANT BUDGET
1847 CONSTANT YEAR
 100 CONSTANT DESTINATION ( how far we have to travel)

VARIABLE TEMP
VARIABLE ACCURACY
VARIABLE TOTAL
.( .)
\ status variables for the traveller
VARIABLE HEALTH
VARIABLE OXEN
VARIABLE OXEN#  ( normally 2)
VARIABLE FOOD
VARIABLE QUALITY
VARIABLE AMMO
VARIABLE CLOTHES
VARIABLE MISC
VARIABLE CASH
VARIABLE WOUNDED

VARIABLE ACTION
VARIABLE MILEAGE
VARIABLE DAY
VARIABLE MONTH

: NEWGAME
     HEALTH OFF
     OXEN OFF
     2 OXEN# !
     FOOD OFF
     AMMO OFF
     CLOTHES OFF
     MISC OFF
     CASH OFF
     WOUNDED OFF
     MILEAGE OFF
;

0 ENUM SUN
  ENUM MON
  ENUM TUE
  ENUM WED
  ENUM THU
  ENUM FRI
  ENUM SAT
DROP

1 ENUM JAN
  ENUM FEB
  ENUM MAR
  ENUM APR
  ENUM MAY
  ENUM JUN
  ENUM JUL
  ENUM AUG
  ENUM SEP
  ENUM OCT
  ENUM NOV
  ENUM DEC
DROP

: DEBIT-TOTAL   ( n -- ) TOTAL DEBIT ;

: ?DAY    TRUE ABORT" Bad day#"  ;
: ?MONTH  TRUE ABORT" Bad Month#" ;

\ days print themselves
: .MON     ." Monday" ;      : .TUE    ." Tuesday" ;
: .WED     ." Wednesday" ;   : .THU    ." Thursday" ;
: .FRI     ." Friday" ;      : .SAT    ." Saturday" ;
: .SUN     ." Sunday" ;
.( .)
\ a table of execution addresses of days
CASE: DAYS  ( 1..7 -- )
      | .SUN | .MON | .TUE | .WED
      | .THU | .FRI | .SAT
      | ?DAY
;CASE

: .DAY     DAY @ DUP 6 MOD DAYS ." , day "  . ;

\ Months print themselves
: MTH1    ." January" ;      : MTH7    ." July" ;
: MTH2    ." February" ;     : MTH8    ." August" ;
: MTH3    ." March" ;        : MTH9    ." September" ;
: MTH4    ." April"  ;       : MTH10   ." October" ;
: MTH5    ." May" ;          : MTH11   ." November" ;
: MTH6    ." June" ;         : MTH12   ." December" ;

CASE: MONTHS ( 1..12 -- )
     | ?MONTH
     | MTH1 | MTH2  | MTH3  | MTH4
     | MTH5 | MTH6  | MTH7  | MTH8
     | MTH9 | MTH10 | MTH11 | MTH12
     | ?MONTH
;CASE

: .MONTH  ( -- )  MONTH @  MONTHS ;

: .DATE  ( -- )   .DAY ." , "  .MONTH SPACE DAY @ 2 .R  ." , "  YEAR . ;
.( .)
\ DOLLAR value formatted printing
: >$<    ( -- n ) [CHAR] $ HOLD ;
: >.<    ( -- n ) [CHAR] . HOLD ;
: '00'    [CHAR] 0 DUP HOLD HOLD ;
: DOLLARS ( n -- ) DUP ABS 0  <# '00' >.< #S >$< ROT SIGN #> TYPE SPACE ;

: .BALANCE    PRINT." YOU HAVE "  TOTAL @ DOLLARS ." left" ;

: GET_ACCURACY ( -- )
          PRINT."  How well can you shoot?"
          PRINT."  (1) BEST"
          PRINT."  (2) GOOD"
          PRINT."  (3) FAIR"
          PRINT."  (4) Not sure..."
          PRINT."  (5) BAD"
          PRINT."  (1..5) : "
          ACCURACY  1 5 VALID-INPUT 25 * ACCURACY !  ;

: TEAM    ( -- )
          CR
          PRINT." How much do you want to spend"
          PRINT." on your team of oxen? ($200-$300)"
          OXEN 200 300 VALID-INPUT ;

: GETFOOD  ( -- ) PRINT."  ON FOOD "            FOOD  0 TOTAL @ VALID-INPUT ;
: GETAMMO  ( -- ) PRINT."  ON AMMUNITION "      AMMO  0 TOTAL @ VALID-INPUT ;
: CLOTHING ( -- ) PRINT."  ON CLOTHING "     CLOTHES  0 TOTAL @ VALID-INPUT ;
: GETMISC  ( -- ) PRINT."  ON MISC. SUPPLIES "  MISC  0 TOTAL @ VALID-INPUT ;

: .Y/N     ( ? --) DOTHIS ." Yes"   OTHERWISE ." No"   ENDTHIS ;
.( .)
: .SUPPLIES
         CR
         PRINT."     -- Supplies Report --"
         CR    .DATE
         PRINT." FOOD          :   "  FOOD    @ DOLLARS
         PRINT." BULLETS       :   "  AMMO    @ DOLLARS
         PRINT." CLOTHING      :   "  CLOTHES @ DOLLARS
         PRINT." MISC. SUPPLIES:   "  MISC    @ DOLLARS
         PRINT." CASH          :   "  CASH    @ DOLLARS
         PRINT."        -- Status --"
         PRINT."  Health       :   "  HEALTH @  4 .R
         PRINT."  Wounded      :   "  WOUNDED @ .Y/N
         CR
;

: BUYSTUFF
          PRINT."  Let's get you set you for the trip:"
          TEAM     DEBIT-TOTAL .BALANCE
          GETFOOD  DEBIT-TOTAL .BALANCE
          GETAMMO  DEBIT-TOTAL .BALANCE
          CLOTHING DEBIT-TOTAL .BALANCE
          GETMISC  DEBIT-TOTAL .BALANCE
          TOTAL @ CASH !
;

: SETUP   CR
          PRINT."  Your budget for the trip is: " BUDGET DOLLARS
          BUDGET TOTAL !
          GET_ACCURACY
          BUYSTUFF
          100 HEALTH !
          WOUNDED OFF
          .SUPPLIES
;
.( .)
\ =====================================================
\ End of game messages
: AGAIN?  CR CR ." Type RUN to play again" CR  ABORT ;

: SORRY  GREEN CR
         PRINT."  ********************************"
         PRINT."  We are sorry. You didn't make it"
         PRINT."  to the great territory of Oregon."
         PRINT."  We will notify yer kinfolk."
         CR
         PRINT."  - Sincerely"
         CR
         PRINT."           The Oregon"
         PRINT."      -Chamber of Commerce-"
         HEALTH OFF
         AGAIN? ;

: CONGRATS
         GREEN PAGE
         PRINT." ************************"
         PRINT." President James K. Polk"
         PRINT." sends you his heartiest"
         PRINT." congratulations,"
         CR
         PRINT." He wishes you a prosperous life"
         PRINT." at your new home."
         AGAIN? ;
.( .)

: SEE-DOCTOR
         CR  ...
         PRINT." The doc wants " 20 RANDOM# 4 +  DUP DOLLARS
         CASH DEBIT  ( ALSO subtract the payment)
         PRINT." to patch you up."

         CASH @  1 <
         DOTHIS
            PRINT." You cain't afford it partner!"
            20 RANDOM# 5 + HEALTH DEBIT
            DROP
         OTHERWISE
            CASH DEBIT
            PRINT." You got enough money."
            PRINT." He's good with the needle & thread"
            WOUNDED OFF
            10 HEALTH CREDIT
             5 MISC CREDIT
         ENDTHIS
;
.( .)
\ ====================================================
\ random sickness selector
CHOICE:  ." Pneumonia"      30 HEALTH DEBIT ;
CHOICE:  ." Typhoid fever"  23 HEALTH DEBIT ;
CHOICE:  ." Swine Flu"      10 HEALTH DEBIT ;
CHOICE:  ." Consumption"    20 HEALTH DEBIT ;
CHOICE:  ." Scurvy"         15 HEALTH DEBIT ;
CHOICE:  ." Infection"      20 HEALTH DEBIT ;
CHOICE:  ." smallpox"       40 HEALTH DEBIT ;
CHOICE:  ." Unknown disease" 30 HEALTH DEBIT ;

CASE: DISEASES  8 CHOICES,  ;CASE
: SICKNESS      8 RANDOM DISEASES ;

: ?DEAD
         HEALTH @ 1 <
         DOTHIS  ...
            CR PRINT." Unfortunately you died on"  1000 MS
            CR .DATE
            CR ." of "  SICKNESS
            CR
            SORRY
        ENDTHIS ;

CHOICE: ." hand"    4 HEALTH DEBIT  ;
CHOICE: ." leg"     7 HEALTH DEBIT  ;
CHOICE: ." arm"     5 HEALTH DEBIT  ;
CHOICE: ." belly"  10 HEALTH DEBIT ;
CHOICE: ." backside :-)"
        CR ." (sorry, 't ain't funny)"  8 HEALTH DEBIT ;
CHOICE: ." head..."  HEALTH OFF ;
CHOICE: ." heart!"   HEALTH OFF ;

CASE: ANATOMY   7 CHOICES,   ;CASE

: BODYPART      7 RANDOM ANATOMY ;
.( .)
\ =====================================================
\ BAD luck
: STARVED
         PRINT."  You ran out of food and"
         PRINT."  starved to death"
         HEALTH OFF
         SORRY ;

: SNAKEBITE
         PRINT." You got bit by a snake!" ...
         PRINT." Right in the " BODYPART
         50 %CHANCE
         DOTHIS
            PRINT." there ain't no cure fer it!"
            HEALTH OFF
            SORRY
         OTHERWISE
            PRINT." You darn near died!"
            17 HEALTH DEBIT
        ENDTHIS
;

: MASSACRE
          PRINT." You were attacked and"
          PRINT." massacred by criminals"
          HEALTH OFF
          SORRY ;

: FROZE
          PRINT." Weather took a turn partner."
          PRINT." It went down to 30 below."
          PRINT." You and the family froze solid"
          HEALTH OFF
          SORRY
;
.( .)
: NOMEDICINE
          CR
          PRINT."  You ran out of medical supplies"
          PRINT."  and died of "
          WOUNDED @
          DOTHIS   ."  your injuries"
          OTHERWISE   ... SICKNESS
          ENDTHIS
          HEALTH OFF
          SORRY
;

: BANDITS
          PRINT."  Bandits Attacked!" HONK CR
          30 %CHANCE
          DOTHIS
             PRINT."  You ran out of bullets--"
             PRINT."  They got lots of yer cash"
             50 RANDOM# CASH DEBIT
             AMMO OFF
          ENDTHIS

          20 %CHANCE
          DOTHIS
               PRINT." and... they took one of your oxen"
               1 OXEN# DEBIT
          ENDTHIS

          10 %CHANCE
          DOTHIS
              WOUNDED ON
          ENDTHIS
;
.( .)
: VERYSICK
          PRINT." Partner you is looking sickly."
          PRINT." The DOC says you got the " SICKNESS
          PRINT." STOP FOR MEDICAL ATTENTION"
          5 RANDOM# DAYS CREDIT
          SEE-DOCTOR
          CR
          50 %CHANCE
          DOTHIS
               PRINT." Hey you pulled through!"
               10 HEALTH CREDIT
          OTHERWISE
              18 %CHANCE
              DOTHIS
                   PRINT." I got some bad news partner" ...
                   PRINT." You didn't make it. :-("
                   HEALTH OFF
                   ?DEAD
              ENDTHIS

              PRINT." You didn't make a full recovery"
              PRINT." but ya ain't dead yet!"
              2 HEALTH CREDIT
         ENDTHIS
 ;

 \ =========================================
 CHOICE:  ." wheel" ;
 CHOICE:  ." axle" ;
 CHOICE:  ." yoke" ;
 CHOICE:  ." whipple-tree" ;
 CHOICE:  ." seat" ;
 CASE: PARTS  5 CHOICES,   ;CASE

: PART    5 RANDOM PARTS  ;

: BUSTED-WAGON
        PRINT." Yer wagon gots a busted " PART
        PRINT." It's gonna take some time to fix 'er up!"
        3 RANDOM# DAYS CREDIT
        ...
        PRINT." That'll cost ya "
        5 RANDOM# DUP DOLLARS
        CASH DEBIT
        5 RANDOM# MISC DEBIT

 ;

: SWAMPED
      CR
      PRINT." Wagon gets swamped fording a"
      PRINT." river. You lost some food"
      20 RANDOM 10 +   FOOD DEBIT
      ...
      33 %CHANCE
      DOTHIS
         PRINT." and some clothes"
         20 RANDOM 5 +  CLOTHES DEBIT
      ENDTHIS
;

: FOG
     PRINT." Lost your way in a heavy fog"
     ...
     PRINT." You lost " 4 RANDOM# DUP DAY CREDIT
     DUP .   ." days."
     2* FOOD DEBIT
;

: FIRE
     PRINT." There was a fire in your"
     PRINT." wagon. Food and supplies"
     PRINT." are damaged!"
     20 RANDOM 10 + FOOD DEBIT
     10 RANDOM 2 +  MISC DEBIT
;
CR .( 50% complete ...)
CR
: RAIN
     PRINT." Heavy rain" ...
     PRINT." Time & supplies were lost." ...
     3 RANDOM#   DAY  CREDIT
     7 RANDOM#   MISC DEBIT
    12 RANDOM#   FOOD DEBIT
;

: BAD-WATER
     PRINT." Bad water, You lost time"
     PRINT." looking for a clean spring."
     ...
     3 RANDOM# DAY CREDIT
     3 RANDOM HEALTH DEBIT
;

: SONLOST
     PRINT." Your son wandered off" ...
     PRINT." Spent a day looking for him"
     1 DAY CREDIT
     2 FOOD DEBIT
;

: OXLOST
     PRINT." OX wandered off. Two days lost" ...
     2 DAY CREDIT

     PRINT." (Tie him up next time)"
     4 RANDOM FOOD DEBIT
;
.( .)
: TERRAIN
     PRINT." RUGGED MOUNTAINS" ...
     37 %CHANCE
     DOTHIS
        PRINT." You got lost and loose valuable"
        PRINT." time trying to find a trail."
       2 DAY CREDIT
     OTHERWISE
        PRINT." You pushed through."
     ENDTHIS

     21 %CHANCE
     DOTHIS
        PRINT." Wagon damaged! Lost time and supplies"
        2 RANDOM#   DAY CREDIT
        4 RANDOM#   FOOD DEBIT
        2 RANDOM    MISC DEBIT
     ENDTHIS
;

: BLIZZARD
     PRINT." Blizzard in mountains at south pass" ...
     47 %CHANCE DOTHIS
         PRINT." Time & supplies lost"
         2 RANDOM#   DAY CREDIT
         2 RANDOM   MISC DEBIT
         4 RANDOM#  FOOD DEBIT
    OTHERWISE
        PRINT." You made it safely through"
        PRINT." South Pass. Only light snow."
        CR
    ENDTHIS
;
.( .)
CASE: TRAGEDIES
       | SNAKEBITE  | MASSACRE     | FROZE          | NOMEDICINE
       | BANDITS    | VERYSICK     | BUSTED-WAGON   | SWAMPED
       | FOG        | FIRE         | RAIN           | BAD-WATER
       | SONLOST    | OXLOST       | TERRAIN        | BLIZZARD
;CASE

DECIMAL
: SHITHAPPENS
        CR  ...
        PRINT." Tragedy has done commenced!"
        CR
        16 RANDOM TRAGEDIES
        ?DEAD ;

: ?BROKE
        CASH @ 1 <
        DOTHIS
           PRINT." Partner, yer flat broke!"
        ENDTHIS ;
.( .)
: DOCTOR?
     PRINT." Wanna see a doctor?"
     YES?
     DOTHIS     SEE-DOCTOR
     OTHERWISE  PRINT." Ok, it's yer funeral."
     ENDTHIS
;

: ?HEALTH
      20 %CHANCE
      DOTHIS  ( don't report this all the time)
         HEALTH @ 20 <
         DOTHIS  CR PRINT." You don't look so good partner." DOCTOR?  ENDTHIS

         HEALTH @ 20 30 BETWEEN
         DOTHIS  CR PRINT." You gotta look after yerself better."  ENDTHIS

         HEALTH @ 31 49 BETWEEN
         DOTHIS  CR PRINT." You feelin' ok? Ya looks kinda pale." ENDTHIS

         HEALTH @ 49 >
         DOTHIS  CR PRINT." Yer still lookin' purty healthy"  ENDTHIS
     ENDTHIS
;

: ?SEE-DOCTOR
     CR
     PRINT." Wanna have a doc look at you?"
     YES?
     DOTHIS
        SEE-DOCTOR
        60 %CHANCE
        DOTHIS
            PRINT." He patched you up!"
            10 RANDOM HEALTH CREDIT
            WOUNDED OFF
         OTHERWISE
            PRINT." He fixed it but yer still hurtin'"
            WOUNDED OFF
            20 RANDOM# HEALTH DEBIT
        ENDTHIS
     ENDTHIS
     ?DEAD ;
.( .)
: GOTSHOT
          PRINT." OUCH! You got shot in the " BODYPART
          20 RANDOM#  HEALTH DEBIT
          ?DEAD
          WOUNDED ON
          5  RANDOM# MISC DEBIT
          10 RANDOM# AMMO DEBIT

          25 %CHANCE
          DOTHIS
             PRINT." and they took one of your oxen."
             1 OXEN# DEBIT
          ENDTHIS

         ?SEE-DOCTOR
;

: ?GOTSHOT
         WOUNDED @ DOTHIS  GOTSHOT  ENDTHIS ;

: WANNAEAT  ( -- n)
          CR
          PRINT." How do you wanna eat?"
          PRINT."   (1) POORLY"
          PRINT."   (2) OK"
          PRINT."   (3) WELL? "
          QUALITY 1 3 VALID-INPUT
;

: RUNNING
          PRINT." You are running away" ...
          40 RANDOM#  MILEAGE CREDIT
          10 RANDOM  HEALTH DEBIT
          30 OXEN DEBIT
           2 RANDOM DAY CREDIT
          15 %CHANCE DOTHIS WOUNDED ON ENDTHIS
          12 %CHANCE DOTHIS GOTSHOT    ENDTHIS
;
.( .)
: ATTACK    PRINT."  You are attacking " ...
            49 %CHANCE
            DOTHIS
                GOTSHOT
            OTHERWISE
               PRINT." You scared them off!"
               PRINT." and found their money and food"
               CR
               60 RANDOM 10 FOOD CREDIT
              120 RANDOM 30 CASH CREDIT
               15 RANDOM HEALTH CREDIT
           ENDTHIS
;

: DEFEND    PRINT." We circled the wagons" ...
            PRINT." and let 'em have it!" ...
            20 RANDOM 2+ AMMO DEBIT
            AMMO @ 0 <  DOTHIS  MASSACRE  ENDTHIS

            65 %CHANCE
            DOTHIS
               CR
               PRINT." You are a pretty good shot!"
               PRINT." They took off and left us alone"
               CR
               10 HEALTH CREDIT
                5 OXEN CREDIT
               10 RANDOM# AMMO DEBIT

            OTHERWISE
               CR
               PRINT." We took some hits but survived"
               20 RANDOM AMMO DEBIT
               10 HEALTH DEBIT
               30 %CHANCE
               DOTHIS
                  GOTSHOT
               ENDTHIS
            ENDTHIS
;
.( .)
: CONTINUE
         CR
         PRINT."  Continuing " ...
          2 RANDOM    HEALTH  DEBIT
         10 RANDOM#   OXEN    DEBIT
          5 RANDOM    CLOTHES DEBIT
         14 RANDOM#   OXEN# @ *  MILEAGE CREDIT
          5 %CHANCE DOTHIS    WOUNDED ON    ENDTHIS
         33 %CHANCE DOTHIS    SHITHAPPENS   ENDTHIS
;

CASE: REACTION  ( n -- )
       | RUNNING | ATTACK  | CONTINUE  | DEFEND
;CASE

: HOSTILE-DECIDE ( -- )
         PRINT." They look hostile!"
         PRINT." Whaddya reckon we should do?"
         PRINT."   (1) RUN"
         PRINT."   (2) ATTACK"
         PRINT."   (3) CONTINUE"
         PRINT."   (4) DEFEND"
         ACTION 1 4 VALID-INPUT DROP
         CR ...
         ACTION @ 1- REACTION
         ?GOTSHOT
;

\ ======================================
\ random names for food
CHOICE: ." eatin'" ;
CHOICE: ." food" ;
CHOICE: ." viddles" ;
CHOICE: ." grub" ;
CASE: FOODS  4 CHOICES,  ;CASE
: FOODSTUFF  4 RANDOM FOODS ;
.( .)
\ ======================================
\ game animals
CHOICE: ." deer"
        PRINT." We got food for days!" CR
        100 FOOD CREDIT ;

CHOICE: ." possum"
        PRINT." Ain't much food but better than nothin'" CR
         10 FOOD CREDIT ;

CHOICE: ." squirrel"
        PRINT." We is gonna be hungry" CR
         5 FOOD CREDIT ;

CHOICE: ." duck"
        PRINT." A little greasy, but fillin'" CR
        15 FOOD CREDIT ;

CHOICE: ." turkey"
        PRINT." Now that's some good viddles" CR
         25 FOOD CREDIT  ;

CASE: VARMINTS  5 CHOICES,   ;CASE

: ANIMAL    5 RANDOM VARMINTS ;
.( .)
: HUNT
        PRINT." You are hunting"
        PRINT." Be vaarrwee quiet " ...
        PRINT." Press space bar to fire"
        BEGIN KEY? BL = UNTIL
        CR PRINT." BANG!" CR

        ACCURACY @ HEALTH @ *    \  HEALTH affect accuracy
        55 MAX %CHANCE DOTHIS
             PRINT." You shot a " ANIMAL
        OTHERWISE
             PRINT." You missed."
             PRINT." Yer gonna be hungry tonight." ...
             5 FOOD DEBIT
             3 HEALTH DEBIT
       ENDTHIS
       5 RANDOM 1+ AMMO DEBIT
;

: .CASH  ." You have " CASH @ DOLLARS ." cash" ;

: BUYFOOD
         PRINT." How much do you want to spend?"
         CR .CASH
         TEMP  1 CASH @  VALID-INPUT
         DUP CASH DEBIT  FOOD CREDIT
         CR .CASH ." left"
;

\ ================================================
\ status testers begin with a ?

: ?FOOD  \ test DOTHIS we have enough Food points left
          FOOD @ 1 < DOTHIS   STARVED  ENDTHIS
          FOOD @ 10 <
          DOTHIS
              PRINT." You need to do some hunting
              PRINT." or by some " FOODSTUFF ." !!!"
              PRINT." 1. Hunt"
              PRINT." 2. Buy Food"
              PRINT." Enter to go on"
              CR
              KEY
              CASE
                  [CHAR] 1 OF HUNT     ENDOF
                  [CHAR] 2 OF BUYFOOD  ENDOF
              ENDCASE
          ENDTHIS ;
.( .)
: ?WOUNDED
         WOUNDED @ 0 <>
         DOTHIS CR
            PRINT." Did you know you are wounded?"
            DOCTOR?
         ENDTHIS
;

: ?TIMEOUT
         DAY @ 22 >
         DOTHIS
            CR PRINT." It's a terrible shame."
            1000 MS
            PRINT." Y'all didn't get to Oregon
            PRINT." in time.
            1000 MS
            PRINT." I reckon yer lost" CR CR
            SORRY
         ENDTHIS
  ;
.( .)
\ good stuff that can happen
: NATIVES
        CR
        PRINT." You bumped into friendly Haida people."
        50 %CHANCE
        DOTHIS
            PRINT." They gave you some fresh " FOODSTUFF
            20 RANDOM# FOOD CREDIT
             5 HEALTH CREDIT
        ENDTHIS
        22 %CHANCE
        DOTHIS
            PRINT." and fed your animals!"
            40 OXEN CREDIT
        ENDTHIS
;

: HUNTER
         33 %CHANCE
         DOTHIS
             CR PRINT." You met a hunter and he gave you a " ANIMAL
         ENDTHIS
;

: GRAZING
         50 %CHANCE DOTHIS
             CR
             PRINT." Good luck!"
             PRINT." Your Oxen found some nice grazing."
             25 RANDOM#  OXEN CREDIT
         ENDTHIS
;

: GOODWEATHER
           63 %CHANCE DOTHIS
             CR
             PRINT." The weather is good for travelling."
             2 OXEN CREDIT
             2 HEALTH CREDIT
             2 CLOTHES CREDIT
          ENDTHIS
;

CASE: GOODTHINGS
     | NATIVES  | HUNTER  | GRAZING | GOODWEATHER
;CASE

: HAPPYDAYS   4 RANDOM GOODTHINGS  ;
.( .)
: AreWeThereYet?
         MILEAGE @ DESTINATION  >
         DOTHIS
            CONGRATS
         THEN
         PRINT." We travelled "  MILEAGE @ . ." miles."
;

: CONSUME  \  things are used up every day
      10 RANDOM# HEALTH DEBIT
      40 RANDOM# OXEN# @ * 5 + OXEN DEBIT
      10 RANDOM# FOOD DEBIT
      10 RANDOM# CLOTHES DEBIT
      10 RANDOM# MISC DEBIT
;

: ?OXEN
         OXEN @ 10 <
         DOTHIS  PRINT." Yer oxen are almost dead!"
             PRINT." Wanna stop for grazing"
             YES?
             50 %CHANCE
             DOTHIS
                20 RANDOM# OXEN CREDIT
                OXEN @ 15 <
                DOTHIS    PRINT." Your oxen are weak"
                OTHERWISE PRINT." You oxen are doing better"
                ENDTHIS
            OTHERWISE
                50 OXEN CREDIT
                PRINT." Your oxen got a great rest"
                CR
             ENDTHIS
        ENDTHIS
        5 %CHANCE DOTHIS
              CR PRINT." Uhoh, we got company!"
              HOSTILE-DECIDE
        ENDTHIS
;

CHOICE: CR ." Your coat fell apart. "
        CR ." You died of exposure. "  ;

CHOICE: CR ." Your cheap boots rotted away. "
        CR ." Your feet rotted next! " ;

CHOICE: CR ." Your underwear chaffed too much"
        CR ." You died crying..." ;

CHOICE: CR ." Your hat became infested with earwigs."
        CR ." They ate your brain" ;
CASE: WARDROBE-FAILURE   4 CHOICES,   ;CASE

: ?CLOTHING
        CLOTHES @ 1 <
        DOTHIS
          4 RANDOM WARDROBE-FAILURE
          HEALTH OFF
          SORRY
        ENDTHIS ;

.( .)
: TITLE-PAGE
         TEXT  GREEN
         CENTER." * O R E G O N  T R A I L *"
         CR CENTER." The game that time forgot"
         CR CR CR
         2000 MS
         CENTER." Based on BASIC version
         CENTER." by Majestyx on Atariage"
         1000 MS
         CR CR CR CR
         CENTER." Re-write in Forth by TheBF"
         CR CENTER." Version 1.5"
         0 22 AT-XY
         CENTER." Press a key to begin"
         KEY DROP
;

: OPENING
         TITLE-PAGE
         YELLOW PAGE
         PRINT."  -- You're on the Oregon trail" ...
         12 RANDOM# MONTH !
         1 DAY !
         CR .DATE ...
         SETUP
;
.( .)
: CAMP   CR
         PRINT." Oxen are tied up, fire is lit."
         PRINT." Get some sleep partner" ...
         33 %CHANCE DOTHIS
              PRINT." Uhoh! I heard some footsteps"
              PRINT." over yonder!"
              HOSTILE-DECIDE
        OTHERWISE
              CR
              PRINT." We had a peacful night"
              PRINT." Eat some vittles and git goin'"
              10 RANDOM#  FOOD DEBIT
              10 HEALTH   CREDIT
              50 RANDOM#  OXEN# @ *  OXEN CREDIT
        ENDTHIS
;
.( .)
: VALIDATE ( c addr len -- ? )  ROT SCAN NIP ;

: MENU-KEY ( c)
         BEGIN
            KEY  DUP S" 12349" VALIDATE
         0= WHILE
            DROP
         REPEAT ;

.( .)
: MENU
     CR
     PRINT." It's " .DAY
     PRINT." What do you want to do?"
     PRINT." 1) Keep moving"
     PRINT." 2) Setup Camp for the night"
     PRINT." 3) Hunt"
     PRINT." 4) Check supplies"
     CR ." > " MENU-KEY DUP EMIT
     CASE
       [CHAR] 1 OF CONTINUE    ENDOF
       [CHAR] 2 OF CAMP        ENDOF
       [CHAR] 3 OF HUNT        ENDOF
       [CHAR] 4 OF .SUPPLIES   ENDOF
       [CHAR] 9 OF ." Secret programmer escape ;-)" ABORT ENDOF
    ENDCASE
;
CR .( . Starting...)
: RUN ( -- )
    DECIMAL
    NEWGAME
    OPENING
    BEGIN
      MENU
      CONSUME
      AreWeThereYet?
      18 %CHANCE DOTHIS  SHITHAPPENS  ENDTHIS
      18 %CHANCE DOTHIS  HAPPYDAYS    ENDTHIS
      ( test our status)
      ?TIMEOUT  ?FOOD  ?OXEN ?CLOTHING  ?BROKE  ?WOUNDED  ?HEALTH
      ?DEAD
      1 DAY CREDIT
      ?TIMEOUT
   AGAIN ;
CR
CR .( /OREGON command removes game)
CR .( Press a key to start ) KEY DROP
RUN

Oregontrail.png.aaad2bdf6dca30fb30a3a9b12855d860.png

OREGON.zip

Edited August 3, 2020 by TheBF
New Version that plays better

+TheBF · August 3, 2020

Who am I kidding. Once I opened that code up I couldn't just leave it alone.

I found a bunch of stupid stuff in OREGON Trail that I fixed in the new version post in previous post.

You can read the source code if you really want to know the details.

Better yet change it up and give it back to us.

I also added some problems with clothing wearing out so invest your budget wisely.

Suffice to say you now can't win by always pressing CONTINUE like you could before.

That will be it for Oregon trail for a while ... I hope.

Maybe I should do a Yukon Goldrush and have a few polar bears and grizzlies in the mix... :lol:

+TheBF · August 4, 2020

Just to see what it would take I continued working on my INLINE[] optimizer.

I realized that I should have emulated the Forth compiler loop to make it easier.

With that awakening I added the ability to compile literal numbers inline.

Next I made use of the fact that every Forth word has an kind of identifier as the first cell of its definition.

This can be treated like a 'type' identifier as you would see in typed languages.

Armed with that knowledge I could determine if a word was a VARIABLE or a CONSTANT and compile the appropriate code for those words as well.

The got a little more complicate but it makes sense to me.

It reduced the running time of the 10,000 number Sieve benchmark by 10% just by inlining one constant in the inner loop. Not bad.

Spoiler


\ inline3.fth Compiles inline code as headless word in HEAP  Aug 4, 2020
\ *VERSION 3* CAN OPTIMIZE VARIABLES, CONSTANTS AND LITERAL NUMBERS*

\ Problem:
\  The preamble overhead to compile an ITC word as inline machine code is too big.
\  You need 8 bytes for the header and 8 bytes to correct the IP.
\  This meant it was easier make new code words that combined other code
\  words.
\  INLINE[ ] in this version uses HEAP memory to compile a headless version
\  of the new code word. That XT is compiled into your Forth definition.
\

\ **not portable Forth code**  Uses TMS9900/CAMEL99 CARNAL Knowledge

NEEDS .S   FROM DSK1.TOOLS
NEEDS CASE FROM DSK1.CASE

MARKER /INLINE

HERE
HEX
\ CFA of a code word contains the address of the next cell
: NOTCODE? ( -- ?)  DUP @ 2- - ;

\ Heap management words
: HEAP    ( -- addr) H @ ;
: HALLOT  ( n -- )   H +! ;
: HEAP,  ( n -- )   HEAP ! 2 HALLOT ;

\ scan MACHINE code looking for the NEXT, routine.
\ Abort if NEXT is not found after 256 bytes. This is an arbitrary size
\ but most Forth code words are much smaller than 256 bytes.
: TONEXT ( adr --  adr2 )
           0                \ flag that falls thru if we don't succeed
           SWAP
         ( ADR) 80          \ max length of code word is $80 CELLS
           BOUNDS
           DO
             I @ 045A  =   \ test each CELL for CAMEL99 NEXT (B *R10)
             IF   DROP I LEAVE
             THEN
           2 +LOOP
           DUP 0= ABORT" NEXT not found" ;

\ LIT, macro compiles the following machine code into HEAP memory
\              *SP  DECT,
\           TOS *SP  MOV,
\           TOS SWAP LI,

: LIT,      ( n -- ) 0646 HEAP, C584 HEAP,  0204 HEAP, ( n) HEAP,  ;

: VAR,    >BODY LIT,  ;               \ compile variable PFA as literal
: CON,    >BODY LIT,  C114 HEAP,  ;   \ compile constant PFA & compile @


CREATE WORDBUFF  22 ALLOT  \ parsing buffer

\ new interpreter loop for inlining
: INLINE[ ( -- addr)  \ Returns address where code has been copied
           HEAP DUP 2+ HEAP,  \ create the ITC header for CODE word
           BEGIN
             BL PARSE-WORD WORDBUFF PLACE
             WORDBUFF CHAR+ C@ [CHAR] ] <>
           WHILE
              WORDBUFF FIND
              IF ( *it's a Forth word* )
                 DUP NOTCODE?
                 IF DUP
                    @  \ get the "executor" code routine address
                    CASE
                      ['] DOVAR OF  VAR,  ENDOF
                      ['] DOCON OF  CON,  ENDOF
                      TRUE ABORT" Unrecognized type"
                    ENDCASE

                 ELSE  \ it's a CODE primitive
                     \ calc. start and len. of code
                     >BODY DUP TONEXT OVER  -   ( -- PFA PFA len)
                     HEAP OVER HALLOT SWAP CMOVE   \ transcribe code to HEAP
                 THEN

             ELSE ( maybe its a number)
                 COUNT NUMBER?  ?ERR
                 ( n ) LIT,   \ compile n as a literal
             THEN
           REPEAT
           045A HEAP,   \ compile NEXT at end of HEAP code
           COMPILE,     \ compile HEAP XT into current colon definition
;  IMMEDIATE

\ need NORMAL copies of words that are WEIRD in the Camel99 kernel
CODE @      C114 ,                  NEXT, ENDCODE
CODE C@     D114 , 0984 ,           NEXT, ENDCODE
CODE DROP   C136 ,                  NEXT, ENDCODE

HERE SWAP - SPACE DECIMAL . .( bytes) HEX CR

+Lee Stewart · August 4, 2020

Wow! Your INLINE[ ] coding is very slick! Unfortunately for me, however, I probably cannot do anything like this in fbForth 2.0 for a couple of reasons:

Several CODE words JuMP into other words or to common routines to save space, which means they have no inline NEXT.
A host of CODE words branch into other banks via a low-expansion-RAM trampoline routine and return by branching to another low-expansion-RAM trampoline routine that contains the NEXT instruction. This routine switches the ROM to bank 0 before it returns to the inner interpreter via NEXT.

There may be other flies in the ointment, but the above two are more than enough to preclude INLINE[ ] functionality for fbForth 2.0. Oh, well.

...lee

+TheBF · August 4, 2020

Thanks. I still have to add a code fragment to handle USER variables but now the framework makes it straightforward.

Yes I had a similar problem with the primitives in scratchpad RAM. They defied my detection method for code words.

This is why I created duplicates of the problem words.

All of this is pointing in the direction of moving to building a native code Forth kernel for TI-99.

I spoke with Stephen Pelc the CEO of MPE Forth a few years back and he told me that when they switched to their VFX native code compiler development they were benchmarking the new compiler against their older threaded versions. He said "We stopped comparing when the difference was 12X faster".

I have been sidetracked in that endeavour because I wanted to have a complete threaded system that I was good before moving on. It's getting close.

+TheBF · August 4, 2020

Final inline optimizer handles USER variables but not completely. I wimped out and simply compile the address for the current workspace.

It's mostly for amusement because if you really need a lot of speed Forth Assembler is best for the 9900.

Spoilers show the final code that will be released. The error message for an un-optimizable word has been improved and the offending word will be printed by ?ERR.

The two little videos show Camel99 Forth V2.62C and TurboForth running the same code to calculate 10,000 primes. They both come in at about 6.3 seconds on my stop watch. The TI-99 elapsed timer is a little high.

You can also see the code running called OPTIMUSPRIMES which is running with all the primitives inlined. It runs in about 4.1 seconds.

Spoiler


\ inline4.fth Compiles inline code as headless word in HEAP  Aug 4, 2020
\ *VERSION 3* CAN OPTIMIZE VARIABLES, CONSTANTS AND LITERAL NUMBERS*

\ Problem:
\  The preamble overhead to compile an ITC word as inline machine code
\  is too big. You need 8 bytes for the header and 8 bytes to correct the IP.
\  This meant it was easier make new code words that combined other code words.
\  INLINE[ ] in this version uses HEAP memory to compile a headless version
\  of the new code word. That XT is compiled into your Forth definition.
\

\ **not portable Forth code**  Uses TMS9900/CAMEL99 CARNAL Knowledge

\ NEEDS .S   FROM DSK1.TOOLS
NEEDS CASE FROM DSK1.CASE

MARKER /INLINE

HERE
HEX
\ CFA of a code word contains the address of the next cell
: NOTCODE? ( -- ?)  DUP @ 2- - ;

\ Heap management words
: HEAP    ( -- addr) H @ ;
: HALLOT  ( n -- )   H +! ;
: HEAP,  ( n -- )   HEAP ! 2 HALLOT ;

\ scan MACHINE code looking for the NEXT, routine.
\ Abort if NEXT is not found after 256 bytes. This is an arbitrary size
\ but most Forth code words are much smaller than 256 bytes.
: TONEXT ( adr --  adr2 )
           0                \ flag that falls thru if we don't succeed
           SWAP
         ( ADR) 80          \ max length of code word is $80 CELLS
           BOUNDS
           DO
             I @ 045A  =   \ test each CELL for CAMEL99 NEXT (B *R10)
             IF   DROP I LEAVE
             THEN
           2 +LOOP
           DUP 0= ABORT" NEXT not found" ;

\ LIT, macro compiles the following machine code into HEAP memory
\              *SP  DECT,
\           TOS *SP  MOV,
\           TOS SWAP LI,
: LIT,      ( n -- ) 0646 HEAP, C584 HEAP, 0204 HEAP, ( n) HEAP, ;

: VAR,    >BODY LIT,  ;               \ compile variable PFA as literal
: CON,    >BODY LIT,  C114 HEAP,  ;   \ compile constant PFA & compile @

\ <<NOT MULTI-TASKING FRIENDLY>> computes address of compiler's workspace
: USER,   ( xt --)  EXECUTE LIT,  ;  \ execute user VAR to compute address 1st

\ new interpreter loop for inlining
: INLINE[ ( -- addr)  \ Returns address where code has been copied
           HEAP ( -- XT)  \ HEAP will be our new execution token (XT)
           DUP 2+ HEAP,   \ create the ITC header for CODE word

           BEGIN   BL WORD CHAR+ C@  [CHAR] ] <>  WHILE
              HERE FIND
              IF ( *it's a Forth word* )
                 DUP NOTCODE?
                 IF DUP
                    @  \ get the "executor" code routine address
                    CASE
                      ['] DOVAR    OF  VAR,  ENDOF
                      ['] DOCON    OF  CON,  ENDOF
                      ['] DOUSER @ OF USER,  ENDOF \ douser is Weird
                      CR ." *Can't optimize type"  TRUE  ?ERR
                    ENDCASE

                 ELSE  \ it's a CODE primitive
                     \ calc. start and len. of code
                     >BODY DUP TONEXT OVER  -   ( -- PFA PFA len)
                     HEAP OVER HALLOT SWAP CMOVE   \ transcribe code to HEAP
                 THEN

             ELSE ( maybe its a number)
                 COUNT NUMBER?  ?ERR
                 ( n ) LIT,   \ compile n as a literal
             THEN
           REPEAT
           045A HEAP,   \ compile NEXT at end of HEAP code
           COMPILE,     \ compile HEAP XT into current colon definition
;  IMMEDIATE

\ need NORMAL copies of words that are WEIRD in the Camel99 kernel
CODE @      C114 ,         NEXT, ENDCODE
CODE C@     D114 , 0984 ,  NEXT, ENDCODE
CODE DROP   C136 ,         NEXT, ENDCODE

HERE SWAP - SPACE DECIMAL . .( bytes) HEX CR

+TheBF · August 5, 2020

The Dreaded Sprite Coincidence

While looking to update a PONG demonstration game I started to wonder about coincidence detection. My original code was an optimized version of the TI-Forth code.

I wrote some CODE words and the net result was I got COINC to be 2X faster but it always seem needlessly complicated to me.

My Sprite COINC using distance calculation

Spoiler


HEX
CODE RANGE? ( n n n -- n') \ FORTH: OR OR 8000 AND
          E136 ,          \ *SP+ TOS SOC,
          E136 ,          \ *SP+ TOS SOC,
          0244 , 8000 ,   \ TOS 8000 ANDI,
          NEXT,
          ENDCODE
 
CODE DXY  ( x2 y2 x1 y1 --- dx dy )   \ Common factor for SP.DIST,SP.DISTXY
          C036 ,  \ *SP+ R0 MOV,      \ pop x1->R0
          6136 ,  \ *SP+ TOS SUB,     \ pop y1-y2->tos
          6016 ,  \ *SP  R0 SUB,      \ x1-x2->R0, keep stack location
          C0C4 ,  \  TOS R3 MOV,      \ dup tos in r3, MPY goes into R4
          38C4 ,  \  TOS R3 MPY,      \ r3^2, result->r4 (tos)
          C080 ,  \  R0  R2  MOV,     \ dup R0
          3802 ,  \  R2  R0  MPY,     \ RO^2
          C581 ,  \  R1 *SP  MOV,     \ result to stack
          NEXT,                       \ 16 bytes
          ENDCODE
.( .)
\ factored DIST out for re-use
\ With new machine code words and no Rstack operations it is 2X faster
: DIST     ( x2 y2 x1 y1 -- distance^2) \ distance between 2 coordinates
            DXY  2DUP +                  \ sum the squares
            DUP RANGE?                   \ check if out of range
            IF  DROP 7FFF                \ throw away the copy, return 32K
            THEN ;                       \ otherwise return the calculation
 
: SP.DIST   ( spr#1 spr#2 -- dist^2 ) POSITION ROT POSITION DIST ;
: SP.DISTXY ( x y spr# -- dist^2 )    POSITION DIST ;

\ text macros for clarity and speed of coicidence detection
: 2(X^2)   ( n -- 2(n^2) S" DUP * 2*" EVALUATE ;  IMMEDIATE
: <=       ( n n -- ? )  S" 1- <" EVALUATE ; IMMEDIATE

\ 0 means no coincidence
: COINC     ( sp#1 sp#2 tol -- ? )  2(X^2) -ROT SP.DIST > ;

That's a lot of code to compare two X,Y pairs!

I found this great site here https://ti99resources.wordpress.com/documents/ and took a look at an Assembly Language book. I was curious how an Assembly Language coder would do this.

Subtraction of course and comparison to a value. DUH!

I have words that index into the sprite table and I have a word to read 2 VDP bytes at once. ( V@)

I have a code word that splits an integer into 2 bytes.

Putting that all together in Forth gave me this and even without optimization it is still faster than my master work above based on the TI Forth code.

Summing the squares was indeed overkill.


: COINC ( spr#1 spr#2 tol -- ?)
        >R
        SP.Y V@  SWAP SP.Y V@ ( <COL,ROW> <COL,ROW>)
        SPLIT ROT SPLIT ( -- col row col row )
        ROT - ABS R@ <
       -ROT - ABS R> <
        AND ;

+Lee Stewart · August 5, 2020

32 minutes ago, TheBF said:

The Dreaded Sprite Coincidence

I never did like that TI Forth code. I converted probably all of it to ALC, but for Build 13 of fbForth 2.0, I will be studying on your code to possibly include improvements on those words ( COINC COINCXY COINCALL SPRDIST SPRDISTXY ).

...lee

+TheBF · August 5, 2020

I pulled one SWAP out of COINC which speeds it up a little bit

: COINC ( spr#1 spr#2 tol -- ?)
        >R  SP.Y V@ SPLIT \ expand POSITION for speed
        ROT SP.Y V@ SPLIT
        ( -- col row  col row)
        ROT - ABS R@ <
       -ROT - ABS R> <
        AND ;

I put together a little test to see how it performs with automotion.

The test is not using COINCXY for testing the borders of the screen. I find it easier to read the sprite descriptor table (SDT) X and Y coordinates separately.

I have CODE words called SP.X SP.Y to compute the VDP addresses given a sprite# parameter. For clarity there is also SP.X@ and SP.Y@ .

This would not be a big deal in a language with local variables but needlessly reading two values onto the stack when you don't need both just means you have to do more shuffling.

I am beginning to think the SPRITE command set from BASIC is not optimal for Forth for this reason.

Here is the new code and a test video. It seems to work and takes a lot less space than the old one.

Spoiler


\ BETTER Sprite COINC detector
NEEDS DUMP       FROM DSK1.TOOLS
NEEDS SPRITE     FROM DSK1.DIRSPRIT
NEEDS AUTOMOTION FROM DSK1.AUTOMOTION

MARKER /TEST

DECIMAL
: COINC ( spr#1 spr#2 tol -- ?)
        >R  SP.Y V@ SPLIT \ expand POSITION for speed
        ROT SP.Y V@ SPLIT
        ( -- col row  col row)
        ROT - ABS R@ <
       -ROT - ABS R> <
        AND ;

\ : TESTC   TMR@  0 1 8 COINC TMR@ NIP - . ;  \ 1406 uS

: COINCXY   ( dx dy sp# tol -- ? )
        >R
        SP.Y V@ SPLIT
      ( -- col row col row )
        ROT - ABS R@ <
       -ROT - ABS R> <
        AND ;

: BOUNCE.X  ( spr# -- ) ]SMT 1+ DUP VC@ NEGATE  SWAP VC! ;
: BOUNCE.Y  ( spr# -- ) ]SMT    DUP VC@ NEGATE  SWAP VC! ;

: TRAPPED ( spr# -- )
     DUP SP.X@ 242 7 WITHIN
     IF
        DUP BOUNCE.X
     THEN
     DUP SP.Y@ 179 7 WITHIN
     IF  BOUNCE.Y
     ELSE DROP
     THEN ;

DECIMAL
: COINCTEST ( motionx motiony -- )
       7 SCREEN
       PAGE ." CAMEL99 Forth"
       CR   ." Coincidence Test with Automotion"
       ( char colr  x   y   sp# )
       [CHAR] @  16   90 100  0 SPRITE
       [CHAR] #   3  200 100  1 SPRITE

       1 MAGNIFY

       127 127 1 MOTION
       5   5   0 MOTION
       AUTOMOTION
       BEGIN
          1 TRAPPED   \ test moving sprite for border limits
          COINCALL
          IF   1 DUP BOUNCE.X BOUNCE.Y
               0 DUP BOUNCE.X BOUNCE.Y
               2 0 SP.COLOR
               HONK
               16 0 SP.COLOR
          THEN
         ?TERMINAL
       UNTIL
       STOPMOTION  ;

GDMike · August 9, 2020

Question, and I apologise for not knowing, but is fbforth and/or camel forth command line in graphics mode when they startup?

My question arrives because I thought how much I like color forth. With it's style. As seen here.

https://en.m.wikipedia.org/wiki/ColorForth

+Lee Stewart · August 10, 2020

2 hours ago, GDMike said:

Question, and I apologise for not knowing, but is fbforth and/or camel forth command line in graphics mode when they startup?

My question arrives because I thought how much I like color forth. With it's style. As seen here.

https://en.m.wikipedia.org/wiki/ColorForth

fbForth, TurboForth, TI Forth and Camel99 Forth all start up in Text40 mode—the first two also in Text80 mode. It is easy enough to start them (Camel99 Forth?) up in Graphics mode, however. if that is what you want. I am not sure how to automate startup in Camel99 Forth (Brian will be along shortly, I am sure), but the others can be started up in whatever mode you want by properly setting up block #1 of the system blocks file for fbForth (FBLOCKS) and TurboForth (BLOCKS) and block #3 of TI Forth. The command line works fine in Graphics mode (32 characters, however)—Bitmap or Multicolor mode, not so much.

...lee

+TheBF · August 10, 2020

Interesting. I wondered about color Forth for TI-99 but never did any research. It is the really "odd-man-out" dialect in the Forth world.

Currently Camel99 is a micro kernel. That is by design. My thoughts were towards flexibility so everything extra is loaded on top of the kernel.

Typing: INCLUDE DSK1.GRAFIX will get you in graphics mode with the regular HCHAR VCHAR etc. BASIC words. You switch back and forth with TEXT or GRAPHICS commands.

It would be trival to compile a new kernel that boots in Graphics mode if you want one. That would not give you COLOR Forth however.

The compiler loop must be changed to read the color of the text to determine what's going on in the code. Not really hard to do but it will require that I understand what COLOR Forth actually does. I think we would need to add some magic key code as well to control the text color. Chuck originally developed Color Forth to use a 3 button mouse as the keyboard enhancement and he memorize the binary codes for 0 to 7 to control colors (It was something like that. I don't remember the exact detail)

The compiler loop (INTERPRET ) in Camel99 is a vector so in theory I could add COLOR Forth on top of Camel99 but to be truly COLOR Forth is should also be generating native machine code I believe. We could experiment with something...

Camel99 Forth Information goes here

Recommended Posts

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Join the conversation

Recently Browsing 0 members