implement the remaining forms of plot quest action
This commit is contained in:
parent
6b9df9680c
commit
e465141017
|
|
@ -44,6 +44,7 @@ module Waterdeep.Actions
|
|||
, restockCliffwatchInn
|
||||
, restockBuildersHall
|
||||
, getOpponents
|
||||
, doPlotAction
|
||||
, mandatoryQuestCard
|
||||
) where
|
||||
|
||||
|
|
@ -53,6 +54,7 @@ import Control.Monad (when, unless, guard, join, replicateM, replicateM_)
|
|||
import Control.Monad.Random
|
||||
import Control.Monad.State (get)
|
||||
import Control.Monad.Trans.Writer
|
||||
import Data.Char
|
||||
import Data.Function
|
||||
import Data.List
|
||||
import Data.Maybe
|
||||
|
|
@ -200,15 +202,17 @@ completeQuest' quest = do
|
|||
guard $ ((quest ^. questCost) `MS.isSubsetOf` tavern)
|
||||
activePlayerState . playerTavern %= (`MS.difference` (quest ^. questCost))
|
||||
name <- use activePlayerName
|
||||
broadcast $ name ++ " completed the " ++ (quest ^. questTitle) ++ " quest."
|
||||
broadcast $ name ++ " completed the \"" ++ (quest^.questTitle) ++ "\" "
|
||||
++ map toLower (show (quest^.questType)) ++ " quest."
|
||||
delimitAction $ do
|
||||
quest ^. questReward
|
||||
forM_ (filter ((==Immediately) . fst) (quest^.questPlotActions)) $ snd
|
||||
forM_ (filter (\(s,c,a) -> c == Immediately) (quest^.questPlotActions)) $ \(s,c,a) -> a
|
||||
if (quest ^. questType == Mandatory)
|
||||
then gameIntrigueDiscard <>= [mandatoryQuestCard quest]
|
||||
else if null (quest ^. questPlotActions)
|
||||
then activePlayerState . playerCompletedQuests <>= [quest]
|
||||
else activePlayerState . playerActivePlotQuests <>= [quest]
|
||||
then activePlayerState . playerCompletedQuests <>= [quest]
|
||||
else activePlayerState . playerPlotQuests <>= [quest]
|
||||
doPlotAction (== CompletesQuest (quest^.questType))
|
||||
|
||||
discardUncompletedQuest :: GameAction
|
||||
discardUncompletedQuest = do
|
||||
|
|
@ -244,6 +248,7 @@ buyBuilding = do
|
|||
gameBuildings %= IM.insert newKey newState
|
||||
broadcast $ name ++ " built the " ++ (b ^. building . buildingTitle) ++ "."
|
||||
scorePoints (b ^. buildingAccumulation)
|
||||
doPlotAction (== BuysBuilding)
|
||||
restockBuildersHall
|
||||
|
||||
chooseFreeBuilding :: GameAction
|
||||
|
|
@ -298,6 +303,7 @@ playIntrigue = do
|
|||
intrigue ^. intrigueAction
|
||||
unless (intrigue ^. intrigueType == MandatoryQuest) $
|
||||
gameIntrigueDiscard <>= [intrigue]
|
||||
doPlotAction (== PlaysIntrigue)
|
||||
return ()
|
||||
|
||||
returnAgent :: GameAction
|
||||
|
|
@ -572,6 +578,19 @@ forEachControlledBuilding m = do
|
|||
where
|
||||
b `isControlledBy` p = b ^. buildingOwner == p
|
||||
|
||||
doPlotAction :: (PlotQualifier -> Bool) -> Waterdeep ()
|
||||
doPlotAction f = do
|
||||
updating (activePlayerState.playerPlotQuests.traverse.questPlotActions.traverse) $ \case
|
||||
(Active, cond@(Whenever qual), action) | f qual -> do
|
||||
filterChoices action
|
||||
return (Active,cond,action)
|
||||
-- TODO: Let player choose when (or if) to use once-per-round actions
|
||||
(Active, cond@(OncePerRoundWhen qual), action) | f qual -> do
|
||||
filterChoices action >>= \case
|
||||
Nothing -> return (Active,cond,action) -- action can't be completed now
|
||||
Just _ -> return (Used,cond,action) -- action is used up for this round
|
||||
x -> return x
|
||||
|
||||
mandatoryQuestCard :: Quest -> IntrigueCard
|
||||
mandatoryQuestCard q =
|
||||
IntrigueCard
|
||||
|
|
|
|||
|
|
@ -11,18 +11,19 @@ module Waterdeep.Logic
|
|||
|
||||
import Control.Applicative
|
||||
import Control.Arrow ((&&&))
|
||||
import Control.Monad
|
||||
import Control.Monad hiding (forM_, mapM_)
|
||||
import Control.Monad.Random
|
||||
import Control.Monad.State
|
||||
import Control.Monad.State hiding (forM_, mapM_)
|
||||
import Control.Monad.Trans.Writer
|
||||
import Data.List
|
||||
import Data.Foldable (toList)
|
||||
import Data.Foldable (toList, foldMap, forM_, mapM_)
|
||||
import Data.Maybe
|
||||
import Data.Monoid
|
||||
import Data.Traversable (traverse)
|
||||
import Data.Traversable (traverse, for, forM, mapM)
|
||||
import Lens.Family2
|
||||
import Lens.Family2.State
|
||||
import Lens.Family2.Stock
|
||||
import Prelude hiding (forM, mapM)
|
||||
import Text.Printf
|
||||
import Waterdeep.Actions
|
||||
import Waterdeep.Buildings (basicBuildings)
|
||||
|
|
@ -77,6 +78,12 @@ newHarborState i = newBuildingState noPlayerID $
|
|||
, _buildingAccumType = NoAccumulation
|
||||
}
|
||||
|
||||
doActionProvided :: ResourceSet -> Waterdeep ()
|
||||
doActionProvided provided = when (not . Set.null $ provided) $ do
|
||||
broadcast $ "Action provided " ++ joinStrings (map show $ toList provided) ++ "."
|
||||
forM_ provided $ \r -> do
|
||||
doPlotAction (== ActionProvides r)
|
||||
|
||||
waterdeepGame :: Waterdeep [PlayerID]
|
||||
waterdeepGame = do
|
||||
np <- use gameNumberOfPlayers
|
||||
|
|
@ -94,16 +101,12 @@ waterdeepGame = do
|
|||
let p = head $ IM.keys ambassadorIM
|
||||
withActivePlayer p $ do
|
||||
provided <- snd <$> delimitAction assignAmbassador
|
||||
when (not . Set.null $ provided) $
|
||||
broadcast $ "Action provided " ++ joinStrings (map show $ toList provided) ++ "."
|
||||
-- TODO: Plot quests based on provided resources
|
||||
doActionProvided provided
|
||||
fix $ \loop -> do
|
||||
assign gameActivePlayer =<< use gameCurrentPlayer
|
||||
filterChoices (delimitAction assignAgent) >>= \case
|
||||
Just (_, provided) -> do
|
||||
when (not . Set.null $ provided) $
|
||||
broadcast $ "Action provided " ++ joinStrings (map show $ toList provided) ++ "."
|
||||
-- TODO: Plot quests based on provided resources
|
||||
doActionProvided provided
|
||||
filterChoices $ join $ solicitChoice "Complete a quest?" $
|
||||
[ ("Yes", completeQuest)
|
||||
, ("No", return ())
|
||||
|
|
@ -139,18 +142,17 @@ beginRound round = do
|
|||
np <- use gameNumberOfPlayers
|
||||
let agents = initialAgents np round
|
||||
forM_ [1..np] $ \p -> withActivePlayer p $ do
|
||||
qs <- use $ activePlayerState . playerUsedPlotQuests
|
||||
activePlayerState . playerUsedPlotQuests .= []
|
||||
activePlayerState . playerActivePlotQuests <>= qs
|
||||
activePlayerState . playerAgentsInPool .= agents
|
||||
activePlayerState . playerPlotQuests . traverse
|
||||
. questPlotActions . traverse . plotActionState .= Active
|
||||
activePlayerState . playerAgentsInPool .= agents
|
||||
use (activePlayerState . playerHasLieutenant) >>= \case
|
||||
True -> activePlayerState . playerAgentsInPool += 1 >> return ()
|
||||
False -> return ()
|
||||
forM_ [1..np] $ \p -> withActivePlayer p $ do
|
||||
qs <- use $ activePlayerState . playerActivePlotQuests
|
||||
forM_ qs $ \q -> do
|
||||
forM_ (q^.questPlotActions) $ \(condition, action) -> do
|
||||
when (condition == StartOfRound) action
|
||||
updating (activePlayerState.playerPlotQuests.traverse.questPlotActions.traverse) $ \(s,c,a) -> do
|
||||
case c of
|
||||
StartOfRound -> a >> return (Used,c,a)
|
||||
_ -> return (s,c,a)
|
||||
|
||||
scoreFinalPoints :: Waterdeep ()
|
||||
scoreFinalPoints = do
|
||||
|
|
@ -166,8 +168,7 @@ scoreFinalPoints = do
|
|||
QuestBonus types pts -> do
|
||||
quests <- concat <$> sequence
|
||||
[ use $ activePlayerState . playerCompletedQuests
|
||||
, use $ activePlayerState . playerActivePlotQuests
|
||||
, use $ activePlayerState . playerUsedPlotQuests
|
||||
, use $ activePlayerState . playerPlotQuests
|
||||
]
|
||||
let matches = length . filter ((`elem` types) . (view questType)) $ quests
|
||||
activePlayerState . playerScore += matches * pts
|
||||
|
|
|
|||
|
|
@ -37,7 +37,7 @@ defaultQuestDeck =
|
|||
, _questReward = do
|
||||
takeResources 1 [Cleric,Fighter,Rogue,Wizard]
|
||||
, _questPlotActions =
|
||||
[(StartOfRound, takeResources 1 [Cleric,Fighter,Rogue,Wizard])]
|
||||
[(Active, StartOfRound, takeResources 1 [Cleric,Fighter,Rogue,Wizard])]
|
||||
}
|
||||
, Quest { _questType = Piety
|
||||
, _questTitle = "Protect the House of Wonder"
|
||||
|
|
@ -46,7 +46,7 @@ defaultQuestDeck =
|
|||
, _questReward = do
|
||||
scorePoints 8
|
||||
, _questPlotActions =
|
||||
[(Whenever (CompletesQuest [Piety]), scorePoints 2)]
|
||||
[(Active, Whenever (CompletesQuest Piety), scorePoints 2)]
|
||||
}
|
||||
, Quest { _questType = Piety
|
||||
, _questTitle = "Produce a Miracle for the Masses"
|
||||
|
|
@ -55,7 +55,8 @@ defaultQuestDeck =
|
|||
, _questReward = do
|
||||
scorePoints 5
|
||||
, _questPlotActions =
|
||||
[( OncePerRoundWhen (ActionProvides [Cleric])
|
||||
[( Active
|
||||
, OncePerRoundWhen (ActionProvides Cleric)
|
||||
, do { returnResources 1 [Fighter, Rogue, Wizard]
|
||||
; takeResources 1 [Cleric]
|
||||
})]
|
||||
|
|
@ -164,7 +165,7 @@ defaultQuestDeck =
|
|||
, _questReward = do
|
||||
noAction
|
||||
, _questPlotActions =
|
||||
[(Immediately, gainLieutenant)]
|
||||
[(Active, Immediately, gainLieutenant)]
|
||||
}
|
||||
, Quest { _questType = Warfare
|
||||
, _questTitle = "Train Bladesingers"
|
||||
|
|
@ -192,8 +193,7 @@ defaultQuestDeck =
|
|||
, _questReward = do
|
||||
scorePoints 6
|
||||
, _questPlotActions =
|
||||
[(Whenever (ActionProvides [Fighter])
|
||||
, takeResources 1 [Fighter])]
|
||||
[(Active, Whenever (ActionProvides Fighter), takeResources 1 [Fighter])]
|
||||
}
|
||||
, Quest { _questType = Warfare
|
||||
, _questTitle = "Deliver an Ultimatum"
|
||||
|
|
@ -221,7 +221,7 @@ defaultQuestDeck =
|
|||
scorePoints 8
|
||||
takeResources 4 [Gold]
|
||||
, _questPlotActions =
|
||||
[(Whenever (CompletesQuest [Warfare]), scorePoints 2)]
|
||||
[(Active, Whenever (CompletesQuest Warfare), scorePoints 2)]
|
||||
}
|
||||
, Quest { _questType = Warfare
|
||||
, _questTitle = "Confront the Xanathar"
|
||||
|
|
@ -248,7 +248,7 @@ defaultQuestDeck =
|
|||
, _questReward = do
|
||||
noAction
|
||||
, _questPlotActions =
|
||||
[(Whenever PlaysIntrigue, scorePoints 2)]
|
||||
[(Active, Whenever PlaysIntrigue, scorePoints 2)]
|
||||
}
|
||||
, Quest { _questType = Skullduggery
|
||||
, _questTitle = "Establish Shadow Thieves' Guild"
|
||||
|
|
@ -274,7 +274,7 @@ defaultQuestDeck =
|
|||
, _questReward = do
|
||||
scorePoints 6
|
||||
, _questPlotActions =
|
||||
[(Whenever (ActionProvides [Rogue]), takeResources 2 [Gold])]
|
||||
[(Active, Whenever (ActionProvides Rogue), takeResources 2 [Gold])]
|
||||
}
|
||||
, Quest { _questType = Skullduggery
|
||||
, _questTitle = "Raid on Undermountain"
|
||||
|
|
@ -350,7 +350,7 @@ defaultQuestDeck =
|
|||
, _questReward = do
|
||||
scorePoints 8
|
||||
, _questPlotActions =
|
||||
[(Whenever (CompletesQuest [Skullduggery]), scorePoints 2)]
|
||||
[(Active, Whenever (CompletesQuest Skullduggery), scorePoints 2)]
|
||||
}
|
||||
, Quest { _questType = Arcana
|
||||
, _questTitle = "Expose Red Wizards' Spies"
|
||||
|
|
@ -407,7 +407,7 @@ defaultQuestDeck =
|
|||
scorePoints 6
|
||||
enableAssignOnceToOpponentsSpace
|
||||
, _questPlotActions =
|
||||
[(StartOfRound, enableAssignOnceToOpponentsSpace)]
|
||||
[(Active, StartOfRound, enableAssignOnceToOpponentsSpace)]
|
||||
}
|
||||
, Quest { _questType = Arcana
|
||||
, _questTitle = "Study the Illusk Arch"
|
||||
|
|
@ -416,7 +416,7 @@ defaultQuestDeck =
|
|||
, _questReward = do
|
||||
scorePoints 8
|
||||
, _questPlotActions =
|
||||
[(Whenever (CompletesQuest [Arcana]), scorePoints 2)]
|
||||
[(Active, Whenever (CompletesQuest Arcana), scorePoints 2)]
|
||||
}
|
||||
, Quest { _questType = Arcana
|
||||
, _questTitle = "Explore Ahghairon's Tower"
|
||||
|
|
@ -425,7 +425,7 @@ defaultQuestDeck =
|
|||
, _questReward = do
|
||||
scorePoints 6
|
||||
, _questPlotActions =
|
||||
[(Whenever (ActionProvides [Wizard]), drawIntrigue)]
|
||||
[(Active, Whenever (ActionProvides Wizard), drawIntrigue)]
|
||||
}
|
||||
, Quest { _questType = Arcana
|
||||
, _questTitle = "Infiltrate Halaster's Circle"
|
||||
|
|
@ -471,7 +471,7 @@ defaultQuestDeck =
|
|||
, _questReward = do
|
||||
scorePoints 6
|
||||
, _questPlotActions =
|
||||
[(Whenever BuysBuilding, scorePoints 4)]
|
||||
[(Active, Whenever BuysBuilding, scorePoints 4)]
|
||||
}
|
||||
, Quest { _questType = Commerce
|
||||
, _questTitle = "Loot the Crypt of Chauntea"
|
||||
|
|
@ -518,7 +518,7 @@ defaultQuestDeck =
|
|||
, _questReward = do
|
||||
scorePoints 10
|
||||
, _questPlotActions =
|
||||
[(Whenever (ActionProvides [Gold]), takeResources 1 [Rogue])]
|
||||
[(Active, Whenever (ActionProvides Gold), takeResources 1 [Rogue])]
|
||||
}
|
||||
, Quest { _questType = Commerce
|
||||
, _questTitle = "Lure Artisans of Mirabar"
|
||||
|
|
@ -545,7 +545,7 @@ defaultQuestDeck =
|
|||
, _questReward = do
|
||||
scorePoints 8
|
||||
, _questPlotActions =
|
||||
[(Whenever (CompletesQuest [Commerce]), scorePoints 2)]
|
||||
[(Active, Whenever (CompletesQuest Commerce), scorePoints 2)]
|
||||
}
|
||||
, Quest { _questType = Commerce
|
||||
, _questTitle = "Send Aid to the Harpers"
|
||||
|
|
|
|||
|
|
@ -4,6 +4,7 @@
|
|||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
{-# LANGUAGE RankNTypes #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE TupleSections #-}
|
||||
|
||||
module Waterdeep.Types
|
||||
( AccumulationType(..)
|
||||
|
|
@ -18,6 +19,7 @@ module Waterdeep.Types
|
|||
, Lord(..)
|
||||
, PlayerID
|
||||
, PlayerState(..)
|
||||
, PlotState(..)
|
||||
, PlotCondition(..)
|
||||
, PlotQualifier(..)
|
||||
, Quest(..)
|
||||
|
|
@ -55,8 +57,7 @@ module Waterdeep.Types
|
|||
, playerTavern
|
||||
, playerIncompleteQuests
|
||||
, playerCompletedQuests
|
||||
, playerActivePlotQuests
|
||||
, playerUsedPlotQuests
|
||||
, playerPlotQuests
|
||||
, playerIntrigueCards
|
||||
, playerAgentsInPool
|
||||
, playerHasLieutenant
|
||||
|
|
@ -84,6 +85,9 @@ module Waterdeep.Types
|
|||
, gameBuildings
|
||||
, gameWaterdeepHarbor
|
||||
, gameStdGen
|
||||
, plotActionState
|
||||
, plotCondition
|
||||
, plotAction
|
||||
, gamePlayerState
|
||||
, gamePlayerName
|
||||
, activePlayerState
|
||||
|
|
@ -162,9 +166,9 @@ data Quest =
|
|||
{ _questType :: QuestType
|
||||
, _questTitle :: String
|
||||
, _questQuote :: String
|
||||
, _questCost :: MS.MultiSet Resource
|
||||
, _questCost :: ResourceBag
|
||||
, _questReward :: GameAction
|
||||
, _questPlotActions :: [(PlotCondition, GameAction)]
|
||||
, _questPlotActions :: [(PlotState, PlotCondition, GameAction)]
|
||||
}
|
||||
|
||||
data IntrigueCard =
|
||||
|
|
@ -182,11 +186,10 @@ data PlayerState =
|
|||
, _playerFaction :: Faction
|
||||
, _playerLord :: Lord
|
||||
, _playerScore :: Int
|
||||
, _playerTavern :: MS.MultiSet Resource
|
||||
, _playerTavern :: ResourceBag
|
||||
, _playerIncompleteQuests :: [Quest]
|
||||
, _playerCompletedQuests :: [Quest]
|
||||
, _playerActivePlotQuests :: [Quest]
|
||||
, _playerUsedPlotQuests :: [Quest]
|
||||
, _playerPlotQuests :: [Quest]
|
||||
, _playerIntrigueCards :: [IntrigueCard]
|
||||
, _playerAgentsInPool :: Int
|
||||
, _playerHasLieutenant :: Bool
|
||||
|
|
@ -228,6 +231,9 @@ data WaterdeepState =
|
|||
data Resource = Cleric | Fighter | Rogue | Wizard | Gold
|
||||
deriving (Eq,Ord,Enum,Bounded,Show)
|
||||
|
||||
type ResourceSet = Set.Set Resource
|
||||
type ResourceBag = MS.MultiSet Resource
|
||||
|
||||
data QuestType = Piety | Warfare | Skullduggery | Arcana | Commerce | Mandatory
|
||||
deriving (Eq,Ord,Enum,Bounded,Show)
|
||||
|
||||
|
|
@ -246,8 +252,10 @@ data AccumulationType = NoAccumulation
|
|||
| AccumulateResource Resource Int
|
||||
deriving (Eq,Show)
|
||||
|
||||
data PlotQualifier = ActionProvides [Resource]
|
||||
| CompletesQuest [QuestType]
|
||||
data PlotState = Active | Used deriving (Eq,Show)
|
||||
|
||||
data PlotQualifier = ActionProvides Resource
|
||||
| CompletesQuest QuestType
|
||||
| PlaysIntrigue
|
||||
| BuysBuilding
|
||||
deriving (Eq,Show)
|
||||
|
|
@ -263,8 +271,6 @@ data WaterdeepPrompt a where
|
|||
Broadcast :: String -> WaterdeepPrompt ()
|
||||
SolicitChoice :: PlayerID -> String -> [(String, a)] -> WaterdeepPrompt a
|
||||
|
||||
type ResourceSet = Set.Set Resource
|
||||
|
||||
data Waterdeep a =
|
||||
Waterdeep { unWaterdeep :: WriterT ResourceSet
|
||||
(StateT WaterdeepState
|
||||
|
|
@ -322,6 +328,15 @@ instance MonadRandom Waterdeep where
|
|||
instance MonadSplit StdGen Waterdeep where
|
||||
getSplit = gameStdGen %%= R.split
|
||||
|
||||
plotActionState :: Lens' (PlotState, PlotCondition, GameAction) PlotState
|
||||
plotActionState f (s,c,a) = fmap (,c,a) $ f s
|
||||
|
||||
plotCondition :: Lens' (PlotState, PlotCondition, GameAction) PlotCondition
|
||||
plotCondition f (s,c,a) = fmap (s,,a) $ f c
|
||||
|
||||
plotAction :: Lens' (PlotState, PlotCondition, GameAction) GameAction
|
||||
plotAction f (s,c,a) = fmap (s,c,) $ f a
|
||||
|
||||
gamePlayerState :: PlayerID -> Lens' WaterdeepState PlayerState
|
||||
gamePlayerState n = lens
|
||||
(\w -> w ^. gamePlayerStates . intAt n . to fromJust)
|
||||
|
|
@ -363,8 +378,7 @@ newPlayerState i (name, faction, lord) =
|
|||
, _playerTavern = mempty
|
||||
, _playerIncompleteQuests = []
|
||||
, _playerCompletedQuests = []
|
||||
, _playerActivePlotQuests = []
|
||||
, _playerUsedPlotQuests = []
|
||||
, _playerPlotQuests = []
|
||||
, _playerIntrigueCards = []
|
||||
, _playerAgentsInPool = 0
|
||||
, _playerHasLieutenant = False
|
||||
|
|
|
|||
|
|
@ -10,13 +10,16 @@ module Waterdeep.Util
|
|||
, mif
|
||||
, joinStrings
|
||||
, (<$$>)
|
||||
, updating
|
||||
) where
|
||||
|
||||
import Control.Applicative
|
||||
import Control.Monad.State
|
||||
import Data.List
|
||||
import Data.Maybe
|
||||
import Data.Monoid
|
||||
import Lens.Family2
|
||||
import Lens.Family2.State
|
||||
|
||||
deleteAt :: Int -> [a] -> [a]
|
||||
deleteAt n l = left ++ drop 1 right
|
||||
|
|
@ -57,3 +60,6 @@ joinStrings (x:xs) = x ++ ", " ++ joinStrings xs
|
|||
(<$$>) :: Applicative f => (a -> b) -> f a -> f b
|
||||
(<$$>) = (<$>)
|
||||
infixr 0 <$$>
|
||||
|
||||
updating :: (Functor m, MonadState a m) => LensLike m a a b b -> (b -> m b) -> m ()
|
||||
updating l f = put =<< l f =<< get
|
||||
|
|
|
|||
|
|
@ -23,7 +23,8 @@ executable waterdeep
|
|||
MultiWayIf,
|
||||
NoMonomorphismRestriction,
|
||||
RankNTypes,
|
||||
TemplateHaskell
|
||||
TemplateHaskell,
|
||||
TupleSections
|
||||
build-depends: base >=4.6 && <4.7,
|
||||
MonadPrompt >=1.0 && <1.1,
|
||||
MonadRandom >=0.1 && <0.2,
|
||||
|
|
|
|||
Loading…
Reference in New Issue