diff --git a/hangman.cabal b/hangman.cabal --- a/hangman.cabal +++ b/hangman.cabal @@ -1,5 +1,5 @@ Name: hangman -Version: 1.0.1 +Version: 1.0.2 Synopsis: Hangman implementation in Haskell written in two hours. Description: @@ -20,6 +20,8 @@ Category: Game Build-type: Simple Cabal-version: >=1.6 +Data-dir: src/main/resources +Data-files: words.txt Source-Repository head type: git @@ -29,10 +31,9 @@ -- a README. -- Extra-source-files: - Executable hangman -- Specify the source directory here - Hs-source-dirs: src + Hs-source-dirs: src/main/haskell -- .hs or .lhs file containing the Main module. Main-is: Main.hs diff --git a/src/Main.hs b/src/Main.hs deleted file mode 100644 --- a/src/Main.hs +++ /dev/null @@ -1,225 +0,0 @@ -{-# 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" - diff --git a/src/main/haskell/Main.hs b/src/main/haskell/Main.hs new file mode 100644 --- /dev/null +++ b/src/main/haskell/Main.hs @@ -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 +import Paths_hangman + +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. +main :: IO () +main = do + listOfWords <- getWords =<< (getDataFileName "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" + diff --git a/src/main/resources/words.txt b/src/main/resources/words.txt new file mode 100644 --- /dev/null +++ b/src/main/resources/words.txt @@ -0,0 +1,852 @@ +a +able +about +account +acid +across +act +addition +adjustment +advertisement +after +again +against +agreement +air +all +almost +among +amount +amusement +and +angle +angry +animal +answer +ant +any +apparatus +apple +approval +arch +argument +arm +army +art +as +at +attack +attempt +attention +attraction +authority +automatic +awake +baby +back +bad +bag +balance +ball +band +base +basin +basket +bath +be +beautiful +because +bed +bee +before +behaviour +belief +bell +bent +berry +between +bird +birth +bit +bite +bitter +black +blade +blood +blow +blue +board +boat +body +boiling +bone +book +boot +bottle +box +boy +brain +brake +branch +brass +bread +breath +brick +bridge +bright +broken +brother +brown +brush +bucket +building +bulb +burn +burst +business +but +butter +button +by +cake +camera +canvas +card +care +carriage +cart +cat +cause +certain +chain +chalk +chance +change +cheap +cheese +chemical +chest +chief +chin +church +circle +clean +clear +clock +cloth +cloud +coal +coat +cold +collar +colour +comb +come +comfort +committee +common +company +comparison +competition +complete +complex +condition +connection +conscious +control +cook +copper +copy +cord +cork +cotton +cough +country +cover +cow +crack +credit +crime +cruel +crush +cry +cup +cup +current +curtain +curve +cushion +damage +danger +dark +daughter +day +dead +dear +death +debt +decision +deep +degree +delicate +dependent +design +desire +destruction +detail +development +different +digestion +direction +dirty +discovery +discussion +disease +disgust +distance +distribution +division +do +dog +door +doubt +down +drain +drawer +dress +drink +driving +drop +dry +dust +ear +early +earth +east +edge +education +effect +egg +elastic +electric +end +engine +enough +equal +error +even +event +ever +every +example +exchange +existence +expansion +experience +expert +eye +face +fact +fall +false +family +far +farm +fat +father +fear +feather +feeble +feeling +female +fertile +fiction +field +fight +finger +fire +first +fish +fixed +flag +flame +flat +flight +floor +flower +fly +fold +food +foolish +foot +for +force +fork +form +forward +fowl +frame +free +frequent +friend +from +front +fruit +full +future +garden +general +get +girl +give +glass +glove +go +goat +gold +good +government +grain +grass +great +green +grey +grip +group +growth +guide +gun +hair +hammer +hand +hanging +happy +harbour +hard +harmony +hat +hate +have +he +head +healthy +hear +hearing +heart +heat +help +high +history +hole +hollow +hook +hope +horn +horse +hospital +hour +house +how +humour +I +ice +idea +if +ill +important +impulse +in +increase +industry +ink +insect +instrument +insurance +interest +invention +iron +island +jelly +jewel +join +journey +judge +jump +keep +kettle +key +kick +kind +kiss +knee +knife +knot +knowledge +land +language +last +late +laugh +law +lead +leaf +learning +leather +left +leg +let +letter +level +library +lift +light +like +limit +line +linen +lip +liquid +list +little +living +lock +long +look +loose +loss +loud +love +low +machine +make +male +man +manager +map +mark +market +married +mass +match +material +may +meal +measure +meat +medical +meeting +memory +metal +middle +military +milk +mind +mine +minute +mist +mixed +money +monkey +month +moon +morning +mother +motion +mountain +mouth +move +much +muscle +music +nail +name +narrow +nation +natural +near +necessary +neck +need +needle +nerve +net +new +news +night +no +noise +normal +north +nose +not +note +now +number +nut +observation +of +off +offer +office +oil +old +on +only +open +operation +opinion +opposite +or +orange +order +organization +ornament +other +out +oven +over +owner +page +pain +paint +paper +parallel +parcel +part +past +paste +payment +peace +pen +pencil +person +physical +picture +pig +pin +pipe +place +plane +plant +plate +play +please +pleasure +plough +pocket +point +poison +polish +political +poor +porter +position +possible +pot +potato +powder +power +present +price +print +prison +private +probable +process +produce +profit +property +prose +protest +public +pull +pump +punishment +purpose +push +put +quality +question +quick +quiet +quite +rail +rain +range +rat +rate +ray +reaction +reading +ready +reason +receipt +record +red +regret +regular +relation +religion +representative +request +respect +responsible +rest +reward +rhythm +rice +right +ring +river +road +rod +roll +roof +room +root +rough +round +rub +rule +run +sad +safe +sail +salt +same +sand +say +scale +school +science +scissors +screw +sea +seat +second +secret +secretary +see +seed +seem +selection +self +send +sense +separate +serious +servant +sex +shade +shake +shame +sharp +sheep +shelf +ship +shirt +shock +shoe +short +shut +side +sign +silk +silver +simple +sister +size +skin + +skirt +sky +sleep +slip +slope +slow +small +smash +smell +smile +smoke +smooth +snake +sneeze +snow +so +soap +society +sock +soft +solid +some + +son +song +sort +sound +soup +south +space +spade +special +sponge +spoon +spring +square +stage +stamp +star +start +statement +station +steam +steel +stem +step +stick +sticky +stiff +still +stitch +stocking +stomach +stone +stop +store +story +straight +strange +street +stretch +strong +structure +substance +such +sudden +sugar +suggestion +summer +sun +support +surprise +sweet +swim +system +table +tail +take +talk +tall +taste +tax +teaching +tendency +test +than +that +the +then +theory +there +thick +thin +thing +this +thought +thread +throat +through +through +thumb +thunder +ticket +tight +till +time +tin +tired +to +toe +together +tomorrow +tongue +tooth +top +touch +town +trade +train +transport +tray +tree +trick +trouble +trousers +true +turn +twist +umbrella +under +unit +up +use +value +verse +very +vessel +view +violent +voice +waiting +walk +wall +war +warm +wash +waste +watch +water +wave +wax +way +weather +week +weight +well +west +wet +wheel +when +where +while +whip +whistle +white +who +why +wide +will +wind +window +wine +wing +winter +wire +wise +with +woman +wood +wool +word +work +worm +wound +writing +wrong +year +yellow +yes +yesterday +you +young