record resources provided by each action, and the action boundaries
This commit is contained in:
parent
7bdd14fc83
commit
748fe76f4a
|
|
@ -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]
|
||||
|
|
|
|||
|
|
@ -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 = ""
|
||||
})
|
||||
|
|
|
|||
|
|
@ -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 ())
|
||||
|
|
|
|||
Loading…
Reference in New Issue