diff options
Diffstat (limited to 'Game.hs')
| -rw-r--r-- | Game.hs | 211 |
1 files changed, 0 insertions, 211 deletions
diff --git a/Game.hs b/Game.hs deleted file mode 100644 index 2888bbe..0000000 --- a/Game.hs +++ /dev/null @@ -1,211 +0,0 @@ -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 - let defaultPlayers = [ Player "Alice" 0 [] - , Player "Bob" 0 [] - , Player "Carol" 0 [] - ] - pidx <- firstPlayer defaultPlayers decks - let game = Game { players = 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 |