diff options
Diffstat (limited to 'src/Game.hs')
| -rw-r--r-- | src/Game.hs | 207 |
1 files changed, 207 insertions, 0 deletions
diff --git a/src/Game.hs b/src/Game.hs new file mode 100644 index 0000000..7e553e7 --- /dev/null +++ b/src/Game.hs @@ -0,0 +1,207 @@ +module Game where + +import Prelude hiding (round) +import qualified Data.List as L +import Data.Char (isDigit) +import Data.Function (on) +import Control.Monad (mapM_) +import System.Random (RandomGen, getStdGen, newStdGen) +import Player (Player(..), shed, draw) +import qualified Player as P +import Card (Card(..)) +import qualified Card as C + +data Setup = Setup { playerN :: Int + , roundN :: Int + , deckN :: Int + , cardN :: Int -- ^ cards dealt to each player + , autoMode :: Bool + } + +data Game = Game { players :: [Player] + , playerIdx :: Int + , attack :: Int + , direction :: Int -- ^ 1 when CCW, -1 when CW + , prevCard :: Card + , stockPile :: [Card] + , discardPile :: [Card] + , round :: Int + } + +-- | Set up game. +beginGame :: Setup -> IO Game +beginGame setup@(Setup n r d c a) = do + gen <- getStdGen + let decks = C.shuffle gen $ C.fullDecks d + let stock = drop n decks + pidx <- firstPlayer P.defaultPlayers decks + let game = Game { players = P.defaultPlayers + , playerIdx = pidx + , attack = 1 + , direction = 1 + , prevCard = head stock + , stockPile = tail stock + , discardPile = [] + , round = 0 + } + beginRound setup game + +-- | Determine playerIdx from top `n` cards from `stock`. +firstPlayer :: [Player] -> [Card] -> IO Int +firstPlayer plyrs stock = do + let cards = take (length plyrs) stock + putStrLn "Drawing cards to determine playing order..." + mapM_ (\(Player name _ _, i) -> + putStrLn $ name ++ " draws " ++ C.showCard (cards !! i)) + $ zip plyrs [0..] + let minRank = L.minimumBy (compare `on` C.rank) + let playerIdx = case L.elemIndex (minRank cards) cards of + Just i -> i + Nothing -> 0 -- impossible + putStrLn $ (P.name $ plyrs !! playerIdx) ++ " goes first" + return playerIdx + +-- | Begin round. +beginRound :: Setup -> Game -> IO 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 from stock pile to each player in game. +dealCards :: Int -> Game -> Game +dealCards c game@(Game plyrs _ _ _ _ stock _ _) + | (length $ P.cards $ head plyrs) < c = + dealCards c game { players = newPlyrs, stockPile = newStock } + | otherwise = game + where newPlyrs = giveOneCardEach stock plyrs + newStock = drop c stock + giveOneCardEach = + zipWith (\card player -> player { P.cards = card:(P.cards player) }) + +-- | Let current player take their turn. +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 $ "Stock: " ++ (show $ length stock) + ++ ", Discard: " ++ (show $ length disc) + putStrLn $ "Current attack: " ++ show att + putStrLn $ "Prev card: " ++ C.showCard prev + + decision <- if auto + then return $ automate game + else prompt game + game' <- case decision of + Nothing -> drawAndSkip game + Just card -> shedAndContinue card game + + if playerIdx game' == pidx -- shedAndContinue does this when player wins + 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 round) = do + gen <- newStdGen + let stockLongEnough = if length stock < att + then stock ++ (C.shuffle gen disc) + else stock + let stock' = drop att stockLongEnough + let disc' = if length stock < att + then [] + else disc + let cardsToDraw = take att stockLongEnough + let player = plyrs !! pidx + let player' = player `draw` cardsToDraw + 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' round + +-- | Game state after player sheds card. +shedAndContinue :: Card -> Game -> IO Game +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 + 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 + Card _ C.Seven -> 1 + _ -> att + putStrLn $ (P.name player) ++ " plays " ++ (C.showCard card) + 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 + let player = plyrs !! pidx + let cards = P.cards player + cardIdxStr <- getLine + if any (== False) $ map isDigit cardIdxStr + then do + putStrLn "Please input card #" + prompt game + else do + let cardIdx = read cardIdxStr - 1 + if cardIdx == -1 + then do + return Nothing + else do + if cardIdx < 0 || cardIdx >= length cards + then do + putStrLn "This card does not exist, try again" + prompt game + else do + let card = cards !! cardIdx + if C.isValid prev att card + then return $ Just card + else do + putStrLn "You cannot play this card, try again" + prompt game + +-- | Make an automated decision to draw/shed card. +automate :: Game -> Maybe Card +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 :: 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' + 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 |