diff --git a/src/ConsoleUI.hs b/src/ConsoleUI.hs index a32ce45..416e3c8 100755 --- a/src/ConsoleUI.hs +++ b/src/ConsoleUI.hs @@ -6,7 +6,6 @@ module Main (main) where import Control.Applicative -import Control.Lens import Control.Monad import Control.Monad.Prompt import Control.Monad.Random @@ -14,6 +13,11 @@ import Control.Monad.State import Data.IORef import Data.List import Data.Monoid +import Data.Traversable (traverse) +import Lens.Family2 +import Lens.Family2.Stock +import Lens.Family2.State +import Lens.Family2.TH import System.IO import System.Random import System.Random.Shuffle @@ -141,7 +145,7 @@ printWaterdeep w = do putStrLn (" " ++ (q ^. questTitle)) putStrLn "" putStrLn "Builder's Hall:" - forM_ (w ^. gameBuildersHall) $ \b -> do + forM_ (w ^.. gameBuildersHall . traverse) $ \b -> do printf " %s (%d gold -> %d points)\n" (b ^. building . buildingTitle) (b ^. building . buildingCost) diff --git a/src/Waterdeep/Actions.hs b/src/Waterdeep/Actions.hs index 11a2679..0696eb2 100644 --- a/src/Waterdeep/Actions.hs +++ b/src/Waterdeep/Actions.hs @@ -44,22 +44,28 @@ module Waterdeep.Actions import Control.Applicative import Control.Arrow ((&&&)) -import Control.Lens import Control.Monad import Control.Monad.Random import Control.Monad.State import Control.Monad.Trans.Writer +import Data.Function import Data.List import Data.Maybe import Data.Monoid +import Data.Traversable (traverse) +import Lens.Family2 +import Lens.Family2.State +import Lens.Family2.Stock import System.Random.Shuffle import Text.Printf import Waterdeep.Types import Waterdeep.Util -import qualified Data.IntMap as IM -import qualified Data.Map as M -import qualified Data.MultiSet as MS +import qualified Data.Foldable as F +import qualified Data.IntMap as IM +import qualified Data.Map as M +import qualified Data.MultiSet as MS +import qualified Data.Traversable as T noAction :: GameAction noAction = return () @@ -110,7 +116,8 @@ chooseQuest = do replaceQuests :: GameAction replaceQuests = do - quests <- gameCliffwatchInn <<.= [] + quests <- use gameCliffwatchInn + gameCliffwatchInn .= [] gameQuestDiscard <>= quests restockCliffwatchInn @@ -201,56 +208,62 @@ discardUncompletedQuest = do name <- use $ activePlayerName broadcast $ name ++ " discarded the " ++ (quest ^. questTitle) ++ " quest." +chooseFromBuildersHall :: Waterdeep (Int, BuildingState) +chooseFromBuildersHall = do + choices <- IM.foldrWithKey accumBuildings [] <$> use gameBuildersHall + (i, b) <- solicitChoice "Choose a building from Builder's Hall:" $ nubOn fst choices + gameBuildersHall . intAt i .= Nothing + return (i, b) + where + accumBuildings i b a = (label b, (i, b)) : a + label b = printf "%s (%d Gold, %d Points)" + (b ^. building . buildingTitle) + (b ^. building . buildingCost) + (b ^. buildingAccumulation) + buyBuilding :: GameAction buyBuilding = do - let label b = printf "%s (%d Gold, %d Points)" - (b ^. building . buildingTitle) - (b ^. building . buildingCost) - (b ^. buildingAccumulation) - choices <- zipWith (\i b -> (label b, (i, b))) [0..] <$> use gameBuildersHall - (i, b) <- solicitChoice "Choose a building from Builder's Hall:" $ nubOn fst choices - let cost = b ^. building . buildingCost - returnResources cost [Gold] - scorePoints (b ^. buildingAccumulation) - gameBuildersHall %= deleteAt i - p <- use gameActivePlayer - gameBuildings <>= [b & buildingOwner .~ p & buildingAccumulation .~ 0] - name <- use $ activePlayerName + (i, b) <- chooseFromBuildersHall + p <- use gameActivePlayer + name <- use activePlayerName + returnResources (b ^. building . buildingCost) [Gold] + newKey <- (+1) . fst . IM.findMax <$> use gameBuildings + let newState = b & buildingOwner .~ p & buildingAccumulation .~ 0 + gameBuildings %= IM.insert newKey newState broadcast $ name ++ " built the " ++ (b ^. building . buildingTitle) ++ "." + scorePoints (b ^. buildingAccumulation) restockBuildersHall chooseFreeBuilding :: GameAction chooseFreeBuilding = do - let label b = printf "%s (%d Points)" - (b ^. building . buildingTitle) - (b ^. buildingAccumulation) - choices <- zipWith (\i b -> (label b, (i, b))) [0..] <$> use gameBuildersHall - (i, b) <- solicitChoice "Choose a building from Builder's Hall:" $ nubOn fst choices - scorePoints (b ^. buildingAccumulation) - gameBuildersHall %= deleteAt i - p <- use gameActivePlayer - gameBuildings <>= [b & buildingOwner .~ p & buildingAccumulation .~ 0] - name <- use $ activePlayerName + (i, b) <- chooseFromBuildersHall + p <- use gameActivePlayer + name <- use activePlayerName + newKey <- (+1) . fst . IM.findMax <$> use gameBuildings + let newState = b & buildingOwner .~ p & buildingAccumulation .~ 0 + gameBuildings %= IM.insert newKey newState broadcast $ name ++ " built the " ++ (b ^. building . buildingTitle) ++ " for free." + scorePoints (b ^. buildingAccumulation) restockBuildersHall drawFreeBuilding :: GameAction drawFreeBuilding = do Just b <- drawBuilding' p <- use gameActivePlayer - gameBuildings <>= [newBuildingState p b] + newKey <- (+1) . fst . IM.findMax <$> use gameBuildings + gameBuildings %= IM.insert newKey (newBuildingState p b) name <- use $ activePlayerName broadcast $ name ++ " built the " ++ (b ^. buildingTitle) ++ " for free." discardUnoccupiedBuilding :: GameAction discardUnoccupiedBuilding = do - allBuildings <- zip [0..] <$> use gameBuildings + allBuildings <- IM.toAscList <$> use gameBuildings p <- use gameActivePlayer let ownedBuildings = filter ((== p) . view buildingOwner . snd) allBuildings let emptyBuildings = filter (null . view buildingAgents . snd) ownedBuildings let choices = map (\(i,b) -> (b ^. building . buildingTitle, (i, b))) emptyBuildings (i, b) <- solicitChoice "Choose a building to discard:" $ nubOn fst choices - gameBuildings %= deleteAt i + gameBuildings . intAt i .= Nothing gameBuildingDiscard <>= [b ^. building] name <- use $ activePlayerName broadcast $ name ++ " discarded the " ++ (b ^. building . buildingTitle) ++ "." @@ -280,24 +293,24 @@ returnAgent = return () -- TODO returnAgentFromHarbor :: GameAction returnAgentFromHarbor = return () -- TODO -assignAgentToBuilding :: Lens' WaterdeepState BuildingState -> Waterdeep () -assignAgentToBuilding bl = do - activePlayerState . playerAgentsInPool -= 1 +assignAgentToBuilding :: Traversal' WaterdeepState BuildingState -> Waterdeep () +assignAgentToBuilding bt = do + activePlayerState.playerAgentsInPool -= 1 p <- use gameActivePlayer - bl . buildingAgents <>= [p] + bt.buildingAgents <>= [p] name <- use $ activePlayerName - bName <- use (bl . building . buildingTitle) + bName <- fromJust . firstOf (bt.building.buildingTitle) <$> get broadcast $ name ++ " assigned an agent to " ++ bName ++ "." - owner <- use (bl . buildingOwner) + owner <- fromJust . firstOf (bt.buildingOwner) <$> get when (owner `notElem` [noPlayerID, p]) $ - withActivePlayer owner =<< use (bl . building . buildingOwnerAction) - join $ use (bl . building . buildingAction) + withActivePlayer owner . fromJust . firstOf (bt.building.buildingOwnerAction) =<< get + fromJust . firstOf (bt.building.buildingAction) =<< get -assignAgentToHarbor :: Lens' ([PlayerID], [PlayerID], [PlayerID]) [PlayerID] -> Waterdeep () -assignAgentToHarbor l = do - activePlayerState . playerAgentsInPool -= 1 +assignAgentToHarbor :: Traversal' WaterdeepState [PlayerID] -> Waterdeep () +assignAgentToHarbor t = do + activePlayerState.playerAgentsInPool -= 1 p <- use gameActivePlayer - gameWaterdeepHarbor . l <>= [p] + t <>= [p] name <- use $ activePlayerName broadcast $ name ++ " assigned an agent to Waterdeep Harbor." playIntrigue @@ -308,16 +321,21 @@ assignAgent = do guard (agents > 0) w <- get let buildings = execWriter $ 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, assignAgentToBuilding l)] - case w ^. gameWaterdeepHarbor of - ([], _, _) -> tell [("Waterdeep Harbor", assignAgentToHarbor _1)] - (_, [], _) -> tell [("Waterdeep Harbor", assignAgentToHarbor _2)] - (_, _, []) -> tell [("Waterdeep Harbor", assignAgentToHarbor _3)] - _ -> return () + forM_ (w ^. gameBuildings . to IM.keys) $ \i -> do + let t :: Traversal' WaterdeepState BuildingState + t = gameBuildings . intAt i . traverse + when (anyOf (t . buildingAgents) null w) $ do + let title = fromJust $ firstOf (t.building.buildingTitle) w + tell [(title, assignAgentToBuilding t)] + let harbor = getFirst $ flip F.foldMap [1,2,3] $ \i -> First $ + let t :: Traversal' WaterdeepState [PlayerID] + t = gameWaterdeepHarbor . intAt i . traverse + in if (anyOf t null w) + then Just (assignAgentToHarbor t) + else Nothing + case harbor of + Just f -> tell [("Waterdeep Harbor", f)] + Nothing -> return () join $ solicitChoice "Assign one agent to:" $ nubOn fst buildings assignAgentToBuildersHall :: GameAction @@ -340,8 +358,8 @@ gainLieutenant = do gainAmbassador :: GameAction gainAmbassador = do guard . not . or . toListOf (traverse . playerHasAmbassador) =<< use gamePlayerStates - gameBuildings . each . buildingAgents %= (\\ [noPlayerID]) - gameWaterdeepHarbor . each %= (\\ [noPlayerID]) + gameBuildings . traverse . buildingAgents %= (\\ [noPlayerID]) + gameWaterdeepHarbor . traverse %= (\\ [noPlayerID]) activePlayerState . playerHasAmbassador .= True name <- use $ activePlayerName broadcast $ name ++ " gained the Ambassador." @@ -357,7 +375,7 @@ assignMandatoryQuest quest = do becomeFirstPlayer :: GameAction becomeFirstPlayer = do - gameFirstPlayer <~ use gameActivePlayer + assign gameFirstPlayer =<< use gameActivePlayer name <- use $ activePlayerName broadcast $ name ++ " is now the first player." @@ -432,16 +450,19 @@ restockCliffwatchInn = do restockBuildersHall :: Waterdeep () restockBuildersHall = do - num <- length <$> use gameBuildersHall - when (num < 3) $ do - mb <- drawBuilding' - case mb of - Nothing -> return () - Just b -> do - gameBuildersHall <>= [newBuildingState noPlayerID b] - broadcast $ "Added " ++ (b ^. buildingTitle) ++ " to Builder's Hall." - restockBuildersHall - + hall <- use gameBuildersHall + let missing = getFirst $ flip F.foldMap [1,2,3] $ \i -> First $ + if i `IM.member` hall then Nothing else Just i + case missing of + Nothing -> return () + Just i -> do + mb <- drawBuilding' + case mb of + Nothing -> return () + Just b -> do + gameBuildersHall . intAt i .= Just (newBuildingState noPlayerID b) + broadcast $ "Added " ++ (b ^. buildingTitle) ++ " to Builder's Hall." + restockBuildersHall getOpponents :: Waterdeep [PlayerState] getOpponents = do @@ -449,10 +470,13 @@ getOpponents = do filter (\p1 -> (p1 ^. playerNumber) /= p) . toListOf traverse <$> use gamePlayerStates getNumberOfBuildings :: Waterdeep Int -getNumberOfBuildings = - length . filter (\b -> b ^. buildingOwner /= noPlayerID) <$> use gameBuildings +getNumberOfBuildings = countOf traverse isOwned <$> use gameBuildings + where + isOwned b = b ^. buildingOwner /= noPlayerID getNumberOfControlledBuildings :: Waterdeep Int getNumberOfControlledBuildings = do p <- use gameActivePlayer - length . filter (\b -> b ^. buildingOwner == p) <$> use gameBuildings + countOf traverse (`isOwnedBy` p) <$> use gameBuildings + where + b `isOwnedBy` p = b ^. buildingOwner == p diff --git a/src/Waterdeep/Logic.hs b/src/Waterdeep/Logic.hs index 31bb7c2..bdee97d 100644 --- a/src/Waterdeep/Logic.hs +++ b/src/Waterdeep/Logic.hs @@ -11,7 +11,6 @@ module Waterdeep.Logic import Control.Applicative import Control.Arrow ((&&&)) -import Control.Lens import Control.Monad import Control.Monad.Random import Control.Monad.State @@ -19,6 +18,10 @@ import Control.Monad.Trans.Writer import Data.List import Data.Maybe import Data.Monoid +import Data.Traversable (traverse) +import Lens.Family2 +import Lens.Family2.State +import Lens.Family2.Stock import System.Random.Shuffle import Text.Printf import Waterdeep.Actions @@ -51,13 +54,15 @@ newGame players quests intrigues buildings rndgen = , _gameIntrigueDiscard = intrigues , _gameBuildingDeck = [] , _gameBuildingDiscard = buildings - , _gameBuildersHall = [] - , _gameBuildings = map (newBuildingState noPlayerID) basicBuildings - , _gameWaterdeepHarbor = ([], [], []) + , _gameBuildersHall = IM.empty + , _gameBuildings = IM.fromAscList buildingStates + , _gameWaterdeepHarbor = IM.fromAscList [(1,[]),(2,[]),(3,[])] , _gameStdGen = rndgen } where - playerStates = [ (i, newPlayerState i p) | (i, p) <- zip [1..] players ] + playerStates = zipWith (\i p -> (i, newPlayerState i p)) [1..] players + buildingStates = zipWith (\i b -> (i, newBuildingState np b)) [1..] basicBuildings + np = noPlayerID basicBuildings :: [Building] basicBuildings = @@ -97,7 +102,7 @@ waterdeepGame = do beginRound round -- TODO: Assign ambassador (if in play) fix $ \loop -> do - gameActivePlayer <~ use gameCurrentPlayer + assign gameActivePlayer =<< use gameCurrentPlayer filterChoices assignAgent >>= \case Just () -> do filterChoices $ join $ solicitChoice "Complete a quest?" $ @@ -108,7 +113,8 @@ waterdeepGame = do advanceToNextPlayer loop Nothing -> do - passes <- gameConsecutivePasses <+= 1 + gameConsecutivePasses += 1 + passes <- use gameConsecutivePasses when (passes < np) $ do advanceToNextPlayer loop @@ -125,18 +131,19 @@ beginRound :: Int -> Waterdeep () beginRound round = do broadcast $ "Starting round " ++ show round ++ "." gameCurrentRound .= round - gameCurrentPlayer <~ use gameFirstPlayer - gameActivePlayer <~ use gameFirstPlayer - gameBuildings . traverse . buildingAgents .= [] - gameBuildersHall . traverse . buildingAgents .= [] - gameBuildersHall . traverse . buildingAccumulation += 1 - gameWaterdeepHarbor . each .= [] + assign gameCurrentPlayer =<< use gameFirstPlayer + assign gameActivePlayer =<< use gameFirstPlayer + gameBuildings . traverse . buildingAgents .= [] + gameBuildersHall . traverse . buildingAgents .= [] + gameBuildersHall . traverse . buildingAccumulation += 1 + gameWaterdeepHarbor . traverse .= [] np <- use gameNumberOfPlayers let agents = initialAgents np round forM_ [1..np] $ \p -> withActivePlayer p $ do - qs <- activePlayerState . playerUsedPlotQuests <<.= [] + qs <- use $ activePlayerState . playerUsedPlotQuests + activePlayerState . playerUsedPlotQuests .= [] activePlayerState . playerActivePlotQuests <>= qs - activePlayerState . playerAgentsInPool .= agents + activePlayerState . playerAgentsInPool .= agents use (activePlayerState . playerHasLieutenant) >>= \case True -> activePlayerState . playerAgentsInPool += 1 >> return () False -> return () @@ -164,7 +171,7 @@ scoreFinalPoints = do printf "%s scored %d points for completing %d %s and/or %s quests." name (matches * pts) matches (show (types !! 0)) (show (types !! 1)) BuildingBonus pts -> do - owned <- length . filter ((== p) . (view buildingOwner)) <$> use gameBuildings + owned <- countOf (traverse.buildingOwner) (== p) <$> use gameBuildings activePlayerState . playerScore += owned * pts when (owned > 0) $ broadcast $ printf "%s scored %d points for controlling %d buildings." @@ -177,7 +184,7 @@ determineWinners = do let winners1 = filter ((== bestScore) . view playerScore) playerStates let bestGold = maximum $ map playerGold winners1 let winners2 = filter ((== bestGold) . playerGold) winners1 - return (winners2 ^.. each . playerNumber) + return (winners2 ^.. traverse . playerNumber) where playerGold = MS.occur Gold . view playerTavern diff --git a/src/Waterdeep/Types.hs b/src/Waterdeep/Types.hs index 9c27f09..2333c51 100644 --- a/src/Waterdeep/Types.hs +++ b/src/Waterdeep/Types.hs @@ -101,7 +101,6 @@ module Waterdeep.Types ) where import Control.Applicative -import Control.Lens import Control.Monad import Control.Monad.Prompt import Control.Monad.Random @@ -112,7 +111,13 @@ import Control.Monad.Trans.Maybe (MaybeT, runMaybeT) import Control.Monad.Trans.State (StateT, runStateT) import Data.IntMap (IntMap) import Data.Map (Map) +import Data.Maybe import Data.Monoid +import Lens.Family2 +import Lens.Family2.State +import Lens.Family2.Stock +import Lens.Family2.TH +import Lens.Family2.Unchecked (lens) import System.Random (StdGen) import qualified Data.IntMap as IM @@ -205,9 +210,9 @@ data WaterdeepState = , _gameIntrigueDiscard :: [IntrigueCard] , _gameBuildingDeck :: [Building] , _gameBuildingDiscard :: [Building] - , _gameBuildersHall :: [BuildingState] - , _gameBuildings :: [BuildingState] - , _gameWaterdeepHarbor :: ([PlayerID], [PlayerID], [PlayerID]) + , _gameBuildersHall :: IntMap BuildingState + , _gameBuildings :: IntMap BuildingState + , _gameWaterdeepHarbor :: IntMap [PlayerID] , _gameStdGen :: StdGen } @@ -305,7 +310,9 @@ instance MonadSplit StdGen Waterdeep where getSplit = gameStdGen %%= R.split gamePlayerState :: PlayerID -> Lens' WaterdeepState PlayerState -gamePlayerState n = gamePlayerStates . singular (ix n) +gamePlayerState n = lens + (\w -> w ^. gamePlayerStates . intAt n . to fromJust) + (\w ps' -> w & gamePlayerStates . intAt n .~ Just ps') gamePlayerName :: PlayerID -> Lens' WaterdeepState String gamePlayerName n = gamePlayerState n . playerName @@ -320,7 +327,8 @@ activePlayerName = activePlayerState . playerName withActivePlayer :: PlayerID -> Waterdeep a -> Waterdeep a withActivePlayer p m = do - p0 <- gameActivePlayer <<.= p + p0 <- use gameActivePlayer + gameActivePlayer .= p r <- m gameActivePlayer .= p0 return r diff --git a/src/Waterdeep/Util.hs b/src/Waterdeep/Util.hs index 4f91c79..2d4acba 100644 --- a/src/Waterdeep/Util.hs +++ b/src/Waterdeep/Util.hs @@ -4,8 +4,10 @@ module Waterdeep.Util , on , nubOn , sortOn + , countOf ) where +import Lens.Family2 import Data.List import Data.Monoid @@ -23,3 +25,6 @@ nubOn f = nubBy ((==) `on` f) sortOn :: Ord b => (a -> b) -> [a] -> [a] sortOn f = sortBy (compare `on` f) + +countOf :: Num r => FoldLike (Sum r) a a' b b' -> (b -> Bool) -> a -> r +countOf l f = getSum . views l (\b -> if f b then Sum 1 else Sum 0)