From 2a7fe3abea4c42fd7f5f6886827f2d8edf0656a6 Mon Sep 17 00:00:00 2001 From: Jesse McDonald Date: Sat, 26 Apr 2014 20:55:46 -0500 Subject: [PATCH] implement assigning agents & playing intrigue cards --- src/Test.hs | 16 +++++- src/Waterdeep/Logic.hs | 127 +++++++++++++++++++++++++++++++++++------ src/Waterdeep/Types.hs | 7 +-- 3 files changed, 126 insertions(+), 24 deletions(-) diff --git a/src/Test.hs b/src/Test.hs index df7f473..30024f4 100644 --- a/src/Test.hs +++ b/src/Test.hs @@ -95,6 +95,20 @@ b5 = Building { _buildingCost = 4 , _buildingAccumType = NoAccumulation } +i1 = IntrigueCard { _intrigueTitle = "Graduation Day" + , _intrigueType = Utility + , _intrigueAction = mrepeat 2 (TakeResource [Wizard]) + <> OneOpponent (TakeResource [Wizard]) + , _intrigueQuote = "" + } + +i2 = IntrigueCard { _intrigueTitle = "Call for Adventurers" + , _intrigueType = Utility + , _intrigueAction = mrepeat 2 (TakeResource [Cleric, Fighter, Rogue, Wizard]) + <> OneOpponent (TakeResource [Cleric, Fighter, Rogue, Wizard]) + , _intrigueQuote = "" + } + clearScreen :: IO () clearScreen = putStr "\o033[H\o033[2J" >> hFlush stdout @@ -177,7 +191,7 @@ menuPrompt ref redraw prm@(SolicitChoice p t cs) = do main :: IO () main = do - w0 <- newGame [p1, p2] [q1, q2] [] [b1, b2, b3, b4, b5] <$> getSplit + w0 <- newGame [p1, p2] [q1, q2] [i1, i2] [b1, b2, b3, b4, b5] <$> getSplit ref <- newIORef (DisplayState { _gameState = w0, _gameMessages = [] }) let gamePlayerName n = w0 ^. gamePlayer n . playerName (winners, w') <- runWaterdeepM (menuPrompt ref (drawState ref)) waterdeepGame w0 diff --git a/src/Waterdeep/Logic.hs b/src/Waterdeep/Logic.hs index a557d2c..8fe718a 100644 --- a/src/Waterdeep/Logic.hs +++ b/src/Waterdeep/Logic.hs @@ -14,6 +14,7 @@ import Control.Lens import Control.Monad import Control.Monad.Random import Control.Monad.State +import Control.Monad.Writer import Data.List import Data.Maybe import Data.Monoid @@ -21,6 +22,7 @@ import System.Random.Shuffle import Text.Printf import Waterdeep.Types import Waterdeep.Monad +import Waterdeep.Util import qualified Data.IntMap as IM import qualified Data.Map as M @@ -48,9 +50,8 @@ newGame players quests intrigues buildings rndgen , _gameIntrigueDiscard = intrigues , _gameBuildingDeck = [] , _gameBuildingDiscard = buildings - , _gameBasicBuildings = map (newBuildingState noPlayerID) basicBuildings , _gameBuildersHall = [] - , _gameAdvancedBuildings = [] + , _gameBuildings = map (newBuildingState noPlayerID) basicBuildings , _gameWaterdeepHarbor = ([], [], []) , _gameStdGen = rndgen } @@ -86,7 +87,25 @@ newBuildingState p b = } basicBuildings :: [Building] -basicBuildings = [] +basicBuildings = + [ basicBuilding "Aurora's Realms Shop" (mrepeat 4 $ TakeResource [Gold]) + , basicBuilding "Blackstaff Tower" (TakeResource [Wizard]) + , basicBuilding "Builder's Hall" BuyBuilding + , basicBuilding "Castle Waterdeep" (BecomeFirstPlayer `Then` DrawIntrigue) + , basicBuilding "Field of Triumph" (mrepeat 2 $ TakeResource [Fighter]) + , basicBuilding "The Grinning Lion Tavern" (mrepeat 2 $ TakeResource [Rogue]) + , basicBuilding "The Plinth" (TakeResource [Cleric]) + ] + +basicBuilding :: String -> GameAction -> Building +basicBuilding title action = + Building + { _buildingCost = 0 + , _buildingTitle = title + , _buildingAction = action + , _buildingOwnerAction = NoAction + , _buildingAccumType = NoAccumulation + } waterdeepGame :: Waterdeep [PlayerID] waterdeepGame = do @@ -111,13 +130,6 @@ waterdeepGame = do False -> do passes <- gameConsecutivePasses <+= 1 when (passes < length ps) loop - performAction 1 $ TakeResource [Cleric, Fighter, Rogue, Wizard, Gold] - filterChoices $ performAction 1 $ - ReturnResource [Wizard] - <> ReturnResource [Cleric, Fighter, Gold] - <> ReturnResource [Cleric, Fighter] - <> (ReturnResource [Cleric] `OrElse` TakeResource [Cleric]) - -- performAction 2 $ ChooseQuest scoreFinalPoints notifyState determineWinners @@ -126,14 +138,13 @@ beginRound :: Int -> Waterdeep () beginRound round = do gameCurrentRound .= round gameCurrentPlayer <~ use gameFirstPlayer - gameBasicBuildings . traverse . buildingAgents .= [] - gameAdvancedBuildings . traverse . buildingAgents .= [] + gameBuildings . traverse . buildingAgents .= [] gameBuildersHall . traverse . buildingAgents .= [] gameBuildersHall . traverse . buildingAccumulation += 1 players <- IM.size <$> use gamePlayers forM_ [1..players] $ \p -> do qs <- gamePlayer p . playerUsedPlotQuests <<.= [] - gamePlayer p . playerActivePlotQuests %= (++ qs) + gamePlayer p . playerActivePlotQuests <>= qs gamePlayer p . playerAgentsInPool .= initialAgents players round notifyState return () @@ -212,7 +223,7 @@ performAction p a = do let names = qs ^.. traverse . questTitle q <- solicitChoice p "Please choose a quest:" $ zip names qs gameCliffwatchInn %= (\\ [q]) - gamePlayer p . playerIncompleteQuests %= (++ [q]) + gamePlayer p . playerIncompleteQuests <>= [q] broadcast $ name ++ " chose " ++ (q ^. questTitle) ++ " from Cliffwatch Inn." restockCliffwatchInn return True @@ -221,7 +232,7 @@ performAction p a = do case mq of Nothing -> return False Just q -> do - gamePlayer p . playerIncompleteQuests %= (++[q]) + gamePlayer p . playerIncompleteQuests <>= [q] broadcast $ name ++ " drew " ++ (q ^. questTitle) ++ " from the quest deck." return True DrawIntrigue -> do @@ -229,8 +240,64 @@ performAction p a = do case mi of Nothing -> return False Just i -> do - gamePlayer p . playerIntrigueCards %= (++[i]) + gamePlayer p . playerIntrigueCards <>= [i] return True + PlayIntrigue -> do + intrigues <- use (gamePlayer p . playerIntrigueCards) + if null intrigues + then return False + else do + let sameTitle a b = fst a == fst b + let choices = nubBy sameTitle $ zip (map (view intrigueTitle) intrigues) [0..] + i <- solicitChoice p "Play one intrigue card:" choices + let deleteAt n l = (take n l) ++ (drop (n + 1) l) + gamePlayer p . playerIntrigueCards %= deleteAt i + performAction p (intrigues ^. singular (ix i) . intrigueAction) + AssignAgent -> do + agents <- use (gamePlayer p . playerAgentsInPool) + if agents <= 0 + then return False + else do + w <- get + let assignToBuilding :: Lens' WaterdeepState BuildingState -> Waterdeep Bool + assignToBuilding bl = do + gamePlayer p . playerAgentsInPool -= 1 + bl . buildingAgents <>= [p] + bName <- use (bl . building . buildingTitle) + broadcast $ name ++ " assigned an agent to " ++ bName ++ "." + owner <- use (bl . buildingOwner) + when (owner /= noPlayerID) $ + void . performAction owner =<< use (bl . building . buildingOwnerAction) + performAction p =<< use (bl . building . buildingAction) + let assignToHarbor l = do + gamePlayer p . playerAgentsInPool -= 1 + gameWaterdeepHarbor . l <>= [p] + broadcast $ name ++ " assigned an agent to Waterdeep Harbor." + performAction p PlayIntrigue + let findBuildings :: Writer [(String, Waterdeep Bool)] () + findBuildings = do + forM_ [0 .. length (w ^. gameBuildings) - 1] $ \i -> do + let l :: Lens' WaterdeepState BuildingState + l = gameBuildings . singular (ix i) + when (null (w ^. l . buildingAgents)) $ do + tell [(w ^. l . building . buildingTitle, assignToBuilding l)] + case w ^. gameWaterdeepHarbor of + ([], _, _) -> tell [("Waterdeep Harbor", assignToHarbor _1)] + (_, [], _) -> tell [("Waterdeep Harbor", assignToHarbor _2)] + (_, _, []) -> tell [("Waterdeep Harbor", assignToHarbor _3)] + _ -> return () + let buildings = execWriter findBuildings + if null buildings + then return False + else do + join $ solicitChoice p "Assign one agent to:" buildings + Optional a1 -> do + join $ solicitChoice p "Perform action?" $ + [ ("Yes", performAction p a1) + , ("No", return False)] + ChooseOne as -> do + a1 <- solicitChoice p "Choose an action:" $ map (show &&& id) as + performAction p a1 a1 `Then` a2 -> do (&&) <$> performAction p a1 <*> performAction p a2 a1 `OrElse` a2 -> do @@ -238,6 +305,28 @@ performAction p a = do case r1 of True -> return True False -> performAction p a2 + ForEachBuilding a1 -> do + nb <- length . filter (\b -> b ^. buildingOwner /= noPlayerID) <$> use gameBuildings + and <$> replicateM nb (performAction p a1) + ForEachControlledBuilding a1 -> do + nb <- length . filter (\b -> b ^. buildingOwner == p) <$> use gameBuildings + and <$> replicateM nb (performAction p a1) + OneOpponent a1 -> do + players <- toListOf traverse <$> use gamePlayers + let opponents = filter (\player -> (player ^. playerNumber) /= p) players + let choices = map (\p -> (p ^. playerName, p ^. playerNumber)) opponents + opID <- solicitChoice p "Choose one opponent:" choices + opName <- use (gamePlayer opID . playerName) + broadcast $ name ++ " chose " ++ opName ++ "." + performAction opID a1 + EachOpponent a1 -> do + players <- toListOf traverse <$> use gamePlayers + let opponents = filter (\player -> (player ^. playerNumber) /= p) players + forM_ opponents $ \op -> do + performAction (op ^. playerNumber) a1 + return True + CurrentPlayer a1 -> + flip performAction a1 =<< use gameCurrentPlayer _ -> return False scoreFinalPoints :: Waterdeep () @@ -260,7 +349,7 @@ scoreFinalPoints = do (p ^. playerName) (matches * pts) matches (show (types !! 0)) (show (types !! 1)) BuildingBonus pts -> do - ownedBuildings <- length <$> filter ((== (p ^. playerNumber)) . (view buildingOwner)) <$> use gameAdvancedBuildings + ownedBuildings <- length <$> filter ((== (p ^. playerNumber)) . (view buildingOwner)) <$> use gameBuildings gamePlayer (p ^. playerNumber) . playerScore += ownedBuildings * pts when (ownedBuildings > 0) $ broadcast $ printf "%s scored %d points for controlling %d buildings." @@ -308,7 +397,7 @@ restockCliffwatchInn = do case mq of Nothing -> return () Just q -> do - gameCliffwatchInn %= (++ [q]) + gameCliffwatchInn <>= [q] broadcast $ "Added " ++ (q ^. questTitle) ++ " to Cliffwatch Inn." restockCliffwatchInn @@ -320,6 +409,6 @@ restockBuildersHall = do case mb of Nothing -> return () Just b -> do - gameBuildersHall %= (++ [newBuildingState noPlayerID b]) + gameBuildersHall <>= [newBuildingState noPlayerID b] broadcast $ "Added " ++ (b ^. buildingTitle) ++ " to Builder's Hall." restockBuildersHall diff --git a/src/Waterdeep/Types.hs b/src/Waterdeep/Types.hs index b856622..bbb474d 100644 --- a/src/Waterdeep/Types.hs +++ b/src/Waterdeep/Types.hs @@ -69,9 +69,8 @@ module Waterdeep.Types , gameIntrigueDiscard , gameBuildingDeck , gameBuildingDiscard - , gameBasicBuildings , gameBuildersHall - , gameAdvancedBuildings + , gameBuildings , gameWaterdeepHarbor , gameStdGen , gamePlayer @@ -165,9 +164,8 @@ data WaterdeepState = , _gameIntrigueDiscard :: [IntrigueCard] , _gameBuildingDeck :: [Building] , _gameBuildingDiscard :: [Building] - , _gameBasicBuildings :: [BuildingState] , _gameBuildersHall :: [BuildingState] - , _gameAdvancedBuildings :: [BuildingState] + , _gameBuildings :: [BuildingState] , _gameWaterdeepHarbor :: ([PlayerID], [PlayerID], [PlayerID]) , _gameStdGen :: StdGen } deriving (Show) @@ -223,6 +221,7 @@ data GameAction = NoAction | TakeAccumulated | TakeResourceFromOpponent [Resource] | AssignMandatoryQuest Quest + | BecomeFirstPlayer | Optional GameAction | ChooseOne [GameAction] | Then GameAction GameAction