skat/src/Skat/Operations.hs

module Skat.Operations (
    turn, turnGeneric, play, playOpen, publishGameResults,
    publishGameStart, play_, sortRender, undo_
) where

import Control.Monad.State
import System.Random (newStdGen, randoms)
import Data.List
import Data.Ord
import qualified Data.Set as S

import Skat
import Skat.Card
import Skat.Pile
import Skat.Player (chooseCard, Players(..), Player(..), PL(..),
    updatePlayer, playersToList, player, MonadPlayer)
import Skat.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

play_ :: HasCard c => c -> Skat ()
play_ card = do
    hand <- gets currentHand
    trCol <- gets trumpColour
    modifyp $ playCard hand card
    table <- getp tableCards
    case length table of
        1 -> do modify (setCurrentHand $ next hand)
                modify $ setTurnColour (Just $ effectiveColour trCol $ head table)
        3 -> evaluateTable >>= modify . setCurrentHand
        _ -> modify (setCurrentHand $ next hand)

undo_ :: HasCard c => c -> Hand -> Maybe Colour -> Team -> Skat ()
undo_ card oldCurrent oldTurnCol oldWinner = do
    modify $ setCurrentHand oldCurrent
    modify $ setTurnColour oldTurnCol
    modifyp $ unplayCard oldCurrent (toCard card) oldWinner

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

turn :: Skat (Int, Int)
turn = turnGeneric play 10

evaluateTable :: Skat Hand
evaluateTable = do
    trumpCol <- gets trumpColour
    turnCol <- gets turnColour
    table <- getp tableCards
    ps <- gets players
    let winnerHand = uorigin $ getPile $ highestCard trumpCol turnCol table
        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
    table <- getp tableCards
    turnCol <- gets turnColour
    trump <- gets trumpColour
    cards <- getp $ handCards (hand p)
    fallen <- getp played
    (card, p') <- chooseCard p table fallen cards
    modifyPlayers $ updatePlayer p'
    modifyp $ playCard (hand p) card
    ps <- fmap playersToList $ gets players
    table' <- getp tableCards
    ps' <- mapM (\p -> onCardPlayed p (head table')) ps
    mapM_ (modifyPlayers . updatePlayer) ps'
    return (toCard card)

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

publishGameResults :: (Int, Int) -> Skat ()
publishGameResults res = do
    pls <- gets players
    mapM_ (\p -> onGameResults p res) (playersToList pls)

publishGameStart :: Hand -> Skat ()
publishGameStart sglPlayer = do
    pls <- gets players
    mapM_ (\p -> onGameStart p sglPlayer) (playersToList pls)