Add remaining haskell book exercises
This commit is contained in:
69
Haskell-book/26/Morra/app/Main.hs
Normal file
69
Haskell-book/26/Morra/app/Main.hs
Normal file
@@ -0,0 +1,69 @@
|
||||
module Main where
|
||||
|
||||
import Control.Monad
|
||||
import Control.Monad.Trans.State
|
||||
import System.Random
|
||||
import System.Console.ANSI (clearScreen)
|
||||
|
||||
type Score = StateT (Integer, Integer) IO (Integer, Integer)
|
||||
|
||||
yourTurn :: IO (Integer, Integer)
|
||||
yourTurn = do
|
||||
putStrLn "Wie viele Finger zeigen Sie?"
|
||||
shown <- liftM read getLine
|
||||
|
||||
putStrLn "Wie viele Finger wird der Gegner zeigen?"
|
||||
guessed <- liftM read getLine
|
||||
|
||||
clearScreen
|
||||
|
||||
return (shown, guessed)
|
||||
|
||||
|
||||
aiTurn :: IO (Integer, Integer)
|
||||
aiTurn = do
|
||||
gen1 <- getStdGen
|
||||
|
||||
let (shown, gen2) = randomR (1, 5) gen1
|
||||
putStrLn $ "Der Gegner zeigt: " ++ (show shown)
|
||||
|
||||
let (guessed, gen3) = randomR (1, 5) gen2
|
||||
putStrLn $ "Der Gegner hat " ++ (show guessed) ++ " geraten."
|
||||
|
||||
setStdGen gen3
|
||||
return (shown, guessed)
|
||||
|
||||
|
||||
score :: IO (Integer, Integer) -> Score
|
||||
score partnerTurn = StateT $ \(s1, s2) -> do
|
||||
you <- yourTurn
|
||||
partner <- partnerTurn
|
||||
let sum = (fst you) + (snd partner)
|
||||
|
||||
let yourScore = if (snd you) == sum then 1 else 0
|
||||
let partnerScore = if (snd partner) == sum then 1 else 0
|
||||
return ((yourScore, partnerScore), (s1 + yourScore, s2 + partnerScore))
|
||||
|
||||
|
||||
loopGame :: IO (Integer, Integer)
|
||||
-> (Integer, Integer)
|
||||
-> IO (Either (Integer, Integer) (Integer, Integer))
|
||||
loopGame partnerTurn currentScore = do
|
||||
(result, s) <- runStateT (score partnerTurn) currentScore
|
||||
putStrLn $ show $ result
|
||||
|
||||
case s of
|
||||
(16, _) -> return $ Left result
|
||||
(_, 16) -> return $ Right result
|
||||
_ -> loopGame partnerTurn s
|
||||
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
winner <- loopGame aiTurn (0, 0)
|
||||
|
||||
case winner of
|
||||
Left x -> putStrLn $ "You've won! Score: " ++ (show x)
|
||||
Right x -> putStrLn $ "You've lost! Score: " ++ (show x)
|
||||
|
||||
return ()
|
||||
Reference in New Issue
Block a user