( Simple random numbers JCB 11:33 10/26/10) hex \ Galois LFSR x^32 + x^31 + x^29 + x + 1 079f18c4e value lfsr : random lfsr 1 and negate 0d0000001 and lfsr 1 rshift xor dup to lfsr ; ( Hunt the Wumpus JCB 16:42 01/15/11) decimal : m 1- , ; \ original map was 1-based, we are 0-based : triples create 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 : randrange ( u -- n ) \ return random number between 0 and n-1 random swap mod ; : randroom 20 randrange ; variable you variable wumpus 2variable pits 2variable bats : @+ ( addr -- n addr+cell ) dup @ swap cell+ ; : bounds ( a n -- a+n a ) OVER + SWAP ; : exits ( u -- u0 u1 u2 ) \ exits for room u map @+ @+ @ ; : 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 ; : room. \ print room number . ; : getroom \ input room number from console pad dup 10 accept bounds 0 >r begin 2dup <> while dup c@ [char] 0 - r> 10 * + >r 1+ repeat 2drop r> ; : warn ( addr u f -- ) \ if f, type line addr,u if cr type else 2drop then ; variable gameover : endgame ( addr u -- ) cr type true 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 randrange 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 recurse then ; : domove begin cr ." WHERE TO? " getroom dup nearyou 0= while cr ." -NOT POSSIBLE" repeat moveplayer ; : doshoot begin 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 then loop gameover @ 0= if cr ." MISSED" then drop ; : upper dup 96 > if 32 - then ; : pick1 ( k0 k1 -- k ) \ wait for key k0 or k1 begin key upper >r over r@ = over r@ = or until ; : 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 @ room. cr ." TUNNELS LEAD TO " you @ exits room. room. room. cr ." SHOOT OR MOVE (S-M)? " begin key upper dup [char] M = over [char] S = or until dup emit [char] M = if domove else doshoot wakewumpus then ; : cheat cr ." you " you @ room. ." wumpus " wumpus @ room. ." bats " bats 2@ room. room. ." pits " pits 2@ room. room. ; : setup 20 0 do i loop 50 0 do randroom roll loop you ! wumpus ! bats 2! pits 2! 14 0 do drop loop ; : instructions cr ." WELCOME TO 'HUNT THE WUMPUS'" cr ." THE WUMPUS LIVES IN A CAVE OF 20 ROOMS. EACH ROOM" cr ." HAS 3 TUNNELS LEADING TO OTHER ROOMS. (LOOK AT A" cr ." DODECAHEDRON TO SEE HOW THIS WORKS-IF YOU DON'T KNOW" cr ." WHAT A DODECAHEDRON IS, ASK SOMEONE)" cr cr ." HAZARDS:" cr ." BOTTOMLESS PITS - TWO ROOMS HAVE BOTTOMLESS PITS IN THEM" cr ." IF YOU GO THERE, YOU FALL INTO THE PIT (& LOSE!)" cr ." SUPER BATS - TWO OTHER ROOMS HAVE SUPER BATS. IF YOU" cr ." GO THERE, A BAT GRABS YOU AND TAKES YOU TO SOME OTHER" cr ." ROOM AT RANDOM. (WHICH MIGHT BE TROUBLESOME)" cr cr ." WUMPUS:" cr ." THE WUMPUS IS NOT BOTHERED BY THE HAZARDS (HE HAS SUCKER" cr ." FEET AND IS TOO BIG FOR A BAT TO LIFT). USUALLY" cr ." HE IS ASLEEP. TWO THINGS WAKE HIM UP: YOUR ENTERING" cr ." HIS ROOM OR YOUR SHOOTING AN ARROW." cr ." IF THE WUMPUS WAKES, HE MOVES (P=.75) ONE ROOM" cr ." OR STAYS STILL (P=.25). AFTER THAT, IF HE IS WHERE YOU" cr ." ARE, HE EATS YOU UP (& YOU LOSE!)" cr cr ." YOU:" cr ." EACH TURN YOU MAY MOVE OR SHOOT A CROOKED ARROW" cr ." MOVING: YOU CAN GO ONE ROOM (THRU ONE TUNNEL)" cr ." ARROWS: YOU HAVE 5 ARROWS. YOU LOSE WHEN YOU RUN OUT." cr ." EACH ARROW CAN GO FROM 1 TO 5 ROOMS. YOU AIM BY TELLING" cr ." THE COMPUTER THE ROOM#S YOU WANT THE ARROW TO GO TO." cr ." IF THE ARROW CAN'T GO THAT WAY (IE NO TUNNEL) IT MOVES" cr ." AT RAMDOM TO THE NEXT ROOM." cr ." IF THE ARROW HITS THE WUMPUS, YOU WIN." cr ." IF THE ARROW HITS YOU, YOU LOSE." cr cr ." WARNINGS:" cr ." WHEN YOU ARE ONE ROOM AWAY FROM WUMPUS OR HAZARD," cr ." THE COMPUTER SAYS:" cr ." WUMPUS- 'I SMELL A WUMPUS'" cr ." BAT - 'BATS NEARBY'" cr ." PIT - 'I FEEL A DRAFT'" cr ; : yesno ( addr u -- f ) cr type begin key upper dup [char] Y = over [char] N = or until dup emit [char] 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 ; game bye