summaryrefslogtreecommitdiff
path: root/Game.hs
blob: 71c62986466babcaf4b4050629913ca3c58622d0 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
module Game where

import Data.Char (isDigit)
import Control.Monad (when)
import System.Random (RandomGen)
import Player (Player, shed, draw)
import qualified Player as P
import Card (Card)
import qualified Card as C

data Direction = CCW | CW
data Game = Game { players :: [Player]
                 , playerIdx :: Int
                 , attack :: Integer
                 , direction :: Direction
                 , stockPile :: [Card]
                 , discardPile :: [Card]
                 }

-- | Advance game state.
advanceGame :: Game -> IO Game
advanceGame game@(Game plyrs pidx att dir stock disc) = do
    cardToPlay <- prompt game
    let newPidx = (pidx + 1) `mod` (length plyrs)
    advanceGame (Game plyrs newPidx att dir 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 _ _ _) = do
    let player = plyrs !! pidx
    let cards = P.cards player
    putStrLn $ P.name player ++ "'s turn (input 0 to skip turn and draw card)"
    putStrLn $ P.showCards 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 return $ Just (cards !! cardIdx)

-- | 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) })