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)