summaryrefslogtreecommitdiff
path: root/src/Player.hs
blob: 8b64c79043a3fb68280be58dc048592c8ec259fc (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
module Player where

import qualified Data.List as L
import Card (Card)
import qualified Card as C
import qualified Color

data Player = Player { name :: String
                     , penalty :: Int
                     , cards :: [Card]
                     }

defaultPlayers :: [Player]
defaultPlayers = map (\name -> Player name 0 []) $
    ["Alice", "Bob", "Carol", "David", "Eve", "Frank", "Gina", "Howard"]

-- | Update `i`-th player in `ps` to `p`.
update :: [Player] -> Int -> Player -> [Player]
update ps i p =
    let (left, right) = splitAt i ps
     in left ++ [p] ++ (tail right)

-- | Same player after shedding card specified.
shed :: Player -> Card -> Player
shed (Player n p cs) c = Player n p $ L.delete c cs

-- | Same player after drawing cards specified.
draw :: Player -> [Card] -> Player
draw (Player n p cs) cs' = Player n p $ L.sort (cs' ++ cs)

-- | Show player's cards, e.g. "1. Spade 2"
showCards :: Player -> Card -> Int -> String
showCards (Player _ _ cs) prev att =
    unlines $ zipWith joinAndColorize [1..] cs
        where joinAndColorize n c =
                  if C.isValid prev att c
                     then if C.isSpecial c
                             then Color.green $ join n c
                             else join n c
                     else Color.red $ join n c
              join n c = (show n) ++ ". " ++ (C.showCard c)

-- | Empty all players' cards.
clearCards :: [Player] -> [Player]
clearCards plyrs = map clear plyrs
    where clear (Player n p _) = Player n p []

-- | Update penalty for each player after a round.
calcPenalties :: [Player] -> [Player]
calcPenalties plyrs = map penalize plyrs
    where penalize (Player n p c) = Player n (p + length c) c

-- | Pretty print penalties.
showPenalties :: [Player] -> String
showPenalties = unlines . map showPenalty
    where showPenalty (Player n p _) = n ++ ":\t" ++ show p