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

rework plot actions to avoid the buggy/racy "updating" combinator

This commit is contained in:
Jesse D. McDonald 2014-09-03 01:16:14 -05:00
parent e465141017
commit 9fcbb1cf77
4 changed files with 68 additions and 41 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

39
src/Waterdeep/Actions.hs
View File

@ -50,7 +50,7 @@ module Waterdeep.Actions
import Control.Applicative
import Control.Arrow ((&&&))
import Control.Monad (when, unless, guard, join, replicateM, replicateM_)
import Control.Monad (when, unless, guard, join, replicateM, replicateM_, void)
import Control.Monad.Random
import Control.Monad.State (get)
import Control.Monad.Trans.Writer
@ -211,7 +211,7 @@ completeQuest' quest = do
then gameIntrigueDiscard <>= [mandatoryQuestCard quest]
else if null (quest ^. questPlotActions)
then activePlayerState . playerCompletedQuests <>= [quest]
else activePlayerState . playerPlotQuests <>= [quest]
else activePlayerState . playerPlotQuests . intAtNext .= Just quest
doPlotAction (== CompletesQuest (quest^.questType))
discardUncompletedQuest :: GameAction
@ -243,9 +243,8 @@ buyBuilding = do
p <- use gameActivePlayer
name <- use activePlayerName
returnResources (b ^. building . buildingCost) [Gold]
newKey <- (+1) . fst . IM.findMax <$> use gameBuildings
let newState = b & buildingOwner .~ p & buildingAccumulation .~ 0
gameBuildings %= IM.insert newKey newState
gameBuildings . intAtNext .= Just newState
broadcast $ name ++ " built the " ++ (b ^. building . buildingTitle) ++ "."
scorePoints (b ^. buildingAccumulation)
doPlotAction (== BuysBuilding)
@ -256,9 +255,8 @@ chooseFreeBuilding = do
(i, b) <- chooseFromBuildersHall
p <- use gameActivePlayer
name <- use activePlayerName
newKey <- (+1) . fst . IM.findMax <$> use gameBuildings
let newState = b & buildingOwner .~ p & buildingAccumulation .~ 0
gameBuildings %= IM.insert newKey newState
gameBuildings . intAtNext .= Just newState
broadcast $ name ++ " built the " ++ (b ^. building . buildingTitle) ++ " for free."
scorePoints (b ^. buildingAccumulation)
restockBuildersHall
@ -267,8 +265,7 @@ drawFreeBuilding :: GameAction
drawFreeBuilding = do
Just b <- drawBuilding'
p <- use gameActivePlayer
newKey <- (+1) . fst . IM.findMax <$> use gameBuildings
gameBuildings %= IM.insert newKey (newBuildingState p b)
gameBuildings . intAtNext .= Just (newBuildingState p b)
name <- use $ activePlayerName
broadcast $ name ++ " built the " ++ (b ^. buildingTitle) ++ " for free."
@ -579,17 +576,21 @@ forEachControlledBuilding m = do
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
doPlotAction f = void $ delimitAction $ do
walkIntMap (activePlayerState . playerPlotQuests) $ \k l -> do
-- Assumption: Plot actions within the same card do not affect each other.
actions <- use $ l . singular _Just . questPlotActions
actions' <- forM actions $ \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
l . singular _Just . questPlotActions .= actions'
mandatoryQuestCard :: Quest -> IntrigueCard
mandatoryQuestCard q =

22
src/Waterdeep/Logic.hs
View File

@ -16,14 +16,14 @@ import Control.Monad.Random
import Control.Monad.State hiding (forM_, mapM_)
import Control.Monad.Trans.Writer
import Data.List
import Data.Foldable (toList, foldMap, forM_, mapM_)
import Data.Foldable (toList, foldMap, forM_, mapM_, sequenceA_)
import Data.Maybe
import Data.Monoid
import Data.Traversable (traverse, for, forM, mapM)
import Data.Traversable (traverse, for, forM, mapM, sequenceA)
import Lens.Family2
import Lens.Family2.State
import Lens.Family2.Stock
import Prelude hiding (forM, mapM)
import Prelude hiding (forM, mapM, mapM_)
import Text.Printf
import Waterdeep.Actions
import Waterdeep.Buildings (basicBuildings)
@ -149,10 +149,10 @@ beginRound round = do
True -> activePlayerState . playerAgentsInPool += 1 >> return ()
False -> return ()
forM_ [1..np] $ \p -> withActivePlayer p $ do
updating (activePlayerState.playerPlotQuests.traverse.questPlotActions.traverse) $ \(s,c,a) -> do
case c of
StartOfRound -> a >> return (Used,c,a)
_ -> return (s,c,a)
actions <- activePlayerState.playerPlotQuests.traverse.questPlotActions.traverse %%= \case
(Active, StartOfRound, a) -> ([a], (Used, StartOfRound, a))
x -> (mempty, x)
mapM_ filterChoices actions
scoreFinalPoints :: Waterdeep ()
scoreFinalPoints = do
@ -166,10 +166,10 @@ scoreFinalPoints = do
broadcast $ printf "%s scored %d points for having %d %ss." name pts n (show r)
use (activePlayerState . playerLord . lordBonus) >>= \case
QuestBonus types pts -> do
quests <- concat <$> sequence
[ use $ activePlayerState . playerCompletedQuests
, use $ activePlayerState . playerPlotQuests
]
quests <- concat . sequenceA
[ view (activePlayerState . playerCompletedQuests)
, toListOf (activePlayerState . playerPlotQuests . traverse)
] <$> get
let matches = length . filter ((`elem` types) . (view questType)) $ quests
activePlayerState . playerScore += matches * pts
when (matches > 0) $ broadcast $

10
src/Waterdeep/Types.hs
View File

@ -189,7 +189,7 @@ data PlayerState =
, _playerTavern :: ResourceBag
, _playerIncompleteQuests :: [Quest]
, _playerCompletedQuests :: [Quest]
, _playerPlotQuests :: [Quest]
, _playerPlotQuests :: IM.IntMap Quest
, _playerIntrigueCards :: [IntrigueCard]
, _playerAgentsInPool :: Int
, _playerHasLieutenant :: Bool
@ -376,10 +376,10 @@ newPlayerState i (name, faction, lord) =
, _playerLord = lord
, _playerScore = 0
, _playerTavern = mempty
, _playerIncompleteQuests = []
, _playerCompletedQuests = []
, _playerPlotQuests = []
, _playerIntrigueCards = []
, _playerIncompleteQuests = mempty
, _playerCompletedQuests = mempty
, _playerPlotQuests = mempty
, _playerIntrigueCards = mempty
, _playerAgentsInPool = 0
, _playerHasLieutenant = False
, _playerHasAmbassador = False

38
src/Waterdeep/Util.hs
View File

@ -1,3 +1,4 @@
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RankNTypes #-}
module Waterdeep.Util
@ -10,24 +11,29 @@ module Waterdeep.Util
, mif
, joinStrings
, (<$$>)
, updating
, whenM
, unlessM
, nextIntKey
, intAtNext
, walkIntMap
) where
import Control.Applicative
import Control.Monad.State
import Data.List
import Data.Function
import Data.Maybe
import Data.Monoid
import Lens.Family2
import Lens.Family2.State
import Lens.Family2.Stock
import qualified Data.IntMap as IM
deleteAt :: Int -> [a] -> [a]
deleteAt n l = left ++ drop 1 right
where (left, right) = splitAt n l
on :: (b -> b -> c) -> (a -> b) -> (a -> a -> c)
(f `on` g) a b = (g a) `f` (g b)
nubOn :: Eq b => (a -> b) -> [a] -> [a]
nubOn f = nubBy ((==) `on` f)
@ -61,5 +67,25 @@ joinStrings (x:xs) = x ++ ", " ++ joinStrings xs
(<$$>) = (<$>)
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
-- Like when/unless, except that the condition is an action yielding a Bool
-- rather than a pure Bool. Avoids the need for spurious condition variables.
whenM, unlessM :: Monad m => m Bool -> m () -> m ()
whenM mc ma = do { c <- mc; when c ma }
unlessM mc ma = do { c <- mc; unless c ma }
-- Returns the next available key in an IntMap, starting from 1 if the map is empty.
nextIntKey :: IM.IntMap a -> IM.Key
nextIntKey im = if IM.null im then 1 else 1 + fst (IM.findMax im)
-- This isn't really a lens since it doesn't refer to a constant location.
-- You don't get back what you put in, and setting twice has a different
-- effect than setting once. Nonetheless, I find it useful. It works like
-- intAt except that the (implied) key parameter always refers to the next
-- available key.
intAtNext :: Applicative f => (Maybe b -> f (Maybe b)) -> IM.IntMap b -> f (IM.IntMap b)
intAtNext f im = maybe im (flip (IM.insert (nextIntKey im)) im) <$> f Nothing
walkIntMap :: MonadState a m => Lens' a (IM.IntMap b)
-> (IM.Key -> Lens' a (Maybe b) -> m r) -> m ()
walkIntMap l f = use l >>= \im -> unless (IM.null im) $ go (fst $ IM.findMin im) where
go k = f k (l . intAt k) >> use l >>= maybe (return ()) (go . fst) . IM.lookupGT k