Jump to content
TheBF

Camel99 Forth Information goes here

Recommended Posts

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

  • Like 1

Share this post


Link to post
Share on other sites

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

 

 

  • Like 3

Share this post


Link to post
Share on other sites
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

  • Like 1

Share this post


Link to post
Share on other sites

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

 

 

 

  • Like 2

Share this post


Link to post
Share on other sites
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. :) 

Share this post


Link to post
Share on other sites

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 [email protected] ;
: SPINCHAR ( -- char ) SPIN# @ 1+ 3 AND DUP SPIN# ! SCHARS + [email protected]  ;
: 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 [email protected] - >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 [email protected]  ( -- mantissa)
          CASE
            0 OF  0                    ENDOF
           40 OF  OVER 1+ [email protected]           ENDOF
           41 OF  OVER 1+ [email protected] 64 * >R
                  OVER 2+ [email protected]  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 [email protected] READH
          CR PAD HEAD.REC
          CR 13 SPACES  ." -type-  -sect- -b/rec-"

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

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

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

: MORE  ( <filename>)
          ARG$ DV80 R/O OPEN >R
          BEGIN
             PAD DUP 50 [email protected] READ-LINE ?FILERR ( adr len flag)
          WHILE
             CR TYPE
             SPACEBAR
             [email protected] ?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
          [email protected]  50  #1 READ-LINE ?FILERR ( -- #bytes eof?)
        WHILE
          [email protected] 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 & _ )
              [email protected] 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 by TheBF
typo
  • Like 1

Share this post


Link to post
Share on other sites

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 [email protected] INVERT SWAP VC!  \ invert char patterns
         LOOP ;

: HITYPE ( addr len --)  BOUNDS DO   I  [email protected] 80 OR (EMIT)  LOOP ;
: HILITE ( Vaddr len --) BOUNDS DO   I [email protected] 80 OR I VC!   LOOP ;
: NORMAL ( Vaddr len --) BOUNDS DO   I [email protected] 7F AND I VC!  LOOP ;

 

 

 

hiliteForth.png

Edited by TheBF
Replaced -1 XOR with INVERT
  • Like 1

Share this post


Link to post
Share on other sites
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

Share this post


Link to post
Share on other sites
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

 

Share this post


Link to post
Share on other sites
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 [email protected]  C! and [email protected]  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.

 

Share this post


Link to post
Share on other sites
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)

 

Share this post


Link to post
Share on other sites
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....

Share this post


Link to post
Share on other sites

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+ [email protected] [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 [email protected]     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 + [email protected] ] 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 + [email protected] ]
           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

 

 

Share this post


Link to post
Share on other sites

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:

  1. ."  is re-written so it compiles strings to VDP RAM to save CPU RAM for program logic.
  2. PRINT."   is the same as ."  but adds the new-line first like BASIC Print.
  3. IF etc.  has been replaced by:   DOTHIS <CODE>  OTHERWISE <CODE>   ENDTHIS
  4. ...   prints a small random number of dots at 1/4 second intervals to make it look like time is passing
  5. %CHANCE    lets you alter the game chances of things happening. Used with  DOTHIS
  6. 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
     

Source code for 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
INCLUDE DSK1.RANDOM
INCLUDE DSK1.INPUT
INCLUDE DSK1.FASTCASE
INCLUDE DSK1.CASE
INCLUDE DSK1.ENUM
INCLUDE DSK1.VDPMEM

\ ====================================================
\ 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 [email protected] 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/[email protected] 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
: RANDOM   ( n -- )   1 OVER CLIP  RND ;    \ limit RND number to min(1)

\ =========================================
\ 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 1+ ;  \ Random # 1..12

\ random delay with dot printing
: ...  ( n -- ) 9 RANDOM CELL+  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
     OXEN# OFF
     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 ;
.( . 242.)
: .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 CYAN QUIT ;

: SORRY  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
         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."
         CR
         PRINT." Press a key to end" KEY DROP
         AGAIN? ;
.( .)
: ?DEAD
         HEALTH @ 0=
         DOTHIS  ...
            CR PRINT." Unfortunately you died on"  1000 MS
            CR .DATE
            CR
            SORRY
        ENDTHIS ;

: SEE-DOCTOR
         CR  ...
         PRINT." The doc wants " 30 RANDOM 5 +  DUP DOLLARS
         PRINT." to patch you up."
         DUP CASH @ >
         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
         ?DEAD
;
.( .)
\ ====================================================
\ 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 ;
CASE: DISEASES  7 CHOICES,  ;CASE

: SICKNESS     7 RANDOM DISEASES ;

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

CASE: ANATOMY   5 CHOICES,   ;CASE

: BODYPART    5 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!"
        ...
        PRINT." That'll cost ya "
        5 RANDOM 1+ 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 1+ 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 .( 1/2 way .)
: RAIN
     PRINT." Heavy rain" ...
     PRINT." Time & supplies were lost." ...
     3 RANDOM 1+  DAY CREDIT
     7 RANDOM    MISC DEBIT
    12 RANDOM 1+ FOOD DEBIT
;

: BAD-WATER
     PRINT." Bad water, You lost time"
     PRINT." looking for a clean spring."
     ...
     3 RANDOM 1+ DAY CREDIT
     2 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" ...
     PRINT." (Tie him up next time)"
     2 DAY CREDIT
     4 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 1+ DAY CREDIT
        4 RANDOM 1+ FOOD DEBIT
        2 RANDOM MISC DEBIT
     ENDTHIS
;

: BLIZZARD
     PRINT." Blizzard in mountains at south pass" ...
     47 %CHANCE DOTHIS
         PRINT." Time & supplies lost"
         2 RANDOM  1+ DAY CREDIT
         2 RANDOM MISC DEBIT
         4 RANDOM 1+ 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." Tragegy has done commenced!"
        CR
        16 RANDOM TRAGEDIES ;

: ?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
            10 HEALTH DEBIT
        ENDTHIS
     ENDTHIS
     ?DEAD ;
.( .)
: GOTSHOT
          PRINT." OUCH! You got shot in the " BODYPART
          ?DEAD
          WOUNDED ON
          5 RANDOM MISC DEBIT
          20 RANDOM 2+ 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 1+ MILEAGE CREDIT
          10 RANDOM HEALTH DEBIT
          20 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 1+ 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 " ...
         20 RANDOM 1+ MILEAGE CREDIT
          2 RANDOM HEALTH DEBIT
         10 RANDOM 2+ OXEN DEBIT
          5 RANDOM CLOTHES DEBIT
         14 RANDOM 2+  OXEN# @ *  MILEAGE CREDIT
         2 %CHANCE DOTHIS    WOUNDED ON   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 or by some food!!!"
              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 @ 25 >
         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 fresh food"
            20 RANDOM 4 +  FOOD CREDIT
             5 HEALTH CREDIT
        ENDTHIS
        22 %CHANCE
        DOTHIS
            PRINT." and fed your animals!"
            40 OXEN CREDIT
        ENDTHIS
;

: HUNTER
         50 %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."
             15 RANDOM 2+  OXEN CREDIT
         ENDTHIS
;

: GOODWEATHER
           63 %CHANCE DOTHIS
             CR
             PRINT." The weather is good for travelling."
             1 OXEN CREDIT
             1 HEALTH CREDIT
             1 CLOTHING 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 1+ HEALTH DEBIT
      40 RANDOM 1+ OXEN# @ * 5 + OXEN DEBIT
      10 RANDOM 1+ FOOD DEBIT
      10 RANDOM 1+ CLOTHES DEBIT
      10 RANDOM 1+ MISC DEBIT
;

: ?OXEN
         OXEN @ 10 <
         DOTHIS  PRINT." Yer oxen are almost dead!"
             PRINT." Wanna stop for grazing"
             YES?
             50 %CHANCE
             DOTHIS
                ROLL-DICE OXEN CREDIT
                OXEN @ 15 <
                DOTHIS    PRINT." Your oxen are weak"
                OTHERWISE PRINT." You oxen are doing better"
                ENDTHIS
            OTHERWISE
                ROLL-DICE 5 * OXEN CREDIT
                PRINT." Your oxen got a great rest"
                CR
             ENDTHIS
        ENDTHIS
        31 %CHANCE DOTHIS
              CR PRINT." Uhoh, we got company!"
              HOSTILE-DECIDE
        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 CR
         CENTER." Re-write in Forth by TheBF"
         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 1+ 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 1+  FOOD DEBIT
              10 HEALTH CREDIT
              50 RANDOM 15 + OXEN CREDIT
               ( 2 oxen multiplies the credit)
        ENDTHIS
;
.( .)
: VALIDATE ( c addr len -- ? )  ROT SCAN NIP ;

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

: CONTINUE
         CR
         PRINT."  Continuing " ...
         20 RANDOM 1+ MILEAGE CREDIT
          2 RANDOM HEALTH DEBIT
         10 RANDOM 2+ OXEN DEBIT
          5 RANDOM CLOTHES DEBIT
         14 RANDOM 2+  OXEN# @ *  MILEAGE CREDIT
         2 %CHANCE DOTHIS    WOUNDED ON   ENDTHIS
;
.( .)
: 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
     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
      16 %CHANCE DOTHIS  HAPPYDAYS    ENDTHIS
      ( test our status)
      ?TIMEOUT  ?FOOD  ?OXEN  ?BROKE  ?DEAD  ?WOUNDED  ?HEALTH
      1 DAY CREDIT
      ?TIMEOUT
   AGAIN ;

RUN

 

 

Oregontrail.png.aaad2bdf6dca30fb30a3a9b12855d860.png

OREGON.zip

  • Like 3

Share this post


Link to post
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

Guest
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

Loading...

  • Recently Browsing   0 members

    No registered users viewing this page.

×
×
  • Create New...