implement assigning agents & playing intrigue cards

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

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 .= []
+   gameBuildings    . traverse . buildingAgents .= []
-   gameAdvancedBuildings . 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

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