skat/Card.hs

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