summaryrefslogtreecommitdiff
path: root/Game.hs
diff options
context:
space:
mode:
authorFrederick Yin <fkfd@fkfd.me>2023-01-08 21:10:52 +0800
committerFrederick Yin <fkfd@fkfd.me>2023-01-08 21:10:52 +0800
commit23c093dbf45f13e1842dada2dc933944a1402fd6 (patch)
tree072b738a72f649f8530d347ba6d62d5db168452c /Game.hs
parentc50c43698af9b4291f1e63154d19123ed89b8f10 (diff)
Divide turn logic into shed and draw
Diffstat (limited to 'Game.hs')
-rw-r--r--Game.hs69
1 files changed, 38 insertions, 31 deletions
diff --git a/Game.hs b/Game.hs
index 816a65c..871d188 100644
--- a/Game.hs
+++ b/Game.hs
@@ -33,41 +33,48 @@ beginTurn game@(Game plyrs pidx att dir stock disc) = do
decision <- prompt game
let player = plyrs !! pidx
- let player' = case decision of
- Nothing -> player `draw` (take att stock)
- Just card -> player `shed` card
- let (left, right) = splitAt pidx plyrs
- let plyrs' = left ++ [player'] ++ (tail right)
+ game'@(Game _ pidx' _ _ _ _)
+ <- case decision of
+ Nothing -> drawAndSkip game
+ Just card -> shedAndContinue card game
- let stock' = case decision of
- Nothing -> tail stock
- Just _ -> stock
- let disc' = case decision of
- Nothing -> disc
- Just card -> card:disc
-
- let att' = case decision of
- Just (Card _ C.Two) -> if att == 1 then 2 else att + 2
- Just (Card _ C.Three) -> if att == 1 then 3 else att + 3
- _ -> 1
- let dir' = case decision of
- Just (Card _ C.Queen) -> negate dir
- _ -> dir
- let pidx' = case decision of
- Just (Card _ C.Jack) -> (pidx + 2 * dir') `mod` length plyrs
- _ -> (pidx + dir') `mod` length plyrs
- let game' = Game plyrs' pidx' att' dir' stock' disc'
-
- case decision of
- Nothing -> do
- putStrLn $ (P.name player) ++ " draws " ++ (C.showCard $ head stock)
- Just card -> do
- putStrLn $ (P.name player) ++ " plays " ++ (C.showCard card)
-
- if null $ P.cards player'
+ if pidx' == pidx -- shedAndContinue does this when player wins
then return game'
else beginTurn game'
+-- | Game state after player draws card(s) and skips turn.
+drawAndSkip :: Game -> IO Game
+drawAndSkip game@(Game plyrs pidx att dir stock disc) = do
+ let player = plyrs !! pidx
+ let player' = player `draw` (take att stock)
+ let plyrs' = P.update plyrs pidx player'
+ let pidx' = (pidx + dir) `mod` length plyrs
+ let stock' = drop att stock
+ putStrLn $ (P.name player) ++ " draws " ++ (C.showCards $ take att stock)
+ return $ Game plyrs' pidx' 1 dir stock' disc
+
+-- | Game state after player sheds card.
+shedAndContinue :: Card -> Game -> IO Game
+shedAndContinue card game@(Game plyrs pidx att dir stock disc) = do
+ let player = plyrs !! pidx
+ let player' = player `shed` card
+ let disc' = card:disc
+ let plyrs' = P.update plyrs pidx player'
+ let dir' = case card of
+ Card _ C.Queen -> negate dir
+ _ -> dir
+ let pidx' = if null $ P.cards player'
+ then pidx -- round ends
+ else case card of
+ Card _ C.Jack -> (pidx + 2 * dir') `mod` length plyrs
+ _ -> (pidx + dir') `mod` length plyrs
+ let att' = case card of
+ Card _ C.Two -> if att == 1 then 2 else att + 2
+ Card _ C.Three -> if att == 1 then 3 else att + 3
+ _ -> 1
+ putStrLn $ (P.name player) ++ " plays " ++ (C.showCard card)
+ return $ Game plyrs' pidx' att' dir' stock disc'
+
-- | Prompt player to play a card (or draw card and skip turn).
prompt :: Game -> IO (Maybe Card)
prompt game@(Game plyrs pidx att _ _ _) = do