hangman 1.0.1 → 1.0.2
raw patch · 4 files changed
+1081/−228 lines, 4 files
Files
- hangman.cabal +4/−3
- src/Main.hs +0/−225
- src/main/haskell/Main.hs +225/−0
- src/main/resources/words.txt +852/−0
hangman.cabal view
@@ -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
− src/Main.hs
@@ -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"-
+ src/main/haskell/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+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"+
+ src/main/resources/words.txt view
@@ -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