change _playerTavern to a Map and implement additional actions

src/Test.hs

@@ -25,6 +25,30 @@ f2 = Faction "Pilots" Green
 l2 = Lord "Princess Anastasia" "" (QuestBonus [Arcana, Warfare] 4)
 p2 = ("Ned", f2, l2)
 
+q1 = Quest { _questType = Arcana
+           , _questTitle = "Research Palantirs"
+           , _questQuote = ""
+           , _questAction = Transaction $
+                              [ Transaction $
+                                 map (\r -> ReturnResource [r]) [Cleric,Rogue,Rogue,Wizard]
+                              , Repeat 4 $ ReturnResource [Gold]
+                              , ScorePoints 15
+                              , Repeat 8 $ TakeResource [Gold]
+                              ]
+           , _questPlotActions = []
+           }
+
+q2 = Quest { _questType = Skullduggery
+           , _questTitle = "Rob Waterdeep Bank"
+           , _questQuote = ""
+           , _questAction = Transaction $
+                              [ Repeat 8 $ ReturnResource [Rogue]
+                              , ScorePoints 10
+                              , Repeat 16 $ TakeResource [Gold]
+                              ]
+           , _questPlotActions = []
+           }
+
 b1 = Building { _buildingCost = 6
               , _buildingTitle = "Monastary"
               , _buildingAction = Group [TakeResource [Cleric], TakeResource [Cleric]]
@@ -116,7 +140,7 @@ dummyPrompt prm@(SolicitChoice w p t cs) = do
 
 main :: IO ()
 main = do
-   w <- newGame [p1, p2] [] [] [b1,b2,b3,b4,b5]
+   w <- newGame [p1, p2] [q1, q2] [] [b1, b2, b3, b4, b5]
    winners <- fst <$> runWaterdeepM dummyPrompt waterdeepGame w
    let gamePlayerName n = w ^. gamePlayer n . playerName
-   putStrLn ("Winner(s): " ++ intercalate ", " (toListOf (traverse . to gamePlayerName) winners))
+   putStrLn ("Winner(s): " ++ intercalate ", " (winners ^.. traverse . to gamePlayerName))

src/Waterdeep/Logic.hs

@@ -9,6 +9,7 @@ module Waterdeep.Logic
    ) where
 
 import Control.Applicative
+import Control.Arrow ((&&&))
 import Control.Lens
 import Control.Monad
 import Control.Monad.Random
@@ -20,6 +21,7 @@ import Waterdeep.Types
 import Waterdeep.Monad
 
 import qualified Data.IntMap as IM
+import qualified Data.Map    as M
 
 newGame :: (MonadRandom m, MonadSplit StdGen m)
         => [(String,Faction,Lord)]
@@ -79,7 +81,7 @@ newPlayerState i name faction lord =
       , _playerFaction          = faction
       , _playerLord             = lord
       , _playerScore            = 0
-      , _playerTavern           = []
+      , _playerTavern           = M.empty
       , _playerIncompleteQuests = []
       , _playerCompletedQuests  = []
       , _playerActivePlotQuests = []
@@ -97,29 +99,71 @@ waterdeepGame :: Waterdeep [PlayerID]
 waterdeepGame = do
    forM_ [1..8] $ \round -> do
       beginRound round
-      void $ solicitChoice 1 "Choose one" [("Option A", ()), ("Option B", ())]
+      performAction 1 $ TakeResource [Cleric, Fighter, Rogue, Wizard, Gold]
+      performAction 2 $ ChooseQuest
    notifyState
    determineWinners
 
 beginRound :: Int -> Waterdeep ()
 beginRound round = do
-   gameCurrentRound .= round
+   gameCurrentRound  .= round
+   gameCurrentPlayer <~ use gameFirstPlayer
+   gameBasicBuildings    . traverse . _2 .= []
+   gameAdvancedBuildings . traverse . _2 .= []
+   gameBuildersHall      . traverse . _2 .= []
+   gameBuildersHall      . traverse . _3 += 1
+   players <- IM.size <$> use gamePlayers
+   forM_ [1..players] $ \p -> do
+      qs <- gamePlayer p . playerUsedPlotQuests <<.= []
+      gamePlayer p . playerActivePlotQuests %= (++ qs)
+      gamePlayer p . playerAgentsInPool .= initialAgents players round
    notifyState
    return ()
 
+initialAgents :: Int -> Int -> Int
+initialAgents players round =
+   if round >= 5 then startingAgents + 1 else startingAgents
+   where startingAgents = 6 - players
+
 performAction :: PlayerID -> GameAction -> Waterdeep Bool
 performAction p a = case a of
+   ScorePoints n -> do
+      gamePlayer p . playerScore += n
+      return True
+   TakeResource rs -> do
+      r <- solicitChoice p "Please choose one:" $ map (show &&& id) rs
+      gamePlayer p . playerTavern %= flip (M.unionWith (+)) (M.fromList [(r, 1)])
+      return True
+   ChooseQuest -> do
+      qs <- use gameCliffwatchInn
+      if null qs
+         then return False
+         else do
+            let names = qs ^.. traverse . questTitle
+            q <- solicitChoice p "Please choose a quest:" $ zip names qs
+            gameCliffwatchInn %= (\\ [q])
+            gamePlayer p . playerIncompleteQuests %= (++ [q])
+            restockCliffwatchInn
+            return True
    DrawQuest -> do
       mq <- drawQuest
       case mq of
          Nothing -> return False
          Just q  -> do
-            gamePlayers . singular (ix p) . playerIncompleteQuests %= (++[q])
+            gamePlayer p . playerIncompleteQuests %= (++[q])
+            return True
+   DrawIntrigue -> do
+      mi <- drawIntrigue
+      case mi of
+         Nothing -> return False
+         Just i  -> do
+            gamePlayer p . playerIntrigueCards %= (++[i])
             return True
    _ -> return False
 
 determineWinners :: Waterdeep [PlayerID]
 determineWinners = do
+   -- TODO: Implement tie-breaker(s)
    let compareScores a b = (b^.playerScore) `compare` (a^.playerScore)
    ps <- sortBy compareScores <$> toListOf traverse <$> use gamePlayers
    let bestScore = (head ps) ^. playerScore

src/Waterdeep/Monad.hs

@@ -63,7 +63,9 @@ notifyState :: Waterdeep ()
 notifyState = get >>= Waterdeep . lift . prompt . NotifyState
 
 solicitChoice :: PlayerID -> String -> [(String, a)] -> Waterdeep a
-solicitChoice p t cs = do
+solicitChoice _ _ []  = error "There must be at least one option to choose."
+solicitChoice _ _ [c] = return (snd c)  -- only one option, don't bother asking
+solicitChoice p t cs  = do
    notifyState
    w <- get
    Waterdeep $ lift $ prompt (SolicitChoice w p t cs)

src/Waterdeep/Types.hs

@@ -74,6 +74,7 @@ module Waterdeep.Types
 
 import Control.Lens
 import Data.IntMap (IntMap)
+import Data.Map (Map)
 import System.Random (StdGen)
 
 type PlayerID = Int
@@ -124,7 +125,7 @@ data PlayerState =
       , _playerFaction          :: Faction
       , _playerLord             :: Lord
       , _playerScore            :: Int
-      , _playerTavern           :: [(Int,Resource)]
+      , _playerTavern           :: Map Resource Int
       , _playerIncompleteQuests :: [Quest]
       , _playerCompletedQuests  :: [Quest]
       , _playerActivePlotQuests :: [Quest]
@@ -247,3 +248,12 @@ instance Eq Faction where
 
 instance Ord Faction where
    a `compare` b = (a^.factionColor) `compare` (b^.factionColor)
+
+instance Eq Quest where
+   a == b = a^.questTitle == b^.questTitle
+
+instance Eq Building where
+   a == b = a^.buildingTitle == b^.buildingTitle
+
+instance Eq IntrigueCard where
+   a == b = a^.intrigueTitle == b^.intrigueTitle