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 )

;

( 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 =

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

;

( 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 -- )

DUP 3 .R 3 SPACES

1 11

FOR 2DUP *

4 .R

1 +

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 +

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 -- )

5 FOR DUP CHARACTER

16 +

DROP ;

: TABLE ( -- )

15 FOR DUP LINE

1 +

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 .

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."

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 )

;

( 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