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

record resources provided by each action, and the action boundaries

This commit is contained in:
Jesse D. McDonald 2014-07-26 17:10:50 -05:00
parent 7bdd14fc83
commit 748fe76f4a
3 changed files with 57 additions and 40 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
src/Waterdeep/Actions.hs
View File

@ -88,6 +88,7 @@ takeResources n rs = do
received <- map (head &&& length) . group . sort <$$> replicateM n $ do received <- map (head &&& length) . group . sort <$$> replicateM n $ do
r <- solicitChoice "Take one item:" $ map (show &&& id) rs r <- solicitChoice "Take one item:" $ map (show &&& id) rs
activePlayerState . playerTavern <>= MS.singleton r activePlayerState . playerTavern <>= MS.singleton r
actionProvided r
return r return r
let items = joinStrings $ map (\(r,n) -> show n ++ " " ++ show r) received let items = joinStrings $ map (\(r,n) -> show n ++ " " ++ show r) received
name <- use $ activePlayerName name <- use $ activePlayerName
@ -200,6 +201,7 @@ completeQuest' quest = do
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) ++ " quest."
delimitAction $ do
quest ^. questReward quest ^. questReward
forM_ (filter ((==Immediately) . fst) (quest^.questPlotActions)) $ snd forM_ (filter ((==Immediately) . fst) (quest^.questPlotActions)) $ snd
if (quest ^. questType == Mandatory) if (quest ^. questType == Mandatory)
@ -341,7 +343,7 @@ useBuilding :: Lens' WaterdeepState BuildingState -> Waterdeep ()
useBuilding bl = do useBuilding bl = do
p <- use gameActivePlayer p <- use gameActivePlayer
owner <- use $ bl.buildingOwner owner <- use $ bl.buildingOwner
when (owner `notElem` [noPlayerID, p]) $ when (owner `notElem` [noPlayerID, p]) $ fst <$$> delimitAction $
withActivePlayer owner =<< use (bl.building.buildingOwnerAction) withActivePlayer owner =<< use (bl.building.buildingOwnerAction)
join . use $ bl.building.buildingAction join . use $ bl.building.buildingAction
@ -476,24 +478,25 @@ enableAssignOnceToOpponentsSpace :: GameAction
enableAssignOnceToOpponentsSpace = do enableAssignOnceToOpponentsSpace = do
activePlayerState . playerCanUseOpSpace .= True activePlayerState . playerCanUseOpSpace .= True
forOneOpponent :: GameAction -> GameAction forOneOpponent :: Waterdeep a -> Waterdeep a
forOneOpponent a1 = do forOneOpponent a1 = do
opponents <- getOpponents opponents <- getOpponents
let choices = map (view playerName &&& (view playerNumber &&& view playerName)) opponents let choices = map (view playerName &&& (view playerNumber &&& view playerName)) opponents
(opID, opName) <- solicitChoice "Choose one opponent:" choices (opID, opName) <- solicitChoice "Choose one opponent:" choices
name <- use $ activePlayerName name <- use $ activePlayerName
broadcast $ name ++ " chose " ++ opName ++ "." 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 forEachOpponent a1 = do
opponents <- getOpponents 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 forCurrentPlayer a1 = do
p <- use gameCurrentPlayer p <- use gameCurrentPlayer
withActivePlayer p a1 withActivePlayer p $ delimitAction a1
shufflePiles :: Lens WaterdeepState WaterdeepState [a] [a] shufflePiles :: Lens WaterdeepState WaterdeepState [a] [a]
-> Lens WaterdeepState WaterdeepState [a] [a] -> Lens WaterdeepState WaterdeepState [a] [a]

60
src/Waterdeep/Intrigues.hs
View File

@ -6,6 +6,7 @@ import Control.Applicative
import Control.Arrow ((&&&)) import Control.Arrow ((&&&))
import Control.Monad import Control.Monad
import Data.List import Data.List
import Data.Foldable (toList)
import Data.Monoid import Data.Monoid
import Data.Traversable (traverse) import Data.Traversable (traverse)
import Lens.Family2 import Lens.Family2
@ -80,26 +81,26 @@ defaultIntrigueDeck = concat $ map (uncurry replicate) $
}) })
, (2, IntrigueCard { _intrigueTitle = "Arcane Mishap" , (2, IntrigueCard { _intrigueTitle = "Arcane Mishap"
, _intrigueType = Attack , _intrigueType = Attack
, _intrigueAction = forEachOpponent $ do , _intrigueAction = actionProvidedSet <=< forEachOpponent $ do
result <- filterChoices $ returnResources 1 [Wizard] result <- filterChoices $ returnResources 1 [Wizard]
when (result == Nothing) $ do snd <$$> forCurrentPlayer $ when (result == Nothing) $
forCurrentPlayer $ drawIntrigue drawIntrigue
, _intrigueQuote = "" , _intrigueQuote = ""
}) })
, (2, IntrigueCard { _intrigueTitle = "Assassination" , (2, IntrigueCard { _intrigueTitle = "Assassination"
, _intrigueType = Attack , _intrigueType = Attack
, _intrigueAction = forEachOpponent $ do , _intrigueAction = actionProvidedSet <=< forEachOpponent $ do
result <- filterChoices $ returnResources 1 [Rogue] result <- filterChoices $ returnResources 1 [Rogue]
when (result == Nothing) $ do snd <$$> forCurrentPlayer $ when (result == Nothing) $
forCurrentPlayer $ takeResources 2 [Gold] takeResources 2 [Gold]
, _intrigueQuote = "" , _intrigueQuote = ""
}) })
, (2, IntrigueCard { _intrigueTitle = "Ambush" , (2, IntrigueCard { _intrigueTitle = "Ambush"
, _intrigueType = Attack , _intrigueType = Attack
, _intrigueAction = forEachOpponent $ do , _intrigueAction = actionProvidedSet <=< forEachOpponent $ do
result <- filterChoices $ returnResources 1 [Fighter] result <- filterChoices $ returnResources 1 [Fighter]
when (result == Nothing) $ do snd <$$> forCurrentPlayer $ when (result == Nothing) $
forCurrentPlayer $ takeResources 1 [Fighter] takeResources 1 [Fighter]
, _intrigueQuote = "" , _intrigueQuote = ""
}) })
, (3, IntrigueCard { _intrigueTitle = "Bidding War" , (3, IntrigueCard { _intrigueTitle = "Bidding War"
@ -184,10 +185,10 @@ defaultIntrigueDeck = concat $ map (uncurry replicate) $
}) })
, (2, IntrigueCard { _intrigueTitle = "Lack of Faith" , (2, IntrigueCard { _intrigueTitle = "Lack of Faith"
, _intrigueType = Attack , _intrigueType = Attack
, _intrigueAction = forEachOpponent $ do , _intrigueAction = actionProvidedSet <=< forEachOpponent $ do
result <- filterChoices $ returnResources 1 [Cleric] result <- filterChoices $ returnResources 1 [Cleric]
when (result == Nothing) $ do snd <$$> forCurrentPlayer $ when (result == Nothing) $
forCurrentPlayer $ scorePoints 2 scorePoints 2
, _intrigueQuote = "" , _intrigueQuote = ""
}) })
, (1, IntrigueCard { _intrigueTitle = "Real Estate Deal" , (1, IntrigueCard { _intrigueTitle = "Real Estate Deal"
@ -207,13 +208,14 @@ defaultIntrigueDeck = concat $ map (uncurry replicate) $
, _intrigueAction = do , _intrigueAction = do
takeResources 2 [Rogue] takeResources 2 [Rogue]
name <- use activePlayerName name <- use activePlayerName
forEachOpponent $ do actionProvidedSet <=< forEachOpponent $ do
join . solicitChoice ("Give " ++ name ++ " 1 Rogue for 3 points?") $ join . solicitChoice ("Give " ++ name ++ " 1 Rogue for 3 points?") $
[ ("Yes", do { returnResources 1 [Rogue] [ ("Yes", do { returnResources 1 [Rogue]
; forCurrentPlayer $ takeResources 1 [Rogue] ; (_, p) <- forCurrentPlayer $ takeResources 1 [Rogue]
; scorePoints 3 ; scorePoints 3
; return p
}) })
, ("No", return ()) , ("No", return mempty)
] ]
, _intrigueQuote = "" , _intrigueQuote = ""
}) })
@ -222,13 +224,14 @@ defaultIntrigueDeck = concat $ map (uncurry replicate) $
, _intrigueAction = do , _intrigueAction = do
takeResources 2 [Fighter] takeResources 2 [Fighter]
name <- use activePlayerName name <- use activePlayerName
forEachOpponent $ do actionProvidedSet <=< forEachOpponent $ do
join . solicitChoice ("Give " ++ name ++ " 1 Fighter for 3 points?") $ join . solicitChoice ("Give " ++ name ++ " 1 Fighter for 3 points?") $
[ ("Yes", do { returnResources 1 [Fighter] [ ("Yes", do { returnResources 1 [Fighter]
; forCurrentPlayer $ takeResources 1 [Fighter] ; (_, p) <- forCurrentPlayer $ takeResources 1 [Fighter]
; scorePoints 3 ; scorePoints 3
; return p
}) })
, ("No", return ()) , ("No", return mempty)
] ]
, _intrigueQuote = "" , _intrigueQuote = ""
}) })
@ -237,13 +240,14 @@ defaultIntrigueDeck = concat $ map (uncurry replicate) $
, _intrigueAction = do , _intrigueAction = do
takeResources 1 [Wizard] takeResources 1 [Wizard]
name <- use activePlayerName name <- use activePlayerName
forEachOpponent $ do actionProvidedSet <=< forEachOpponent $ do
join . solicitChoice ("Give " ++ name ++ " 1 Wizard for 5 points?") $ join . solicitChoice ("Give " ++ name ++ " 1 Wizard for 5 points?") $
[ ("Yes", do { returnResources 1 [Wizard] [ ("Yes", do { returnResources 1 [Wizard]
; forCurrentPlayer $ takeResources 1 [Wizard] ; (_, p) <- forCurrentPlayer $ takeResources 1 [Wizard]
; scorePoints 5 ; scorePoints 5
; return p
}) })
, ("No", return ()) , ("No", return mempty)
] ]
, _intrigueQuote = "" , _intrigueQuote = ""
}) })
@ -269,13 +273,14 @@ defaultIntrigueDeck = concat $ map (uncurry replicate) $
, _intrigueAction = do , _intrigueAction = do
takeResources 1 [Cleric] takeResources 1 [Cleric]
name <- use activePlayerName name <- use activePlayerName
forEachOpponent $ do actionProvidedSet <=< forEachOpponent $ do
join . solicitChoice ("Give " ++ name ++ " 1 Cleric for 5 points?") $ join . solicitChoice ("Give " ++ name ++ " 1 Cleric for 5 points?") $
[ ("Yes", do { returnResources 1 [Cleric] [ ("Yes", do { returnResources 1 [Cleric]
; forCurrentPlayer $ takeResources 1 [Cleric] ; (_, p) <- forCurrentPlayer $ takeResources 1 [Cleric]
; scorePoints 5 ; scorePoints 5
; return p
}) })
, ("No", return ()) , ("No", return mempty)
] ]
, _intrigueQuote = "" , _intrigueQuote = ""
}) })
@ -284,13 +289,14 @@ defaultIntrigueDeck = concat $ map (uncurry replicate) $
, _intrigueAction = do , _intrigueAction = do
takeResources 4 [Gold] takeResources 4 [Gold]
name <- use activePlayerName name <- use activePlayerName
forEachOpponent $ do actionProvidedSet <=< forEachOpponent $ do
join . solicitChoice ("Give " ++ name ++ " 4 Gold for 4 points?") $ join . solicitChoice ("Give " ++ name ++ " 4 Gold for 4 points?") $
[ ("Yes", do { returnResources 4 [Gold] [ ("Yes", do { returnResources 4 [Gold]
; forCurrentPlayer $ takeResources 4 [Gold] ; (_, p) <- forCurrentPlayer $ takeResources 4 [Gold]
; scorePoints 4 ; scorePoints 4
; return p
}) })
, ("No", return ()) , ("No", return mempty)
] ]
, _intrigueQuote = "" , _intrigueQuote = ""
}) })

16
src/Waterdeep/Logic.hs
View File

@ -16,6 +16,7 @@ import Control.Monad.Random
import Control.Monad.State import Control.Monad.State
import Control.Monad.Trans.Writer import Control.Monad.Trans.Writer
import Data.List import Data.List
import Data.Foldable (toList)
import Data.Maybe import Data.Maybe
import Data.Monoid import Data.Monoid
import Data.Traversable (traverse) import Data.Traversable (traverse)
@ -29,8 +30,8 @@ import Waterdeep.Types
import Waterdeep.Util import Waterdeep.Util
import qualified Data.IntMap as IM import qualified Data.IntMap as IM
import qualified Data.Map as M
import qualified Data.MultiSet as MS import qualified Data.MultiSet as MS
import qualified Data.Set as Set
newGame :: [(String,Faction,Lord)] newGame :: [(String,Faction,Lord)]
-> [Quest] -> [Quest]
@ -91,11 +92,18 @@ waterdeepGame = do
ambassadorIM <- IM.filter (view playerHasAmbassador) <$> use gamePlayerStates ambassadorIM <- IM.filter (view playerHasAmbassador) <$> use gamePlayerStates
unless (IM.null ambassadorIM) $ do unless (IM.null ambassadorIM) $ do
let p = head $ IM.keys ambassadorIM 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 fix $ \loop -> do
assign gameActivePlayer =<< use gameCurrentPlayer assign gameActivePlayer =<< use gameCurrentPlayer
filterChoices assignAgent >>= \case filterChoices (delimitAction assignAgent) >>= \case
Just () -> do 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?" $ filterChoices $ join $ solicitChoice "Complete a quest?" $
[ ("Yes", completeQuest) [ ("Yes", completeQuest)
, ("No", return ()) , ("No", return ())