nybble
/
waterdeep
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

implement the remaining forms of plot quest action

This commit is contained in:
Jesse D. McDonald 2014-09-01 18:12:43 -05:00
parent 6b9df9680c
commit e465141017
7 changed files with 99 additions and 58 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
src/Waterdeep/Actions.hs
View File

@ -44,6 +44,7 @@ module Waterdeep.Actions
, restockCliffwatchInn , restockCliffwatchInn
, restockBuildersHall , restockBuildersHall
, getOpponents , getOpponents
, doPlotAction
, mandatoryQuestCard , mandatoryQuestCard
) where ) where
@ -53,6 +54,7 @@ import Control.Monad (when, unless, guard, join, replicateM, replicateM_)
import Control.Monad.Random import Control.Monad.Random
import Control.Monad.State (get) import Control.Monad.State (get)
import Control.Monad.Trans.Writer import Control.Monad.Trans.Writer
import Data.Char
import Data.Function import Data.Function
import Data.List import Data.List
import Data.Maybe import Data.Maybe
@ -200,15 +202,17 @@ completeQuest' quest = do
guard $ ((quest ^. questCost) `MS.isSubsetOf` tavern) guard $ ((quest ^. questCost) `MS.isSubsetOf` tavern)
activePlayerState . playerTavern %= (`MS.difference` (quest ^. questCost)) activePlayerState . playerTavern %= (`MS.difference` (quest ^. questCost))
name <- use activePlayerName name <- use activePlayerName
broadcast $ name ++ " completed the " ++ (quest ^. questTitle) ++ " quest." broadcast $ name ++ " completed the \"" ++ (quest^.questTitle) ++ "\" "
++ map toLower (show (quest^.questType)) ++ " quest."
delimitAction $ do delimitAction $ do
quest ^. questReward 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) if (quest ^. questType == Mandatory)
then gameIntrigueDiscard <>= [mandatoryQuestCard quest] then gameIntrigueDiscard <>= [mandatoryQuestCard quest]
else if null (quest ^. questPlotActions) else if null (quest ^. questPlotActions)
then activePlayerState . playerCompletedQuests <>= [quest] then activePlayerState . playerCompletedQuests <>= [quest]
else activePlayerState . playerActivePlotQuests <>= [quest] else activePlayerState . playerPlotQuests <>= [quest]
doPlotAction (== CompletesQuest (quest^.questType))
discardUncompletedQuest :: GameAction discardUncompletedQuest :: GameAction
discardUncompletedQuest = do discardUncompletedQuest = do
@ -244,6 +248,7 @@ buyBuilding = do
gameBuildings %= IM.insert newKey newState gameBuildings %= IM.insert newKey newState
broadcast $ name ++ " built the " ++ (b ^. building . buildingTitle) ++ "." broadcast $ name ++ " built the " ++ (b ^. building . buildingTitle) ++ "."
scorePoints (b ^. buildingAccumulation) scorePoints (b ^. buildingAccumulation)
doPlotAction (== BuysBuilding)
restockBuildersHall restockBuildersHall
chooseFreeBuilding :: GameAction chooseFreeBuilding :: GameAction
@ -298,6 +303,7 @@ playIntrigue = do
intrigue ^. intrigueAction intrigue ^. intrigueAction
unless (intrigue ^. intrigueType == MandatoryQuest) $ unless (intrigue ^. intrigueType == MandatoryQuest) $
gameIntrigueDiscard <>= [intrigue] gameIntrigueDiscard <>= [intrigue]
doPlotAction (== PlaysIntrigue)
return () return ()
returnAgent :: GameAction returnAgent :: GameAction
@ -572,6 +578,19 @@ forEachControlledBuilding m = do
where where
b `isControlledBy` p = b ^. buildingOwner == p 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 :: Quest -> IntrigueCard
mandatoryQuestCard q = mandatoryQuestCard q =
IntrigueCard IntrigueCard

2
src/Waterdeep/Intrigues.hs
View File

@ -137,7 +137,7 @@ defaultIntrigueDeck = concat $ map (uncurry replicate) $
, (1, IntrigueCard { _intrigueTitle = "Change of Plans" , (1, IntrigueCard { _intrigueTitle = "Change of Plans"
, _intrigueType = Utility , _intrigueType = Utility
, _intrigueAction = do , _intrigueAction = do
discardUncompletedQuest discardUncompletedQuest
scorePoints 6 scorePoints 6
forEachOpponent $ do forEachOpponent $ do
join . solicitChoice "Discard uncompleted quest for 3 points?" $ join . solicitChoice "Discard uncompleted quest for 3 points?" $

41
src/Waterdeep/Logic.hs
View File

@ -11,18 +11,19 @@ module Waterdeep.Logic
import Control.Applicative import Control.Applicative
import Control.Arrow ((&&&)) import Control.Arrow ((&&&))
import Control.Monad import Control.Monad hiding (forM_, mapM_)
import Control.Monad.Random import Control.Monad.Random
import Control.Monad.State import Control.Monad.State hiding (forM_, mapM_)
import Control.Monad.Trans.Writer import Control.Monad.Trans.Writer
import Data.List import Data.List
import Data.Foldable (toList) import Data.Foldable (toList, foldMap, forM_, mapM_)
import Data.Maybe import Data.Maybe
import Data.Monoid import Data.Monoid
import Data.Traversable (traverse) import Data.Traversable (traverse, for, forM, mapM)
import Lens.Family2 import Lens.Family2
import Lens.Family2.State import Lens.Family2.State
import Lens.Family2.Stock import Lens.Family2.Stock
import Prelude hiding (forM, mapM)
import Text.Printf import Text.Printf
import Waterdeep.Actions import Waterdeep.Actions
import Waterdeep.Buildings (basicBuildings) import Waterdeep.Buildings (basicBuildings)
@ -77,6 +78,12 @@ newHarborState i = newBuildingState noPlayerID $
, _buildingAccumType = NoAccumulation , _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 :: Waterdeep [PlayerID]
waterdeepGame = do waterdeepGame = do
np <- use gameNumberOfPlayers np <- use gameNumberOfPlayers
@ -94,16 +101,12 @@ waterdeepGame = do
let p = head $ IM.keys ambassadorIM let p = head $ IM.keys ambassadorIM
withActivePlayer p $ do withActivePlayer p $ do
provided <- snd <$> delimitAction assignAmbassador provided <- snd <$> delimitAction assignAmbassador
when (not . Set.null $ provided) $ doActionProvided provided
broadcast $ "Action provided " ++ joinStrings (map show $ toList provided) ++ "."
-- TODO: Plot quests based on provided resources
fix $ \loop -> do fix $ \loop -> do
assign gameActivePlayer =<< use gameCurrentPlayer assign gameActivePlayer =<< use gameCurrentPlayer
filterChoices (delimitAction assignAgent) >>= \case filterChoices (delimitAction assignAgent) >>= \case
Just (_, provided) -> do Just (_, provided) -> do
when (not . Set.null $ provided) $ doActionProvided provided
broadcast $ "Action provided " ++ joinStrings (map show $ toList provided) ++ "."
-- TODO: Plot quests based on provided resources
filterChoices $ join $ solicitChoice "Complete a quest?" $ filterChoices $ join $ solicitChoice "Complete a quest?" $
[ ("Yes", completeQuest) [ ("Yes", completeQuest)
, ("No", return ()) , ("No", return ())
@ -139,18 +142,17 @@ beginRound round = do
np <- use gameNumberOfPlayers np <- use gameNumberOfPlayers
let agents = initialAgents np round let agents = initialAgents np round
forM_ [1..np] $ \p -> withActivePlayer p $ do forM_ [1..np] $ \p -> withActivePlayer p $ do
qs <- use $ activePlayerState . playerUsedPlotQuests activePlayerState . playerPlotQuests . traverse
activePlayerState . playerUsedPlotQuests .= [] . questPlotActions . traverse . plotActionState .= Active
activePlayerState . playerActivePlotQuests <>= qs activePlayerState . playerAgentsInPool .= agents
activePlayerState . playerAgentsInPool .= agents
use (activePlayerState . playerHasLieutenant) >>= \case use (activePlayerState . playerHasLieutenant) >>= \case
True -> activePlayerState . playerAgentsInPool += 1 >> return () True -> activePlayerState . playerAgentsInPool += 1 >> return ()
False -> return () False -> return ()
forM_ [1..np] $ \p -> withActivePlayer p $ do forM_ [1..np] $ \p -> withActivePlayer p $ do
qs <- use $ activePlayerState . playerActivePlotQuests updating (activePlayerState.playerPlotQuests.traverse.questPlotActions.traverse) $ \(s,c,a) -> do
forM_ qs $ \q -> do case c of
forM_ (q^.questPlotActions) $ \(condition, action) -> do StartOfRound -> a >> return (Used,c,a)
when (condition == StartOfRound) action _ -> return (s,c,a)
scoreFinalPoints :: Waterdeep () scoreFinalPoints :: Waterdeep ()
scoreFinalPoints = do scoreFinalPoints = do
@ -166,8 +168,7 @@ scoreFinalPoints = do
QuestBonus types pts -> do QuestBonus types pts -> do
quests <- concat <$> sequence quests <- concat <$> sequence
[ use $ activePlayerState . playerCompletedQuests [ use $ activePlayerState . playerCompletedQuests
, use $ activePlayerState . playerActivePlotQuests , use $ activePlayerState . playerPlotQuests
, use $ activePlayerState . playerUsedPlotQuests
] ]
let matches = length . filter ((`elem` types) . (view questType)) $ quests let matches = length . filter ((`elem` types) . (view questType)) $ quests
activePlayerState . playerScore += matches * pts activePlayerState . playerScore += matches * pts

32
src/Waterdeep/Quests.hs
View File

@ -37,7 +37,7 @@ defaultQuestDeck =
, _questReward = do , _questReward = do
takeResources 1 [Cleric,Fighter,Rogue,Wizard] takeResources 1 [Cleric,Fighter,Rogue,Wizard]
, _questPlotActions = , _questPlotActions =
[(StartOfRound, takeResources 1 [Cleric,Fighter,Rogue,Wizard])] [(Active, StartOfRound, takeResources 1 [Cleric,Fighter,Rogue,Wizard])]
} }
, Quest { _questType = Piety , Quest { _questType = Piety
, _questTitle = "Protect the House of Wonder" , _questTitle = "Protect the House of Wonder"
@ -46,7 +46,7 @@ defaultQuestDeck =
, _questReward = do , _questReward = do
scorePoints 8 scorePoints 8
, _questPlotActions = , _questPlotActions =
[(Whenever (CompletesQuest [Piety]), scorePoints 2)] [(Active, Whenever (CompletesQuest Piety), scorePoints 2)]
} }
, Quest { _questType = Piety , Quest { _questType = Piety
, _questTitle = "Produce a Miracle for the Masses" , _questTitle = "Produce a Miracle for the Masses"
@ -55,7 +55,8 @@ defaultQuestDeck =
, _questReward = do , _questReward = do
scorePoints 5 scorePoints 5
, _questPlotActions = , _questPlotActions =
[( OncePerRoundWhen (ActionProvides [Cleric]) [( Active
, OncePerRoundWhen (ActionProvides Cleric)
, do { returnResources 1 [Fighter, Rogue, Wizard] , do { returnResources 1 [Fighter, Rogue, Wizard]
; takeResources 1 [Cleric] ; takeResources 1 [Cleric]
})] })]
@ -164,7 +165,7 @@ defaultQuestDeck =
, _questReward = do , _questReward = do
noAction noAction
, _questPlotActions = , _questPlotActions =
[(Immediately, gainLieutenant)] [(Active, Immediately, gainLieutenant)]
} }
, Quest { _questType = Warfare , Quest { _questType = Warfare
, _questTitle = "Train Bladesingers" , _questTitle = "Train Bladesingers"
@ -192,8 +193,7 @@ defaultQuestDeck =
, _questReward = do , _questReward = do
scorePoints 6 scorePoints 6
, _questPlotActions = , _questPlotActions =
[(Whenever (ActionProvides [Fighter]) [(Active, Whenever (ActionProvides Fighter), takeResources 1 [Fighter])]
, takeResources 1 [Fighter])]
} }
, Quest { _questType = Warfare , Quest { _questType = Warfare
, _questTitle = "Deliver an Ultimatum" , _questTitle = "Deliver an Ultimatum"
@ -221,7 +221,7 @@ defaultQuestDeck =
scorePoints 8 scorePoints 8
takeResources 4 [Gold] takeResources 4 [Gold]
, _questPlotActions = , _questPlotActions =
[(Whenever (CompletesQuest [Warfare]), scorePoints 2)] [(Active, Whenever (CompletesQuest Warfare), scorePoints 2)]
} }
, Quest { _questType = Warfare , Quest { _questType = Warfare
, _questTitle = "Confront the Xanathar" , _questTitle = "Confront the Xanathar"
@ -248,7 +248,7 @@ defaultQuestDeck =
, _questReward = do , _questReward = do
noAction noAction
, _questPlotActions = , _questPlotActions =
[(Whenever PlaysIntrigue, scorePoints 2)] [(Active, Whenever PlaysIntrigue, scorePoints 2)]
} }
, Quest { _questType = Skullduggery , Quest { _questType = Skullduggery
, _questTitle = "Establish Shadow Thieves' Guild" , _questTitle = "Establish Shadow Thieves' Guild"
@ -274,7 +274,7 @@ defaultQuestDeck =
, _questReward = do , _questReward = do
scorePoints 6 scorePoints 6
, _questPlotActions = , _questPlotActions =
[(Whenever (ActionProvides [Rogue]), takeResources 2 [Gold])] [(Active, Whenever (ActionProvides Rogue), takeResources 2 [Gold])]
} }
, Quest { _questType = Skullduggery , Quest { _questType = Skullduggery
, _questTitle = "Raid on Undermountain" , _questTitle = "Raid on Undermountain"
@ -350,7 +350,7 @@ defaultQuestDeck =
, _questReward = do , _questReward = do
scorePoints 8 scorePoints 8
, _questPlotActions = , _questPlotActions =
[(Whenever (CompletesQuest [Skullduggery]), scorePoints 2)] [(Active, Whenever (CompletesQuest Skullduggery), scorePoints 2)]
} }
, Quest { _questType = Arcana , Quest { _questType = Arcana
, _questTitle = "Expose Red Wizards' Spies" , _questTitle = "Expose Red Wizards' Spies"
@ -407,7 +407,7 @@ defaultQuestDeck =
scorePoints 6 scorePoints 6
enableAssignOnceToOpponentsSpace enableAssignOnceToOpponentsSpace
, _questPlotActions = , _questPlotActions =
[(StartOfRound, enableAssignOnceToOpponentsSpace)] [(Active, StartOfRound, enableAssignOnceToOpponentsSpace)]
} }
, Quest { _questType = Arcana , Quest { _questType = Arcana
, _questTitle = "Study the Illusk Arch" , _questTitle = "Study the Illusk Arch"
@ -416,7 +416,7 @@ defaultQuestDeck =
, _questReward = do , _questReward = do
scorePoints 8 scorePoints 8
, _questPlotActions = , _questPlotActions =
[(Whenever (CompletesQuest [Arcana]), scorePoints 2)] [(Active, Whenever (CompletesQuest Arcana), scorePoints 2)]
} }
, Quest { _questType = Arcana , Quest { _questType = Arcana
, _questTitle = "Explore Ahghairon's Tower" , _questTitle = "Explore Ahghairon's Tower"
@ -425,7 +425,7 @@ defaultQuestDeck =
, _questReward = do , _questReward = do
scorePoints 6 scorePoints 6
, _questPlotActions = , _questPlotActions =
[(Whenever (ActionProvides [Wizard]), drawIntrigue)] [(Active, Whenever (ActionProvides Wizard), drawIntrigue)]
} }
, Quest { _questType = Arcana , Quest { _questType = Arcana
, _questTitle = "Infiltrate Halaster's Circle" , _questTitle = "Infiltrate Halaster's Circle"
@ -471,7 +471,7 @@ defaultQuestDeck =
, _questReward = do , _questReward = do
scorePoints 6 scorePoints 6
, _questPlotActions = , _questPlotActions =
[(Whenever BuysBuilding, scorePoints 4)] [(Active, Whenever BuysBuilding, scorePoints 4)]
} }
, Quest { _questType = Commerce , Quest { _questType = Commerce
, _questTitle = "Loot the Crypt of Chauntea" , _questTitle = "Loot the Crypt of Chauntea"
@ -518,7 +518,7 @@ defaultQuestDeck =
, _questReward = do , _questReward = do
scorePoints 10 scorePoints 10
, _questPlotActions = , _questPlotActions =
[(Whenever (ActionProvides [Gold]), takeResources 1 [Rogue])] [(Active, Whenever (ActionProvides Gold), takeResources 1 [Rogue])]
} }
, Quest { _questType = Commerce , Quest { _questType = Commerce
, _questTitle = "Lure Artisans of Mirabar" , _questTitle = "Lure Artisans of Mirabar"
@ -545,7 +545,7 @@ defaultQuestDeck =
, _questReward = do , _questReward = do
scorePoints 8 scorePoints 8
, _questPlotActions = , _questPlotActions =
[(Whenever (CompletesQuest [Commerce]), scorePoints 2)] [(Active, Whenever (CompletesQuest Commerce), scorePoints 2)]
} }
, Quest { _questType = Commerce , Quest { _questType = Commerce
, _questTitle = "Send Aid to the Harpers" , _questTitle = "Send Aid to the Harpers"

44
src/Waterdeep/Types.hs
View File

@ -4,8 +4,9 @@
{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-} {-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TupleSections #-}
module Waterdeep.Types module Waterdeep.Types
( AccumulationType(..) ( AccumulationType(..)
, BonusType(..) , BonusType(..)
, Building(..) , Building(..)
@ -18,6 +19,7 @@ module Waterdeep.Types
, Lord(..) , Lord(..)
, PlayerID , PlayerID
, PlayerState(..) , PlayerState(..)
, PlotState(..)
, PlotCondition(..) , PlotCondition(..)
, PlotQualifier(..) , PlotQualifier(..)
, Quest(..) , Quest(..)
@ -55,8 +57,7 @@ module Waterdeep.Types
, playerTavern , playerTavern
, playerIncompleteQuests , playerIncompleteQuests
, playerCompletedQuests , playerCompletedQuests
, playerActivePlotQuests , playerPlotQuests
, playerUsedPlotQuests
, playerIntrigueCards , playerIntrigueCards
, playerAgentsInPool , playerAgentsInPool
, playerHasLieutenant , playerHasLieutenant
@ -84,6 +85,9 @@ module Waterdeep.Types
, gameBuildings , gameBuildings
, gameWaterdeepHarbor , gameWaterdeepHarbor
, gameStdGen , gameStdGen
, plotActionState
, plotCondition
, plotAction
, gamePlayerState , gamePlayerState
, gamePlayerName , gamePlayerName
, activePlayerState , activePlayerState
@ -162,9 +166,9 @@ data Quest =
{ _questType :: QuestType { _questType :: QuestType
, _questTitle :: String , _questTitle :: String
, _questQuote :: String , _questQuote :: String
, _questCost :: MS.MultiSet Resource , _questCost :: ResourceBag
, _questReward :: GameAction , _questReward :: GameAction
, _questPlotActions :: [(PlotCondition, GameAction)] , _questPlotActions :: [(PlotState, PlotCondition, GameAction)]
} }
data IntrigueCard = data IntrigueCard =
@ -182,11 +186,10 @@ data PlayerState =
, _playerFaction :: Faction , _playerFaction :: Faction
, _playerLord :: Lord , _playerLord :: Lord
, _playerScore :: Int , _playerScore :: Int
, _playerTavern :: MS.MultiSet Resource , _playerTavern :: ResourceBag
, _playerIncompleteQuests :: [Quest] , _playerIncompleteQuests :: [Quest]
, _playerCompletedQuests :: [Quest] , _playerCompletedQuests :: [Quest]
, _playerActivePlotQuests :: [Quest] , _playerPlotQuests :: [Quest]
, _playerUsedPlotQuests :: [Quest]
, _playerIntrigueCards :: [IntrigueCard] , _playerIntrigueCards :: [IntrigueCard]
, _playerAgentsInPool :: Int , _playerAgentsInPool :: Int
, _playerHasLieutenant :: Bool , _playerHasLieutenant :: Bool
@ -228,6 +231,9 @@ data WaterdeepState =
data Resource = Cleric | Fighter | Rogue | Wizard | Gold data Resource = Cleric | Fighter | Rogue | Wizard | Gold
deriving (Eq,Ord,Enum,Bounded,Show) deriving (Eq,Ord,Enum,Bounded,Show)
type ResourceSet = Set.Set Resource
type ResourceBag = MS.MultiSet Resource
data QuestType = Piety | Warfare | Skullduggery | Arcana | Commerce | Mandatory data QuestType = Piety | Warfare | Skullduggery | Arcana | Commerce | Mandatory
deriving (Eq,Ord,Enum,Bounded,Show) deriving (Eq,Ord,Enum,Bounded,Show)
@ -246,8 +252,10 @@ data AccumulationType = NoAccumulation
| AccumulateResource Resource Int | AccumulateResource Resource Int
deriving (Eq,Show) deriving (Eq,Show)
data PlotQualifier = ActionProvides [Resource] data PlotState = Active | Used deriving (Eq,Show)
| CompletesQuest [QuestType]
data PlotQualifier = ActionProvides Resource
| CompletesQuest QuestType
| PlaysIntrigue | PlaysIntrigue
| BuysBuilding | BuysBuilding
deriving (Eq,Show) deriving (Eq,Show)
@ -263,8 +271,6 @@ data WaterdeepPrompt a where
Broadcast :: String -> WaterdeepPrompt () Broadcast :: String -> WaterdeepPrompt ()
SolicitChoice :: PlayerID -> String -> [(String, a)] -> WaterdeepPrompt a SolicitChoice :: PlayerID -> String -> [(String, a)] -> WaterdeepPrompt a
type ResourceSet = Set.Set Resource
data Waterdeep a = data Waterdeep a =
Waterdeep { unWaterdeep :: WriterT ResourceSet Waterdeep { unWaterdeep :: WriterT ResourceSet
(StateT WaterdeepState (StateT WaterdeepState
@ -320,7 +326,16 @@ instance MonadRandom Waterdeep where
getRandomRs r = randomRs r <$> (gameStdGen %%= R.split) getRandomRs r = randomRs r <$> (gameStdGen %%= R.split)
instance MonadSplit StdGen Waterdeep where instance MonadSplit StdGen Waterdeep where
getSplit = gameStdGen %%= R.split 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 :: PlayerID -> Lens' WaterdeepState PlayerState
gamePlayerState n = lens gamePlayerState n = lens
@ -363,8 +378,7 @@ newPlayerState i (name, faction, lord) =
, _playerTavern = mempty , _playerTavern = mempty
, _playerIncompleteQuests = [] , _playerIncompleteQuests = []
, _playerCompletedQuests = [] , _playerCompletedQuests = []
, _playerActivePlotQuests = [] , _playerPlotQuests = []
, _playerUsedPlotQuests = []
, _playerIntrigueCards = [] , _playerIntrigueCards = []
, _playerAgentsInPool = 0 , _playerAgentsInPool = 0
, _playerHasLieutenant = False , _playerHasLieutenant = False

8
src/Waterdeep/Util.hs
View File

@ -1,6 +1,6 @@
{-# LANGUAGE RankNTypes #-} {-# LANGUAGE RankNTypes #-}
module Waterdeep.Util module Waterdeep.Util
( deleteAt ( deleteAt
, on , on
, nubOn , nubOn
@ -10,13 +10,16 @@ module Waterdeep.Util
, mif , mif
, joinStrings , joinStrings
, (<$$>) , (<$$>)
, updating
) where ) where
import Control.Applicative import Control.Applicative
import Control.Monad.State
import Data.List import Data.List
import Data.Maybe import Data.Maybe
import Data.Monoid import Data.Monoid
import Lens.Family2 import Lens.Family2
import Lens.Family2.State
deleteAt :: Int -> [a] -> [a] deleteAt :: Int -> [a] -> [a]
deleteAt n l = left ++ drop 1 right 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 (<$$>) :: Applicative f => (a -> b) -> f a -> f b
(<$$>) = (<$>) (<$$>) = (<$>)
infixr 0 <$$> 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

3
waterdeep.cabal
View File

@ -23,7 +23,8 @@ executable waterdeep
MultiWayIf, MultiWayIf,
NoMonomorphismRestriction, NoMonomorphismRestriction,
RankNTypes, RankNTypes,
TemplateHaskell TemplateHaskell,
TupleSections
build-depends: base >=4.6 && <4.7, build-depends: base >=4.6 && <4.7,
MonadPrompt >=1.0 && <1.1, MonadPrompt >=1.0 && <1.1,
MonadRandom >=0.1 && <0.2, MonadRandom >=0.1 && <0.2,