skat/Operations.hs

module Operations where

import Control.Monad.State
import System.Random (newStdGen, randoms)
import Data.List
import Data.Ord

import Card
import Skat
import Pile
import Player (chooseCard, Players(..), Player(..), PL(..),
    updatePlayer, playersToList, player)
import Utils (shuffle)

compareRender :: Card -> Card -> Ordering
compareRender (Card t1 c1) (Card t2 c2) = case compare c1 c2 of
    EQ -> compare t1 t2
    v  -> v

sortRender :: [Card] -> [Card]
sortRender = sortBy compareRender

turnGeneric :: (PL -> Skat Card)
            -> Int
            -> Hand
            -> Skat (Int, Int)
turnGeneric playFunc depth n = do
    table <- getp tableCards
    ps <- gets players
    let p = player ps n
    hand <- getp $ handCards n
    trCol <- gets trumpColour
    case length table of
        0 -> playFunc p >> turnGeneric playFunc depth (next n)
        1 -> do
            modify $ setTurnColour
                (Just $ effectiveColour trCol $ head table)
            playFunc p
            turnGeneric playFunc depth (next n)
        2 -> playFunc p >> turnGeneric playFunc depth (next n)
        3 -> do
            w <- evaluateTable
            if depth <= 1 || length hand == 0
                then countGame
                else turnGeneric playFunc (depth - 1) w

turn :: Hand -> Skat (Int, Int)
turn n = turnGeneric play 10 n

evaluateTable :: Skat Hand
evaluateTable = do
    trumpCol <- gets trumpColour
    turnCol <- gets turnColour
    table <- getp tableCards
    ps <- gets players
    let winningCard = highestCard trumpCol turnCol table
    Just winnerHand <- getp $ originOfCard winningCard
    let winner = player ps winnerHand
    modifyp $ cleanTable (team winner)
    modify $ setTurnColour Nothing
    return $ hand winner

countGame :: Skat (Int, Int)
countGame = getp count

play :: (Show p, Player p) => p -> Skat Card
play p = do
    liftIO $ putStrLn "playing"
    table <- getp tableCardsS
    turnCol <- gets turnColour
    trump <- gets trumpColour
    hand <- getp $ handCards (hand p)
    fallen <- getp played
    (card, p') <- chooseCard p table fallen hand
    modifyPlayers $ updatePlayer p'
    modifyp $ playCard card
    ps <- fmap playersToList $ gets players
    table' <- getp tableCardsS
    ps' <- mapM (\p -> onCardPlayed p (head table')) ps
    mapM_ (modifyPlayers . updatePlayer) ps'
    return card

playOpen :: (Show p, Player p) => p -> Skat Card
playOpen p = do
    --liftIO $ putStrLn $ show (hand p) ++ " playing open"
    card <- chooseCardOpen p
    modifyp $ playCard card
    return card