implement assigning agents & playing intrigue cards
This commit is contained in:
parent
4a23b5f419
commit
2a7fe3abea
16
src/Test.hs
16
src/Test.hs
|
|
@ -95,6 +95,20 @@ b5 = Building { _buildingCost = 4
|
|||
, _buildingAccumType = NoAccumulation
|
||||
}
|
||||
|
||||
i1 = IntrigueCard { _intrigueTitle = "Graduation Day"
|
||||
, _intrigueType = Utility
|
||||
, _intrigueAction = mrepeat 2 (TakeResource [Wizard])
|
||||
<> OneOpponent (TakeResource [Wizard])
|
||||
, _intrigueQuote = ""
|
||||
}
|
||||
|
||||
i2 = IntrigueCard { _intrigueTitle = "Call for Adventurers"
|
||||
, _intrigueType = Utility
|
||||
, _intrigueAction = mrepeat 2 (TakeResource [Cleric, Fighter, Rogue, Wizard])
|
||||
<> OneOpponent (TakeResource [Cleric, Fighter, Rogue, Wizard])
|
||||
, _intrigueQuote = ""
|
||||
}
|
||||
|
||||
clearScreen :: IO ()
|
||||
clearScreen = putStr "\o033[H\o033[2J" >> hFlush stdout
|
||||
|
||||
|
|
@ -177,7 +191,7 @@ menuPrompt ref redraw prm@(SolicitChoice p t cs) = do
|
|||
|
||||
main :: IO ()
|
||||
main = do
|
||||
w0 <- newGame [p1, p2] [q1, q2] [] [b1, b2, b3, b4, b5] <$> getSplit
|
||||
w0 <- newGame [p1, p2] [q1, q2] [i1, i2] [b1, b2, b3, b4, b5] <$> getSplit
|
||||
ref <- newIORef (DisplayState { _gameState = w0, _gameMessages = [] })
|
||||
let gamePlayerName n = w0 ^. gamePlayer n . playerName
|
||||
(winners, w') <- runWaterdeepM (menuPrompt ref (drawState ref)) waterdeepGame w0
|
||||
|
|
|
|||
|
|
@ -14,6 +14,7 @@ import Control.Lens
|
|||
import Control.Monad
|
||||
import Control.Monad.Random
|
||||
import Control.Monad.State
|
||||
import Control.Monad.Writer
|
||||
import Data.List
|
||||
import Data.Maybe
|
||||
import Data.Monoid
|
||||
|
|
@ -21,6 +22,7 @@ import System.Random.Shuffle
|
|||
import Text.Printf
|
||||
import Waterdeep.Types
|
||||
import Waterdeep.Monad
|
||||
import Waterdeep.Util
|
||||
|
||||
import qualified Data.IntMap as IM
|
||||
import qualified Data.Map as M
|
||||
|
|
@ -48,9 +50,8 @@ newGame players quests intrigues buildings rndgen
|
|||
, _gameIntrigueDiscard = intrigues
|
||||
, _gameBuildingDeck = []
|
||||
, _gameBuildingDiscard = buildings
|
||||
, _gameBasicBuildings = map (newBuildingState noPlayerID) basicBuildings
|
||||
, _gameBuildersHall = []
|
||||
, _gameAdvancedBuildings = []
|
||||
, _gameBuildings = map (newBuildingState noPlayerID) basicBuildings
|
||||
, _gameWaterdeepHarbor = ([], [], [])
|
||||
, _gameStdGen = rndgen
|
||||
}
|
||||
|
|
@ -86,7 +87,25 @@ newBuildingState p b =
|
|||
}
|
||||
|
||||
basicBuildings :: [Building]
|
||||
basicBuildings = []
|
||||
basicBuildings =
|
||||
[ basicBuilding "Aurora's Realms Shop" (mrepeat 4 $ TakeResource [Gold])
|
||||
, basicBuilding "Blackstaff Tower" (TakeResource [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 :: String -> GameAction -> Building
|
||||
basicBuilding title action =
|
||||
Building
|
||||
{ _buildingCost = 0
|
||||
, _buildingTitle = title
|
||||
, _buildingAction = action
|
||||
, _buildingOwnerAction = NoAction
|
||||
, _buildingAccumType = NoAccumulation
|
||||
}
|
||||
|
||||
waterdeepGame :: Waterdeep [PlayerID]
|
||||
waterdeepGame = do
|
||||
|
|
@ -111,13 +130,6 @@ waterdeepGame = do
|
|||
False -> do
|
||||
passes <- gameConsecutivePasses <+= 1
|
||||
when (passes < length ps) loop
|
||||
performAction 1 $ TakeResource [Cleric, Fighter, Rogue, Wizard, Gold]
|
||||
filterChoices $ performAction 1 $
|
||||
ReturnResource [Wizard]
|
||||
<> ReturnResource [Cleric, Fighter, Gold]
|
||||
<> ReturnResource [Cleric, Fighter]
|
||||
<> (ReturnResource [Cleric] `OrElse` TakeResource [Cleric])
|
||||
-- performAction 2 $ ChooseQuest
|
||||
scoreFinalPoints
|
||||
notifyState
|
||||
determineWinners
|
||||
|
|
@ -126,14 +138,13 @@ beginRound :: Int -> Waterdeep ()
|
|||
beginRound round = do
|
||||
gameCurrentRound .= round
|
||||
gameCurrentPlayer <~ use gameFirstPlayer
|
||||
gameBasicBuildings . traverse . buildingAgents .= []
|
||||
gameAdvancedBuildings . traverse . buildingAgents .= []
|
||||
gameBuildings . traverse . buildingAgents .= []
|
||||
gameBuildersHall . traverse . buildingAgents .= []
|
||||
gameBuildersHall . traverse . buildingAccumulation += 1
|
||||
players <- IM.size <$> use gamePlayers
|
||||
forM_ [1..players] $ \p -> do
|
||||
qs <- gamePlayer p . playerUsedPlotQuests <<.= []
|
||||
gamePlayer p . playerActivePlotQuests %= (++ qs)
|
||||
gamePlayer p . playerActivePlotQuests <>= qs
|
||||
gamePlayer p . playerAgentsInPool .= initialAgents players round
|
||||
notifyState
|
||||
return ()
|
||||
|
|
@ -212,7 +223,7 @@ performAction p a = do
|
|||
let names = qs ^.. traverse . questTitle
|
||||
q <- solicitChoice p "Please choose a quest:" $ zip names qs
|
||||
gameCliffwatchInn %= (\\ [q])
|
||||
gamePlayer p . playerIncompleteQuests %= (++ [q])
|
||||
gamePlayer p . playerIncompleteQuests <>= [q]
|
||||
broadcast $ name ++ " chose " ++ (q ^. questTitle) ++ " from Cliffwatch Inn."
|
||||
restockCliffwatchInn
|
||||
return True
|
||||
|
|
@ -221,7 +232,7 @@ performAction p a = do
|
|||
case mq of
|
||||
Nothing -> return False
|
||||
Just q -> do
|
||||
gamePlayer p . playerIncompleteQuests %= (++[q])
|
||||
gamePlayer p . playerIncompleteQuests <>= [q]
|
||||
broadcast $ name ++ " drew " ++ (q ^. questTitle) ++ " from the quest deck."
|
||||
return True
|
||||
DrawIntrigue -> do
|
||||
|
|
@ -229,8 +240,64 @@ performAction p a = do
|
|||
case mi of
|
||||
Nothing -> return False
|
||||
Just i -> do
|
||||
gamePlayer p . playerIntrigueCards %= (++[i])
|
||||
gamePlayer p . playerIntrigueCards <>= [i]
|
||||
return True
|
||||
PlayIntrigue -> do
|
||||
intrigues <- use (gamePlayer p . playerIntrigueCards)
|
||||
if null intrigues
|
||||
then return False
|
||||
else 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)
|
||||
gamePlayer p . playerIntrigueCards %= deleteAt i
|
||||
performAction p (intrigues ^. singular (ix i) . intrigueAction)
|
||||
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
|
||||
bl . buildingAgents <>= [p]
|
||||
bName <- use (bl . building . buildingTitle)
|
||||
broadcast $ name ++ " assigned an agent to " ++ bName ++ "."
|
||||
owner <- use (bl . buildingOwner)
|
||||
when (owner /= noPlayerID) $
|
||||
void . performAction owner =<< use (bl . building . buildingOwnerAction)
|
||||
performAction p =<< use (bl . building . buildingAction)
|
||||
let assignToHarbor l = do
|
||||
gamePlayer p . playerAgentsInPool -= 1
|
||||
gameWaterdeepHarbor . l <>= [p]
|
||||
broadcast $ name ++ " assigned an agent to Waterdeep Harbor."
|
||||
performAction p PlayIntrigue
|
||||
let findBuildings :: Writer [(String, Waterdeep Bool)] ()
|
||||
findBuildings = 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, assignToBuilding l)]
|
||||
case w ^. gameWaterdeepHarbor of
|
||||
([], _, _) -> tell [("Waterdeep Harbor", assignToHarbor _1)]
|
||||
(_, [], _) -> 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)]
|
||||
ChooseOne as -> do
|
||||
a1 <- solicitChoice p "Choose an action:" $ map (show &&& id) as
|
||||
performAction p a1
|
||||
a1 `Then` a2 -> do
|
||||
(&&) <$> performAction p a1 <*> performAction p a2
|
||||
a1 `OrElse` a2 -> do
|
||||
|
|
@ -238,6 +305,28 @@ performAction p a = do
|
|||
case r1 of
|
||||
True -> return True
|
||||
False -> performAction p a2
|
||||
ForEachBuilding a1 -> do
|
||||
nb <- length . filter (\b -> b ^. buildingOwner /= noPlayerID) <$> use gameBuildings
|
||||
and <$> replicateM nb (performAction p a1)
|
||||
ForEachControlledBuilding a1 -> do
|
||||
nb <- length . filter (\b -> b ^. buildingOwner == p) <$> use gameBuildings
|
||||
and <$> replicateM nb (performAction p a1)
|
||||
OneOpponent a1 -> 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)
|
||||
broadcast $ name ++ " chose " ++ opName ++ "."
|
||||
performAction opID a1
|
||||
EachOpponent a1 -> do
|
||||
players <- toListOf traverse <$> use gamePlayers
|
||||
let opponents = filter (\player -> (player ^. playerNumber) /= p) players
|
||||
forM_ opponents $ \op -> do
|
||||
performAction (op ^. playerNumber) a1
|
||||
return True
|
||||
CurrentPlayer a1 ->
|
||||
flip performAction a1 =<< use gameCurrentPlayer
|
||||
_ -> return False
|
||||
|
||||
scoreFinalPoints :: Waterdeep ()
|
||||
|
|
@ -260,7 +349,7 @@ scoreFinalPoints = do
|
|||
(p ^. playerName) (matches * pts) matches
|
||||
(show (types !! 0)) (show (types !! 1))
|
||||
BuildingBonus pts -> do
|
||||
ownedBuildings <- length <$> filter ((== (p ^. playerNumber)) . (view buildingOwner)) <$> use gameAdvancedBuildings
|
||||
ownedBuildings <- length <$> filter ((== (p ^. playerNumber)) . (view buildingOwner)) <$> use gameBuildings
|
||||
gamePlayer (p ^. playerNumber) . playerScore += ownedBuildings * pts
|
||||
when (ownedBuildings > 0) $
|
||||
broadcast $ printf "%s scored %d points for controlling %d buildings."
|
||||
|
|
@ -308,7 +397,7 @@ restockCliffwatchInn = do
|
|||
case mq of
|
||||
Nothing -> return ()
|
||||
Just q -> do
|
||||
gameCliffwatchInn %= (++ [q])
|
||||
gameCliffwatchInn <>= [q]
|
||||
broadcast $ "Added " ++ (q ^. questTitle) ++ " to Cliffwatch Inn."
|
||||
restockCliffwatchInn
|
||||
|
||||
|
|
@ -320,6 +409,6 @@ restockBuildersHall = do
|
|||
case mb of
|
||||
Nothing -> return ()
|
||||
Just b -> do
|
||||
gameBuildersHall %= (++ [newBuildingState noPlayerID b])
|
||||
gameBuildersHall <>= [newBuildingState noPlayerID b]
|
||||
broadcast $ "Added " ++ (b ^. buildingTitle) ++ " to Builder's Hall."
|
||||
restockBuildersHall
|
||||
|
|
|
|||
|
|
@ -69,9 +69,8 @@ module Waterdeep.Types
|
|||
, gameIntrigueDiscard
|
||||
, gameBuildingDeck
|
||||
, gameBuildingDiscard
|
||||
, gameBasicBuildings
|
||||
, gameBuildersHall
|
||||
, gameAdvancedBuildings
|
||||
, gameBuildings
|
||||
, gameWaterdeepHarbor
|
||||
, gameStdGen
|
||||
, gamePlayer
|
||||
|
|
@ -165,9 +164,8 @@ data WaterdeepState =
|
|||
, _gameIntrigueDiscard :: [IntrigueCard]
|
||||
, _gameBuildingDeck :: [Building]
|
||||
, _gameBuildingDiscard :: [Building]
|
||||
, _gameBasicBuildings :: [BuildingState]
|
||||
, _gameBuildersHall :: [BuildingState]
|
||||
, _gameAdvancedBuildings :: [BuildingState]
|
||||
, _gameBuildings :: [BuildingState]
|
||||
, _gameWaterdeepHarbor :: ([PlayerID], [PlayerID], [PlayerID])
|
||||
, _gameStdGen :: StdGen
|
||||
} deriving (Show)
|
||||
|
|
@ -223,6 +221,7 @@ data GameAction = NoAction
|
|||
| TakeAccumulated
|
||||
| TakeResourceFromOpponent [Resource]
|
||||
| AssignMandatoryQuest Quest
|
||||
| BecomeFirstPlayer
|
||||
| Optional GameAction
|
||||
| ChooseOne [GameAction]
|
||||
| Then GameAction GameAction
|
||||
|
|
|
|||
Loading…
Reference in New Issue