Dr. Ting´s Forth lessons for beginners
This is part of the tutorial of Dr. Ting for learning Win32forth
(it should run on any ANSI forth )
sources on SVFIG , read manual : http://www.forth.org/eforth.html
you can run any example one by one copying all of them to an editor.
( If your forth does not have FOR NEXT , then make an ALIAS )
ALIAS FOR DO ALIAS NEXT LOOP
( Example 1. The Universal Greeting )
DECIMAL
: HELLO CR ." Hello, world!" ;
( Example 2. The Big F )
: bar CR ." *****" ;
: post CR ." * " ;
: F bar post bar post post post ;
( Type 'F' and a return on your keyboard, and you will see a large
F character displayed on the screen )
( Example 3. FIG, Forth Interest Group )
: center CR ." * " ;
: sides CR ." * *" ;
: triad1 CR ." * * *" ;
: triad2 CR ." ** *" ;
: triad3 CR ." * **" ;
: triad4 CR ." *** " ;
: quart CR ." ** **" ;
: right CR ." * ***" ;
: bigT bar center center center center center center ;
: bigI center center center center center center center ;
: bigN sides triad2 triad2 triad1 triad3 triad2 sides ;
: bigG triad4 sides post right triad1 sides triad4 ;
: FIG F bigI bigG ;
( Example 4. Repeated Patterns)
( FOR [ index -- ] Set up loop given the index.
NEXT [ -- ] Decrement index by 1. If index<0, exit. If index=limit, exit loop; otherwise
Otherwise repeat after FOR.
R@ [ -- index ] Return the current loop index. )
VARIABLE WIDTH ( number of asterisks to print )
: ASTERISKS ( -- , print n asterisks on the screen, n=width )
WIDTH @ ( limit=width, initial index=0 )
FOR ." *" ( print one asterisk at a time )
NEXT ( repeat n times ) ;
: RECTANGLE ( height width -- , print a rectangle of asterisks )
WIDTH ! ( initialize width to be printed )
FOR CR
ASTERISKS ( print a line of asterisks )
NEXT ;
: PARALLELOGRAM ( height width -- )
WIDTH !
FOR CR R@ SPACES ( shift the lines to the right )
ASTERISKS ( print one line )
NEXT ;
: TRIANGLE ( width -- , print a triangle area with asterisks )
FOR CR
R@ WIDTH ! ( increase width every line )
ASTERISKS ( print one line )
NEXT
;
( Try the following instructions:
3 10 RECTANGLE
5 18 PARALLELOGRAM
12 TRIANGLE )
( Example 5. The Theory That Jack Built )
( This example shows you how to build a hiararchical structure in Forth)
DECIMAL
: the ." the " ;
: that CR ." That " ;
: this CR ." This is " the ;
: jack ." Jack Builds" ;
: summary ." Summary" ;
: flaw ." Flaw" ;
: mummery ." Mummery" ;
: k ." Constant K" ;
: haze ." Krudite Verbal Haze" ;
: phrase ." Turn of a Plausible Phrase" ;
: bluff ." Chaotic Confusion and Bluff" ;
: stuff ." Cybernatics and Stuff" ;
: theory ." Theory " jack ;
: button ." Button to Start the Machine" ;
: child ." Space Child with Brow Serene" ;
: cybernatics ." Cybernatics and Stuff" ;
: hiding CR ." Hiding " the flaw ;
: lay that ." Lay in " the theory ;
: based CR ." Based on " the mummery ;
: saved that ." Saved " the summary ;
: cloak CR ." Cloaking " k ;
: thick IF that ELSE CR ." And " THEN
." Thickened " the haze ;
: hung that ." Hung on " the phrase ;
: cover IF that ." Covered "
ELSE CR ." To Cover "
THEN bluff ;
: make CR ." To Make with " the cybernatics ;
: pushed CR ." Who Pushed " button ;
: without CR ." Without Confusion, Exposing the Bluff" ;
: rest ( pause for user interaction )
." . " ( print a period )
10 SPACES ( followed by 10 spaces )
KEY ( wait the user to press a key )
DROP CR CR CR ;
(
KEY [ -- char ] Wait for a keystroke, and return the
ASCII code of the key pressed.
DROP [ n -- ] Discard the number.
SPACE [ -- ] Display a blank.
SPACES [ n -- ] Display n blanks.
IF [ f -- ] If the flag is 0, skip the following
instructions up to ELSE or THEN. If
flag is not 0, execute the following
instructions up to ELSE and skip to
THEN.
ELSE [ -- ] Skip the following instructions
up to THEN.
THEN [ -- ] Terminate an IF-ELSE-THEN structure
or an IF-THEN structure.
)
: cloaked cloak saved based hiding lay rest ;
: THEORY
CR this theory rest
this flaw lay rest
this mummery hiding lay rest
this summary based hiding lay rest
this k saved based hiding lay rest
this haze cloaked
this bluff hung 1 thick cloaked
this stuff 1 cover hung 0 thick cloaked
this button make 0 cover hung 0 thick cloaked
this child pushed
CR ." That Made with " cybernatics without hung
CR ." And, Shredding " the haze cloak
CR ." Wrecked " the summary based hiding
CR ." And Demolished " the theory rest
;
( Type THEORY to start)
( Example 6. Help )
( How to use Forth interpreter to carry on a dialog )
: question
CR CR ." Any more problems you want to solve?"
CR ." What kind ( sex, job, money, health ) ?"
CR ;
: help CR
CR ." Hello! My name is Creating Computer."
CR ." Hi there!"
CR ." Are you enjoying yourself here?"
KEY 32 OR 121 =
CR
IF CR ." I am glad to hear that."
ELSE CR ." I am sorry about that."
CR ." maybe we can brighten your visit a bit."
THEN
CR ." Say!"
CR ." I can solved all kinds of problems except those dealing"
CR ." with Greece. "
question ;
: sex CR CR ." Is your problem TOO MUCH or TOO LITTLE ? "
CR ;
: too ; \ ( noop for syntax smoothness )
: much CR CR ." You call that a problem ? !! I SHOULD have that problem. "
CR ." If it reall y bothers you, take a cold shower. "
question ;
: little
CR CR ." Why are you here! "
CR ." You should be in Tokyo or New York of Amsterdam or"
CR ." some place with some action."
question ;
: health
CR CR ." My advise to you is:"
CR ." 1. Take two tablets of aspirin."
CR ." 2. Drink plenty of fluids."
CR ." 3. Go to bed (along) ."
question
;
: job CR CR ." I can sympathize with you."
CR ." I have to work very long every day with no pay."
CR ." My advise to you, is to open a rental computer store."
question
;
: money
CR CR ." Sorry! I am broke too."
CR ." Why don't you sell encyclopedias of marry"
CR ." someone rich or stop eating, so you won't "
CR ." need so much money?"
question
;
: HELP help ;
: H help ;
: h help ;
( Type 'help' to start )
Example 7. Money Exchange
( The first example we will use to demonstrate how numbers are
used in Forth is a money exchange program, which converts money
represented in different currencies. Let's start with the
following currency exchange table:
33.55 NT 1 Dollar
7.73 HK 1 Dollar
9.47 RMB 1 Dollar
1 Ounce Gold 285 Dollars
1 Ounce Silver 4.95 Dollars )
DECIMAL
: NT ( nNT -- $ ) 100 3355 */ ;
: $NT ( $ -- nNT ) 3355 100 */ ;
: RMB ( nRMB -- $ ) 100 947 */ ;
: $RMB ( $ -- nJmp ) 947 100 */ ;
: HK ( nHK -- $ ) 100 773 */ ;
: $HK ( $ -- $ ) 773 100 */ ;
: GOLD ( nOunce -- $ ) 285 * ;
: $GOLD ( $ -- nOunce ) 285 / ;
: SILVER ( nOunce -- $ ) 495 100 */ ;
: $SILVER ( $ -- nOunce ) 100 495 */ ;
: OUNCE ( n -- n, a word to improve syntax ) ;
: DOLLARS ( n -- ) . ;
( With this set of money exchange words, we can do some tests:
5 ounce gold .
10 ounce silver .
100 $NT .
20 $RMB .
If you have many different currency bills in your wallet, you
can add then all up in dollars:
1000 NT 500 HK + .S
320 RMB + .S
DOLLARS ( print out total worth in dollars )
Example 8. Temperature Conversion
( Converting temperature readings between Celcius and Farenheit
is also an interesting problem. The difference between temperature
conversion and money exchange is that the two temperature scales
have an offset besides the scaling factor. )
: F>C ( nFarenheit -- nCelcius )
32 -
10 18 */
;
: C>F ( nCelcius -- nFarenheit )
18 10 */
32 +
;
( Try these commands
90 F>C . shows the temperature in a hot summer day and
0 C>F . shows the temperature in a cold winter night.
In the above examples, we use the following Forth arithmatic
operators:
+ [ n1 n2 -- n1+n2 ] Add n1 and n2 and leave sum on stack.
- [ n1 n2 -- n1-n2 ] Subtract n2 from n1 and leave differrence
on stack.
* [ n1 n2 -- n1*n2 ] Multiply n1 and n2 and leave product
on stack.
/ [ n1 n2 -- n1/n2 ] Divide n1 by n2 and leave quotient on
stack.
*/ [ n1 n2 n3 -- n1*n2/n3] Multiply n1 and n2, divide the product
by n3 and leave quotient on the stack.
.S [ ... -- ... ] Show the topmost 4 numbers on stack.
)
( Example 9. Weather Reporting. )
: WEATHER ( nFarenheit -- )
DUP 55 <
IF ." Too cold!" DROP
ELSE 85 <
IF ." About right."
ELSE ." Too hot!"
THEN
THEN
;
( You can type the following instructions and get some responses from the
computer:
90 WEATHER Too hot!
70 WEATHER About right.
32 WEATHER Too cold.
)
( Example 10. Print the multiplication table )
: ONEROW ( nRow -- )
CR
DUP 3 .R 3 SPACES
1 11
FOR 2DUP *
4 .R
1 +
NEXT
DROP ;
: MULTIPLY ( -- )
CR CR 6 SPACES
1 11
FOR DUP 4 .R 1 +
NEXT DROP
1 11
FOR DUP ONEROW 1 +
NEXT DROP
;
( Type MULTIPLY to print the multiplication table )
( Example 11. Calendars )
( Print weekly calendars for any month in any year. )
DECIMAL
VARIABLE JULIAN ( 0 is 1/1/1950, good until 2050 )
VARIABLE LEAP ( 1 for a leap year, 0 otherwise. )
( 1461 CONSTANT 4YEARS ( number of days in 4 years )
: YEAR ( YEAR --, compute Julian date and leap year )
DUP
1949 - 1461 4 */MOD ( days since 1/1/1949 )
365 - JULIAN ! ( 0 for 1/1/1950 )
3 = ( modulus 3 for a leap year )
IF 1 ELSE 0 THEN ( leap year )
LEAP !
DUP 2000 = ( 2000 is not a leap year )
IF 0 LEAP ! THEN
;
: FIRST ( MONTH -- 1ST, 1st of a month from Jan. 1 )
DUP 1 =
IF DROP 0 EXIT THEN ( 0 for Jan. 1 )
DUP 2 =
IF DROP 31 EXIT THEN ( 31 for Feb. 1 )
DUP 3 =
IF DROP 59 LEAP @ + EXIT THEN ( 59/60 for Mar. 1 )
4 - 30624 1000 */
90 + LEAP @ + ( Apr. 1 to Dec. 1 )
;
: STARS 60 FOR 42 EMIT NEXT ; ( form the boarder )
: HEADER ( -- ) ( print title bar )
CR STARS CR
." SUN MON TUE WED THU FRI SAT"
CR STARS CR ( print weekdays )
;
: BLANKS ( MONTH -- ) ( skip days not in this month )
FIRST JULIAN @ + ( Julian date of 1st of month )
7 MOD 8 * SPACES ; ( skip colums if not Sunday )
: DAYS ( MONTH -- ) ( print days in a month )
DUP FIRST ( days of 1st this month )
SWAP 1 + FIRST ( days of 1st next month )
OVER - 1 - ( loop to print the days )
1 SWAP ( first day count -- )
FOR 2DUP + 1 -
JULIAN @ + 7 MOD ( which day in the week? )
IF ELSE CR THEN ( start a new line if Sunday )
DUP 8 U.R ( print day in 8 column field )
1 +
NEXT
2DROP ; ( discard 1st day in this month )
: MONTH ( N -- ) ( print a month calendar )
HEADER DUP BLANKS ( print header )
DAYS CR STARS CR ; ( print days )
: JANUARY YEAR 1 MONTH ;
: FEBRUARY YEAR 2 MONTH ;
: MARCH YEAR 3 MONTH ;
: APRIL YEAR 4 MONTH ;
: MAY YEAR 5 MONTH ;
: JUNE YEAR 6 MONTH ;
: JULY YEAR 7 MONTH ;
: AUGUST YEAR 8 MONTH ;
: SEPTEMBER YEAR 9 MONTH ;
: OCTOBER YEAR 10 MONTH ;
: NOVEMBER YEAR 11 MONTH ;
: DECEMBER YEAR 12 MONTH ;
( To print the calender of April 2019, type:
2019 APRIL
)
( Example 12. Sines and Cosines)
( Sines and cosines of angles are among the most often encountered
transdential functions, useful in drawing circles and many other
different applications. They are usually computed using floating
numbers for accuracy and dynamic range. However, for graphics
applications in digital systems, single integers in the range from
-32768 to 32767 are sufficient for most purposes. We shall
study the computation of sines and cosines using the single
integers.
The value of sine or cosine of an angle lies between -1.0 and +1.0.
We choose to use the integer 10000 in decimal to represent 1.0
in the computation so that the sines and cosines can be represented
with enough precision for most applications. Pi is therefore
31416, and 90 degree angle is represented by 15708. Angles
are first reduced in to the range from -90 to +90 degrees,
and then converted to radians in the ranges from -15708 to
+15708. From the radians we compute the values of sine and
cosine.
The sines and cosines thus computed are accurate to 1 part in
10000. This algorithm was first published by John Bumgarner
in Forth Dimensions, Volume IV, No. 1, p. 7.
31415 CONSTANT PI
10000 CONSTANT 10K )
VARIABLE XS ( square of scaled angle )
: KN ( n1 n2 -- n3, n3=10000-n1*x*x/n2 where x is the angle )
XS @ SWAP / ( x*x/n2 )
NEGATE 10000 */ ( -n1*x*x/n2 )
10000 + ( 10000-n1*x*x/n2 )
;
: (SIN) ( x -- sine*10K, x in radian*10K )
DUP DUP 10000 */ ( x*x scaled by 10K )
XS ! ( save it in XS )
10000 72 KN ( last term )
42 KN 20 KN 6 KN ( terms 3, 2, and 1 )
10000 */ ( times x )
;
: (COS) ( x -- cosine*10K, x in radian*10K )
DUP 10000 */ XS ! ( compute and save x*x )
10000 56 KN 30 KN 12 KN 2 KN ( serial expansion )
;
: SIN ( degree -- sine*10K )
31415 180 */ ( convert to radian )
(SIN) ( compute sine )
;
: COS ( degree -- cosine*10K )
31415 180 */
(COS)
;
( To test the routines, type:
90 SIN . 9999
45 SIN . 7070
30 SIN . 5000
0 SIN . 0
90 COS . 0
45 COS . 7071
0 COS . 10000 )
( Example 13. Square Root)
( There are many ways to take the square root of an integer. The
special routine here was first discovered by Wil Baden. Wil
used this routine as a programming challenge while attending
a FORML Conference in Taiwan, 1984.
This algorithm is based on the fact that the square of n+1 is equal
to the sum of the square of n plus 2n+1. You start with an 0 on
the stack and add to it 1, 3, 5, 7, etc., until the sum is greater
than the integer you wished to take the root. That number when
you stopped is the square root.
)
: SQRT ( n -- root )
65025 OVER U< ( largest square it can handle)
IF DROP 255 EXIT THEN ( safety exit )
>R ( save sqaure )
1 1 ( initial square and root )
BEGIN ( set n1 as the limit )
OVER R@ U< ( next square )
WHILE
DUP CELLS 1 + ( n*n+2n+1 )
ROT + SWAP
1 + ( n+1 )
REPEAT
SWAP DROP
R> DROP
;
( Example 14. Radix for Number Conversions )
DECIMAL
( : DECIMAL 10 BASE ! ; )
( : HEX 16 BASE ! ; )
: OCTAL 8 BASE ! ;
: BINARY 2 BASE ! ;
( Try converting numbers among different radices:
DECIMAL 12345 HEX U.
HEX ABCD DECIMAL U.
DECIMAL 100 BINARY U.
BINARY 101010101010 DECIMAL U.
Real programmers impress on novices by carrying a HP calculator
which can convert numbers between decimal and hexadecimal. A
Forth computer has this calculator built in, besides other functions.
)
( Example 15. ASCII Character Table )
: CHARACTER ( n -- )
DUP EMIT HEX DUP 3 .R
OCTAL DUP 4 .R
DECIMAL 3 .R
2 SPACES
;
: LINE ( n -- )
CR
5 FOR DUP CHARACTER
16 +
NEXT
DROP ;
: TABLE ( -- )
32
15 FOR DUP LINE
1 +
NEXT
DROP ;
( Example 16. Random Numbers)
( Random numbers are often used in computer simulations and computer
games. This random number generator was published in Leo Brodie's
'Starting Forth'. )
VARIABLE RND ( seed )
HERE RND ! ( initialize seed )
: RANDOM ( -- n, a random number within 0 to 65536 )
RND @ 31421 * ( RND*31421 )
6927 + ( RND*31421+6926, mod 65536)
DUP RND ! ( refresh he seed )
;
: CHOOSE ( n1 -- n2, a random number within 0 to n1 )
RANDOM UM* ( n1*random to a double product)
SWAP DROP ( discard lower part )
; ( in fact divide by 65536 )
( To test the routine, type
100 CHOOSE .
100 CHOOSE .
100 CHOOSE .
and varify that the results are randomly distributed betweem 0 and
99 . )
( Example 17. Guess a Number )
: GetNumber ( -- n )
BEGIN
CR ." Enter a Number: " ( show message )
QUERY BL WORD NUMBER? ( get a string )
UNTIL ( repeat until a valid number )
;
( With this utility instruction, we can write a game 'Guess a Number.' )
: InitialNumber ( -- n , set up a number for the player to guess )
CR CR CR ." What limit do you want?"
GetNumber ( ask the user to enter a number )
CR ." I have a number between 0 and " DUP .
CR ." Now you try to guess what it is."
CR
CHOOSE ( choose a random number )
; ( between 0 and limit )
: Check ( n1 -- , allow player to guess, exit when the guess is correct )
BEGIN CR ." Please enter your guess."
GetNumber
2DUP = ( equal? )
IF 2DROP ( discard both numbers )
CR ." Correct!!!"
EXIT
THEN
OVER <
IF CR ." Too low."
ELSE CR ." Too high!"
THEN CR
0 UNTIL ( always repeat )
;
: Greet ( -- )
CR CR CR ." GUESS A NUMBER"
CR ." This is a number guessing game. I'll think"
CR ." of a number between 0 and any limit you want."
CR ." (It should be smaller than 32000.)"
CR ." Then you have to guess what it is."
;
: GUESS ( -- , the game )
Greet
BEGIN InitialNumber ( set initial number)
Check ( let player guess )
CR CR ." Do you want to play again? (Y/N) "
KEY ( get one key )
32 OR 110 = ( exit if it is N or n )
UNTIL
CR CR ." Thank you. Have a good day." ( sign off )
CR
;
( Type 'GUESS' will initialize the game and the computer will entertain
a user for a while. Note the use of the indefinite loop structure:
BEGIN <repeat-clause> [ f ] UNTIL
You can jump out of the infinite loop by the instruction EXIT, which
skips all the instructions in a Forth definition up to ';', which
terminates this definition and continues to the next definition. )
original document : -- written by Dr. Chen Hanson Ting -- web adaption by PeterForth 2019