From 4898dea4040fb865eea1ea70cded25c3a4495421 Mon Sep 17 00:00:00 2001 From: Jesse McDonald Date: Sun, 13 Apr 2014 01:54:20 -0500 Subject: [PATCH] implement sequencing of GameActions with a Monoid interface --- src/Test.hs | 36 ++++++++++++------------ src/Waterdeep/Logic.hs | 63 ++++++++++++++++++++++++++++++++++++++++-- src/Waterdeep/Types.hs | 22 +++++++++++---- src/Waterdeep/Util.hs | 8 ++++++ 4 files changed, 103 insertions(+), 26 deletions(-) create mode 100644 src/Waterdeep/Util.hs diff --git a/src/Test.hs b/src/Test.hs index 22f5002..5df3db0 100644 --- a/src/Test.hs +++ b/src/Test.hs @@ -4,6 +4,7 @@ import Waterdeep.Types import Waterdeep.Monad import Waterdeep.Logic +import Waterdeep.Util (mrepeat) import Control.Applicative import Control.Lens import Control.Monad @@ -11,6 +12,7 @@ import Control.Monad.Prompt import Control.Monad.Random import Control.Monad.State import Data.List +import Data.Monoid import Text.Printf import System.IO import System.Random @@ -29,59 +31,57 @@ p2 = ("Ned", f2, l2) q1 = Quest { _questType = Arcana , _questTitle = "Research Palantirs" , _questQuote = "" - , _questAction = Transaction $ - [ Transaction $ - map (\r -> ReturnResource [r]) [Cleric,Rogue,Rogue,Wizard] - , Repeat 4 $ ReturnResource [Gold] - , ScorePoints 15 - , Repeat 8 $ TakeResource [Gold] - ] + , _questAction = ReturnResource [Cleric] + <> ReturnResource [Rogue] + <> ReturnResource [Rogue] + <> ReturnResource [Wizard] + <> mrepeat 4 (ReturnResource [Gold]) + <> ScorePoints 15 + <> mrepeat 8 (TakeResource [Gold]) , _questPlotActions = [] } q2 = Quest { _questType = Skullduggery , _questTitle = "Rob Waterdeep Bank" , _questQuote = "" - , _questAction = Transaction $ - [ Repeat 8 $ ReturnResource [Rogue] - , ScorePoints 10 - , Repeat 16 $ TakeResource [Gold] - ] + , _questAction = mrepeat 8 (ReturnResource [Rogue]) + <> ScorePoints 10 + <> mrepeat 16 (TakeResource [Gold]) , _questPlotActions = [] } b1 = Building { _buildingCost = 6 , _buildingTitle = "Monastary" - , _buildingAction = Group [TakeResource [Cleric], TakeResource [Cleric]] + , _buildingAction = mrepeat 2 (TakeResource [Cleric]) , _buildingOwnerAction = TakeResource [Cleric] , _buildingAccumType = NoAccumulation } b2 = Building { _buildingCost = 4 , _buildingTitle = "Training Hall" - , _buildingAction = Group [TakeResource [Fighter], TakeResource [Fighter]] + , _buildingAction = mrepeat 2 (TakeResource [Fighter]) , _buildingOwnerAction = TakeResource [Fighter] , _buildingAccumType = NoAccumulation } b3 = Building { _buildingCost = 4 , _buildingTitle = "Prison Yard" - , _buildingAction = Group [TakeResource [Rogue], TakeResource [Rogue]] + , _buildingAction = mrepeat 2 (TakeResource [Rogue]) , _buildingOwnerAction = TakeResource [Rogue] , _buildingAccumType = NoAccumulation } b4 = Building { _buildingCost = 6 , _buildingTitle = "Wizard School" - , _buildingAction = Group [TakeResource [Wizard], TakeResource [Wizard]] + , _buildingAction = mrepeat 2 (TakeResource [Wizard]) , _buildingOwnerAction = TakeResource [Wizard] , _buildingAccumType = NoAccumulation } b5 = Building { _buildingCost = 4 , _buildingTitle = "Gold Mine" - , _buildingAction = Group $ replicate 4 $ TakeResource [Gold] - , _buildingOwnerAction = Group $ replicate 2 $ TakeResource [Gold] + , _buildingAction = mrepeat 4 (TakeResource [Gold]) + , _buildingOwnerAction = mrepeat 4 (TakeResource [Gold]) , _buildingAccumType = NoAccumulation } diff --git a/src/Waterdeep/Logic.hs b/src/Waterdeep/Logic.hs index 2a6256f..687fee0 100644 --- a/src/Waterdeep/Logic.hs +++ b/src/Waterdeep/Logic.hs @@ -16,6 +16,7 @@ import Control.Monad.Random import Control.Monad.State import Data.List import Data.Maybe +import Data.Monoid import System.Random.Shuffle import Waterdeep.Types import Waterdeep.Monad @@ -97,8 +98,25 @@ waterdeepGame = do replicateM_ (3 + p) $ performAction p $ TakeResource [Gold] forM_ [1..8] $ \round -> do beginRound round + fix $ \loop -> do + p <- use gameCurrentPlayer + success <- filterChoices $ performAction p AssignAgent + case success of + True -> do + filterChoices $ performAction p CompleteQuest + gameCurrentPlayer .= (p `mod` length ps) + 1 + gameConsecutivePasses .= 0 + loop + False -> do + passes <- gameConsecutivePasses <+= 1 + when (passes < length ps) loop performAction 1 $ TakeResource [Cleric, Fighter, Rogue, Wizard, Gold] - performAction 2 $ ChooseQuest + filterChoices $ performAction 1 $ + ReturnResource [Wizard] + <> ReturnResource [Cleric, Fighter, Gold] + <> ReturnResource [Cleric, Fighter] + <> ReturnResource [Cleric] + -- performAction 2 $ ChooseQuest scoreFinalPoints notifyState determineWinners @@ -124,15 +142,54 @@ initialAgents players round = if round >= 5 then startingAgents + 1 else startingAgents where startingAgents = 6 - players +data ContWD a where + Done :: (a, WaterdeepState) -> ContWD a + Cont :: WaterdeepPrompt b -> (b -> ContWD a) -> ContWD a + +-- |Permit only choices which lead to a True result. +-- Returns False if and only if no such choice exists. +-- If result is False, state remains unchanged. +filterChoices :: Waterdeep Bool -> Waterdeep Bool +filterChoices m = do + mw' <- filteredChoice =<< (runWaterdeepC Done Cont m <$> get) + case mw' of + Just w' -> put w' >> return True + Nothing -> return False + where + tryChoice :: ContWD Bool -> Bool + tryChoice (Done a) = fst a + tryChoice (Cont (NotifyState w) cont) = tryChoice $ cont () + tryChoice (Cont (SolicitChoice w p t cs) cont) = + or $ map (tryChoice . cont . snd) cs + filteredChoice :: ContWD Bool -> Waterdeep (Maybe WaterdeepState) + filteredChoice (Done (a,w)) = if a then return (Just w) else return Nothing + filteredChoice (Cont (NotifyState w) cont) = filteredChoice $ cont () + filteredChoice (Cont (SolicitChoice w p t cs) cont) = do + let cs' = filter (tryChoice . cont . snd) cs + if null cs' + then return Nothing + else filteredChoice =<< (cont <$> (put w >> solicitChoice p t cs')) + performAction :: PlayerID -> GameAction -> Waterdeep Bool performAction p a = case a of + NoAction -> return True ScorePoints n -> do gamePlayer p . playerScore += n return True TakeResource rs -> do - r <- solicitChoice p "Please choose one:" $ map (show &&& id) rs + r <- solicitChoice p "Take one item:" $ map (show &&& id) rs gamePlayer p . playerTavern %= flip (M.unionWith (+)) (M.fromList [(r, 1)]) return True + ReturnResource rs -> do + tavern <- use $ gamePlayer p . playerTavern + let rs' = filter ((> 0) . maybe 0 id . flip M.lookup tavern) rs + if null rs' + then return False + else do + r <- solicitChoice p "Return one item:" $ map (show &&& id) rs' + let removeOne x = if x > 1 then Just (x-1) else Nothing + gamePlayer p . playerTavern %= M.update removeOne r + return True ChooseQuest -> do qs <- use gameCliffwatchInn if null qs @@ -158,6 +215,8 @@ performAction p a = case a of Just i -> do gamePlayer p . playerIntrigueCards %= (++[i]) return True + a1 `Then` a2 -> do + (&&) <$> performAction p a1 <*> performAction p a2 _ -> return False scoreFinalPoints :: Waterdeep () diff --git a/src/Waterdeep/Types.hs b/src/Waterdeep/Types.hs index ab45e92..139e1f6 100644 --- a/src/Waterdeep/Types.hs +++ b/src/Waterdeep/Types.hs @@ -81,6 +81,7 @@ module Waterdeep.Types import Control.Lens import Data.IntMap (IntMap) import Data.Map (Map) +import Data.Monoid import System.Random (StdGen) type PlayerID = Int @@ -192,7 +193,8 @@ data AccumulationType = NoAccumulation | AccumulateResource Resource Int deriving (Eq,Show) -data GameAction = ScorePoints Int +data GameAction = NoAction + | ScorePoints Int | TakeResource [Resource] | ReturnResource [Resource] | GiveResource [Resource] @@ -201,6 +203,7 @@ data GameAction = ScorePoints Int | DrawQuest | DrawNamedQuestType | DistributeQuests + | CompleteQuest | ChooseAndCompleteQuest | DiscardUncompletedQuest | BuyBuilding @@ -220,18 +223,18 @@ data GameAction = ScorePoints Int | TakeAccumulated | TakeResourceFromOpponent [Resource] | AssignMandatoryQuest Quest - | Group [GameAction] | Optional GameAction - | ChooseFrom [GameAction] - | Transaction [GameAction] - | Repeat Int GameAction - | IfThenElse GameAction GameAction GameAction + | ChooseOne [GameAction] + | Then GameAction GameAction + | OrElse GameAction GameAction | ForEachBuilding GameAction | ForEachControlledBuilding GameAction | OneOpponent GameAction | EachOpponent GameAction | CurrentPlayer GameAction deriving (Show) +infixr `Then` +infixr `OrElse` data PlotQualifier = ActionProvides [Resource] | CompletesQuest [QuestType] @@ -275,3 +278,10 @@ instance Eq Building where instance Eq IntrigueCard where a == b = a^.intrigueTitle == b^.intrigueTitle + +instance Monoid GameAction where + mempty = NoAction + NoAction `mappend` x = x + x `mappend` NoAction = x + (x `Then` y) `mappend` z = x `Then` (y `mappend` z) + x `mappend` y = x `Then` y diff --git a/src/Waterdeep/Util.hs b/src/Waterdeep/Util.hs new file mode 100644 index 0000000..e0d7929 --- /dev/null +++ b/src/Waterdeep/Util.hs @@ -0,0 +1,8 @@ +module Waterdeep.Util + ( mrepeat + ) where + +import Data.Monoid + +mrepeat :: (Monoid m) => Int -> m -> m +mrepeat n m = mconcat $ replicate n m