module Card where import Data.List import Utils data Type = Seven | Eight | Nine | Queen | King | Ten | Ace | Jack deriving (Eq, Ord, Show, Enum) countType :: Type -> Int countType Ace = 11 countType Ten = 10 countType King = 4 countType Queen = 3 countType Jack = 2 countType _ = 0 data Colour = Diamonds | Hearts | Spades | Clubs deriving (Eq, Ord, Show, Enum, Read) data Card = Card Type Colour deriving (Eq, Show) countCard :: Card -> Int countCard (Card t _) = countType t count :: [Card] -> Int count = sum . map countCard data Team = Team | Single deriving (Show, Eq, Ord, Enum) data Space = Table | Hand1 | Hand2 | Hand3 | WonTeam | WonSingle | SkatP deriving (Show, Eq, Ord, Enum) teamPile :: Team -> Space teamPile Team = WonTeam teamPile Single = WonSingle playerHand :: Index -> Space playerHand One = Hand1 playerHand Two = Hand2 playerHand Three = Hand3 playerOfHand :: Space -> Index playerOfHand Hand1 = One playerOfHand Hand2 = Two playerOfHand Hand3 = Three data CardS = CardS { getCard :: Card , getSpace :: Space , getOwner :: Space } deriving (Show, Eq) moveCard :: Card -> Space -> [CardS] -> [CardS] moveCard card sp cards = map f cards where f c = if card == getCard c then c { getSpace = sp } else c findCards :: Space -> [CardS] -> [Card] findCards sp cards = foldr f [] cards where f (CardS c s _) cs | s == sp = c : cs | otherwise = cs data Index = One | Two | Three deriving (Show, Ord, Eq, Enum) next :: Index -> Index next One = Two next Two = Three next Three = One prev :: Index -> Index prev One = Three prev Two = One prev Three = Two data Player = Player { team :: Team , index :: Index } deriving Show data Players = Players Player Player Player deriving Show player :: Players -> Index -> Player player (Players p _ _) One = p player (Players _ p _) Two = p player (Players _ _ p) Three = p type Hand = [Card] equals :: Colour -> Maybe Colour -> Bool equals col (Just x) = col == x equals col Nothing = True isTrump :: Colour -> Card -> Bool isTrump trumpCol (Card tp col) | tp == Jack = True | otherwise = col == trumpCol effectiveColour :: Colour -> Card -> Colour effectiveColour trumpCol card@(Card _ col) = if trump then trumpCol else col where trump = isTrump trumpCol card isAllowed :: Colour -> Maybe Colour -> Hand -> Card -> Bool isAllowed trumpCol turnCol cs card = if col `equals` turnCol then True else not $ any (\ca -> effectiveColour trumpCol ca `equals` turnCol && ca /= card) cs where col = effectiveColour trumpCol card putAt :: Space -> Card -> CardS putAt sp c = CardS c sp sp distribute :: [Card] -> [CardS] distribute cards = map (putAt Hand1) hand1 ++ map (putAt Hand2) hand2 ++ map (putAt Hand3) hand3 ++ map (putAt SkatP) skt where round1 = chunksOf 3 (take 9 cards) skt = take 2 $ drop 9 cards round2 = chunksOf 4 (take 12 $ drop 11 cards) round3 = chunksOf 3 (take 9 $ drop 23 cards) hand1 = concatMap (!! 0) [round1, round2, round3] hand2 = concatMap (!! 1) [round1, round2, round3] hand3 = concatMap (!! 2) [round1, round2, round3] playersFromTable :: Players -> [CardS] -> [Player] playersFromTable ps = map (player ps . playerOfHand . getOwner) -- TESTING VARS c1 :: Card c1 = Card Jack Spades c2 :: Card c2 = Card Ace Diamonds c3 :: Card c3 = Card Queen Diamonds c4 :: Card c4 = Card Queen Hearts c5 :: Card c5 = Card Jack Clubs h1 :: Hand h1 = [c1,c2,c3,c4,c5] allCards :: [Card] allCards = [ Card t c | t <- tps, c <- cols ] where tps = [Seven .. Jack] cols = [Diamonds .. Clubs] distributePutSkat :: [Card] -> [CardS] distributePutSkat cards = foldr (\c m -> moveCard c WonSingle m) distributed skt where distributed = distribute cards skt = findCards SkatP distributed