fbForth 2.0: Hunt the Wumpus

[+Lee Stewart]

OK...Here is @Willsy's “Hunt the Wumpus” ported to fbForth 2.0:

 

 

 

( Hunt the Wumpus - JCB 16:42 01/15/11)
( Converted for fbForth...Lee Stewart 19AUG2015)
( Converted for Forth-83 - Mark Wills August 2015 )
( from ANS code written by James Bowman. )
( Original program here: )
( http://excamera.com/sphinx/article-wumpus.html#wumpus )
(   Changes: )
(     definition RANDOM removed. Not needed for Turboforth )
(     defintion @+ removed - TurboForth has @++ )
(     definition 2VARIABLE added )
(     definition 2@ added )
(     definition 2! added )
(   Changes for fbForth 2.0: )
(     definition @++ added )
(     all '\' comments replaced with parentheses comments )
(     words to caps: no case insensitivity in fbForth)
(     replace CREATE with <BUILDS )
(     VARIABLE and 2VARIABLE defs require initial values on stack )
(     definition for CELLS added)
(     definition @++ added )
(     definition 2DUP added )
(     definition 2DROP added )
(     definition CELL+ added )
(     definition ASCII added )
(     definition WITHIN added )
(     definition NIP added )
(     definition ROLL added )
(     definition PAGE added )
(     definition S" added )
(     GETROOM modified for fbForth defs of WORD and NUMBER and )
(        insuring that the input stream is set to TIB for auto- )
(        starting game from LOAD )
(     DOMOVE modified to DROP the room # after the WHILE to )
(        prevent stack pollution )
(     DOSHOOT modified BEGIN..UNTIL  to avoid stack pollution )
(     GAMELOOP modified to only run WAKEWUMPUS if game is not over )
(     RECURSE replaced with fbForth's MYSELF )
(     R@ replaced with fbForth's R )
(     KEY? -1 > replaced with fbForth's ?KEY )
(     PICK1 removed—not used and wrong, anyway)
(     single instance of TRUE changed to 1 )
(     0 GMODE changed to TEXT )
(     added LEAVE after WINGAME in DOSHOOT )
DECIMAL
 
: 2@ ( a-addr -- x1 x2 )
  ( MRW 5th August 2015)
  DUP 2+ @ SWAP @ ;
: 2! ( x1 x2 a-addr -- )
  ( MRW 5th August 2015)
  SWAP OVER ! 2+ ! ;

: 2VARIABLE ( compilation: n1 n2 ) ( execution: a-addr )
  ( LES 19AUG2015)
  VARIABLE , ;
: CELLS ( n -- 2n )
  ( LES 19AUG2015)
  1 SLA ;
: @++  ( addr -- addr+2 n )
  ( LES 19AUG2015)
  DUP 2+ SWAP @ ;
: 2DUP  ( n1 n2 -- n1 n2 n1 n2 )
  ( LES 19AUG2015)
  OVER OVER ;
: 2DROP  ( n1 n2 -- )
  ( LES 20AUG2015)
  DROP DROP ;
: CELL+  ( addr -- addr+2 )
  ( LES 19AUG2015)
  2+ ;
: ASCII ( IS:token -- ascii )
  ( LES 19AUG2015)
   BL WORD HERE 1+ C@
   STATE @ IF  COMPILE LIT , THEN  ;  IMMEDIATE
: WITHIN ( n low high -- true|false )
  ( LES 19AUG2015)
   OVER - >R - R> U< ;
: NIP ( a b -- b )
  ( LES 19AUG2015)
   SWAP DROP ;
: ROLL ( [n]..[0] +n -- [n-1]..[0][n] )                         
  ( LES 19AUG2015)
   -DUP  IF  1-  SWAP  >R  MYSELF  R>  SWAP  THEN  ;
: PAGE  ( -- )
  ( LES 19AUG2015)
   CLS 0 0 GOTOXY ;

: S" ( IS:S" string" -- addr count )
  ( LES 20AUG2015)
   34 ( " ) STATE @
   IF COMPILE SLIT WORD HERE C@ 1+ =CELLS ALLOT COMPILE COUNT
   ELSE WORD HERE PAD HERE C@ 1+ =CELLS CMOVE PAD COUNT THEN
; IMMEDIATE

: M 1- , ; ( original map was 1-based, we are 0-based)
: TRIPLES <BUILDS DOES> SWAP 3 * CELLS + ;
TRIPLES MAP ( r -- addr ) ( address of room r)
2 M 5 M 8 M 1 M 3 M 10 M 2 M 4 M 12 M 3 M 5 M 14 M 1 M 4 M 6 M
5 M 7 M 15 M 6 M 8 M 17 M 1 M 7 M 9 M 8 M 10 M 18 M 2 M 9 M 11 M
10 M 12 M 19 M 3 M 11 M 13 M 12 M 14 M 20 M 4 M 13 M 15 M 6 M 14 M 16 M
15 M 17 M 20 M 7 M 16 M 18 M 9 M 17 M 19 M 11 M 18 M 20 M 13 M 16 M 19 M
20 M 20 M 20 M ( impossible room for lost arrow)
: RANDROOM ( -- n )
 20 RND ;
0 VARIABLE YOU
0 VARIABLE WUMPUS
0. 2VARIABLE PITS
0. 2VARIABLE BATS
: BOUNDS ( a n -- a+n a )
 OVER + SWAP ;
: EXITS ( u -- u0 u1 u2 ) ( exits for room u)
    MAP @++ SWAP @++ SWAP @ ;
 
: ISEXIT ( e r -- f) ( is e an exit for room r)
    MAP
    2DUP @ = >R CELL+
    2DUP @ = >R CELL+
    @ = R> OR R> OR ;
 
: NEARYOU ( r -- f ) ( is room r next to player)
    YOU @ ISEXIT ;
 
: 2NEARYOU ( r0 r1 -- f ) ( is either room next to player)
    >R NEARYOU R> NEARYOU OR ;
 
: ATYOU ( r -- f ) ( is player at room r)
    YOU @ = ;
 
: 2ATYOU ( r0 r1 -- f ) ( is player at room)
    >R ATYOU R> ATYOU OR ;
 
: GETROOM ( -- n ) ( input room number from console)
  ( LES 19AUG2015)
  0 BLK ! 0 IN !  ( insure we are pointing to TIB)
  TIB @ 5 EXPECT 0 IN !
  BL WORD HERE NUMBER DROP ;
: WARN ( addr u f -- ) ( if f, type line addr,u)
    IF CR TYPE ELSE 2DROP THEN ;
0 VARIABLE GAMEOVER
: ENDGAME ( addr u -- )
    CR TYPE 1 GAMEOVER ! ;
 
: LOSEGAME ( ADDR U -- )
    ENDGAME
    CR ." HA HA HA - YOU LOSE!" ;
 
: WINGAME ( addr u -- )
    ENDGAME
    CR ." HEE HEE HEE - THE WUMPUS'LL GETCHA NEXT TIME!!" ;
: WAKEWUMPUS ( -- )
    4 RND DUP 3 = IF
        DROP ( wumpus stays)
    ELSE
        ( wumpus moves)
        CELLS WUMPUS @ MAP + @ WUMPUS !
    THEN
    WUMPUS @ ATYOU IF
        S" TSK TSK TSK- WUMPUS GOT YOU!" LOSEGAME
    THEN
;
: MOVEPLAYER ( r -- c ) ( move player to room r, check for hazards)
    YOU !
    WUMPUS @ ATYOU IF
        CR ." OOPS! BUMPED A WUMPUS"
        WAKEWUMPUS
    THEN
    PITS 2@ 2ATYOU IF
        S" YYYIIIIEEEE . . . FELL IN PIT" LOSEGAME
    THEN
    BATS 2@ 2ATYOU IF
        CR ." ZAP--SUPER BAT SNATCH! ELSEWHEREVILLE FOR YOU!"
        RANDROOM MYSELF
    THEN
;
: DOMOVE
    BEGIN
        CR ." Where to? " GETROOM
        DUP NEARYOU 0=
    WHILE
        DROP CR ." -Not possible"
    REPEAT
    MOVEPLAYER
;
: DOSHOOT
    1    ( put something on stack for next DROP)
    BEGIN
        DROP   ( remove last entry)
        CR ." No. of rooms (1-5) "
        GETROOM
        DUP 1 6 WITHIN
    UNTIL
    YOU @ SWAP ( arrow position on stack)
    0 DO
        CR ." ROOM #" I . ." ? "
        GETROOM 2DUP ISEXIT
        IF NIP ELSE 2DROP 20 THEN
        WUMPUS @ OVER = IF
            S" AHA! YOU GOT THE WUMPUS!" WINGAME LEAVE
        THEN
    LOOP
    GAMEOVER @ 0= IF
        CR ." Missed"
    THEN
    DROP  ( DROP pending room)
;
: UPPER ( a -- a|a-32) ( convert a character to upper case)
    DUP 96 > IF 32 - THEN ;
: GAMELOOP
    CR
    S" I smell a Wumpus!" WUMPUS @ NEARYOU WARN
    S" I feel a draft!" PITS 2@ 2NEARYOU WARN
    S" Bats nearby!" BATS 2@ 2NEARYOU WARN
    CR ." You are in room " YOU @ .
    CR ." Tunnels lead to " YOU @ EXITS . . .
    CR ." Shoot or move (S-M)? "
    BEGIN
        KEY UPPER DUP ASCII M = OVER ASCII S = OR
    UNTIL
    DUP EMIT ASCII M = IF
        DOMOVE
    ELSE
        DOSHOOT GAMEOVER @ 0= IF WAKEWUMPUS THEN
    THEN
;
: CHEAT
    CR ." you " YOU @ .
    ." wumpus " WUMPUS @ .
    ." bats " BATS 2@ . .
    ." pits " PITS 2@ . .
;
: SETUP
    20 0 DO I LOOP
    50 0 DO
        RANDROOM ROLL
    LOOP
    YOU ! WUMPUS ! BATS 2! PITS 2!
    14 0 DO DROP LOOP
;
: WAIT ( -- ) ( wait for key and clear screen)
  0 23 GOTOXY ." Press any key..."
  BEGIN ?KEY UNTIL PAGE ;
: INSTRUCTIONS
TEXT
CR ." WELCOME TO 'HUNT THE WUMPUS'" CR
CR ." The wumpus lives in a cave of 20 rooms. "
   ." Each room has 3 tunnels leading to other"
   ." rooms. (look at a dodecahedron to see   "
   ." how this works - if you don't know what "
   ." a dodecahedron is, ask someone!)" CR
CR ." HAZARDS:" CR
   ." *BOTTOMLESS PITS: two rooms have bottom-"
   ." less pits in them. If you go there, you "
   ." fall into the pit (& lose!)" CR CR
   ." * SUPER BATS: two other rooms have super"
   ." bats. if you go there, a bat grabs you  "
   ." and takes you to some other room at     "
   ." random. (which might be troublesome!)" CR
WAIT
   ." * WUMPUS: the wumpus is not bothered by "
   ." the hazards (he has sucker feet and is  "
   ." too big for a bat to lift). Usually he  "
   ." is asleep. Two things wake him up: your "
   ." entering his room or your shooting an   "
   ." arrow. If the wumpus wakes, he moves one"
   ." room or stays still. After that, if he  "
   ." is where you are, he eats you up and you"
   ." lose!" CR
WAIT
   ." ABOUT YOU:" CR
   ." Each turn you may move or shoot an arrow"
   ." MOVING: you can go one room [thru one   "
   ." tunnel)." CR
   ." ARROWS: you have 5 arrows. You lose when"
   ." you run out. Each arrow can go from 1 to"
   ." 5 rooms. You aim by telling the computer"
   ." the number of rooms you want the arrow  "
   ." to go to. If the arrow can't go that way"
   ." [ie no tunnel) it moves at ramdom to the"
   ." next room. If the arrow hits the wumpus,"
   ." you win. If the arrow hits you...."
WAIT
   ." WARNINGS:"
CR ." When you are one room away from wumpus  "
   ." or hazard, the computer says:" CR
   ." Wumpus:  'I smell a wumpus'" CR
   ." Bat:     'bats nearby'" CR
   ." Pit:     'I feel a draft'"
WAIT
;
: YESNO ( addr u -- f )
    CR TYPE
    BEGIN
        KEY UPPER DUP ASCII Y = OVER ASCII N = OR
    UNTIL
    DUP EMIT ASCII Y =
;
: GAME
    S" INSTRUCTIONS (Y-N) ? " YESNO IF
    INSTRUCTIONS
    THEN
    BEGIN
        SETUP
        0 GAMEOVER !
        BEGIN
            GAMELOOP
            GAMEOVER @
        UNTIL
        S" Play again (Y-N) ? " YESNO 0=
    UNTIL
;
 

 

 

 

As you can see, it took a bit more than “a few (very minor) changes”! The changes are all documented in the comments at the beginning, which you do not need to load for a working game.

 

[EDIT: Bug fixes in GETROOM , DOMOVE , DOSHOOT and GAMELOOP .]

 

...lee

Edited August 23, 2015 by Lee Stewart

[Omega-TI]

OK...Here is @Willsy's “Hunt the Wumpus” ported to fbForth 2.0:

 

Do we get a downloadable version too?

[Opry99er]

Haha... Awesome Lee!!

[+Lee Stewart]

 

Do we get a downloadable version too?

 

I'll work on one.

 

...lee

[+Lee Stewart]

I found stack-pollution issues in the game that require mods of DOMOVE and DOMOVE . GAMELOOP needs to check that the game is not over before executing WAKEWUMPUS . Also, I had to change GETROOM to insure it is using the TIB for the very first entry when the game is started automatically upon LOADing from a blocks file I will post those changes later. Right now I gotta get some yard work done!

 

...lee

[+Lee Stewart]

I have posted the modified version of “Hunt the Wumpus” in post #1. Here is a blocks file (WUMPUS) with the game in blocks 1 – 11:

 

WUMPUS.zip

 

If you need the file in a disk image, copy it to a disk image with TI99Dir or TIImageTool. To load and run the game if it is on DSK2, type the following:

 

USEBFL DSK2.WUMPUS

1 LOAD

 

The game will start as soon as blocks 1 – 7 are loaded. If you want the game to load and start as soon as you start fbForth 2.0, back up FBLOCKS, rename WUMPUS to FBLOCKS and put it in DSK1. It will load and run the next time you start fbForth 2.0.

 

...lee

[Opry99er]

Neato....