Differences From Artifact [be79e7b8a30d3aea]:
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] [view]
To Artifact [173bfdc365756b98]:
File hangman/hangman.retro part of check-in [448a8ef91e] - various cleanups to hangman (from crc) by crc on 2011-01-22 21:12:45. [annotate] [view]
@@ -11,18 +11,13 @@
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
+5 elements target guessed lifeline this-char foul-count
+stages constant lives ( see graphics.retro )
+create foul-addr lives allot
( --[ Offset Calculation ]------------------------------------ )
( Build an array with offsets for a given character in string )
@@ -45,10 +40,10 @@
: 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 ;
+ dup !this-char offsets ( guessed offsets length )
+ 2dup [ &update-guessed dip ] dip unarray ;
: guessChar ( c- ) @guessed @target rot toGuess ;
( --[ Printing ]---------------------------------------------- )
@@ -57,19 +52,19 @@
: .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 ;
+: .already ( - ) " [already guessed]" puts ;
+: .correct ( - ) " [correct guess] " puts ;
+: .graphic ( - ) lives @lifeline - 1- graphics + @ do ;
+: .wrong ( - ) " [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 +! ;
+: foul+ ( c- ) foul-addr @foul-count + ! foul-count ++ ;
: (guess) ( c- )
@guessed over has
[ .already ]
@@ -78,27 +73,26 @@
[ foul-addr over has
[ .already ]
[ dup foul+ lifeline -- .wrong ] if ] if ] if drop ;
-: guess ( - ) .prompt getc dup putc (guess) ;
+: guess ( - ) .prompt getc &putc &(guess) bi ;
( --[ Game Logic ]-------------------------------------------- )
: _string ( n-$ ) here swap [ '_ , ] times 0 , ;
-: >target ( $- )
- withLength swap target ! _string guessed ! ;
+: >target ( $- ) withLength swap !target _string !guessed ;
-: 0fouls ( - ) 0 foul-count !
+: 0fouls ( - ) 0 !foul-count
foul-addr lives [ 0 over ! 1+ ] times drop ;
-: revive ( - ) lives lifeline ! 0fouls ;
+: 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 ;
+: .win ( - ) foot .target "\nYou WIN!" puts ;
: endgame ( - ) @lifeline &.win &.lose if ;
: (hangman) ( - ) clear repeat dead if; guess again ;
: hangman ( $- ) >target revive (hangman) endgame ;
@@ -105,10 +99,10 @@
( --[ Main Game ]--------------------------------------------- )
: y-or-n ( -f ) getc [ 'y = ] [ 'Y = ] bi or ;
-: .again? ( -f ) cr cr "Play again? [Y/N] " puts y-or-n ;
+: .again? ( -f ) "\n\nPlay again? [Y/N] " puts y-or-n ;
: play ( - )
- initialise dict @ 0; drop
+ initialise @dict 0; drop
repeat get-word hangman .again? [ close-dict bye ] ifFalse again ;
( ============================================================ )
play