diff --git a/src/Test.hs b/src/Test.hs index e48d760..11471d8 100644 --- a/src/Test.hs +++ b/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)) diff --git a/src/Waterdeep/Logic.hs b/src/Waterdeep/Logic.hs index 4161459..92f0806 100644 --- a/src/Waterdeep/Logic.hs +++ b/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 diff --git a/src/Waterdeep/Monad.hs b/src/Waterdeep/Monad.hs index 00bc657..ccf7b80 100644 --- a/src/Waterdeep/Monad.hs +++ b/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) diff --git a/src/Waterdeep/Types.hs b/src/Waterdeep/Types.hs index 743f8bb..c79f038 100644 --- a/src/Waterdeep/Types.hs +++ b/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