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
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
|
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
|
