implement quest completion, Builder's Hall, and misc. specialized actions
This commit is contained in:
parent
2a7fe3abea
commit
17a40c68bf
|
|
@ -1,3 +1,4 @@
|
|||
#! /usr/bin/runhaskell
|
||||
{-# LANGUAGE GADTs #-}
|
||||
{-# LANGUAGE RankNTypes #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
|
|
@ -5,7 +6,6 @@
|
|||
import Waterdeep.Types
|
||||
import Waterdeep.Monad
|
||||
import Waterdeep.Logic
|
||||
import Waterdeep.Util (mrepeat)
|
||||
import Control.Applicative
|
||||
import Control.Lens
|
||||
import Control.Monad
|
||||
|
|
@ -41,71 +41,71 @@ p2 = ("Ned", f2, l2)
|
|||
q1 = Quest { _questType = Arcana
|
||||
, _questTitle = "Research Palantirs"
|
||||
, _questQuote = ""
|
||||
, _questAction = ReturnResource [Cleric]
|
||||
<> ReturnResource [Rogue]
|
||||
<> ReturnResource [Rogue]
|
||||
<> ReturnResource [Wizard]
|
||||
<> mrepeat 4 (ReturnResource [Gold])
|
||||
, _questAction = ReturnResources 1 [Cleric]
|
||||
<> ReturnResources 1 [Rogue]
|
||||
<> ReturnResources 1 [Rogue]
|
||||
<> ReturnResources 1 [Wizard]
|
||||
<> ReturnResources 4 [Gold]
|
||||
<> ScorePoints 15
|
||||
<> mrepeat 8 (TakeResource [Gold])
|
||||
<> TakeResources 8 [Gold]
|
||||
, _questPlotActions = []
|
||||
}
|
||||
|
||||
q2 = Quest { _questType = Skullduggery
|
||||
, _questTitle = "Rob Waterdeep Bank"
|
||||
, _questQuote = ""
|
||||
, _questAction = mrepeat 8 (ReturnResource [Rogue])
|
||||
, _questAction = ReturnResources 8 [Rogue]
|
||||
<> ScorePoints 10
|
||||
<> mrepeat 16 (TakeResource [Gold])
|
||||
<> TakeResources 16 [Gold]
|
||||
, _questPlotActions = []
|
||||
}
|
||||
|
||||
b1 = Building { _buildingCost = 6
|
||||
, _buildingTitle = "Monastary"
|
||||
, _buildingAction = mrepeat 2 (TakeResource [Cleric])
|
||||
, _buildingOwnerAction = TakeResource [Cleric]
|
||||
, _buildingAction = TakeResources 2 [Cleric]
|
||||
, _buildingOwnerAction = TakeResources 1 [Cleric]
|
||||
, _buildingAccumType = NoAccumulation
|
||||
}
|
||||
|
||||
b2 = Building { _buildingCost = 4
|
||||
, _buildingTitle = "Training Hall"
|
||||
, _buildingAction = mrepeat 2 (TakeResource [Fighter])
|
||||
, _buildingOwnerAction = TakeResource [Fighter]
|
||||
, _buildingAction = TakeResources 2 [Fighter]
|
||||
, _buildingOwnerAction = TakeResources 1 [Fighter]
|
||||
, _buildingAccumType = NoAccumulation
|
||||
}
|
||||
|
||||
b3 = Building { _buildingCost = 4
|
||||
, _buildingTitle = "Prison Yard"
|
||||
, _buildingAction = mrepeat 2 (TakeResource [Rogue])
|
||||
, _buildingOwnerAction = TakeResource [Rogue]
|
||||
, _buildingAction = TakeResources 2 [Rogue]
|
||||
, _buildingOwnerAction = TakeResources 1 [Rogue]
|
||||
, _buildingAccumType = NoAccumulation
|
||||
}
|
||||
|
||||
b4 = Building { _buildingCost = 6
|
||||
, _buildingTitle = "Wizard School"
|
||||
, _buildingAction = mrepeat 2 (TakeResource [Wizard])
|
||||
, _buildingOwnerAction = TakeResource [Wizard]
|
||||
, _buildingAction = TakeResources 2 [Wizard]
|
||||
, _buildingOwnerAction = TakeResources 1 [Wizard]
|
||||
, _buildingAccumType = NoAccumulation
|
||||
}
|
||||
|
||||
b5 = Building { _buildingCost = 4
|
||||
, _buildingTitle = "Gold Mine"
|
||||
, _buildingAction = mrepeat 4 (TakeResource [Gold])
|
||||
, _buildingOwnerAction = mrepeat 4 (TakeResource [Gold])
|
||||
, _buildingAction = TakeResources 4 [Gold]
|
||||
, _buildingOwnerAction = TakeResources 2 [Gold]
|
||||
, _buildingAccumType = NoAccumulation
|
||||
}
|
||||
|
||||
i1 = IntrigueCard { _intrigueTitle = "Graduation Day"
|
||||
, _intrigueType = Utility
|
||||
, _intrigueAction = mrepeat 2 (TakeResource [Wizard])
|
||||
<> OneOpponent (TakeResource [Wizard])
|
||||
, _intrigueAction = TakeResources 2 [Wizard]
|
||||
<> OneOpponent (TakeResources 1 [Wizard])
|
||||
, _intrigueQuote = ""
|
||||
}
|
||||
|
||||
i2 = IntrigueCard { _intrigueTitle = "Call for Adventurers"
|
||||
, _intrigueType = Utility
|
||||
, _intrigueAction = mrepeat 2 (TakeResource [Cleric, Fighter, Rogue, Wizard])
|
||||
<> OneOpponent (TakeResource [Cleric, Fighter, Rogue, Wizard])
|
||||
, _intrigueAction = TakeResources 2 [Cleric, Fighter, Rogue, Wizard]
|
||||
<> OneOpponent (TakeResources 1 [Cleric, Fighter, Rogue, Wizard])
|
||||
, _intrigueQuote = ""
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -14,7 +14,7 @@ import Control.Lens
|
|||
import Control.Monad
|
||||
import Control.Monad.Random
|
||||
import Control.Monad.State
|
||||
import Control.Monad.Writer
|
||||
import Control.Monad.Trans.Writer
|
||||
import Data.List
|
||||
import Data.Maybe
|
||||
import Data.Monoid
|
||||
|
|
@ -88,13 +88,16 @@ newBuildingState p b =
|
|||
|
||||
basicBuildings :: [Building]
|
||||
basicBuildings =
|
||||
[ basicBuilding "Aurora's Realms Shop" (mrepeat 4 $ TakeResource [Gold])
|
||||
, basicBuilding "Blackstaff Tower" (TakeResource [Wizard])
|
||||
[ basicBuilding "Aurora's Realms Shop" (TakeResources 4 [Gold])
|
||||
, basicBuilding "Blackstaff Tower" (TakeResources 1 [Wizard])
|
||||
, basicBuilding "Builder's Hall" BuyBuilding
|
||||
, basicBuilding "Castle Waterdeep" (BecomeFirstPlayer `Then` DrawIntrigue)
|
||||
, basicBuilding "Field of Triumph" (mrepeat 2 $ TakeResource [Fighter])
|
||||
, basicBuilding "The Grinning Lion Tavern" (mrepeat 2 $ TakeResource [Rogue])
|
||||
, basicBuilding "The Plinth" (TakeResource [Cleric])
|
||||
, 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
|
||||
|
|
@ -115,15 +118,19 @@ waterdeepGame = do
|
|||
forM_ ps $ \p -> do
|
||||
replicateM_ 2 $ performAction p DrawQuest
|
||||
replicateM_ 2 $ performAction p DrawIntrigue
|
||||
replicateM_ (3 + p) $ performAction p $ TakeResource [Gold]
|
||||
performAction p $ TakeResources (3 + p) [Gold]
|
||||
forM_ [1..8] $ \round -> do
|
||||
beginRound round
|
||||
-- TODO: Assign ambassador (if in play)
|
||||
fix $ \loop -> do
|
||||
p <- use gameCurrentPlayer
|
||||
success <- filterChoices $ performAction p AssignAgent
|
||||
case success of
|
||||
True -> do
|
||||
filterChoices $ performAction p CompleteQuest
|
||||
filterChoices $ join $ solicitChoice p "Complete quest?" $
|
||||
[ ("Yes", performAction p CompleteQuest)
|
||||
, ("No", return True)
|
||||
]
|
||||
gameCurrentPlayer .= (p `mod` length ps) + 1
|
||||
gameConsecutivePasses .= 0
|
||||
loop
|
||||
|
|
@ -190,6 +197,31 @@ filterChoices m = do
|
|||
forwardPrompt (NotifyState w) = get >>= \w0 -> put w >> notifyState >> put w0
|
||||
forwardPrompt (Broadcast s) = broadcast' s
|
||||
|
||||
-- Returns True if there exists some sequence of choices
|
||||
-- which would make the action succeed, or False otherwise.
|
||||
canPerformAction :: PlayerID -> GameAction -> Waterdeep Bool
|
||||
canPerformAction p a = do
|
||||
return . tryChoice . runWaterdeepC Done Cont (performAction p a) =<< get
|
||||
where
|
||||
tryChoice :: ContWD Bool -> Bool
|
||||
tryChoice (Done a) = fst a
|
||||
tryChoice (Cont (NotifyState w) cont) = tryChoice $ cont ()
|
||||
tryChoice (Cont (Broadcast s) cont) = tryChoice $ cont ()
|
||||
tryChoice (Cont (SolicitChoice p t cs) cont) =
|
||||
or $ map (tryChoice . cont . snd) cs
|
||||
|
||||
-- Like (<$>), but with the same fixity and precedence as ($)
|
||||
(<$$>) :: Applicative f => (a -> b) -> f a -> f b
|
||||
(<$$>) = (<$>)
|
||||
infixr 0 <$$>
|
||||
|
||||
joinStrings :: [String] -> String
|
||||
joinStrings [] = "nothing"
|
||||
joinStrings [x] = x
|
||||
joinStrings [x,y] = x ++ " and " ++ y
|
||||
joinStrings [x,y,z] = x ++ ", " ++ y ++ ", and " ++ z
|
||||
joinStrings (x:xs) = x ++ ", " ++ joinStrings xs
|
||||
|
||||
performAction :: PlayerID -> GameAction -> Waterdeep Bool
|
||||
performAction p a = do
|
||||
name <- use $ gamePlayer p . playerName
|
||||
|
|
@ -197,50 +229,218 @@ performAction p a = do
|
|||
NoAction -> return True
|
||||
ScorePoints n -> do
|
||||
gamePlayer p . playerScore += n
|
||||
broadcast $ name ++ " scored " ++ show n ++ "points."
|
||||
broadcast $ name ++ " scored " ++ show n ++ " points."
|
||||
return True
|
||||
TakeResource rs -> do
|
||||
TakeResources n rs -> do
|
||||
received <- map (head &&& length) . group . sort <$$> replicateM n $ do
|
||||
r <- solicitChoice p "Take one item:" $ map (show &&& id) rs
|
||||
gamePlayer p . playerTavern %= flip (M.unionWith (+)) (M.fromList [(r, 1)])
|
||||
broadcast $ name ++ " received one " ++ show r ++ "."
|
||||
gamePlayer p . playerTavern %= M.insertWith' (+) r 1
|
||||
return r
|
||||
let items = joinStrings $ map (\(r,n) -> show n ++ " " ++ show r) received
|
||||
broadcast $ name ++ " received " ++ items ++ "."
|
||||
return True
|
||||
ReturnResource rs -> do
|
||||
ReturnResources n rs -> do
|
||||
maybeReturned <- replicateM n $ do
|
||||
tavern <- use $ gamePlayer p . playerTavern
|
||||
let rs' = filter ((> 0) . maybe 0 id . flip M.lookup tavern) rs
|
||||
let rs' = filter ((>= 1) . maybe 0 id . flip M.lookup tavern) rs
|
||||
if null rs'
|
||||
then return False
|
||||
then return Nothing
|
||||
else do
|
||||
r <- solicitChoice p "Return one item:" $ map (show &&& id) rs'
|
||||
let removeOne x = if x > 1 then Just (x-1) else Nothing
|
||||
gamePlayer p . playerTavern %= M.update removeOne r
|
||||
broadcast $ name ++ " returned one " ++ show r ++ " to the supply."
|
||||
return True
|
||||
return (Just r)
|
||||
let success = and . map isJust $ maybeReturned
|
||||
let returned = map (head &&& length) . group . catMaybes $ maybeReturned
|
||||
let items = joinStrings $ map (\(r,n) -> show n ++ " " ++ show r) $ returned
|
||||
broadcast $ name ++ " returned " ++ items ++ " to the supply."
|
||||
return success
|
||||
ChooseQuest -> do
|
||||
qs <- use gameCliffwatchInn
|
||||
if null qs
|
||||
quests <- use gameCliffwatchInn
|
||||
if null quests
|
||||
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]
|
||||
broadcast $ name ++ " chose " ++ (q ^. questTitle) ++ " from Cliffwatch Inn."
|
||||
let titles = quests ^.. traverse . questTitle
|
||||
i <- solicitChoice p "Choose one quest:" $ zip titles [0..]
|
||||
let quest = quests !! i
|
||||
gameCliffwatchInn %= deleteAt i
|
||||
gamePlayer p . playerIncompleteQuests <>= [quest]
|
||||
broadcast $ name ++ " chose " ++ (quest ^. questTitle) ++ " from Cliffwatch Inn."
|
||||
restockCliffwatchInn
|
||||
return True
|
||||
ReplaceQuests -> do
|
||||
quests <- gameCliffwatchInn <<.= []
|
||||
gameQuestDiscard <>= quests
|
||||
restockCliffwatchInn
|
||||
return True
|
||||
DrawQuest -> do
|
||||
mq <- drawQuest
|
||||
case mq of
|
||||
Nothing -> return False
|
||||
Nothing -> do
|
||||
broadcast $ name ++ " failed to draw a quest because the quest deck is empty."
|
||||
return False
|
||||
Just q -> do
|
||||
gamePlayer p . playerIncompleteQuests <>= [q]
|
||||
broadcast $ name ++ " drew " ++ (q ^. questTitle) ++ " from the quest deck."
|
||||
return True
|
||||
DrawNamedQuestType -> do
|
||||
let qtypes = [Piety, Warfare, Skullduggery, Arcana, Commerce]
|
||||
qtype <- solicitChoice p "Choose a quest type:" $ map (show &&& id) qtypes
|
||||
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 False
|
||||
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) >> return True
|
||||
else do
|
||||
gameQuestDiscard <>= discards
|
||||
gamePlayer p . playerIncompleteQuests <>= [q]
|
||||
return True
|
||||
DistributeQuests -> do
|
||||
np <- IM.size <$> use gamePlayers
|
||||
let loop p' remQuests = do
|
||||
unless (null remQuests) $ do
|
||||
i <- solicitChoice p' "Choose a quest:" $
|
||||
zip (map (view questTitle) remQuests) [0..]
|
||||
gamePlayer p' . playerIncompleteQuests <>= [remQuests !! i]
|
||||
loop ((p' `mod` np) + 1) (deleteAt i remQuests)
|
||||
loop p =<< return . catMaybes =<< replicateM np drawQuest
|
||||
return True
|
||||
CompleteQuest -> do
|
||||
quests <- use (gamePlayer p . playerIncompleteQuests)
|
||||
if null quests
|
||||
then return False
|
||||
else filterChoices $ do
|
||||
let choices = zip (map (view questTitle) quests) [0..]
|
||||
i <- solicitChoice p "Complete one quest:" choices
|
||||
let quest = quests !! i
|
||||
if (quest ^. questType /= Mandatory &&
|
||||
or (map (\q -> q ^. questType == Mandatory) quests))
|
||||
then return False
|
||||
else do
|
||||
gamePlayer p . playerIncompleteQuests %= deleteAt i
|
||||
success <- performAction p (quest ^. questAction)
|
||||
if null (quest ^. questPlotActions)
|
||||
then gamePlayer p . playerCompletedQuests <>= [quest]
|
||||
else gamePlayer p . playerActivePlotQuests <>= [quest]
|
||||
broadcast $ name ++ " completed the " ++ (quest ^. questTitle) ++ " quest."
|
||||
return success
|
||||
ChooseAndCompleteQuest bonusAction -> do
|
||||
quests <- use gameCliffwatchInn
|
||||
if null quests
|
||||
then return False
|
||||
else filterChoices $ do
|
||||
let titles = quests ^.. traverse . questTitle
|
||||
i <- solicitChoice p "Choose one quest:" $ zip titles [0..]
|
||||
let quest = quests !! i
|
||||
if (quest ^. questType /= Mandatory &&
|
||||
or (map (\q -> q ^. questType == Mandatory) quests))
|
||||
then return False
|
||||
else do
|
||||
gameCliffwatchInn %= deleteAt i
|
||||
broadcast $ name ++ " chose " ++ (quest ^. questTitle) ++ " from Cliffwatch Inn."
|
||||
restockCliffwatchInn
|
||||
doQuest <- solicitChoice p "Complete this quest immediately?"
|
||||
[("Yes", True), ("No", False)]
|
||||
case doQuest of
|
||||
True -> do
|
||||
questSuccess <- performAction p (quest ^. questAction)
|
||||
bonusSuccess <- performAction p bonusAction
|
||||
if null (quest ^. questPlotActions)
|
||||
then gamePlayer p . playerCompletedQuests <>= [quest]
|
||||
else gamePlayer p . playerActivePlotQuests <>= [quest]
|
||||
broadcast $ name ++ " completed the " ++ (quest ^. questTitle) ++ " quest."
|
||||
return (questSuccess && bonusSuccess)
|
||||
False -> do
|
||||
gamePlayer p . playerIncompleteQuests <>= [quest]
|
||||
return True
|
||||
DiscardUncompletedQuest -> do
|
||||
quests <- use (gamePlayer p . playerIncompleteQuests)
|
||||
if null quests
|
||||
then return False
|
||||
else do
|
||||
i <- solicitChoice p "Choose a quest to discard:" $
|
||||
zip (map (view questTitle) quests) [0..]
|
||||
let quest = quests !! i
|
||||
gamePlayer p . playerIncompleteQuests %= deleteAt i
|
||||
gameQuestDiscard <>= [quest]
|
||||
broadcast $ name ++ " discarded the " ++ (quest ^. questTitle) ++ " quest."
|
||||
return True
|
||||
BuyBuilding -> do
|
||||
buildings <- use gameBuildersHall
|
||||
if null buildings
|
||||
then return False
|
||||
else do
|
||||
let labels = flip map buildings $ \b -> printf "%s (%d Gold, %d Points)"
|
||||
(b ^. building . buildingTitle)
|
||||
(b ^. building . buildingCost)
|
||||
(b ^. buildingAccumulation)
|
||||
filterChoices $ do
|
||||
i <- solicitChoice p "Choose a building from Builder's Hall:" $
|
||||
zip labels [0..]
|
||||
let b = buildings !! i
|
||||
let cost = b ^. building . buildingCost
|
||||
paid <- performAction p $ ReturnResources cost [Gold]
|
||||
performAction p $ ScorePoints (b ^. buildingAccumulation)
|
||||
gameBuildersHall %= deleteAt i
|
||||
gameBuildings <>= [b & buildingOwner .~ p & buildingAccumulation .~ 0]
|
||||
broadcast $ name ++ " built the " ++ (b ^. building . buildingTitle) ++ "."
|
||||
restockBuildersHall
|
||||
return paid
|
||||
ChooseFreeBuilding -> do
|
||||
buildings <- use gameBuildersHall
|
||||
if null buildings
|
||||
then return False
|
||||
else do
|
||||
let labels = flip map buildings $ \b -> printf "%s (%d Points)"
|
||||
(b ^. building . buildingTitle)
|
||||
(b ^. buildingAccumulation)
|
||||
i <- solicitChoice p "Choose a building from Builder's Hall:" $
|
||||
zip labels [0..]
|
||||
let b = buildings !! i
|
||||
performAction p $ ScorePoints (b ^. buildingAccumulation)
|
||||
gameBuildersHall %= deleteAt i
|
||||
gameBuildings <>= [b & buildingOwner .~ p & buildingAccumulation .~ 0]
|
||||
broadcast $ name ++ " built the " ++ (b ^. building . buildingTitle) ++ " for free."
|
||||
restockBuildersHall
|
||||
return True
|
||||
DrawFreeBuilding -> do
|
||||
mb <- drawBuilding
|
||||
case mb of
|
||||
Nothing -> return False
|
||||
Just b -> do
|
||||
gameBuildings <>= [newBuildingState p b]
|
||||
broadcast $ name ++ " built the " ++ (b ^. buildingTitle) ++ " for free."
|
||||
return True
|
||||
DiscardUnoccupiedBuilding -> do
|
||||
allBuildings <- use gameBuildings
|
||||
let choices = flip mapMaybe (zip allBuildings [0..]) $ \(b, i) ->
|
||||
case b ^. buildingOwner == p of
|
||||
True -> Just (b ^. building . buildingTitle, i)
|
||||
False -> Nothing
|
||||
if null choices
|
||||
then return False
|
||||
else do
|
||||
i <- solicitChoice p "Choose a building to discard:" choices
|
||||
let b = allBuildings !! i
|
||||
gameBuildings %= deleteAt i
|
||||
gameBuildingDiscard <>= [b ^. building]
|
||||
broadcast $ name ++ " discarded the " ++ (b ^. building . buildingTitle) ++ "."
|
||||
return True
|
||||
DrawIntrigue -> do
|
||||
mi <- drawIntrigue
|
||||
case mi of
|
||||
Nothing -> return False
|
||||
Just i -> do
|
||||
gamePlayer p . playerIntrigueCards <>= [i]
|
||||
broadcast $ name ++ " drew an Intrigue card."
|
||||
return True
|
||||
PlayIntrigue -> do
|
||||
intrigues <- use (gamePlayer p . playerIntrigueCards)
|
||||
|
|
@ -250,15 +450,20 @@ performAction p a = do
|
|||
let sameTitle a b = fst a == fst b
|
||||
let choices = nubBy sameTitle $ zip (map (view intrigueTitle) intrigues) [0..]
|
||||
i <- solicitChoice p "Play one intrigue card:" choices
|
||||
let deleteAt n l = (take n l) ++ (drop (n + 1) l)
|
||||
let intrigue = intrigues !! i
|
||||
filterChoices $ do
|
||||
gamePlayer p . playerIntrigueCards %= deleteAt i
|
||||
performAction p (intrigues ^. singular (ix i) . intrigueAction)
|
||||
broadcast $ name ++ " played the " ++ (intrigue ^. intrigueTitle) ++ " Intrigue card."
|
||||
success <- performAction p (intrigue ^. intrigueAction)
|
||||
gameIntrigueDiscard <>= [intrigue]
|
||||
return success
|
||||
ReturnAgent -> return False -- TODO
|
||||
ReturnAgentFromHarbor -> return False -- TODO
|
||||
AssignAgent -> do
|
||||
agents <- use (gamePlayer p . playerAgentsInPool)
|
||||
if agents <= 0
|
||||
then return False
|
||||
else do
|
||||
w <- get
|
||||
let assignToBuilding :: Lens' WaterdeepState BuildingState -> Waterdeep Bool
|
||||
assignToBuilding bl = do
|
||||
gamePlayer p . playerAgentsInPool -= 1
|
||||
|
|
@ -266,7 +471,7 @@ performAction p a = do
|
|||
bName <- use (bl . building . buildingTitle)
|
||||
broadcast $ name ++ " assigned an agent to " ++ bName ++ "."
|
||||
owner <- use (bl . buildingOwner)
|
||||
when (owner /= noPlayerID) $
|
||||
when (owner `notElem` [noPlayerID, p]) $
|
||||
void . performAction owner =<< use (bl . building . buildingOwnerAction)
|
||||
performAction p =<< use (bl . building . buildingAction)
|
||||
let assignToHarbor l = do
|
||||
|
|
@ -274,8 +479,8 @@ performAction p a = do
|
|||
gameWaterdeepHarbor . l <>= [p]
|
||||
broadcast $ name ++ " assigned an agent to Waterdeep Harbor."
|
||||
performAction p PlayIntrigue
|
||||
let findBuildings :: Writer [(String, Waterdeep Bool)] ()
|
||||
findBuildings = do
|
||||
buildings <- execWriterT $ do
|
||||
w <- get
|
||||
forM_ [0 .. length (w ^. gameBuildings) - 1] $ \i -> do
|
||||
let l :: Lens' WaterdeepState BuildingState
|
||||
l = gameBuildings . singular (ix i)
|
||||
|
|
@ -286,17 +491,45 @@ performAction p a = do
|
|||
(_, [], _) -> tell [("Waterdeep Harbor", assignToHarbor _2)]
|
||||
(_, _, []) -> tell [("Waterdeep Harbor", assignToHarbor _3)]
|
||||
_ -> return ()
|
||||
let buildings = execWriter findBuildings
|
||||
if null buildings
|
||||
then return False
|
||||
else do
|
||||
join $ solicitChoice p "Assign one agent to:" buildings
|
||||
Optional a1 -> do
|
||||
join $ solicitChoice p "Perform action?" $
|
||||
[ ("Yes", performAction p a1)
|
||||
, ("No", return False)]
|
||||
AssignAgentToBuildersHall -> return False -- TODO
|
||||
AssignAgentToOpponentsSpace -> return False -- TODO
|
||||
UseOpponentsSpace -> return False -- TODO
|
||||
GainLieutenant -> do
|
||||
gamePlayer p . playerHasLieutenant .= True
|
||||
gamePlayer p . playerAgentsInPool += 1
|
||||
broadcast $ name ++ " gained the Lieutenant."
|
||||
return True
|
||||
GainAmbassador -> do
|
||||
unavail <- or . toListOf (traverse . playerHasAmbassador) <$> use gamePlayers
|
||||
if unavail
|
||||
then return False
|
||||
else do
|
||||
gameBuildings . each . buildingAgents %= (\\ [noPlayerID])
|
||||
gameWaterdeepHarbor . each %= (\\ [noPlayerID])
|
||||
gamePlayer p . playerHasAmbassador .= True
|
||||
broadcast $ name ++ " gained the Ambassador."
|
||||
return True
|
||||
TakeAccumulated ->
|
||||
return True
|
||||
AssignMandatoryQuest quest -> do
|
||||
players <- toListOf traverse <$> use gamePlayers
|
||||
let opponents = filter (\player -> (player ^. playerNumber) /= p) players
|
||||
let choices = map (\p -> (p ^. playerName, p ^. playerNumber)) opponents
|
||||
opID <- solicitChoice p "Choose one opponent:" choices
|
||||
opName <- use (gamePlayer opID . playerName)
|
||||
gamePlayer opID . playerIncompleteQuests <>= [quest]
|
||||
broadcast $ name ++ " assigned " ++ opName ++ " a mandatory quest."
|
||||
return True
|
||||
BecomeFirstPlayer -> do
|
||||
gameFirstPlayer .= p
|
||||
broadcast $ name ++ " is now the first player."
|
||||
return True
|
||||
ChooseOne as -> do
|
||||
a1 <- solicitChoice p "Choose an action:" $ map (show &&& id) as
|
||||
a1 <- solicitChoice p "Choose one:" $ map (show &&& id) as
|
||||
performAction p a1
|
||||
a1 `Then` a2 -> do
|
||||
(&&) <$> performAction p a1 <*> performAction p a2
|
||||
|
|
@ -327,7 +560,6 @@ performAction p a = do
|
|||
return True
|
||||
CurrentPlayer a1 ->
|
||||
flip performAction a1 =<< use gameCurrentPlayer
|
||||
_ -> return False
|
||||
|
||||
scoreFinalPoints :: Waterdeep ()
|
||||
scoreFinalPoints = do
|
||||
|
|
|
|||
|
|
@ -193,16 +193,16 @@ data AccumulationType = NoAccumulation
|
|||
|
||||
data GameAction = NoAction
|
||||
| ScorePoints Int
|
||||
| TakeResource [Resource]
|
||||
| ReturnResource [Resource]
|
||||
| GiveResource [Resource]
|
||||
| TakeResources Int [Resource]
|
||||
| ReturnResources Int [Resource]
|
||||
| GiveResources Int [Resource]
|
||||
| ChooseQuest
|
||||
| ReplaceQuests
|
||||
| DrawQuest
|
||||
| DrawNamedQuestType
|
||||
| DistributeQuests
|
||||
| CompleteQuest
|
||||
| ChooseAndCompleteQuest
|
||||
| ChooseAndCompleteQuest GameAction
|
||||
| DiscardUncompletedQuest
|
||||
| BuyBuilding
|
||||
| ChooseFreeBuilding
|
||||
|
|
@ -219,10 +219,8 @@ data GameAction = NoAction
|
|||
| GainLieutenant
|
||||
| GainAmbassador
|
||||
| TakeAccumulated
|
||||
| TakeResourceFromOpponent [Resource]
|
||||
| AssignMandatoryQuest Quest
|
||||
| BecomeFirstPlayer
|
||||
| Optional GameAction
|
||||
| ChooseOne [GameAction]
|
||||
| Then GameAction GameAction
|
||||
| OrElse GameAction GameAction
|
||||
|
|
|
|||
|
|
@ -1,8 +1,12 @@
|
|||
module Waterdeep.Util
|
||||
( mrepeat
|
||||
, deleteAt
|
||||
) where
|
||||
|
||||
import Data.Monoid
|
||||
|
||||
mrepeat :: (Monoid m) => Int -> m -> m
|
||||
mrepeat n m = mconcat $ replicate n m
|
||||
|
||||
deleteAt :: Int -> [a] -> [a]
|
||||
deleteAt n l = (take n l) ++ (drop (n + 1) l)
|
||||
|
|
|
|||
Loading…
Reference in New Issue