Package into cabal projectHEADmain

1 files changed, 56 insertions, 0 deletions

diff --git a/src/Player.hs b/src/Player.hs
new file mode 100644
index 0000000..8b64c79
--- /dev/null
+++ b/src/Player.hs
@@ -0,0 +1,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