91 lines
2.6 KiB
Haskell
91 lines
2.6 KiB
Haskell
import qualified Data.List as L
|
|
import System.IO
|
|
import System.Random
|
|
|
|
data CoinToss = H | T deriving (Read, Show, Eq)
|
|
|
|
parseToss :: String -> [CoinToss]
|
|
parseToss [] = []
|
|
parseToss (s:sx)
|
|
| s == 'h' || s == 'H' = H : parseToss sx
|
|
| s == 't' || s == 'T' = T : parseToss sx
|
|
| otherwise = parseToss sx
|
|
|
|
notToss :: CoinToss -> CoinToss
|
|
notToss H = T
|
|
notToss T = H
|
|
|
|
instance Random CoinToss where
|
|
random g = let (b, gb) = random g in (if b then H else T, gb)
|
|
randomR = undefined
|
|
|
|
prompt :: (Read a) => String -> String -> (String -> Maybe a) -> IO a
|
|
prompt msg err parse = do
|
|
putStrLn msg
|
|
line <- getLine
|
|
let ans = parse line
|
|
case ans of
|
|
Nothing -> do
|
|
putStrLn err
|
|
prompt msg err parse
|
|
Just ansB -> return ansB
|
|
|
|
showCat :: (Show a) => [a] -> String
|
|
showCat = concatMap show
|
|
|
|
data Winner = Player | CPU
|
|
|
|
-- This may never terminate.
|
|
runToss :: (RandomGen g) => [CoinToss] -> [CoinToss] -> g -> ([CoinToss], Winner)
|
|
runToss player cpu gen =
|
|
let stream = randoms gen
|
|
run ss@(s:sx)
|
|
| L.isPrefixOf player ss = player
|
|
| L.isPrefixOf cpu ss = cpu
|
|
| otherwise = s : run sx
|
|
winner = run stream
|
|
in if L.isSuffixOf player winner
|
|
then (winner, Player)
|
|
else (winner, CPU)
|
|
|
|
game :: (RandomGen g, Num a, Show a) => Bool -> a -> a -> g -> IO ()
|
|
game cpuTurn playerScore cpuScore gen = do
|
|
putStrLn $ "\nThe current score is CPU: " ++ show cpuScore
|
|
++ ", You: " ++ show playerScore
|
|
|
|
let (genA, genB) = split gen
|
|
promptPlayer check =
|
|
prompt "Pick 3 coin sides: " "Invalid input." $ \s ->
|
|
let tosses = parseToss s in
|
|
if check tosses then Just tosses else Nothing
|
|
promptCpu x = putStrLn $ "I have chosen: " ++ showCat x
|
|
|
|
(tosses, winner) <-
|
|
if cpuTurn
|
|
then do
|
|
let cpuChoice = take 3 $ randoms gen
|
|
promptCpu cpuChoice
|
|
playerChoice <- promptPlayer $ \n -> n /= cpuChoice && 3 == length n
|
|
return $ runToss playerChoice cpuChoice genA
|
|
else do
|
|
playerChoice <- promptPlayer $ \n -> 3 == length n
|
|
let cpuChoice = case playerChoice of [a,b,_] -> [notToss b, a, b]
|
|
promptCpu cpuChoice
|
|
return $ runToss playerChoice cpuChoice genA
|
|
|
|
putStrLn $ "The sequence tossed was: " ++ showCat tosses
|
|
|
|
case winner of
|
|
Player -> do
|
|
putStrLn "You win!"
|
|
game (not cpuTurn) (playerScore + 1) cpuScore genB
|
|
CPU -> do
|
|
putStrLn "I win!"
|
|
game (not cpuTurn) playerScore (cpuScore + 1) genB
|
|
|
|
main :: IO ()
|
|
main = do
|
|
hSetBuffering stdin LineBuffering
|
|
stdgen <- getStdGen
|
|
let (cpuFirst, genA) = random stdgen
|
|
game cpuFirst 0 0 genA
|