+Lee Stewart Posted August 20, 2015 Share Posted August 20, 2015 (edited) 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 1 Quote Link to comment https://forums.atariage.com/topic/241861-fbforth-20-hunt-the-wumpus/ Share on other sites More sharing options...
Omega-TI Posted August 20, 2015 Share Posted August 20, 2015 OK...Here is @Willsy's “Hunt the Wumpus” ported to fbForth 2.0: Do we get a downloadable version too? Quote Link to comment https://forums.atariage.com/topic/241861-fbforth-20-hunt-the-wumpus/#findComment-3304343 Share on other sites More sharing options...
Opry99er Posted August 20, 2015 Share Posted August 20, 2015 Haha... Awesome Lee!! Quote Link to comment https://forums.atariage.com/topic/241861-fbforth-20-hunt-the-wumpus/#findComment-3304368 Share on other sites More sharing options...
+Lee Stewart Posted August 20, 2015 Author Share Posted August 20, 2015 Do we get a downloadable version too? I'll work on one. ...lee 2 Quote Link to comment https://forums.atariage.com/topic/241861-fbforth-20-hunt-the-wumpus/#findComment-3304501 Share on other sites More sharing options...
+Lee Stewart Posted August 22, 2015 Author Share Posted August 22, 2015 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 Quote Link to comment https://forums.atariage.com/topic/241861-fbforth-20-hunt-the-wumpus/#findComment-3305869 Share on other sites More sharing options...
+Lee Stewart Posted August 23, 2015 Author Share Posted August 23, 2015 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 1 Quote Link to comment https://forums.atariage.com/topic/241861-fbforth-20-hunt-the-wumpus/#findComment-3306113 Share on other sites More sharing options...
Opry99er Posted August 23, 2015 Share Posted August 23, 2015 Neato.... Quote Link to comment https://forums.atariage.com/topic/241861-fbforth-20-hunt-the-wumpus/#findComment-3306294 Share on other sites More sharing options...
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.