diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/hangman.cabal b/hangman.cabal new file mode 100644 --- /dev/null +++ b/hangman.cabal @@ -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 +Maintainer: Hok Shun Poon +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: diff --git a/src/Main.hs b/src/Main.hs new file mode 100644 --- /dev/null +++ b/src/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 + +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" +