From 23c093dbf45f13e1842dada2dc933944a1402fd6 Mon Sep 17 00:00:00 2001
From: Frederick Yin <fkfd@fkfd.me>
Date: Sun, 8 Jan 2023 21:10:52 +0800
Subject: Divide turn logic into shed and draw

---
 Game.hs | 69 ++++++++++++++++++++++++++++++++++++-----------------------------
 1 file changed, 38 insertions(+), 31 deletions(-)

(limited to 'Game.hs')

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
-- 
cgit v1.2.3