module Reizen where import Skat import Card import Utils import Operations import Render data Reizer = Reizer Index [Card] deriving Show getHand :: Index -> [Reizer] -> [Card] getHand n rs = let (Reizer _ h) = head $ filter (\(Reizer i cs) -> i == n) rs in h goWith :: [Card] -> Int -> IO Bool goWith cs n = query $ "Go with " ++ show n goUp :: [Card] -> Int -> IO Int goUp cs n = query $ "Go up " ++ show n askColour :: [Card] -> IO Colour askColour cs = render (sortRender cs) >> query "Trump should be:" askSkat :: [Card] -> IO (Card, Card) askSkat cs_ = do let cs = sortRender cs_ render cs (n1, n2) <- query "Drop two cards:" if n1 < length cs && n2 < length cs && n1 >= 0 && n2 >= 0 && n1 /= n2 then return (cs !! n1, cs !! n2) else askSkat cs reizen :: IO SkatEnv reizen = do cs <- shuffleCards let cards = distribute cs p1 = Reizer One $ findCards Hand1 cards p2 = Reizer Two $ findCards Hand2 cards p3 = Reizer Three $ findCards Hand3 cards skt = findCards SkatP cards (winner1, new) <- combat p2 p1 0 (Reizer idx _, _) <- combat p3 winner1 new let ps = Players (Player (if idx == One then Single else Team) One) (Player (if idx == Two then Single else Team) Two) (Player (if idx == Three then Single else Team) Three) sglHand = playerHand idx cards' = foldr (\c css -> moveCard c sglHand css) cards skt trumpCol <- askColour (findCards sglHand cards') (s1, s2) <- askSkat (findCards sglHand cards') let cards'' = moveCard s2 WonSingle (moveCard s1 WonSingle cards') return $ SkatEnv cards'' Nothing trumpCol ps combat :: Reizer -> Reizer -> Int -> IO (Reizer, Int) combat r2@(Reizer p2 h2) r1@(Reizer p1 h1) start = do -- advantage for h1 (being challenged) putStrLn $ "Player " ++ show p2 ++ " challenging " ++ show p1 putStrLn $ "Player " ++ show p2 ++ "'s turn" new <- goUp h2 start if new > start then do putStrLn $ "Player " ++ show p2 ++ " goes up to " ++ show new putStrLn $ "Player " ++ show p1 ++ "'s turn" yes <- goWith h1 new if yes then combat r2 r1 new else do putStrLn $ "Player " ++ show p1 ++ " gives up" putStrLn $ "Player " ++ show p2 ++ " wins" return (r2, new) else do putStrLn $ "Player " ++ show p2 ++ " gives up" putStrLn $ "Player " ++ show p1 ++ " wins" return (r1, start)