Artifact be79e7b8a30d3aea2548a7afc7c675df165d69da

File hangman/hangman.retro part of check-in [9f5aa980c6] - update hangman; now works with retro 11 (this is a direct port, needs cleanup) by marc on 2011-01-19 17:15:33. [annotate]

( ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
( Hangman for Retro Console                                    )
(  * Main game logic.                                          )
( ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
( Copyright [c] 2010-11, Marc Simpson                          )
( License: ISC                                                 )
( ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )

( File inclusion will only work if you're running retro from   )
( the same directory as hangman.                               )

include graphics.retro
include dict.retro

( --[ Macros ]------------------------------------------------ )

: 2push ` push ` push ; compile-only
: 2pop  ` pop ` pop ; compile-only

( --[ Variables ]--------------------------------------------- )

5 elements target guessed  lifeline this-char foul-count
stages   constant lives                   ( see graphics.retro )
here lives allot constant foul-addr

( --[ Offset Calculation ]------------------------------------ )

( Build an array with offsets for a given character in string )

: offsets, ( c$- )
  withLength [ [ 2dup @ = ] dip swap &, &drop if 1+ ] iter
  2drop ;

: offsets ( $c-an ) here -rot  swap offsets,   here over - ;

( --[ Allocation ]-------------------------------------------- )

: unallot  (  n- )  neg allot ;
: unarray  ( an- )  nip unallot ;

( --[ Masking ]----------------------------------------------- )

( The array contains offset information; set the guess string )

: update-guessed ( $ offsets len - )
  [ 2dup @ + @this-char swap ! 1+ ] times 2drop ;

: toGuess ( guessed target c - )
  dup this-char !  offsets            ( guessed offsets length )
  2dup 2push  update-guessed  2pop unarray ;

: guessChar ( c- )  @guessed @target rot toGuess ;

( --[ Printing ]---------------------------------------------- )

: .target   ( - )  @target  puts ;
: .guessed  ( - )  @guessed puts ;
: .input    ( - )  @lifeline "Tries: (%d): " puts ;
: .fouls    ( - )  "Fouls: " puts foul-addr puts ;
: .prompt   ( - )  0 0 ^console'at-xy .guessed cr .fouls cr .input ;
: .already  ( - )  space "[already guessed]" puts ;
: .correct  ( - )  space "[correct guess]  " puts ;
: .graphic  ( - )  lives lifeline @ - 1- graphics + @ do ;
: .wrong    ( - )  space "[not present]    " puts .graphic ;

( --[ Guessing ]---------------------------------------------- )

: 0<>   (  x-f ) 0 = not ;
: has   ( $c-f ) ^strings'findChar 0<> ;

: foul+ (  c-  ) foul-addr foul-count @ + ! 1 foul-count +! ;

: (guess) ( c- )
  @guessed over has 
    [ .already ] 
    [ @target over has
      [ dup guessChar .correct ] 
      [ foul-addr over has
        [ .already ] 
        [ dup foul+ lifeline -- .wrong ] if ] if ] if drop ;

: guess ( - ) .prompt getc dup putc (guess) ;

( --[ Game Logic ]-------------------------------------------- )

: _string  ( n-$ )  here swap [ '_ , ] times 0 , ;

: >target  ( $-  )
  withLength swap target ! _string guessed ! ;

: 0fouls    ( -  )  0 foul-count !
                    foul-addr lives [ 0 over ! 1+ ] times drop ;

: revive    ( -  )  lives lifeline ! 0fouls ;
: remaining ( -f )  guessed @ '_ has ;
: alive     ( -f )  remaining lifeline @ 0<> and ;
: dead      ( -f )  alive not ;
: foot      (  - )  0 20 ^console'at-xy ;
: .lose     (  - )  foot "You LOSE; the word was: " puts .target ;
: .win      (  - )  foot .target cr "You WIN!" puts ;
: endgame   (  - )  @lifeline &.win &.lose if ;

: (hangman) (  - )  clear repeat dead if; guess again ;
: hangman   ( $- )  >target revive (hangman) endgame ;

( --[ Main Game ]--------------------------------------------- )

: y-or-n    ( -f )  getc [ 'y = ] [ 'Y = ] bi or ;
: .again?   ( -f )  cr cr "Play again? [Y/N] " puts y-or-n ;
: play      ( -  )
  initialise dict @ 0; drop
  repeat get-word hangman .again? [ close-dict bye ] ifFalse again ;
( ============================================================ )
play