{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE NoMonomorphismRestriction #-} module Waterdeep.Logic ( newGame , waterdeepGame ) where import Control.Applicative import Control.Arrow ((&&&)) import Control.Monad import Control.Monad.Random import Control.Monad.State 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 import Waterdeep.Types import Waterdeep.Util import qualified Data.IntMap as IM import qualified Data.Map as M import qualified Data.MultiSet as MS newGame :: [(String,Faction,Lord)] -> [Quest] -> [IntrigueCard] -> [Building] -> StdGen -> WaterdeepState newGame players quests intrigues buildings rndgen = WaterdeepState { _gameNumberOfPlayers = length players , _gamePlayerStates = IM.fromAscList playerStates , _gameFirstPlayer = 1 , _gameCurrentRound = 0 , _gameCurrentPlayer = 1 , _gameActivePlayer = 1 , _gameConsecutivePasses = 0 , _gameQuestDeck = [] , _gameQuestDiscard = quests , _gameCliffwatchInn = [] , _gameIntrigueDeck = [] , _gameIntrigueDiscard = intrigues , _gameBuildingDeck = [] , _gameBuildingDiscard = buildings , _gameBuildersHall = IM.empty , _gameBuildings = IM.fromAscList buildingStates , _gameWaterdeepHarbor = IM.fromAscList [(1,[]),(2,[]),(3,[])] , _gameStdGen = rndgen } where 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 = [ basicBuilding "Aurora's Realms Shop" (takeResources 4 [Gold]) , basicBuilding "Blackstaff Tower" (takeResources 1 [Wizard]) , basicBuilding "Builder's Hall" buyBuilding , basicBuilding "Castle Waterdeep" (becomeFirstPlayer >> drawIntrigue) , basicBuilding "Field of Triumph" (takeResources 2 [Fighter]) , basicBuilding "The Grinning Lion Tavern" (takeResources 2 [Rogue]) , basicBuilding "The Plinth" (takeResources 1 [Cleric]) , basicBuilding "Cliffwatch Inn (2 Gold)" (chooseQuest >> takeResources 2 [Gold]) , basicBuilding "Cliffwatch Inn (Intrigue)" (chooseQuest >> drawIntrigue) , basicBuilding "Cliffwatch Inn (Reset)" (replaceQuests >> chooseQuest) ] basicBuilding :: String -> GameAction -> Building basicBuilding title action = Building { _buildingCost = 0 , _buildingTitle = title , _buildingAction = action , _buildingOwnerAction = noAction , _buildingAccumType = NoAccumulation } waterdeepGame :: Waterdeep [PlayerID] waterdeepGame = do np <- use gameNumberOfPlayers guard (np >= 2 && np <= 5) restockBuildersHall restockCliffwatchInn forM_ [1..np] $ \p -> withActivePlayer p $ do replicateM_ 2 $ drawQuest replicateM_ 2 $ drawIntrigue takeResources (3 + p) [Gold] forM_ [1..8] $ \round -> do beginRound round -- TODO: Assign ambassador (if in play) fix $ \loop -> do assign gameActivePlayer =<< use gameCurrentPlayer filterChoices assignAgent >>= \case Just () -> do filterChoices $ join $ solicitChoice "Complete a quest?" $ [ ("Yes", completeQuest) , ("No", return ()) ] gameConsecutivePasses .= 0 advanceToNextPlayer loop Nothing -> do gameConsecutivePasses += 1 passes <- use gameConsecutivePasses when (passes < np) $ do advanceToNextPlayer loop broadcast $ "Game over!" scoreFinalPoints determineWinners advanceToNextPlayer :: Waterdeep () advanceToNextPlayer = do p' <- nextPlayerID <$> use gameCurrentPlayer <*> get gameCurrentPlayer .= p' beginRound :: Int -> Waterdeep () beginRound round = do broadcast $ "Starting round " ++ show round ++ "." gameCurrentRound .= round 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 <- use $ activePlayerState . playerUsedPlotQuests activePlayerState . playerUsedPlotQuests .= [] activePlayerState . playerActivePlotQuests <>= qs activePlayerState . playerAgentsInPool .= agents activePlayerState . playerCanUseOpSpace .= False use (activePlayerState . playerHasLieutenant) >>= \case True -> activePlayerState . playerAgentsInPool += 1 >> return () False -> return () --TODO: Start-of-round plot actions scoreFinalPoints :: Waterdeep () scoreFinalPoints = do np <- use gameNumberOfPlayers forM_ [1..np] $ \p -> withActivePlayer p $ do rs <- MS.toAscOccurList <$> use (activePlayerState . playerTavern) name <- use activePlayerName forM_ rs $ \(r, n) -> do let pts = case r of { Gold -> n `div` 2; _ -> n; } activePlayerState . playerScore += pts broadcast $ printf "%s scored %d points for having %d %ss." name pts n (show r) use (activePlayerState . playerLord . lordBonus) >>= \case QuestBonus types pts -> do quests <- concat <$> sequence [ use $ activePlayerState . playerCompletedQuests , use $ activePlayerState . playerActivePlotQuests , use $ activePlayerState . playerUsedPlotQuests ] let matches = length . filter ((`elem` types) . (view questType)) $ quests activePlayerState . playerScore += matches * pts when (matches > 0) $ broadcast $ 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 <- countOf (traverse.buildingOwner) (== p) <$> use gameBuildings activePlayerState . playerScore += owned * pts when (owned > 0) $ broadcast $ printf "%s scored %d points for controlling %d buildings." name (owned * pts) owned determineWinners :: Waterdeep [PlayerID] determineWinners = do playerStates <- toListOf traverse <$> use gamePlayerStates let bestScore = maximum $ map (view playerScore) playerStates let winners1 = filter ((== bestScore) . view playerScore) playerStates let bestGold = maximum $ map playerGold winners1 let winners2 = filter ((== bestGold) . playerGold) winners1 broadcast $ "Winners: " ++ (intercalate ", " (winners2 ^.. traverse . playerName)) return (winners2 ^.. traverse . playerNumber) where playerGold = MS.occur Gold . view playerTavern initialAgents :: Int -> Int -> Int initialAgents players round = if round >= 5 then startingAgents + 1 else startingAgents where startingAgents = case players of { 2 -> 4; 3 -> 3; _ -> 2 }