Package into cabal projectHEADmain

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