583 lines
22 KiB
Haskell
583 lines
22 KiB
Haskell
{-# LANGUAGE GADTs #-}
|
|
{-# LANGUAGE FlexibleContexts #-}
|
|
{-# LANGUAGE LambdaCase #-}
|
|
{-# LANGUAGE MultiWayIf #-}
|
|
{-# LANGUAGE RankNTypes #-}
|
|
{-# LANGUAGE NoMonomorphismRestriction #-}
|
|
|
|
module Waterdeep.Actions
|
|
( noAction
|
|
, scorePoints
|
|
, takeResources
|
|
, returnResources
|
|
, chooseQuest
|
|
, replaceQuests
|
|
, drawQuest
|
|
, drawNamedQuestType
|
|
, distributeQuests
|
|
, completeQuest
|
|
, chooseAndCompleteQuest
|
|
, discardUncompletedQuest
|
|
, buyBuilding
|
|
, chooseFreeBuilding
|
|
, drawFreeBuilding
|
|
, discardUnoccupiedBuilding
|
|
, drawIntrigue
|
|
, playIntrigue
|
|
, returnAgent
|
|
, returnAgentFromHarbor
|
|
, assignAmbassador
|
|
, assignAgent
|
|
, assignAgentToBuildersHall
|
|
, assignAgentToOpponentsSpace
|
|
, useOpponentsSpace
|
|
, gainLieutenant
|
|
, gainAmbassador
|
|
, assignMandatoryQuest
|
|
, becomeFirstPlayer
|
|
, enableAssignOnceToOpponentsSpace
|
|
, forOneOpponent
|
|
, forEachOpponent
|
|
, forCurrentPlayer
|
|
, forEachBuilding
|
|
, forEachControlledBuilding
|
|
, restockCliffwatchInn
|
|
, restockBuildersHall
|
|
, getOpponents
|
|
, mandatoryQuestCard
|
|
) where
|
|
|
|
import Control.Applicative
|
|
import Control.Arrow ((&&&))
|
|
import Control.Monad (when, unless, guard, join, replicateM, replicateM_)
|
|
import Control.Monad.Random
|
|
import Control.Monad.State (get)
|
|
import Control.Monad.Trans.Writer
|
|
import Data.Function
|
|
import Data.List
|
|
import Data.Maybe
|
|
import Data.Monoid
|
|
import Data.Foldable (foldMap, forM_, mapM_)
|
|
import Data.Traversable (traverse, for, forM, mapM)
|
|
import Lens.Family2
|
|
import Lens.Family2.State
|
|
import Lens.Family2.Stock
|
|
import Prelude hiding (forM, mapM)
|
|
import System.Random.Shuffle
|
|
import Text.Printf
|
|
import Waterdeep.Types
|
|
import Waterdeep.Util
|
|
|
|
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 ()
|
|
|
|
scorePoints :: Int -> GameAction
|
|
scorePoints n = do
|
|
activePlayerState . playerScore += n
|
|
name <- use activePlayerName
|
|
broadcast $ printf "%s scored %d points." name n
|
|
|
|
takeResources :: Int -> [Resource] -> GameAction
|
|
takeResources n rs = do
|
|
received <- map (head &&& length) . group . sort <$$> replicateM n $ do
|
|
r <- solicitChoice "Take one item:" $ map (show &&& id) rs
|
|
activePlayerState . playerTavern <>= MS.singleton r
|
|
actionProvided r
|
|
return r
|
|
let items = joinStrings $ map (\(r,n) -> show n ++ " " ++ show r) received
|
|
name <- use $ activePlayerName
|
|
broadcast $ printf "%s received %s." name items
|
|
|
|
returnResources :: Int -> [Resource] -> GameAction
|
|
returnResources n rs = do
|
|
returned <- replicateM n $ do
|
|
r <- solicitChoice "Return one item:" $ map (show &&& id) rs
|
|
guard . (r `MS.member`) =<< use (activePlayerState . playerTavern)
|
|
activePlayerState . playerTavern %= (`MS.difference` MS.singleton r)
|
|
return r
|
|
let groups = map (head &&& length) $ group returned
|
|
let items = joinStrings $ map (\(r,n) -> show n ++ " " ++ show r) groups
|
|
name <- use $ activePlayerName
|
|
broadcast $ name ++ " returned " ++ items ++ " to the supply."
|
|
|
|
chooseQuest' :: Waterdeep Quest
|
|
chooseQuest' = do
|
|
choices <- zipWith (\i q -> (q ^. questTitle, (i, q))) [0..] <$> use gameCliffwatchInn
|
|
(i, quest) <- solicitChoice "Choose one quest:" $ nubOn fst choices
|
|
gameCliffwatchInn %= deleteAt i
|
|
name <- use $ activePlayerName
|
|
broadcast $ name ++ " chose " ++ (quest ^. questTitle) ++ " from Cliffwatch Inn."
|
|
restockCliffwatchInn
|
|
return quest
|
|
|
|
chooseQuest :: GameAction
|
|
chooseQuest = do
|
|
quest <- chooseQuest'
|
|
activePlayerState . playerIncompleteQuests <>= [quest]
|
|
return ()
|
|
|
|
replaceQuests :: GameAction
|
|
replaceQuests = do
|
|
quests <- use gameCliffwatchInn
|
|
gameCliffwatchInn .= []
|
|
gameQuestDiscard <>= quests
|
|
restockCliffwatchInn
|
|
|
|
drawQuest :: GameAction
|
|
drawQuest = do
|
|
Just q <- drawQuest'
|
|
name <- use $ activePlayerName
|
|
activePlayerState . playerIncompleteQuests <>= [q]
|
|
broadcast $ printf "%s drew %s from the quest deck." name (q ^. questTitle)
|
|
|
|
drawNamedQuestType :: GameAction
|
|
drawNamedQuestType = do
|
|
let qtypes = [Piety, Warfare, Skullduggery, Arcana, Commerce]
|
|
qtype <- solicitChoice "Choose a quest type:" $ map (show &&& id) qtypes
|
|
name <- use $ activePlayerName
|
|
broadcast $ name ++ " chose the " ++ (show qtype) ++ " quest type."
|
|
flip fix [] $ \loop discards -> do
|
|
mq <- drawQuest'
|
|
case mq of
|
|
Nothing -> do
|
|
broadcast $ "There were no " ++ show qtype ++ " quests available."
|
|
gameQuestDiscard <>= discards
|
|
return ()
|
|
Just q -> do
|
|
broadcast $ printf "%s drew the %s quest %s."
|
|
name (show (q ^. questType)) (q ^. questTitle)
|
|
if (q ^. questType /= qtype)
|
|
then loop (q : discards)
|
|
else do
|
|
gameQuestDiscard <>= discards
|
|
activePlayerState . playerIncompleteQuests <>= [q]
|
|
return ()
|
|
|
|
distributeQuests :: GameAction
|
|
distributeQuests = do
|
|
let distribute remQuests = unless (null remQuests) $ do
|
|
let choices = zipWith (\i q -> (q ^. questTitle, (i, q))) [0..] remQuests
|
|
(i, quest) <- solicitChoice "Choose a quest:" $ nubOn fst choices
|
|
activePlayerState . playerIncompleteQuests <>= [quest]
|
|
name <- use $ activePlayerName
|
|
broadcast $ printf "%s chose the %s quest." name (quest ^. questTitle)
|
|
p' <- nextPlayerID <$> use gameActivePlayer <*> get
|
|
withActivePlayer p' $ distribute (deleteAt i remQuests)
|
|
distribute =<< catMaybes <$> (flip replicateM drawQuest' =<< use gameNumberOfPlayers)
|
|
|
|
completeQuest :: GameAction
|
|
completeQuest = do
|
|
quests <- zip [0..] <$> use (activePlayerState . playerIncompleteQuests)
|
|
let mandatoryQuests = filter ((== Mandatory) . view questType . snd) quests
|
|
let availQuests = if null mandatoryQuests then quests else mandatoryQuests
|
|
let choices = map (\(i,q) -> (q ^. questTitle, (i, q))) availQuests
|
|
(i, quest) <- solicitChoice "Complete one quest:" $ nubOn fst choices
|
|
activePlayerState . playerIncompleteQuests %= deleteAt i
|
|
completeQuest' quest
|
|
|
|
chooseAndCompleteQuest :: GameAction -> GameAction
|
|
chooseAndCompleteQuest bonusAction = do
|
|
quest <- chooseQuest'
|
|
join $ solicitChoice "Complete this quest immediately?" $
|
|
[ ("Yes", do { incompleteQuests <- use (activePlayerState . playerIncompleteQuests)
|
|
; guard . and $ map ((/= Mandatory) . view questType) incompleteQuests
|
|
; completeQuest' quest
|
|
; bonusAction
|
|
})
|
|
, ("No", activePlayerState . playerIncompleteQuests <>= [quest])
|
|
]
|
|
|
|
-- common to both completeQuest and chooseAndCompleteQuest
|
|
completeQuest' :: Quest -> GameAction
|
|
completeQuest' quest = do
|
|
tavern <- use $ activePlayerState . playerTavern
|
|
guard $ ((quest ^. questCost) `MS.isSubsetOf` tavern)
|
|
activePlayerState . playerTavern %= (`MS.difference` (quest ^. questCost))
|
|
name <- use activePlayerName
|
|
broadcast $ name ++ " completed the " ++ (quest ^. questTitle) ++ " quest."
|
|
delimitAction $ do
|
|
quest ^. questReward
|
|
forM_ (filter ((==Immediately) . fst) (quest^.questPlotActions)) $ snd
|
|
if (quest ^. questType == Mandatory)
|
|
then gameIntrigueDiscard <>= [mandatoryQuestCard quest]
|
|
else if null (quest ^. questPlotActions)
|
|
then activePlayerState . playerCompletedQuests <>= [quest]
|
|
else activePlayerState . playerActivePlotQuests <>= [quest]
|
|
|
|
discardUncompletedQuest :: GameAction
|
|
discardUncompletedQuest = do
|
|
choices <- zipWith (\i q -> (q ^. questTitle, (i, q))) [0..] <$>
|
|
use (activePlayerState . playerIncompleteQuests)
|
|
(i, quest) <- solicitChoice "Choose a quest to discard:" $ nubOn fst choices
|
|
activePlayerState . playerIncompleteQuests %= deleteAt i
|
|
gameQuestDiscard <>= [quest]
|
|
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
|
|
(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
|
|
(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
|
|
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 <- 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 . intAt i .= Nothing
|
|
gameBuildingDiscard <>= [b ^. building]
|
|
name <- use $ activePlayerName
|
|
broadcast $ name ++ " discarded the " ++ (b ^. building . buildingTitle) ++ "."
|
|
|
|
drawIntrigue :: GameAction
|
|
drawIntrigue = do
|
|
Just ic <- drawIntrigue'
|
|
activePlayerState . playerIntrigueCards <>= [ic]
|
|
name <- use $ activePlayerName
|
|
broadcast $ name ++ " drew an Intrigue card."
|
|
|
|
playIntrigue :: GameAction
|
|
playIntrigue = do
|
|
choices <- zipWith (\i ic -> (ic ^. intrigueTitle, (i, ic))) [0..] <$>
|
|
use (activePlayerState . playerIntrigueCards)
|
|
(i, intrigue) <- solicitChoice "Play one intrigue card:" $ nubOn fst choices
|
|
activePlayerState . playerIntrigueCards %= deleteAt i
|
|
name <- use $ activePlayerName
|
|
broadcast $ name ++ " played the " ++ (intrigue ^. intrigueTitle) ++ " Intrigue card."
|
|
intrigue ^. intrigueAction
|
|
unless (intrigue ^. intrigueType == MandatoryQuest) $
|
|
gameIntrigueDiscard <>= [intrigue]
|
|
return ()
|
|
|
|
returnAgent :: GameAction
|
|
returnAgent = do
|
|
w <- get
|
|
let p = w^.gameActivePlayer
|
|
let buildings = flip foldMapBuildings w $ \_ bl ->
|
|
let agents = w^.bl.buildingAgents
|
|
title = w^.bl.building.buildingTitle
|
|
in mif (p `elem` agents) [(title, bl.buildingAgents %= (\\[p]))]
|
|
join $ solicitChoice "Recall an agent from:" $ nubOn fst buildings
|
|
activePlayerState . playerAgentsInPool += 1
|
|
|
|
returnAgentFromHarbor :: GameAction
|
|
returnAgentFromHarbor = do
|
|
w <- get
|
|
let p = w ^. gameActivePlayer
|
|
let choices = flip foldMap [1,2,3] $ \i ->
|
|
let bl :: Lens' WaterdeepState BuildingState
|
|
bl = gameWaterdeepHarbor . intAt i . singular _Just
|
|
in mif (p `elem` (w^.bl.buildingAgents))
|
|
[(w^.bl.building.buildingTitle, bl.buildingAgents %= (\\[p]))]
|
|
join $ solicitChoice "Recall an agent from:" $ choices
|
|
activePlayerState . playerAgentsInPool += 1
|
|
|
|
foldMapBuildings ::
|
|
(Monoid m) => (Bool -> Lens' WaterdeepState BuildingState -> m) -> WaterdeepState -> m
|
|
foldMapBuildings f w = normal <> harbor <> hall
|
|
where
|
|
normal = flip foldMap (w ^. gameBuildings . to IM.keys) $ \i ->
|
|
f False $ gameBuildings . intAt i . singular _Just
|
|
(harborOccupied, harborUnoccupied) = flip foldMap [1,2,3] $ \i ->
|
|
let bl :: Lens' WaterdeepState BuildingState
|
|
bl = gameWaterdeepHarbor . intAt i . singular _Just
|
|
in if null (w^.bl.buildingAgents)
|
|
then (mempty, First $ Just $ f False bl)
|
|
else (f False bl, mempty)
|
|
harbor = harborOccupied <> (maybe mempty id $ getFirst harborUnoccupied)
|
|
hall = flip foldMap (w ^. gameBuildersHall . to IM.keys) $ \i ->
|
|
f True $ gameBuildersHall . intAt i . singular _Just
|
|
|
|
useBuilding :: Lens' WaterdeepState BuildingState -> Waterdeep ()
|
|
useBuilding bl = do
|
|
p <- use gameActivePlayer
|
|
owner <- use $ bl.buildingOwner
|
|
when (owner `notElem` [noPlayerID, p]) $ fst <$$> delimitAction $
|
|
withActivePlayer owner =<< use (bl.building.buildingOwnerAction)
|
|
join . use $ bl.building.buildingAction
|
|
|
|
assignAgentToBuilding :: PlayerID -> Lens' WaterdeepState BuildingState -> Waterdeep ()
|
|
assignAgentToBuilding agent bl = do
|
|
when (agent /= noPlayerID) $
|
|
gamePlayerState agent . playerAgentsInPool -= 1
|
|
bl.buildingAgents <>= [agent]
|
|
name <- use $ activePlayerName
|
|
bName <- use $ bl.building.buildingTitle
|
|
broadcast $ name ++ " assigned an agent to " ++ bName ++ "."
|
|
useBuilding bl
|
|
|
|
assignAmbassador :: GameAction
|
|
assignAmbassador = do
|
|
w <- get
|
|
let p = w^.gameActivePlayer
|
|
let opponents = (w^..gamePlayerStates.traverse.playerNumber) \\ [p]
|
|
let includesOpponent = any (`elem` opponents)
|
|
let usedOpSpace = (activePlayerState . playerCanUseOpSpace .= False)
|
|
let canUseOpSpace = w ^. activePlayerState . playerCanUseOpSpace
|
|
let buildings = flip foldMapBuildings w $ \inHall bl ->
|
|
let agents = w^.bl.buildingAgents
|
|
title = w^.bl.building.buildingTitle
|
|
in if | canUseOpSpace && includesOpponent agents ->
|
|
[(title, usedOpSpace >> assignAgentToBuilding noPlayerID bl)]
|
|
| null agents && not inHall ->
|
|
[(title, assignAgentToBuilding noPlayerID bl)]
|
|
| otherwise -> []
|
|
join $ solicitChoice "Assign an agent to:" $ nubOn fst buildings
|
|
|
|
assignAgent :: GameAction
|
|
assignAgent = do
|
|
agents <- use (activePlayerState . playerAgentsInPool)
|
|
guard (agents > 0)
|
|
w <- get
|
|
let p = w^.gameActivePlayer
|
|
let opponents = (w^..gamePlayerStates.traverse.playerNumber) \\ [p]
|
|
let includesOpponent = any (`elem` opponents)
|
|
let usedOpSpace = (activePlayerState . playerCanUseOpSpace .= False)
|
|
let canUseOpSpace = w ^. activePlayerState . playerCanUseOpSpace
|
|
let buildings = flip foldMapBuildings w $ \inHall bl ->
|
|
let agents = w^.bl.buildingAgents
|
|
title = w^.bl.building.buildingTitle
|
|
in if | canUseOpSpace && includesOpponent agents ->
|
|
[(title, usedOpSpace >> assignAgentToBuilding p bl)]
|
|
| null agents && not inHall ->
|
|
[(title, assignAgentToBuilding p bl)]
|
|
| otherwise -> []
|
|
join $ solicitChoice "Assign an agent to:" $ nubOn fst buildings
|
|
|
|
assignAgentToBuildersHall :: GameAction
|
|
assignAgentToBuildersHall = do
|
|
agents <- use (activePlayerState . playerAgentsInPool)
|
|
guard (agents > 0)
|
|
w <- get
|
|
let p = w^.gameActivePlayer
|
|
let opponents = (w^..gamePlayerStates.traverse.playerNumber) \\ [p]
|
|
let includesOpponent = any (`elem` opponents)
|
|
let usedOpSpace = (activePlayerState . playerCanUseOpSpace .= False)
|
|
let canUseOpSpace = w ^. activePlayerState . playerCanUseOpSpace
|
|
let buildings = flip foldMapBuildings w $ \inHall bl -> mif inHall $
|
|
let agents = w^.bl.buildingAgents
|
|
title = w^.bl.building.buildingTitle
|
|
in if null agents
|
|
then [(title, assignAgentToBuilding p bl)]
|
|
else if canUseOpSpace && includesOpponent agents
|
|
then [(title, usedOpSpace >> assignAgentToBuilding p bl)]
|
|
else []
|
|
join $ solicitChoice "Assign an agent to:" $ nubOn fst buildings
|
|
|
|
assignAgentToOpponentsSpace :: GameAction
|
|
assignAgentToOpponentsSpace = do
|
|
agents <- use (activePlayerState . playerAgentsInPool)
|
|
guard (agents > 0)
|
|
w <- get
|
|
let p = w^.gameActivePlayer
|
|
let opponents = (w^..gamePlayerStates.traverse.playerNumber) \\ [p]
|
|
let includesOpponent = any (`elem` opponents)
|
|
let buildings = flip foldMapBuildings w $ \inHall bl ->
|
|
mif (includesOpponent (w^.bl.buildingAgents)) $
|
|
[(w^.bl.building.buildingTitle, assignAgentToBuilding p bl)]
|
|
join $ solicitChoice "Assign an agent to:" $ nubOn fst buildings
|
|
|
|
useOpponentsSpace :: GameAction
|
|
useOpponentsSpace = do
|
|
agents <- use (activePlayerState . playerAgentsInPool)
|
|
guard (agents > 0)
|
|
w <- get
|
|
let p = w^.gameActivePlayer
|
|
let opponents = (w^..gamePlayerStates.traverse.playerNumber) \\ [p]
|
|
let includesOpponent = any (`elem` opponents)
|
|
let buildings = flip foldMapBuildings w $ \inHall bl ->
|
|
mif (includesOpponent (w^.bl.buildingAgents)) $
|
|
[(w^.bl.building.buildingTitle, useBuilding bl)]
|
|
join $ solicitChoice "Use the effect of one building:" $ nubOn fst buildings
|
|
|
|
gainLieutenant :: GameAction
|
|
gainLieutenant = do
|
|
activePlayerState . playerHasLieutenant .= True
|
|
activePlayerState . playerAgentsInPool += 1
|
|
name <- use $ activePlayerName
|
|
broadcast $ name ++ " gained the Lieutenant."
|
|
return ()
|
|
|
|
gainAmbassador :: GameAction
|
|
gainAmbassador = do
|
|
guard . not . or . toListOf (traverse . playerHasAmbassador) =<< use gamePlayerStates
|
|
gameBuildings . traverse . buildingAgents %= (\\ [noPlayerID])
|
|
gameWaterdeepHarbor . traverse . buildingAgents %= (\\ [noPlayerID])
|
|
gameBuildersHall . traverse . buildingAgents %= (\\ [noPlayerID])
|
|
activePlayerState . playerHasAmbassador .= True
|
|
name <- use $ activePlayerName
|
|
broadcast $ name ++ " gained the Ambassador."
|
|
|
|
assignMandatoryQuest :: Quest -> GameAction
|
|
assignMandatoryQuest quest = do
|
|
name <- use $ activePlayerName
|
|
opponents <- getOpponents
|
|
let choices = map (view playerName &&& (view playerNumber &&& view playerName)) opponents
|
|
(opID, opName) <- solicitChoice "Choose one opponent:" choices
|
|
gamePlayerState opID . playerIncompleteQuests <>= [quest]
|
|
broadcast $ name ++ " assigned " ++ opName ++ " a mandatory quest."
|
|
|
|
becomeFirstPlayer :: GameAction
|
|
becomeFirstPlayer = do
|
|
assign gameFirstPlayer =<< use gameActivePlayer
|
|
name <- use $ activePlayerName
|
|
broadcast $ name ++ " is now the first player."
|
|
|
|
enableAssignOnceToOpponentsSpace :: GameAction
|
|
enableAssignOnceToOpponentsSpace = do
|
|
activePlayerState . playerCanUseOpSpace .= True
|
|
|
|
forOneOpponent :: Waterdeep a -> Waterdeep a
|
|
forOneOpponent a1 = do
|
|
opponents <- getOpponents
|
|
let choices = map (view playerName &&& (view playerNumber &&& view playerName)) opponents
|
|
(opID, opName) <- solicitChoice "Choose one opponent:" choices
|
|
name <- use $ activePlayerName
|
|
broadcast $ name ++ " chose " ++ opName ++ "."
|
|
withActivePlayer opID (fst <$> delimitAction a1)
|
|
|
|
forEachOpponent :: Monoid a => Waterdeep a -> Waterdeep a
|
|
forEachOpponent a1 = do
|
|
opponents <- getOpponents
|
|
mconcat <$$> forM opponents $ \op ->
|
|
withActivePlayer (op ^. playerNumber) (fst <$> delimitAction a1)
|
|
|
|
forCurrentPlayer :: Waterdeep a -> Waterdeep (a, ResourceSet)
|
|
forCurrentPlayer a1 = do
|
|
p <- use gameCurrentPlayer
|
|
withActivePlayer p $ delimitAction a1
|
|
|
|
shufflePiles :: Lens WaterdeepState WaterdeepState [a] [a]
|
|
-> Lens WaterdeepState WaterdeepState [a] [a]
|
|
-> Waterdeep ()
|
|
shufflePiles deck discard = do
|
|
xs <- (++) <$> use discard <*> use deck
|
|
xs' <- shuffleM xs
|
|
deck .= xs'
|
|
discard .= []
|
|
return ()
|
|
|
|
shuffleQuests = shufflePiles gameQuestDeck gameQuestDiscard
|
|
shuffleIntrigues = shufflePiles gameIntrigueDeck gameIntrigueDiscard
|
|
shuffleBuildings = shufflePiles gameBuildingDeck gameBuildingDiscard
|
|
|
|
draw :: Lens WaterdeepState WaterdeepState [a] [a]
|
|
-> Lens WaterdeepState WaterdeepState [a] [a]
|
|
-> Waterdeep (Maybe a)
|
|
draw deck discard = do
|
|
out <- null <$> use deck
|
|
when out $ shufflePiles deck discard
|
|
listToMaybe <$> (deck %%= splitAt 1)
|
|
|
|
drawQuest' = draw gameQuestDeck gameQuestDiscard
|
|
drawIntrigue' = draw gameIntrigueDeck gameIntrigueDiscard
|
|
drawBuilding' = draw gameBuildingDeck gameBuildingDiscard
|
|
|
|
restockCliffwatchInn :: Waterdeep ()
|
|
restockCliffwatchInn = do
|
|
num <- length <$> use gameCliffwatchInn
|
|
when (num < 4) $ do
|
|
mq <- drawQuest'
|
|
case mq of
|
|
Nothing -> return ()
|
|
Just q -> do
|
|
gameCliffwatchInn <>= [q]
|
|
broadcast $ "Added " ++ (q ^. questTitle) ++ " to Cliffwatch Inn."
|
|
restockCliffwatchInn
|
|
|
|
restockBuildersHall :: Waterdeep ()
|
|
restockBuildersHall = do
|
|
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
|
|
p <- use gameActivePlayer
|
|
filter (\p1 -> (p1 ^. playerNumber) /= p) . toListOf traverse <$> use gamePlayerStates
|
|
|
|
forEachBuilding :: GameAction -> GameAction
|
|
forEachBuilding m = do
|
|
advancedBuildings <- countOf traverse isAdvanced <$> use gameBuildings
|
|
replicateM_ advancedBuildings m
|
|
where
|
|
isAdvanced b = b ^. buildingOwner /= noPlayerID
|
|
|
|
forEachControlledBuilding :: GameAction -> GameAction
|
|
forEachControlledBuilding m = do
|
|
p <- use gameActivePlayer
|
|
controlledBuildings <- countOf traverse (`isControlledBy` p) <$> use gameBuildings
|
|
replicateM_ controlledBuildings m
|
|
where
|
|
b `isControlledBy` p = b ^. buildingOwner == p
|
|
|
|
mandatoryQuestCard :: Quest -> IntrigueCard
|
|
mandatoryQuestCard q =
|
|
IntrigueCard
|
|
{ _intrigueTitle = (q ^. questTitle)
|
|
, _intrigueType = MandatoryQuest
|
|
, _intrigueAction = assignMandatoryQuest q
|
|
, _intrigueQuote = (q ^. questQuote)
|
|
}
|