( 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