Lords of Waterdeep simulation -- initial commit.
This commit is contained in:
commit
8999128947
|
|
@ -0,0 +1,4 @@
|
|||
*.swp
|
||||
*.swo
|
||||
*.hi
|
||||
*.o
|
||||
|
|
@ -0,0 +1 @@
|
|||
Test
|
||||
|
|
@ -0,0 +1,122 @@
|
|||
{-# LANGUAGE GADTs #-}
|
||||
{-# LANGUAGE RankNTypes #-}
|
||||
|
||||
import Waterdeep.Types
|
||||
import Waterdeep.Monad
|
||||
import Waterdeep.Logic
|
||||
import Control.Applicative
|
||||
import Control.Lens
|
||||
import Control.Monad
|
||||
import Control.Monad.Prompt
|
||||
import Control.Monad.State
|
||||
import Data.List
|
||||
import Text.Printf
|
||||
import System.IO
|
||||
import System.Random
|
||||
import System.Random.Shuffle
|
||||
|
||||
import qualified Data.IntMap as IM
|
||||
|
||||
f1 = Faction "Jesters" Blue
|
||||
l1 = Lord "Prince Henry XXX" "" (QuestBonus [Skullduggery, Commerce] 4)
|
||||
p1 = ("Harry", f1, l1)
|
||||
|
||||
f2 = Faction "Pilots" Green
|
||||
l2 = Lord "Princess Anastasia" "" (QuestBonus [Arcana, Warfare] 4)
|
||||
p2 = ("Ned", f2, l2)
|
||||
|
||||
b1 = Building { _buildingCost = 6
|
||||
, _buildingTitle = "Monastary"
|
||||
, _buildingAction = Group [TakeResource [Cleric], TakeResource [Cleric]]
|
||||
, _buildingOwnerAction = TakeResource [Cleric]
|
||||
, _buildingAccumulation = NoAccumulation
|
||||
}
|
||||
|
||||
b2 = Building { _buildingCost = 4
|
||||
, _buildingTitle = "Training Hall"
|
||||
, _buildingAction = Group [TakeResource [Fighter], TakeResource [Fighter]]
|
||||
, _buildingOwnerAction = TakeResource [Fighter]
|
||||
, _buildingAccumulation = NoAccumulation
|
||||
}
|
||||
|
||||
b3 = Building { _buildingCost = 4
|
||||
, _buildingTitle = "Prison Yard"
|
||||
, _buildingAction = Group [TakeResource [Rogue], TakeResource [Rogue]]
|
||||
, _buildingOwnerAction = TakeResource [Rogue]
|
||||
, _buildingAccumulation = NoAccumulation
|
||||
}
|
||||
|
||||
b4 = Building { _buildingCost = 6
|
||||
, _buildingTitle = "Wizard School"
|
||||
, _buildingAction = Group [TakeResource [Wizard], TakeResource [Wizard]]
|
||||
, _buildingOwnerAction = TakeResource [Wizard]
|
||||
, _buildingAccumulation = NoAccumulation
|
||||
}
|
||||
|
||||
b5 = Building { _buildingCost = 4
|
||||
, _buildingTitle = "Gold Mine"
|
||||
, _buildingAction = Group $ replicate 4 $ TakeResource [Gold]
|
||||
, _buildingOwnerAction = Group $ replicate 2 $ TakeResource [Gold]
|
||||
, _buildingAccumulation = NoAccumulation
|
||||
}
|
||||
|
||||
printWaterdeep :: WaterdeepState -> IO ()
|
||||
printWaterdeep w = do
|
||||
let ps = map snd $ w ^. gamePlayers . to IM.toAscList
|
||||
putStrLn ("Players: " ++ intercalate ", " (map (^. playerName) ps))
|
||||
putStrLn ("First Player: " ++
|
||||
(w ^. gamePlayers . singular (ix (w ^. gameFirstPlayer)) . playerName))
|
||||
putStrLn ("Current Round: " ++ show (w ^. gameCurrentRound))
|
||||
putStrLn ("Current Player: " ++
|
||||
(w ^. gamePlayers . singular (ix (w ^. gameCurrentPlayer)) . playerName))
|
||||
putStrLn ""
|
||||
putStrLn "Cliffwatch Inn:"
|
||||
forM_ (w ^. gameCliffwatchInn) $ \q -> do
|
||||
putStrLn (" " ++ (q ^. questTitle))
|
||||
putStrLn ""
|
||||
putStrLn "Builder's Hall:"
|
||||
forM_ (w ^. gameBuildersHall) $ \(b,agents,pts) -> do
|
||||
printf " %s (%d gold -> %d points)\n" (b ^. buildingTitle) (b ^. buildingCost) pts
|
||||
putStrLn ""
|
||||
forM_ ps $ \p -> do
|
||||
putStrLn ((p ^. playerName) ++ "'s State:")
|
||||
putStrLn (" Score: " ++ show (p ^. playerScore))
|
||||
putStrLn (" Tavern: " ++ show (p ^. playerTavern))
|
||||
putStrLn (" Color: " ++ show (p ^. playerFaction . factionColor))
|
||||
putStrLn (" Lord: " ++ (p ^. playerLord . lordName))
|
||||
putStrLn (" Faction: " ++ (p ^. playerFaction . factionName))
|
||||
putStrLn (" Incomplete: " ++ show (p ^. playerIncompleteQuests . to length))
|
||||
putStrLn (" Complete: " ++ show (p ^. playerCompletedQuests . to length))
|
||||
putStrLn (" Intrigues: " ++ show (p ^. playerIntrigueCards . to length))
|
||||
putStrLn (" Agent Pool: " ++ show (p ^. playerAgentsInPool))
|
||||
putStrLn ""
|
||||
|
||||
dummyPrompt :: WaterdeepPrompt a -> IO a
|
||||
dummyPrompt prm@(NotifyState w) = return ()
|
||||
dummyPrompt prm@(SolicitChoice w p t cs) = do
|
||||
let menuSize = length cs
|
||||
let menuLine n t = putStrLn (show n ++ ") " ++ t)
|
||||
let blankLine = putStrLn ""
|
||||
let redo why = putStrLn ("ERROR: " ++ why) >> blankLine >> dummyPrompt prm
|
||||
|
||||
printWaterdeep w
|
||||
|
||||
putStrLn t
|
||||
forM_ (zip [1::Int ..] cs) $ \(i, (c, _)) -> menuLine i c
|
||||
|
||||
putStr (w ^. gamePlayer p . playerName)
|
||||
putStr "> " >> hFlush stdout
|
||||
response <- getLine
|
||||
|
||||
case reads response of
|
||||
(ix,""):_ -> if ix >= 1 && ix <= menuSize
|
||||
then blankLine >> return (snd $ cs !! (ix-1))
|
||||
else redo "Invalid choice."
|
||||
_ -> redo "Expected a number."
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
w <- newGame [p1, p2] [] [] [b1,b2,b3,b4,b5]
|
||||
winners <- fst <$> runWaterdeepM dummyPrompt waterdeepGame w
|
||||
let gamePlayerName n = w ^. gamePlayer n . playerName
|
||||
putStrLn ("Winner(s): " ++ intercalate ", " (toListOf (traverse . to gamePlayerName) winners))
|
||||
|
|
@ -0,0 +1,174 @@
|
|||
{-# LANGUAGE GADTs #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE RankNTypes #-}
|
||||
{-# LANGUAGE NoMonomorphismRestriction #-}
|
||||
|
||||
module Waterdeep.Logic
|
||||
( newGame
|
||||
, waterdeepGame
|
||||
) where
|
||||
|
||||
import Control.Applicative
|
||||
import Control.Lens
|
||||
import Control.Monad
|
||||
import Control.Monad.Random
|
||||
import Control.Monad.State
|
||||
import Data.List
|
||||
import Data.Maybe
|
||||
import System.Random.Shuffle
|
||||
import Waterdeep.Types
|
||||
import Waterdeep.Monad
|
||||
|
||||
import qualified Data.IntMap as IM
|
||||
|
||||
newGame :: (MonadRandom m, MonadSplit StdGen m)
|
||||
=> [(String,Faction,Lord)]
|
||||
-> [Quest]
|
||||
-> [IntrigueCard]
|
||||
-> [Building]
|
||||
-> m WaterdeepState
|
||||
newGame players quests intrigues buildings
|
||||
| length players < 2 || length players > 5 = error "This game requires 2-5 players."
|
||||
| otherwise = do
|
||||
let playerStates = IM.fromList $ flip map (zip [1..] players) $
|
||||
\(i,(n,f,l)) -> (i, newPlayerState i n f l)
|
||||
quests' <- shuffleM quests
|
||||
intrigues' <- shuffleM intrigues
|
||||
buildings' <- shuffleM buildings
|
||||
splitGen <- getSplit
|
||||
return $ snd $ runWaterdeep batchMode setupGame $ WaterdeepState
|
||||
{ _gamePlayers = playerStates
|
||||
, _gameFirstPlayer = 1
|
||||
, _gameCurrentRound = 0
|
||||
, _gameCurrentPlayer = 1
|
||||
, _gameConsecutivePasses = 0
|
||||
, _gameQuestDeck = quests'
|
||||
, _gameQuestDiscard = []
|
||||
, _gameCliffwatchInn = []
|
||||
, _gameIntrigueDeck = intrigues'
|
||||
, _gameIntrigueDiscard = []
|
||||
, _gameBuildingDeck = buildings'
|
||||
, _gameBuildingDiscard = []
|
||||
, _gameBasicBuildings = map (\b -> (b, [])) basicBuildings
|
||||
, _gameBuildersHall = []
|
||||
, _gameAdvancedBuildings = []
|
||||
, _gameWaterdeepHarbor = ([], [], [])
|
||||
, _gameStdGen = splitGen
|
||||
}
|
||||
where
|
||||
batchMode :: WaterdeepPrompt a -> a
|
||||
batchMode (NotifyState _) = ()
|
||||
batchMode (SolicitChoice _ _ _ _) = error "No choices during setup."
|
||||
|
||||
setupGame :: Waterdeep ()
|
||||
setupGame = do
|
||||
restockBuildersHall
|
||||
restockCliffwatchInn
|
||||
let ps = [1 .. length players]
|
||||
forM_ (zip ps [4..]) $ \(p, g) -> do
|
||||
replicateM_ 2 $ performAction p DrawQuest
|
||||
replicateM_ 2 $ performAction p DrawIntrigue
|
||||
replicateM_ g $ performAction p $ TakeResource [Gold]
|
||||
return ()
|
||||
|
||||
newPlayerState :: PlayerID -> String -> Faction -> Lord -> PlayerState
|
||||
newPlayerState i name faction lord =
|
||||
PlayerState
|
||||
{ _playerNumber = i
|
||||
, _playerName = name
|
||||
, _playerFaction = faction
|
||||
, _playerLord = lord
|
||||
, _playerScore = 0
|
||||
, _playerTavern = []
|
||||
, _playerIncompleteQuests = []
|
||||
, _playerCompletedQuests = []
|
||||
, _playerActivePlotQuests = []
|
||||
, _playerUsedPlotQuests = []
|
||||
, _playerIntrigueCards = []
|
||||
, _playerAgentsInPool = 0
|
||||
, _playerHasLieutenant = False
|
||||
, _playerHasAmbassador = False
|
||||
}
|
||||
|
||||
basicBuildings :: [Building]
|
||||
basicBuildings = []
|
||||
|
||||
waterdeepGame :: Waterdeep [PlayerID]
|
||||
waterdeepGame = do
|
||||
forM_ [1..8] $ \round -> do
|
||||
beginRound round
|
||||
void $ solicitChoice 1 "Choose one" [("Option A", ()), ("Option B", ())]
|
||||
notifyState
|
||||
determineWinners
|
||||
|
||||
beginRound :: Int -> Waterdeep ()
|
||||
beginRound round = do
|
||||
gameCurrentRound .= round
|
||||
notifyState
|
||||
return ()
|
||||
|
||||
performAction :: PlayerID -> GameAction -> Waterdeep Bool
|
||||
performAction p a = case a of
|
||||
DrawQuest -> do
|
||||
mq <- drawQuest
|
||||
case mq of
|
||||
Nothing -> return False
|
||||
Just q -> do
|
||||
gamePlayers . singular (ix p) . playerIncompleteQuests %= (++[q])
|
||||
return True
|
||||
_ -> return False
|
||||
|
||||
determineWinners :: Waterdeep [PlayerID]
|
||||
determineWinners = do
|
||||
let compareScores a b = (b^.playerScore) `compare` (a^.playerScore)
|
||||
ps <- sortBy compareScores <$> toListOf traverse <$> use gamePlayers
|
||||
let bestScore = (head ps) ^. playerScore
|
||||
return $ map (^.playerNumber) $ takeWhile (\x -> (x^.playerScore) == bestScore) ps
|
||||
|
||||
shufflePiles :: Lens WaterdeepState WaterdeepState [a] [a]
|
||||
-> Lens WaterdeepState WaterdeepState [a] [a]
|
||||
-> Waterdeep ()
|
||||
shufflePiles deck discard = do
|
||||
xs <- (++) <$> use discard <*> use deck
|
||||
xs' <- shuffleM xs
|
||||
deck .= xs'
|
||||
discard .= []
|
||||
return ()
|
||||
|
||||
shuffleQuests = shufflePiles gameQuestDeck gameQuestDiscard
|
||||
shuffleIntrigues = shufflePiles gameIntrigueDeck gameIntrigueDiscard
|
||||
shuffleBuildings = shufflePiles gameBuildingDeck gameBuildingDiscard
|
||||
|
||||
draw :: Lens WaterdeepState WaterdeepState [a] [a]
|
||||
-> Lens WaterdeepState WaterdeepState [a] [a]
|
||||
-> Waterdeep (Maybe a)
|
||||
draw deck discard = do
|
||||
out <- null <$> use deck
|
||||
when out $ shufflePiles deck discard
|
||||
listToMaybe <$> (deck %%= splitAt 1)
|
||||
|
||||
drawQuest = draw gameQuestDeck gameQuestDiscard
|
||||
drawIntrigue = draw gameIntrigueDeck gameIntrigueDiscard
|
||||
drawBuilding = draw gameBuildingDeck gameBuildingDiscard
|
||||
|
||||
restockCliffwatchInn :: Waterdeep ()
|
||||
restockCliffwatchInn = do
|
||||
num <- length <$> use gameCliffwatchInn
|
||||
when (num < 4) $ do
|
||||
mq <- drawQuest
|
||||
case mq of
|
||||
Nothing -> return ()
|
||||
Just q -> do
|
||||
gameCliffwatchInn %= (++ [q])
|
||||
restockCliffwatchInn
|
||||
|
||||
restockBuildersHall :: Waterdeep ()
|
||||
restockBuildersHall = do
|
||||
num <- length <$> use gameBuildersHall
|
||||
when (num < 3) $ do
|
||||
mb <- drawBuilding
|
||||
case mb of
|
||||
Nothing -> return ()
|
||||
Just b -> do
|
||||
gameBuildersHall %= (++ [(b, [], 0)])
|
||||
restockBuildersHall
|
||||
|
|
@ -0,0 +1,78 @@
|
|||
{-# LANGUAGE GADTs #-}
|
||||
{-# LANGUAGE RankNTypes #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
|
||||
module Waterdeep.Monad
|
||||
( WaterdeepPrompt(..)
|
||||
, Waterdeep
|
||||
, notifyState
|
||||
, solicitChoice
|
||||
, runWaterdeepC
|
||||
, runWaterdeep
|
||||
, runWaterdeepM
|
||||
) where
|
||||
|
||||
import Waterdeep.Types
|
||||
import Control.Lens
|
||||
import Control.Applicative
|
||||
import Control.Monad
|
||||
import Control.Monad.Prompt
|
||||
import Control.Monad.Random
|
||||
import Control.Monad.State
|
||||
import Control.Monad.State.Class
|
||||
import Control.Monad.Trans
|
||||
import Control.Monad.Trans.State (StateT, runStateT)
|
||||
import System.Random as R
|
||||
|
||||
data WaterdeepPrompt a where
|
||||
NotifyState :: WaterdeepState -> WaterdeepPrompt ()
|
||||
SolicitChoice :: WaterdeepState -> PlayerID -> String -> [(String, a)] -> WaterdeepPrompt a
|
||||
|
||||
newtype Waterdeep a = Waterdeep { runWaterdeep' :: StateT WaterdeepState (Prompt WaterdeepPrompt) a }
|
||||
|
||||
instance Functor Waterdeep where
|
||||
fmap f (Waterdeep m) = Waterdeep $ fmap f m
|
||||
|
||||
instance Applicative Waterdeep where
|
||||
pure = Waterdeep . pure
|
||||
(Waterdeep f) <*> (Waterdeep a) = Waterdeep (f <*> a)
|
||||
|
||||
instance Monad Waterdeep where
|
||||
return = Waterdeep . return
|
||||
(Waterdeep m) >>= f = Waterdeep (m >>= runWaterdeep' . f)
|
||||
|
||||
instance MonadState WaterdeepState Waterdeep where
|
||||
state f = Waterdeep $ do
|
||||
s <- get
|
||||
let (a, s') = f s
|
||||
put s'
|
||||
lift $ prompt $ NotifyState s'
|
||||
return a
|
||||
|
||||
instance MonadRandom Waterdeep where
|
||||
getRandom = gameStdGen %%= random
|
||||
getRandomR r = gameStdGen %%= randomR r
|
||||
getRandoms = randoms <$> (gameStdGen %%= R.split)
|
||||
getRandomRs r = randomRs r <$> (gameStdGen %%= R.split)
|
||||
|
||||
instance MonadSplit StdGen Waterdeep where
|
||||
getSplit = gameStdGen %%= R.split
|
||||
|
||||
notifyState :: Waterdeep ()
|
||||
notifyState = get >>= Waterdeep . lift . prompt . NotifyState
|
||||
|
||||
solicitChoice :: PlayerID -> String -> [(String, a)] -> Waterdeep a
|
||||
solicitChoice p t cs = do
|
||||
notifyState
|
||||
w <- get
|
||||
Waterdeep $ lift $ prompt (SolicitChoice w p t cs)
|
||||
|
||||
runWaterdeepC :: ((r, WaterdeepState) -> b) -> (forall a. WaterdeepPrompt a -> (a -> b) -> b) -> Waterdeep r -> WaterdeepState -> b
|
||||
runWaterdeepC r p (Waterdeep m) s = runPromptC r p $ runStateT m s
|
||||
|
||||
runWaterdeep :: (forall a. WaterdeepPrompt a -> a) -> Waterdeep r -> WaterdeepState -> (r, WaterdeepState)
|
||||
runWaterdeep p (Waterdeep m) s = runPrompt p $ runStateT m s
|
||||
|
||||
runWaterdeepM :: (Monad m) => (forall a. WaterdeepPrompt a -> m a) -> Waterdeep r -> WaterdeepState -> m (r, WaterdeepState)
|
||||
runWaterdeepM p (Waterdeep m) s = runPromptM p $ runStateT m s
|
||||
|
|
@ -0,0 +1,249 @@
|
|||
{-# LANGUAGE RankNTypes #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
|
||||
module Waterdeep.Types
|
||||
( PlayerID
|
||||
, Lord(..)
|
||||
, Faction(..)
|
||||
, Building(..)
|
||||
, Quest(..)
|
||||
, IntrigueCard(..)
|
||||
, PlayerState(..)
|
||||
, WaterdeepState(..)
|
||||
, Resource(..)
|
||||
, QuestType(..)
|
||||
, IntrigueType(..)
|
||||
, FactionColor(..)
|
||||
, BonusType(..)
|
||||
, AccumulationType(..)
|
||||
, GameAction(..)
|
||||
, PlotQualifier(..)
|
||||
, PlotCondition(..)
|
||||
, lordName
|
||||
, lordQuote
|
||||
, lordBonus
|
||||
, factionName
|
||||
, factionColor
|
||||
, buildingCost
|
||||
, buildingTitle
|
||||
, buildingAction
|
||||
, buildingOwnerAction
|
||||
, buildingAccumulation
|
||||
, questType
|
||||
, questTitle
|
||||
, questQuote
|
||||
, questAction
|
||||
, questPlotActions
|
||||
, intrigueTitle
|
||||
, intrigueType
|
||||
, intrigueAction
|
||||
, intrigueQuote
|
||||
, playerNumber
|
||||
, playerName
|
||||
, playerFaction
|
||||
, playerLord
|
||||
, playerScore
|
||||
, playerTavern
|
||||
, playerIncompleteQuests
|
||||
, playerCompletedQuests
|
||||
, playerActivePlotQuests
|
||||
, playerUsedPlotQuests
|
||||
, playerIntrigueCards
|
||||
, playerAgentsInPool
|
||||
, playerHasLieutenant
|
||||
, playerHasAmbassador
|
||||
, gamePlayers
|
||||
, gameFirstPlayer
|
||||
, gameCurrentRound
|
||||
, gameCurrentPlayer
|
||||
, gameConsecutivePasses
|
||||
, gameQuestDeck
|
||||
, gameQuestDiscard
|
||||
, gameCliffwatchInn
|
||||
, gameIntrigueDeck
|
||||
, gameIntrigueDiscard
|
||||
, gameBuildingDeck
|
||||
, gameBuildingDiscard
|
||||
, gameBasicBuildings
|
||||
, gameBuildersHall
|
||||
, gameAdvancedBuildings
|
||||
, gameWaterdeepHarbor
|
||||
, gameStdGen
|
||||
, gamePlayer
|
||||
) where
|
||||
|
||||
import Control.Lens
|
||||
import Data.IntMap (IntMap)
|
||||
import System.Random (StdGen)
|
||||
|
||||
type PlayerID = Int
|
||||
|
||||
data Lord =
|
||||
Lord
|
||||
{ _lordName :: String
|
||||
, _lordQuote :: String
|
||||
, _lordBonus :: BonusType
|
||||
} deriving (Show)
|
||||
|
||||
data Faction =
|
||||
Faction
|
||||
{ _factionName :: String
|
||||
, _factionColor :: FactionColor
|
||||
} deriving (Show)
|
||||
|
||||
data Building =
|
||||
Building
|
||||
{ _buildingCost :: Int
|
||||
, _buildingTitle :: String
|
||||
, _buildingAction :: GameAction
|
||||
, _buildingOwnerAction :: GameAction
|
||||
, _buildingAccumulation :: AccumulationType
|
||||
} deriving (Show)
|
||||
|
||||
data Quest =
|
||||
Quest
|
||||
{ _questType :: QuestType
|
||||
, _questTitle :: String
|
||||
, _questQuote :: String
|
||||
, _questAction :: GameAction
|
||||
, _questPlotActions :: [(PlotCondition, GameAction)]
|
||||
} deriving (Show)
|
||||
|
||||
data IntrigueCard =
|
||||
IntrigueCard
|
||||
{ _intrigueTitle :: String
|
||||
, _intrigueType :: IntrigueType
|
||||
, _intrigueAction :: GameAction
|
||||
, _intrigueQuote :: String
|
||||
} deriving (Show)
|
||||
|
||||
data PlayerState =
|
||||
PlayerState
|
||||
{ _playerNumber :: PlayerID
|
||||
, _playerName :: String
|
||||
, _playerFaction :: Faction
|
||||
, _playerLord :: Lord
|
||||
, _playerScore :: Int
|
||||
, _playerTavern :: [(Int,Resource)]
|
||||
, _playerIncompleteQuests :: [Quest]
|
||||
, _playerCompletedQuests :: [Quest]
|
||||
, _playerActivePlotQuests :: [Quest]
|
||||
, _playerUsedPlotQuests :: [Quest]
|
||||
, _playerIntrigueCards :: [IntrigueCard]
|
||||
, _playerAgentsInPool :: Int
|
||||
, _playerHasLieutenant :: Bool
|
||||
, _playerHasAmbassador :: Bool
|
||||
} deriving (Show)
|
||||
|
||||
data WaterdeepState =
|
||||
WaterdeepState
|
||||
{ _gamePlayers :: IntMap PlayerState
|
||||
, _gameFirstPlayer :: PlayerID
|
||||
, _gameCurrentRound :: Int
|
||||
, _gameCurrentPlayer :: PlayerID
|
||||
, _gameConsecutivePasses :: Int
|
||||
, _gameQuestDeck :: [Quest]
|
||||
, _gameQuestDiscard :: [Quest]
|
||||
, _gameCliffwatchInn :: [Quest]
|
||||
, _gameIntrigueDeck :: [IntrigueCard]
|
||||
, _gameIntrigueDiscard :: [IntrigueCard]
|
||||
, _gameBuildingDeck :: [Building]
|
||||
, _gameBuildingDiscard :: [Building]
|
||||
, _gameBasicBuildings :: [(Building, [PlayerID])]
|
||||
, _gameBuildersHall :: [(Building, [PlayerID], Int)]
|
||||
, _gameAdvancedBuildings :: [(Building, [PlayerID], Int, Int)]
|
||||
, _gameWaterdeepHarbor :: ([PlayerID], [PlayerID], [PlayerID])
|
||||
, _gameStdGen :: StdGen
|
||||
} deriving (Show)
|
||||
|
||||
data Resource = Cleric | Fighter | Rogue | Wizard | Gold
|
||||
deriving (Eq,Ord,Enum,Bounded,Show)
|
||||
|
||||
data QuestType = Piety | Warfare | Skullduggery | Arcana | Commerce | Mandatory
|
||||
deriving (Eq,Ord,Enum,Bounded,Show)
|
||||
|
||||
data IntrigueType = Utility | Attack
|
||||
deriving (Eq,Ord,Enum,Bounded,Show)
|
||||
|
||||
data FactionColor = Red | Yellow | Green | Blue | Black
|
||||
deriving (Eq,Ord,Enum,Bounded,Show)
|
||||
|
||||
data BonusType = QuestBonus [QuestType] Int
|
||||
| BuildingBonus Int
|
||||
deriving (Eq,Show)
|
||||
|
||||
data AccumulationType = NoAccumulation
|
||||
| AccumulatePoints Int
|
||||
| AccumulateResource Resource Int
|
||||
deriving (Eq,Show)
|
||||
|
||||
data GameAction = ScorePoints Int
|
||||
| TakeResource [Resource]
|
||||
| ReturnResource [Resource]
|
||||
| GiveResource [Resource]
|
||||
| ChooseQuest
|
||||
| ReplaceQuests
|
||||
| DrawQuest
|
||||
| DrawNamedQuestType
|
||||
| DistributeQuests
|
||||
| ChooseAndCompleteQuest
|
||||
| DiscardUncompletedQuest
|
||||
| BuyBuilding
|
||||
| ChooseFreeBuilding
|
||||
| DrawFreeBuilding
|
||||
| DiscardUnoccupiedBuilding
|
||||
| DrawIntrigue
|
||||
| PlayIntrigue
|
||||
| ReturnAgent
|
||||
| ReturnAgentFromHarbor
|
||||
| AssignAgent
|
||||
| AssignAgentToBuildersHall
|
||||
| AssignAgentToOpponentsSpace
|
||||
| UseOpponentsSpace
|
||||
| GainLieutenant
|
||||
| GainAmbassador
|
||||
| TakeAccumulated
|
||||
| TakeResourceFromOpponent [Resource]
|
||||
| AssignMandatoryQuest Quest
|
||||
| Group [GameAction]
|
||||
| Optional GameAction
|
||||
| ChooseFrom [GameAction]
|
||||
| Transaction [GameAction]
|
||||
| Repeat Int GameAction
|
||||
| IfThenElse GameAction GameAction GameAction
|
||||
| ForEachBuilding GameAction
|
||||
| ForEachControlledBuilding GameAction
|
||||
| OneOpponent GameAction
|
||||
| EachOpponent GameAction
|
||||
| CurrentPlayer GameAction
|
||||
deriving (Show)
|
||||
|
||||
data PlotQualifier = ActionProvides [Resource]
|
||||
| CompletesQuest [QuestType]
|
||||
| PlaysIntrigue
|
||||
| BuysBuilding
|
||||
deriving (Eq,Show)
|
||||
|
||||
data PlotCondition = StartOfRound
|
||||
| OncePerRound
|
||||
| OncePerRoundWhen PlotQualifier
|
||||
| Whenever PlotQualifier
|
||||
deriving (Eq,Show)
|
||||
|
||||
makeLenses ''Lord
|
||||
makeLenses ''Faction
|
||||
makeLenses ''Building
|
||||
makeLenses ''Quest
|
||||
makeLenses ''IntrigueCard
|
||||
makeLenses ''PlayerState
|
||||
makeLenses ''WaterdeepState
|
||||
|
||||
gamePlayer :: PlayerID -> Lens' WaterdeepState PlayerState
|
||||
gamePlayer n = lens (\w -> w ^. gamePlayers.singular (ix n))
|
||||
(\w p -> w & gamePlayers.singular (ix n) .~ p)
|
||||
|
||||
instance Eq Faction where
|
||||
a == b = a^.factionColor == b^.factionColor
|
||||
|
||||
instance Ord Faction where
|
||||
a `compare` b = (a^.factionColor) `compare` (b^.factionColor)
|
||||
Loading…
Reference in New Issue