waterdeep/src/Waterdeep/Logic.hs

{-# 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 }