blob: 871d188735c6ca1050ddeea2d3e26a64aa366137 (
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
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
|
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 Game = Game { players :: [Player]
, playerIdx :: Int
, attack :: Int
, direction :: Int -- ^ 1 when CCW, -1 when CW
, stockPile :: [Card]
, discardPile :: [Card]
}
-- | Begin new round of game.
beginRounds :: Int -> Game -> IO Game
beginRounds n game = do
if n == 0
then return game
else do
game' <- beginTurn game
beginRounds (n - 1) game'
-- | Let current player take their turn.
beginTurn :: Game -> IO Game
beginTurn game@(Game plyrs pidx att dir stock disc) = do
putStrLn $ replicate 80 '-'
putStrLn $ "Current attack: " ++ show att
decision <- prompt game
let player = plyrs !! pidx
game'@(Game _ pidx' _ _ _ _)
<- case decision of
Nothing -> drawAndSkip game
Just card -> shedAndContinue card game
if pidx' == pidx -- shedAndContinue does this when player wins
then return game'
else beginTurn game'
-- | Game state after player draws card(s) and skips turn.
drawAndSkip :: Game -> IO Game
drawAndSkip game@(Game plyrs pidx att dir stock disc) = do
let player = plyrs !! pidx
let player' = player `draw` (take att stock)
let plyrs' = P.update plyrs pidx player'
let pidx' = (pidx + dir) `mod` length plyrs
let stock' = drop att stock
putStrLn $ (P.name player) ++ " draws " ++ (C.showCards $ take att stock)
return $ Game plyrs' pidx' 1 dir stock' disc
-- | Game state after player sheds card.
shedAndContinue :: Card -> Game -> IO Game
shedAndContinue card game@(Game plyrs pidx att dir 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
_ -> 1
putStrLn $ (P.name player) ++ " plays " ++ (C.showCard card)
return $ Game plyrs' pidx' 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) })
|
