From e9405365b1d19aef2c0bbf0e66476be9e556c384 Mon Sep 17 00:00:00 2001 From: Frederick Yin Date: Sat, 14 Jan 2023 11:58:36 +0800 Subject: Reset game state after each round --- Game.hs | 62 +++++++++++++++++++++++++++++++++++++++----------------------- Player.hs | 5 +++++ 2 files changed, 44 insertions(+), 23 deletions(-) diff --git a/Game.hs b/Game.hs index e6baf67..2fd87c1 100644 --- a/Game.hs +++ b/Game.hs @@ -1,5 +1,6 @@ module Game where +import Prelude hiding (round) import Data.Char (isDigit) import Control.Monad (mapM_) import System.Random (RandomGen, getStdGen, newStdGen) @@ -11,7 +12,7 @@ import qualified Card as C data Setup = Setup { playerN :: Int , roundN :: Int , deckN :: Int - , cardN :: Int -- cards dealt to each player + , cardN :: Int -- ^ cards dealt to each player , autoMode :: Bool } @@ -22,6 +23,7 @@ data Game = Game { players :: [Player] , prevCard :: Card , stockPile :: [Card] , discardPile :: [Card] + , round :: Int } -- | Set up game. @@ -40,19 +42,22 @@ beginGame setup@(Setup n r d c a) = do , prevCard = head decks , stockPile = tail decks , discardPile = [] + , round = 0 } beginRound setup game -- | Begin round. beginRound :: Setup -> Game -> IO Game -beginRound (Setup _ 0 _ _ _) game = return game -beginRound (Setup n r d c a) game = do - game' <- beginTurn a $ dealCards c game - beginRound (Setup n (r - 1) d c a) game' +beginRound setup@(Setup _ r d c a) game = + if round game == r + then return game + else do + game' <- beginTurn setup $ dealCards c game + beginRound setup game' --- | Deal c cards to each player in game. +-- | Deal c cards from stock pile to each player in game. dealCards :: Int -> Game -> Game -dealCards c game@(Game plyrs _ _ _ _ stock disc) +dealCards c game@(Game plyrs _ _ _ _ stock _ _) | (length $ P.cards $ head plyrs) < c = dealCards c game { players = newPlyrs, stockPile = newStock } | otherwise = game @@ -62,13 +67,13 @@ dealCards c game@(Game plyrs _ _ _ _ stock disc) zipWith (\card player -> player { P.cards = card:(P.cards player) }) -- | Let current player take their turn. -beginTurn :: Bool -> Game -> IO Game -beginTurn auto game@(Game plyrs pidx att dir prev stock disc) = do +beginTurn :: Setup -> Game -> IO Game +beginTurn setup@(Setup _ _ _ _ auto) game@(Game plyrs pidx att dir prev stock disc _) = do let player = plyrs !! pidx putStrLn $ replicate 80 '-' putStrLn $ P.name player ++ "'s turn (input 0 to skip turn and draw card)" - -- putStrLn $ P.showCards player prev att + putStrLn $ P.showCards player prev att putStrLn $ "Stock: " ++ (show $ length stock) ++ ", Discard: " ++ (show $ length disc) putStrLn $ "Current attack: " ++ show att @@ -82,12 +87,12 @@ beginTurn auto game@(Game plyrs pidx att dir prev stock disc) = do Just card -> shedAndContinue card game if playerIdx game' == pidx -- shedAndContinue does this when player wins - then endRound game' - else beginTurn auto game' + then endRound setup game' + else beginTurn setup game' -- | Game state after player draws card(s) and skips turn. drawAndSkip :: Game -> IO Game -drawAndSkip game@(Game plyrs pidx att dir prev stock disc) = do +drawAndSkip game@(Game plyrs pidx att dir prev stock disc round) = do gen <- newStdGen let stockLongEnough = if length stock < att then stock ++ (C.shuffle gen disc) @@ -102,11 +107,11 @@ drawAndSkip game@(Game plyrs pidx att dir prev stock disc) = do let plyrs' = P.update plyrs pidx player' let pidx' = (pidx + dir) `mod` length plyrs putStrLn $ (P.name player) ++ " draws " ++ (C.showCards cardsToDraw) - return $ Game plyrs' pidx' 1 dir prev stock' disc' + return $ Game plyrs' pidx' 1 dir prev stock' disc' round -- | Game state after player sheds card. shedAndContinue :: Card -> Game -> IO Game -shedAndContinue card game@(Game plyrs pidx att dir prev stock disc) = do +shedAndContinue card game@(Game plyrs pidx att dir prev stock disc round) = do let player = plyrs !! pidx let player' = player `shed` card let disc' = card:disc @@ -125,11 +130,11 @@ shedAndContinue card game@(Game plyrs pidx att dir prev stock disc) = do Card _ C.Seven -> 1 _ -> att putStrLn $ (P.name player) ++ " plays " ++ (C.showCard card) - return $ Game plyrs' pidx' att' dir' card stock disc' + return $ Game plyrs' pidx' att' dir' card stock disc' round -- | Prompt player to play a card (or draw card and skip turn). prompt :: Game -> IO (Maybe Card) -prompt game@(Game plyrs pidx att _ prev _ _) = do +prompt game@(Game plyrs pidx att _ prev _ _ _) = do let player = plyrs !! pidx let cards = P.cards player cardIdxStr <- getLine @@ -157,20 +162,31 @@ prompt game@(Game plyrs pidx att _ prev _ _) = do -- | Make an automated decision to draw/shed card. automate :: Game -> Maybe Card -automate game@(Game plyrs pidx att _ prev _ _) = +automate game@(Game plyrs pidx att _ prev _ _ _) = if null validCards then Nothing else Just (head validCards) where validCards = filter (C.isValid prev att) $ P.cards (plyrs !! pidx) -- | Keep penalties and reset game for next round. -endRound :: Game -> IO Game -endRound game@(Game plyrs pidx _ _ _ stock disc) = do - putStrLn $ (P.name $ plyrs !! pidx) ++ " wins this round!" - let plyrs' = P.calcPenalties plyrs +endRound :: Setup -> Game -> IO Game +endRound setup@(Setup _ r d _ _) game@(Game plyrs pidx _ _ _ _ _ roundNo) = do + putStrLn $ replicate 80 '#' + putStrLn $ (P.name $ plyrs !! pidx) ++ " wins round " + ++ (show $ roundNo + 1) ++ "!" + let plyrs' = P.clearCards $ P.calcPenalties plyrs putStrLn "Penalties:" putStrLn $ P.showPenalties plyrs' - return $ Game plyrs' pidx 1 1 (head stock) (tail stock) disc + let stock = C.fullDecks d + return Game { players = plyrs' + , playerIdx = pidx + , attack = 1 + , direction = 1 + , prevCard = head stock + , stockPile = tail stock + , discardPile = [] + , round = roundNo + 1 + } wait :: a -> IO a wait x = getLine >> return x diff --git a/Player.hs b/Player.hs index ec4d180..3bec60c 100644 --- a/Player.hs +++ b/Player.hs @@ -36,6 +36,11 @@ showCards (Player _ _ cs) prev att = 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 -- cgit v1.2.3