Artifact 2278efd8e320992da1d49a26005839a09f50e6f4
File hangman/hangman.retro part of check-in [7058f95d8e] - hangman: minor cleanups to main file by crc on 2010-10-25 20:25:33. [annotate]
( ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
( Hangman for Retro Console )
( * Main game logic. )
( ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
( Copyright [c] 2010, 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
with strings'
( --[ 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$- )
dup getLength
fori push 2dup @ =if pop , else rdrop then 1+ nexti
2drop ;
: offsets ( $c-an ) here -rot swap offsets, here over - ;
( --[ Allocation ]-------------------------------------------- )
: unallot ( - ) neg allot ;
: unarray ( an- ) nip unallot ;
( --[ Masking ]----------------------------------------------- )
( The array contains offset information; set the guess string )
: update-guessed ( $ offsets len - )
for 2dup @ + @this-char swap ! 1+ next 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 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 ) findChar 0<> ;
: foul+ ( c- ) foul-addr foul-count @ + ! 1 foul-count +! ;
: guess ( - )
.prompt key >lower dup emit push
guessed @ tors has if .already else
target @ tors has if tors guessChar .correct else
foul-addr tors has if .already else
tors foul+ lifeline -- .wrong then then then rdrop ;
( --[ Game Logic ]-------------------------------------------- )
: _string ( n-$ ) here swap for '_ , next 0 , ;
: >target ( $- )
dup getLength swap target ! _string guessed ! ;
: 0fouls ( - ) 0 foul-count !
foul-addr lives for 0 over ! 1+ next drop ;
: revive ( - ) lives lifeline ! 0fouls ;
: remaining ( -f ) guessed @ '_ has ;
: alive ( -f ) remaining lifeline @ 0<> and ;
: dead ( -f ) alive not ;
: foot ( - ) 0 20 at-xy ;
: .lose ( - ) foot "You LOSE; the word was: " puts .target ;
: .win ( - ) foot .target cr "You WIN!" puts ;
: endgame ( - ) lifeline @ if .win else .lose then ;
: (hangman) ( - ) clear repeat dead if endgame ;then guess again ;
: hangman ( $- ) >target revive (hangman) ;
( --[ Main Game ]--------------------------------------------- )
: y-or-n ( -f ) key [ '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? 0 =if close-dict bye then again ;
( ============================================================ )
play