Tuesday, February 19, 2008

hmastermind code

-- 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"

hmastermind

well i am a freshman computer science student just learning the haskell programming language. i have implemented the famous mastermind game in haskell, i am currently working on GUI in gtkhs hopefully it will be finished. Just wanted to share the mastermind game with you guys. if there are any issues please don't hesitate to post your queries.