Test programs and Examples

matches.wft

This chapter presents the listing of the file matches.wft which is here only to test some definitions and to present a very simple (host) program.

Last update:	3-January-1999
State (estimation)	100%

---

/* ===========================================================================
 
 matches,qft Oliver Singla
 
 Description: 
 This is a test program I use to test wfroth
 (both the byte string generated and the execution).
 I put some comments for the forth beginners.
 
 =========================================================================== */
 
forget <matches>
: <matches> ;
 
int #matches
 
: xemit ( c n --- )
 swap begin
 dup
 while
 over emit
  1-
 repeat ddrop ;
 
// Create an initialized integer variable
// Example of creation: 10 iint myVar
// Examples of utilization: myVar @
// 90 myVar !
: iint
 build> , does> ;
 
: draw_match ( x f --- )
 if 
 dup 6 gotoxy " O " type
 dup 7 gotoxy " I " type
  8 gotoxy " I " type
 else
 dup 6 gotoxy " . " type
 dup 7 gotoxy " | " type
  8 gotoxy " | " type
 endif ; 
 
int col
: draw_matches ( --- )
 20 col !
 0 begin
 col @ over #matches @ < draw_match
  col 2 +!
  1+ dup 21 ==
 until drop ;
 
: draw_screen ( --- )
 cls
 31 0 gotoxy 18 42 xemit
 31 1 gotoxy " *** 21 MATCHES ***" type
 31 2 gotoxy 18 42 xemit 
 draw_matches ;
 
: [within] ( n1 n2 n3 --- f )
 >r over r> <= -rot >= and ;
 
: wait_1-3 ( --- c )
 begin
 key 
  dup 49 51 [within] not
 while
 drop
 repeat 48 - ;
 
: player_turn
 0 11 gotoxy " How many matches do you take (1,2 or 3) ? " type
 begin
 wait_1-3 dup #matches @ >
 while
 drop
 repeat dup 48 + emit
 #matches -! draw_matches ;
 
: seconds ( n --- )
 500 * delay ;
 
: computer_play ( n --- )
 1 #matches @ 3 min rnd ;
 
: computer_turn ( --- )
 0 14 gotoxy " I'm thinking... " type 1 seconds
 computer_play 
 0 14 gotoxy " I take " type dup . " match" type dup 1 > if " es" type endif
 #matches -! draw_matches ;
 
: init_game ( --- )
 21 #matches ! ;
 
: uppercase ( c1 --- c2 )
 dup 97 122 [within] if 32 - endif ;
 
: another_game? ( --- f )
 0 18 gotoxy " Another game (y/n) ? " type
 begin
 key uppercase 
  78 over == over 89 == or not
 while 
 drop
 repeat 
 dup emit 89 == ;
 
: go ( --- )
 begin
 init_game
 draw_screen
 0 begin
 1+ player_turn 
 #matches @ if 1+ computer_turn endif
  #matches @ not
 until 
 0 16 gotoxy 2 mod if 
 " Sorry, you loose!" type
 else 
 " Congratulations!" type 
 endif
 another_game? not
 until ;