Skip to content

Instantly share code, notes, and snippets.

@ToJans
Last active Sep 28, 2019
Embed
What would you like to do?
A haskell implementation of the hangman game
import Control.Monad (when)
import Data.Char (toLower)
import Data.List (transpose)
import System.Random (randomIO)
wordsPath :: FilePath
wordsPath = "words.txt"-- "/usr/share/dict/words"
data GameState = GameState
{ _wordToGuess :: String
, guesses :: String
}
data GameStatus = Guessing | GameWon | GameLost deriving Eq
hangmanImages :: [[String]]
hangmanImages =
transpose
[ [ " ", " O ", " O ", " O ", " O " , "_O " , "_O_" ]
, [ " ", " ", " | ", " | ", " | " , " | " , " | " ]
, [ " ", " ", " ", "/ ", "/ \\", "/ \\", "/ \\" ]
]
fullHangmanImage :: Int -> [String]
fullHangmanImage index =
"=========" :
"| |" :
map ("| " ++) img
where img = hangmanImages !! index
maxWrongGuesses :: Int
maxWrongGuesses = length hangmanImages - 1
numberOfWrongGuesses :: GameState -> Int
numberOfWrongGuesses (GameState word' guesses') =
length $ filter charNotInWord guesses'
where charNotInWord c = c `notElem` word'
gameStatus :: GameState -> GameStatus
gameStatus (GameState word' guesses')
| isGuessed = GameWon
| isLastGuess = GameLost
| otherwise = Guessing
where
isGuessed = all isCharInGuesses word'
isCharInGuesses x = x `elem` guesses'
gameState = GameState word' guesses'
isLastGuess = numberOfWrongGuesses gameState == maxWrongGuesses
-- for one reason or another getChar also appends <CR>
-- so I implemented my own getChar and made sure empty input is refused
getAChar :: IO Char
getAChar = do
line <- getLine
case line of
[] -> getAChar
(c:_) -> return c
getANewChar :: GameState -> IO Char
getANewChar gameState = do
putStrLn "Next char to guess"
c <- getAChar
if c `elem` guesses gameState
then do
putStrLn "Character already used in guesses."
getANewChar gameState
else
return c
displayState :: GameState -> IO ()
displayState gameState@(GameState word' guesses') =
putStrLn $ unlines $ fullHangmanImage' ++ case gameStatus gameState of
Guessing ->
[ "Word to guess: " ++ wordWithGuesses
, ""
, "Guesses: " ++ guesses'
]
GameWon ->
[ "CONGRATULATIONS!"
, "You correctly guessed the word " ++ word'
, " in " ++ show (length guesses') ++ " tries "
]
GameLost ->
[ "YOU FAILED!"
, "You failed to guess the word " ++ word'
]
where
fullHangmanImage' = fullHangmanImage currentHangmanIndex
currentHangmanIndex = numberOfWrongGuesses gameState
wordWithGuesses = blankOrChar <$> word'
blankOrChar c
| c `elem` guesses' = c
| otherwise = '_'
gameLoop :: GameState -> IO ()
gameLoop gameState = do
displayState gameState
when (gameStatus gameState == Guessing) $ do
c <- getANewChar gameState
gameLoop $ gameState { guesses = guesses gameState ++ [c] }
newGame :: IO GameState
newGame = do
contents <- readFile wordsPath
let words' = filter validWord $ lines contents
let wordcount = length words'
randomNumber <- randomIO
let randomWord = words' !! (randomNumber `mod` wordcount)
return $ GameState randomWord []
where
validWord word =
'\'' `notElem` word &&
map toLower word == word
main :: IO ()
main = do
newGame >>= gameLoop
putStrLn "Play again? (y/n):"
option <- getAChar
when (option == 'y') main
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment