skat/Reizen.hs

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)