diff --git a/src/Waterdeep/Actions.hs b/src/Waterdeep/Actions.hs index 025a9e4..67a24ef 100644 --- a/src/Waterdeep/Actions.hs +++ b/src/Waterdeep/Actions.hs @@ -88,6 +88,7 @@ takeResources n rs = do received <- map (head &&& length) . group . sort <$$> replicateM n $ do r <- solicitChoice "Take one item:" $ map (show &&& id) rs activePlayerState . playerTavern <>= MS.singleton r + actionProvided r return r let items = joinStrings $ map (\(r,n) -> show n ++ " " ++ show r) received name <- use $ activePlayerName @@ -200,8 +201,9 @@ completeQuest' quest = do activePlayerState . playerTavern %= (`MS.difference` (quest ^. questCost)) name <- use activePlayerName broadcast $ name ++ " completed the " ++ (quest ^. questTitle) ++ " quest." - quest ^. questReward - forM_ (filter ((==Immediately) . fst) (quest^.questPlotActions)) $ snd + delimitAction $ do + quest ^. questReward + forM_ (filter ((==Immediately) . fst) (quest^.questPlotActions)) $ snd if (quest ^. questType == Mandatory) then gameIntrigueDiscard <>= [mandatoryQuestCard quest] else if null (quest ^. questPlotActions) @@ -341,7 +343,7 @@ useBuilding :: Lens' WaterdeepState BuildingState -> Waterdeep () useBuilding bl = do p <- use gameActivePlayer owner <- use $ bl.buildingOwner - when (owner `notElem` [noPlayerID, p]) $ + when (owner `notElem` [noPlayerID, p]) $ fst <$$> delimitAction $ withActivePlayer owner =<< use (bl.building.buildingOwnerAction) join . use $ bl.building.buildingAction @@ -476,24 +478,25 @@ enableAssignOnceToOpponentsSpace :: GameAction enableAssignOnceToOpponentsSpace = do activePlayerState . playerCanUseOpSpace .= True -forOneOpponent :: GameAction -> GameAction +forOneOpponent :: Waterdeep a -> Waterdeep a forOneOpponent a1 = do opponents <- getOpponents let choices = map (view playerName &&& (view playerNumber &&& view playerName)) opponents (opID, opName) <- solicitChoice "Choose one opponent:" choices name <- use $ activePlayerName broadcast $ name ++ " chose " ++ opName ++ "." - withActivePlayer opID a1 + withActivePlayer opID (fst <$> delimitAction a1) -forEachOpponent :: GameAction -> GameAction +forEachOpponent :: Monoid a => Waterdeep a -> Waterdeep a forEachOpponent a1 = do opponents <- getOpponents - forM_ opponents $ \op -> withActivePlayer (op ^. playerNumber) a1 + mconcat <$$> forM opponents $ \op -> + withActivePlayer (op ^. playerNumber) (fst <$> delimitAction a1) -forCurrentPlayer :: GameAction -> GameAction +forCurrentPlayer :: Waterdeep a -> Waterdeep (a, ResourceSet) forCurrentPlayer a1 = do p <- use gameCurrentPlayer - withActivePlayer p a1 + withActivePlayer p $ delimitAction a1 shufflePiles :: Lens WaterdeepState WaterdeepState [a] [a] -> Lens WaterdeepState WaterdeepState [a] [a] diff --git a/src/Waterdeep/Intrigues.hs b/src/Waterdeep/Intrigues.hs index 9f59fd6..e56b12f 100644 --- a/src/Waterdeep/Intrigues.hs +++ b/src/Waterdeep/Intrigues.hs @@ -6,6 +6,7 @@ import Control.Applicative import Control.Arrow ((&&&)) import Control.Monad import Data.List +import Data.Foldable (toList) import Data.Monoid import Data.Traversable (traverse) import Lens.Family2 @@ -80,26 +81,26 @@ defaultIntrigueDeck = concat $ map (uncurry replicate) $ }) , (2, IntrigueCard { _intrigueTitle = "Arcane Mishap" , _intrigueType = Attack - , _intrigueAction = forEachOpponent $ do + , _intrigueAction = actionProvidedSet <=< forEachOpponent $ do result <- filterChoices $ returnResources 1 [Wizard] - when (result == Nothing) $ do - forCurrentPlayer $ drawIntrigue + snd <$$> forCurrentPlayer $ when (result == Nothing) $ + drawIntrigue , _intrigueQuote = "" }) , (2, IntrigueCard { _intrigueTitle = "Assassination" , _intrigueType = Attack - , _intrigueAction = forEachOpponent $ do + , _intrigueAction = actionProvidedSet <=< forEachOpponent $ do result <- filterChoices $ returnResources 1 [Rogue] - when (result == Nothing) $ do - forCurrentPlayer $ takeResources 2 [Gold] + snd <$$> forCurrentPlayer $ when (result == Nothing) $ + takeResources 2 [Gold] , _intrigueQuote = "" }) , (2, IntrigueCard { _intrigueTitle = "Ambush" , _intrigueType = Attack - , _intrigueAction = forEachOpponent $ do + , _intrigueAction = actionProvidedSet <=< forEachOpponent $ do result <- filterChoices $ returnResources 1 [Fighter] - when (result == Nothing) $ do - forCurrentPlayer $ takeResources 1 [Fighter] + snd <$$> forCurrentPlayer $ when (result == Nothing) $ + takeResources 1 [Fighter] , _intrigueQuote = "" }) , (3, IntrigueCard { _intrigueTitle = "Bidding War" @@ -184,10 +185,10 @@ defaultIntrigueDeck = concat $ map (uncurry replicate) $ }) , (2, IntrigueCard { _intrigueTitle = "Lack of Faith" , _intrigueType = Attack - , _intrigueAction = forEachOpponent $ do + , _intrigueAction = actionProvidedSet <=< forEachOpponent $ do result <- filterChoices $ returnResources 1 [Cleric] - when (result == Nothing) $ do - forCurrentPlayer $ scorePoints 2 + snd <$$> forCurrentPlayer $ when (result == Nothing) $ + scorePoints 2 , _intrigueQuote = "" }) , (1, IntrigueCard { _intrigueTitle = "Real Estate Deal" @@ -207,13 +208,14 @@ defaultIntrigueDeck = concat $ map (uncurry replicate) $ , _intrigueAction = do takeResources 2 [Rogue] name <- use activePlayerName - forEachOpponent $ do + actionProvidedSet <=< forEachOpponent $ do join . solicitChoice ("Give " ++ name ++ " 1 Rogue for 3 points?") $ [ ("Yes", do { returnResources 1 [Rogue] - ; forCurrentPlayer $ takeResources 1 [Rogue] + ; (_, p) <- forCurrentPlayer $ takeResources 1 [Rogue] ; scorePoints 3 + ; return p }) - , ("No", return ()) + , ("No", return mempty) ] , _intrigueQuote = "" }) @@ -222,13 +224,14 @@ defaultIntrigueDeck = concat $ map (uncurry replicate) $ , _intrigueAction = do takeResources 2 [Fighter] name <- use activePlayerName - forEachOpponent $ do + actionProvidedSet <=< forEachOpponent $ do join . solicitChoice ("Give " ++ name ++ " 1 Fighter for 3 points?") $ [ ("Yes", do { returnResources 1 [Fighter] - ; forCurrentPlayer $ takeResources 1 [Fighter] + ; (_, p) <- forCurrentPlayer $ takeResources 1 [Fighter] ; scorePoints 3 + ; return p }) - , ("No", return ()) + , ("No", return mempty) ] , _intrigueQuote = "" }) @@ -237,13 +240,14 @@ defaultIntrigueDeck = concat $ map (uncurry replicate) $ , _intrigueAction = do takeResources 1 [Wizard] name <- use activePlayerName - forEachOpponent $ do + actionProvidedSet <=< forEachOpponent $ do join . solicitChoice ("Give " ++ name ++ " 1 Wizard for 5 points?") $ [ ("Yes", do { returnResources 1 [Wizard] - ; forCurrentPlayer $ takeResources 1 [Wizard] + ; (_, p) <- forCurrentPlayer $ takeResources 1 [Wizard] ; scorePoints 5 + ; return p }) - , ("No", return ()) + , ("No", return mempty) ] , _intrigueQuote = "" }) @@ -269,13 +273,14 @@ defaultIntrigueDeck = concat $ map (uncurry replicate) $ , _intrigueAction = do takeResources 1 [Cleric] name <- use activePlayerName - forEachOpponent $ do + actionProvidedSet <=< forEachOpponent $ do join . solicitChoice ("Give " ++ name ++ " 1 Cleric for 5 points?") $ [ ("Yes", do { returnResources 1 [Cleric] - ; forCurrentPlayer $ takeResources 1 [Cleric] + ; (_, p) <- forCurrentPlayer $ takeResources 1 [Cleric] ; scorePoints 5 + ; return p }) - , ("No", return ()) + , ("No", return mempty) ] , _intrigueQuote = "" }) @@ -284,13 +289,14 @@ defaultIntrigueDeck = concat $ map (uncurry replicate) $ , _intrigueAction = do takeResources 4 [Gold] name <- use activePlayerName - forEachOpponent $ do + actionProvidedSet <=< forEachOpponent $ do join . solicitChoice ("Give " ++ name ++ " 4 Gold for 4 points?") $ [ ("Yes", do { returnResources 4 [Gold] - ; forCurrentPlayer $ takeResources 4 [Gold] + ; (_, p) <- forCurrentPlayer $ takeResources 4 [Gold] ; scorePoints 4 + ; return p }) - , ("No", return ()) + , ("No", return mempty) ] , _intrigueQuote = "" }) diff --git a/src/Waterdeep/Logic.hs b/src/Waterdeep/Logic.hs index df0bd52..2456a2d 100644 --- a/src/Waterdeep/Logic.hs +++ b/src/Waterdeep/Logic.hs @@ -16,6 +16,7 @@ import Control.Monad.Random import Control.Monad.State import Control.Monad.Trans.Writer import Data.List +import Data.Foldable (toList) import Data.Maybe import Data.Monoid import Data.Traversable (traverse) @@ -29,8 +30,8 @@ import Waterdeep.Types import Waterdeep.Util import qualified Data.IntMap as IM -import qualified Data.Map as M import qualified Data.MultiSet as MS +import qualified Data.Set as Set newGame :: [(String,Faction,Lord)] -> [Quest] @@ -91,11 +92,18 @@ waterdeepGame = do ambassadorIM <- IM.filter (view playerHasAmbassador) <$> use gamePlayerStates unless (IM.null ambassadorIM) $ do let p = head $ IM.keys ambassadorIM - withActivePlayer p $ assignAmbassador + 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 fix $ \loop -> do assign gameActivePlayer =<< use gameCurrentPlayer - filterChoices assignAgent >>= \case - Just () -> do + 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 filterChoices $ join $ solicitChoice "Complete a quest?" $ [ ("Yes", completeQuest) , ("No", return ())