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