Mastermind Game - Repost (Game I wrote back in 07 to teach intermediate haskell)

-- Mastermind Game - Fri 18-11-2007 

-- CS11A - Introduction to Computer Science 

--This module controls the utility functions for the graphics e.g. mouse events, Font Operations... uncomment of using winhugs b4 2006 

--import GraphicsUtils 

--import SOEGraphics

import Graphics.HGL --Graphics modules as to be imported for Grapics to be produced.

import Graphics.HGL.Utils --This module controls the utility functions for the graphics e.g. mouse events, Font Operations

import Random --Imported to allow the random functions to be used

import Prelude hiding (read) --The Prelude as been imported and the function read hidden so that my version can be used

import Data.List (sort) --Imported to allow the sort function to be used

import Data.Char (toLower) --Imported to allow the toLower function to be used

--The following Emurated type hold all the colors to be used 

data Colors = Gr | Cy | Bk | Mg | Yw | Bl deriving (Eq, Ord, Show)

--The following instance allows lower equivalent of the colors to be used 

--Recieved Nov 23 2007 - Code was contributed by my friends #haskell

instance Read Colors where

readsPrec _ (c1:c2:rest) = case lookup (map toLower [c1,c2])

[("gr",Gr),("cy",Cy),("bk",Bk),("mg",Mg),("yw",Yw),("bl",Bl)]

of Just c -> [(c,rest)]

Nothing -> []

--The following function filters all the possible combination for the game

randomize = [ [a, b, c ,d] | a <- rs, b <- rs, c <- rs, d <- rs] 

where rs = [Gr, Cy, Bk, Mg, Yw, Bl]

--The following writes a text file containing all the codes for playing the haskell game

wc = do writeFile "code.txt" (show randomize) 

putStrLn "The Codes has been written!"

--The following are [extensions] to the help function which allows the 

--user to use h, man and info to assess the help file

h = help

man = help

info = help 

--The following function prints text-based help file to the screen

help = do putStrLn$ "The rules of the game are very simple \n" 

++"there are 1296 possible moves \n" 

++"Users are only allowwed to use six inputs \n" 

++"Users may enter Gr | Cy | Bk | Mg | Yw | Bl\n" 

++"Any other input is seen as an error\n" 

++"type about or 'a' to for info on contributers\n\n" 

++"====================================\n" 

++"Possible Responses\n" 

++"====================================\n" 

++"* No Input.\n" 

++"* Two whites.\n" 

++"* One Red, one white.\n" 

++"* One red, two whites.\n" 

++"* Two reds, one white.\n" 

++"* Three reds.\n" 

++"* Four whites.\n" 

++"* One red, Three whites.\n" 

++"* Two reds, two whites.\n" 

++"* Three reds, one white,is impossible.\n" 

++"* Four reds is a correct guess - you win!!\n" 

++"====================================\n" 

++"Hope you enoy\n\n"

a = about

--The following function prints information about users to the screen

about = do putStrLn$ "This following is a clone of the famous haskell \n" 

++"The game was created by a compilation of code \n" 

++"written by 4 contributers that aided in the\n" 

++"deployment of this code, namely,\n\n" 

++"=========================================\n" 

++"|Area of Focus | Contributor |\n" 

++"=========================================\n" 

++"|Code Snippets | Saabeerah Abdullah |\n" 

++"-----------------------------------------\n" 

++"|Documentation | Kaydiann Walters |\n" 

++"-----------------------------------------\n" 

++"|GUI Design | Shana-Kay Barnnett |\n" 

++"-----------------------------------------\n" 

++"|Technical Reviewer | Ferron Hanse |\n" 

++"=========================================\n\n" 

--The following functions states all the possible moves a user can make

moves = putStrLn$ "They are " ++ (show$ length randomize) ++ " possible moves"

--The following function calculates the number of white and the number of red that are in a given guess

--If the user enters a code that equals 4 red he/she is congratulated and the game ends

--For test purposes only!!

mastermindt :: [Colors] -> [Colors] -> IO ()

mastermindt [] [] = do putStrLn "Please enter a Input!!"

mastermindt xs ys = if (length xs) > 4 || (length xs) <> 4

then do putStrLn "Incorrect number of inputs"

else if (length$ filter (id) $zipWith (==) xs ys) == 4

then do putStrLn "4 red 0 white \nCongratulations You've Won!!"

else do putStrLn$ show(numRed xs ys) ++ " red "

++ show (numWhite xs ys)

++ " white \nPlease Try Again "

--The following function finds all the values that are in the correct position

red :: [Colors] -> [Colors] -> [Colors]

red [] [] = []

red (x:xs) (y:ys)

|(x == y) = x : (red xs ys)

|otherwise = red xs ys

--The following function finds all the values that are in the list, but in the wrong position

w :: [Colors] -> [Colors] -> [Colors]

w x y = (white' (sort x) (sort y))

white' [] _ = []

white' _ [] = []

white' (x:xs) (y:ys)

| (x == y) = x : (white' xs ys)

| (x < y) = white' xs (y:ys)

| (x > y) = white' ys (x:xs)

--The following function calculates the length of red values

numRed :: [Colors] -> [Colors] -> Int

numRed xs ys = length (red xs ys)

--The following function calculates the length of white values

numWhite :: [Colors] -> [Colors] -> Int

numWhite xs ys = length (w xs ys) - (numRed xs ys)

----------------------------------------------------MasterMind Game---------------------------------------------------------

--The following function starts the GUI, then loads the game after

mastermind = do wc; game

--The following function starts the game

game = do

putStrLn $ "Welcome to Mastermind\n\nType [q]uit to [e]nd the game at any time\n\n" 

++ "Please remember, only the following color codes can be used:\n\n" 

++ "Colors = Gr | Cy | Bk | Mg | Yw | Bl\n\nExample [Cy,Mg,Yw,Gr]\n\n"

code <- getCode

mmloop code 8 

--The following function qeries the user and ask if they wish to restart the game

putStrLn $ "\nDo you want to start a new game\n"

putStr "Quit ? "

answer <- getLine

if answer == "yes" then game

else if answer == "no" then putStrLn $ "Thank you for playing.. bye"

else return ()

--The following gets a random code from the text named 'code.txt'

getCode = do

codeDB <- readFile "code.txt"

num <- randomRIO (0::Int, 1295) --The following line generates a random number between 0 - 1295

let code = ((read codeDB::[[Colors]]) !! num) --The random number is used to take a code from the index

return (code)

--The following is the mastermind game being looped n number of times

mmloop code tries = do

putStr "Guess? "

guess <- getLine --User is asked to enter a guess

--let result = read guess::[Colors] --The guess as to be converted to a type Colors

let tester = (map (map fst) . sequence $ map reads (words guess) :: [[Colors]])

let result = map read (words guess) :: [Colors]

--let tester = (map (map fst) . sequence $ map reads (words guess) :: [[Colors]])

if guess == "q" || guess == "quit" || guess == "e" || guess == "end" || tries == 0 -- || tester == []

then putStrLn $ "Closing Game, Thank you for playing...\n\nRetrieving code from database...please wait..\n\nThe code was: " ++ (show code)

else if guess == "c"

then do putStrLn "Colors = gr | cy | bk | mg | yw | bl\n\n"

mmloop code tries

else if guess == "h"

then do putStrLn$ "The rules of the game are very simple \n" 

++"Users are only allowwed to use six inputs \n" 

++"Users may enter gr | cy | bk | mg | yw | bl\n" 

++"Any other input is seen as an error\n" 

++"Only 4 Colors must be entered. No less, no more\n" 

++"Type 'c' to get a list of the valid colors" 

++"Type 'a' to for info on developers\n\n" 

++"====================================\n" 

++"Possible Responses\n" 

++"====================================\n" 

++"* No Input.\n" 

++"* Two whites.\n" 

++"* One Red, one white.\n" 

++"* One red, two whites.\n" 

++"* Two reds, one white.\n" 

++"* Three reds.\n" 

++"* Four whites.\n" 

++"* One red, Three whites.\n" 

++"* Two reds, two whites.\n" 

++"* Three reds, one white,is impossible.\n" 

++"* Four reds is a correct guess - you win!!\n" 

++"====================================\n" 

++"Hope you enoy\n\n\n"

mmloop code tries

else if guess == "a"

then do putStrLn$ "This following is a clone of the famous haskell \n" 

++"The game was created by a compilation of code \n" 

++"written by 4 contributers that aided in the\n" 

++"deployment of this code, namely,\n\n" 

++"=========================================\n" 

++"|Area of Focus | Contributor |\n" 

++"=========================================\n" 

++"|Code Snippets | Saabeerah Abdullah |\n" 

++"-----------------------------------------\n" 

++"|Documentation | Kaydiann Walters |\n" 

++"-----------------------------------------\n" 

++"|GUI Design | Shana-Kay Barnnett |\n" 

++"-----------------------------------------\n" 

++"|Technical Reviewer | Ferron Hanse |\n" 

++"=========================================\n\n\n"

mmloop code tries

else if tester == []

then do putStrLn "\nIncorrect input\n"

mmloop code tries

else if (length code) > 4 || (length code) <> 4

then do putStrLn$ "Incorrect number of inputs!! Only " ++ show (length result) ++ " inputs entered\n"

mmloop code tries --Loop function minus one everytime a turn is played

else if (result) == code

then putStrLn $ "4 reds 0 whites\n" ++ "Congratulations, You have Won!!!" ++ " You have guessed it, the was: " ++ (show code)

else do putStrLn$ "\n" ++ show(numRed code result) ++ " red "

++ show (numWhite code result)

++ " white \nPlease Try Again, You have " ++ show tries ++ " tries left\n"

mmloop code (tries-1) --Loop function minus one everytime a turn is played 

--Read function as been edited to give a more friendly error message

read :: Read a => [Char] -> a

read s = case [x | (x,t) <- reads s, ("","") <- lex t] of

[x] -> x

[] -> error "You entered a incorrect input\nGame terminiated\n"

_ -> error "Prelude.read: ambiguous parse"