summaryrefslogtreecommitdiff
path: root/src/Player.hs
diff options
context:
space:
mode:
authorFrederick Yin <fkfd@fkfd.me>2023-03-13 18:23:48 +0800
committerFrederick Yin <fkfd@fkfd.me>2023-03-13 18:23:48 +0800
commit8c6245fac35cdc9a1ef743d29eea9176448d350d (patch)
tree43755f230b1cfe0caee7d29156851479eb23f2b0 /src/Player.hs
parent84ee16536eabd4f637912d25643184cbcc118092 (diff)
Package into cabal projectHEADmain
Diffstat (limited to 'src/Player.hs')
-rw-r--r--src/Player.hs56
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