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