hangman (empty) → 1.0
raw patch · 4 files changed
+295/−0 lines, 4 filesdep +basedep +mtldep +randomsetup-changed
Dependencies added: base, mtl, random, utility-ht
Files
- LICENSE +21/−0
- Setup.hs +2/−0
- hangman.cabal +47/−0
- src/Main.hs +225/−0
+ LICENSE view
@@ -0,0 +1,21 @@+The MIT LICENSE (MIT)++Copyright (c) 2012 Hok Shun Poon++Permission is hereby granted, free of charge, to any person obtaining a copy of+this software and associated documentation files (the "Software"), to deal in+the Software without restriction, including without limitation the rights to+use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies+of the Software, and to permit persons to whom the Software is furnished to do+so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ hangman.cabal view
@@ -0,0 +1,47 @@+Name: hangman+Version: 1.0++Synopsis: Hangman implementation in Haskell written in two hours.+Description:+ A command line implementation of the classic hangman game.+ I wrote this when I was desperately bored during exam revision period+ in a couple of hours.+ + Hopefully you will find the implementation to be of use. It sort of began as+ an assessment of the Haskell development experience, but I plan to continue+ to maintain and extend the implementation to demonstrate how to apply good+ software development practises to Haskell code.++License: MIT+License-file: LICENSE+Author: Hok Shun Poon <fushunpoon _ gmail _ com>+Maintainer: Hok Shun Poon <fushunpoon _ gmail _ com>+Copyright: (c) 2012 Hok Shun Poon+Category: Game+Build-type: Simple+Cabal-version: >=1.6++Source-Repository head+ type: git+ location: https://github.com/fushunpoon/haskell-hangman++-- Extra files to be distributed with the package, such as examples or+-- a README.+-- Extra-source-files: +++Executable hangman+ -- Specify the source directory here+ Hs-source-dirs: src++ -- .hs or .lhs file containing the Main module.+ Main-is: Main.hs+ + -- Packages needed in order to build this package.+ Build-depends: base >= 2 && < 4, mtl, random, utility-ht+ + -- Modules not exported by this package.+ -- Other-modules: + + -- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source.+ -- Build-tools:
+ src/Main.hs view
@@ -0,0 +1,225 @@+{-# LANGUAGE NamedFieldPuns #-}+module Main where++import System.Random++import Control.Monad.Trans+import Control.Monad.State.Lazy+import Data.List+import Data.List.HT++type Hangman a = StateT GameState IO a++data GameState = GameState+ { theWord :: String -- TODO should be in Reader monad+ , guesses :: [Char] -- which characters have been guessed+ , lives :: Int+ , maxLives :: Int -- the number of lives at the beginning.+ }++instance Show GameState where+ show (GameState {theWord,guesses,lives,maxLives}) =+ let wordIndicator = map (replaceWith guesses '_') theWord;+ usedIndicator = "Guessed: {" ++ guesses ++ "}";+ livesIndicator = "Lives: [" ++ replicate lives 'I' ++ "]"+ spacesFromWordToUsed = 15 - length wordIndicator+ spacesFromUsedToLives = 14 - length guesses+ spaces = " "+ in concat [spaces, wordIndicator,+ replicate spacesFromWordToUsed ' ',+ usedIndicator, replicate spacesFromUsedToLives ' ',+ livesIndicator, "\n\n",+ livesIllustrations !! (maxLives-lives)+ ]+ where+ replaceWith cs char c+ | c `elem` cs = c+ | otherwise = char++data GameResult = Won | Lost | NotWon++-- Game defaults+defaultLives = 10+startingGameState word = GameState { theWord = word+ , guesses = []+ , lives = defaultLives+ , maxLives = defaultLives }++--+-- This is the loop that runs with state!+-- 1) Repeatedly show prompt for 1 character only.+-- 2) If this is okay, add it into the list of guesses.+-- 3) If there were matches (elem) then do not decrement lives.+-- 4) Check whether the player has won.+--+runHangman :: Hangman ()+runHangman = do++ -- Read state and show the game status+ gs@GameState {theWord,guesses,lives} <- get+ liftIO $ print gs++ -- Keep asking the user for a single character.+ inputChar <- liftIO $ msum $ repeat retrieveChar+ liftIO $ putStr "\n\n"++ -- Decrement lives only if guess was not in the word+ let updateLives = if inputChar `elem` theWord+ && not (inputChar `elem` guesses) then id else pred++ -- Put state+ let gs' = gs {guesses=guesses `union` [inputChar],lives=updateLives lives}+ put gs'++ case gameResult gs' of+ Won -> liftIO $ do+ print gs'+ putStr $ wonMessage $ show theWord+ Lost -> liftIO $ do+ print gs'+ putStr $ lostMessage $ show theWord+ _ -> runHangman -- neither won or lost. Continue.++ where+ -- Asks user for one character only.+ retrieveChar = do+ inLine <- getLine+ if length inLine == 1+ then return $ head inLine+ else do+ putStrLn "Please enter a single character only. Try again."+ mzero -- failure state++ gameResult :: GameState -> GameResult+ gameResult gs@GameState {theWord,guesses,lives} =+ if all (`elem` guesses) theWord+ then Won+ else if lives < 1 then Lost else NotWon++-- At the beginning of the game, I pick a word randomly from a list of words.+-- I have a game+main :: IO ()+main = do+ listOfWords <- getWords "res/words.txt"+ (randomIndex,_) <- return . randomR (0,length listOfWords) =<< newStdGen + let chosenWord = listOfWords !! randomIndex+ putStrLn introMessage+ putStr "\n\n"+ _ <- execStateT runHangman $ startingGameState chosenWord+ return ()+ where+ getWords filePath = return . concatMap words . lines =<< readFile filePath++introMessage = unlines [+ "!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!",+ "! Hok's Hangman !",+ "!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!",+ "Welcome to the gallows...",+ "You'd better get the word right, or else Mr. Stick gets it."+ ]++wonMessage theWord = unlines [+ "!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!",+ "Congratulations, you've won!! You're so smart!",+ "The word was " ++ theWord ++ " -- HOW DID YOU KNOW?!?"+ ]++lostMessage theWord = unlines [+ "!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!",+ "POOR YOU! You've LOST! You're such a dumbass!",+ "The word was " ++ theWord ++ "."+ ]++livesIllustrations = [lives10,lives9,lives8,+ lives7,lives6,lives5,+ lives4,lives3,lives2,+ lives1,theEnd]++lives10 = " \n" +++ " \n" +++ " \n" +++ " \n" +++ " \n" +++ " \n" +++ " \n"++lives9 = " \n" +++ " \n" +++ " \n" +++ " \n" +++ " \n" +++ " \n" +++ "-------------\n"++lives8 = " \n" +++ " | \n" +++ " | \n" +++ " | \n" +++ " | \n" +++ " | \n" +++ "-------------\n"++lives7 = "----------- \n" +++ " | \n" +++ " | \n" +++ " | \n" +++ " | \n" +++ " | \n" +++ "-------------\n"++lives6 = "----------- \n" +++ " | | \n" +++ " | \n" +++ " | \n" +++ " | \n" +++ " | \n" +++ "-------------\n"++lives5 = "----------- \n" +++ " | | \n" +++ " | O \n" +++ " | \n" +++ " | \n" +++ " | \n" +++ "-------------\n"++lives4 = "----------- \n" +++ " | | \n" +++ " | O \n" +++ " | | \n" +++ " | \n" +++ " | \n" +++ "-------------\n"++lives3 = "----------- \n" +++ " | | \n" +++ " | O \n" +++ " | /| \n" +++ " | \n" +++ " | \n" +++ "-------------\n"++lives2 = "----------- \n" +++ " | | \n" +++ " | o \n" +++ " | /|\\ \n" +++ " | \n" +++ " | \n" +++ "-------------\n"++lives1 = "----------- \n" +++ " | | \n" +++ " | o \n" +++ " | /|\\ \n" +++ " | \\ \n" +++ " | \n" +++ "-------------\n"++theEnd = "----------- \n" +++ " | | \n" +++ " | O \n" +++ " | /|\\ \n" +++ " | / \\ \n" +++ " | \n" +++ "-------------\n"+