module Game where import Data.Char (isDigit) 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] } -- | 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 defaultPlayers = [ Player "Alice" 0 [] , Player "Bob" 0 [] , Player "Carol" 0 [] ] let game = Game { players = defaultPlayers , playerIdx = 0 -- TODO: determine first player , attack = 1 , direction = 1 , prevCard = head decks , stockPile = tail decks , discardPile = [] } 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' -- | Deal c cards to each player in game. dealCards :: Int -> Game -> Game dealCards c game@(Game plyrs _ _ _ _ stock disc) | (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 :: Bool -> Game -> IO Game beginTurn 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 game' else beginTurn auto 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 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' -- | Game state after player sheds card. shedAndContinue :: Card -> Game -> IO Game shedAndContinue card game@(Game plyrs pidx att dir prev 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 Card _ C.Seven -> 1 _ -> att putStrLn $ (P.name player) ++ " plays " ++ (C.showCard card) return $ Game plyrs' pidx' att' dir' card 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 _ 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 :: Game -> IO Game endRound game@(Game plyrs pidx _ _ _ stock disc) = do putStrLn $ (P.name $ plyrs !! pidx) ++ " wins this round!" let plyrs' = P.calcPenalties plyrs putStrLn "Penalties:" putStrLn $ P.showPenalties plyrs' return $ Game plyrs' pidx 1 1 (head stock) (tail stock) disc wait :: a -> IO a wait x = getLine >> return x