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