From 8c6245fac35cdc9a1ef743d29eea9176448d350d Mon Sep 17 00:00:00 2001 From: Frederick Yin Date: Mon, 13 Mar 2023 18:23:48 +0800 Subject: Package into cabal project --- src/Player.hs | 56 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 56 insertions(+) create mode 100644 src/Player.hs (limited to 'src/Player.hs') 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 -- cgit v1.2.3