implement sequencing of GameActions with a Monoid interface
This commit is contained in:
parent
fe3c7e54e7
commit
4898dea404
36
src/Test.hs
36
src/Test.hs
|
|
@ -4,6 +4,7 @@
|
|||
import Waterdeep.Types
|
||||
import Waterdeep.Monad
|
||||
import Waterdeep.Logic
|
||||
import Waterdeep.Util (mrepeat)
|
||||
import Control.Applicative
|
||||
import Control.Lens
|
||||
import Control.Monad
|
||||
|
|
@ -11,6 +12,7 @@ import Control.Monad.Prompt
|
|||
import Control.Monad.Random
|
||||
import Control.Monad.State
|
||||
import Data.List
|
||||
import Data.Monoid
|
||||
import Text.Printf
|
||||
import System.IO
|
||||
import System.Random
|
||||
|
|
@ -29,59 +31,57 @@ p2 = ("Ned", f2, l2)
|
|||
q1 = Quest { _questType = Arcana
|
||||
, _questTitle = "Research Palantirs"
|
||||
, _questQuote = ""
|
||||
, _questAction = Transaction $
|
||||
[ Transaction $
|
||||
map (\r -> ReturnResource [r]) [Cleric,Rogue,Rogue,Wizard]
|
||||
, Repeat 4 $ ReturnResource [Gold]
|
||||
, ScorePoints 15
|
||||
, Repeat 8 $ TakeResource [Gold]
|
||||
]
|
||||
, _questAction = ReturnResource [Cleric]
|
||||
<> ReturnResource [Rogue]
|
||||
<> ReturnResource [Rogue]
|
||||
<> ReturnResource [Wizard]
|
||||
<> mrepeat 4 (ReturnResource [Gold])
|
||||
<> ScorePoints 15
|
||||
<> mrepeat 8 (TakeResource [Gold])
|
||||
, _questPlotActions = []
|
||||
}
|
||||
|
||||
q2 = Quest { _questType = Skullduggery
|
||||
, _questTitle = "Rob Waterdeep Bank"
|
||||
, _questQuote = ""
|
||||
, _questAction = Transaction $
|
||||
[ Repeat 8 $ ReturnResource [Rogue]
|
||||
, ScorePoints 10
|
||||
, Repeat 16 $ TakeResource [Gold]
|
||||
]
|
||||
, _questAction = mrepeat 8 (ReturnResource [Rogue])
|
||||
<> ScorePoints 10
|
||||
<> mrepeat 16 (TakeResource [Gold])
|
||||
, _questPlotActions = []
|
||||
}
|
||||
|
||||
b1 = Building { _buildingCost = 6
|
||||
, _buildingTitle = "Monastary"
|
||||
, _buildingAction = Group [TakeResource [Cleric], TakeResource [Cleric]]
|
||||
, _buildingAction = mrepeat 2 (TakeResource [Cleric])
|
||||
, _buildingOwnerAction = TakeResource [Cleric]
|
||||
, _buildingAccumType = NoAccumulation
|
||||
}
|
||||
|
||||
b2 = Building { _buildingCost = 4
|
||||
, _buildingTitle = "Training Hall"
|
||||
, _buildingAction = Group [TakeResource [Fighter], TakeResource [Fighter]]
|
||||
, _buildingAction = mrepeat 2 (TakeResource [Fighter])
|
||||
, _buildingOwnerAction = TakeResource [Fighter]
|
||||
, _buildingAccumType = NoAccumulation
|
||||
}
|
||||
|
||||
b3 = Building { _buildingCost = 4
|
||||
, _buildingTitle = "Prison Yard"
|
||||
, _buildingAction = Group [TakeResource [Rogue], TakeResource [Rogue]]
|
||||
, _buildingAction = mrepeat 2 (TakeResource [Rogue])
|
||||
, _buildingOwnerAction = TakeResource [Rogue]
|
||||
, _buildingAccumType = NoAccumulation
|
||||
}
|
||||
|
||||
b4 = Building { _buildingCost = 6
|
||||
, _buildingTitle = "Wizard School"
|
||||
, _buildingAction = Group [TakeResource [Wizard], TakeResource [Wizard]]
|
||||
, _buildingAction = mrepeat 2 (TakeResource [Wizard])
|
||||
, _buildingOwnerAction = TakeResource [Wizard]
|
||||
, _buildingAccumType = NoAccumulation
|
||||
}
|
||||
|
||||
b5 = Building { _buildingCost = 4
|
||||
, _buildingTitle = "Gold Mine"
|
||||
, _buildingAction = Group $ replicate 4 $ TakeResource [Gold]
|
||||
, _buildingOwnerAction = Group $ replicate 2 $ TakeResource [Gold]
|
||||
, _buildingAction = mrepeat 4 (TakeResource [Gold])
|
||||
, _buildingOwnerAction = mrepeat 4 (TakeResource [Gold])
|
||||
, _buildingAccumType = NoAccumulation
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -16,6 +16,7 @@ import Control.Monad.Random
|
|||
import Control.Monad.State
|
||||
import Data.List
|
||||
import Data.Maybe
|
||||
import Data.Monoid
|
||||
import System.Random.Shuffle
|
||||
import Waterdeep.Types
|
||||
import Waterdeep.Monad
|
||||
|
|
@ -97,8 +98,25 @@ waterdeepGame = do
|
|||
replicateM_ (3 + p) $ performAction p $ TakeResource [Gold]
|
||||
forM_ [1..8] $ \round -> do
|
||||
beginRound round
|
||||
fix $ \loop -> do
|
||||
p <- use gameCurrentPlayer
|
||||
success <- filterChoices $ performAction p AssignAgent
|
||||
case success of
|
||||
True -> do
|
||||
filterChoices $ performAction p CompleteQuest
|
||||
gameCurrentPlayer .= (p `mod` length ps) + 1
|
||||
gameConsecutivePasses .= 0
|
||||
loop
|
||||
False -> do
|
||||
passes <- gameConsecutivePasses <+= 1
|
||||
when (passes < length ps) loop
|
||||
performAction 1 $ TakeResource [Cleric, Fighter, Rogue, Wizard, Gold]
|
||||
performAction 2 $ ChooseQuest
|
||||
filterChoices $ performAction 1 $
|
||||
ReturnResource [Wizard]
|
||||
<> ReturnResource [Cleric, Fighter, Gold]
|
||||
<> ReturnResource [Cleric, Fighter]
|
||||
<> ReturnResource [Cleric]
|
||||
-- performAction 2 $ ChooseQuest
|
||||
scoreFinalPoints
|
||||
notifyState
|
||||
determineWinners
|
||||
|
|
@ -124,15 +142,54 @@ initialAgents players round =
|
|||
if round >= 5 then startingAgents + 1 else startingAgents
|
||||
where startingAgents = 6 - players
|
||||
|
||||
data ContWD a where
|
||||
Done :: (a, WaterdeepState) -> ContWD a
|
||||
Cont :: WaterdeepPrompt b -> (b -> ContWD a) -> ContWD a
|
||||
|
||||
-- |Permit only choices which lead to a True result.
|
||||
-- Returns False if and only if no such choice exists.
|
||||
-- If result is False, state remains unchanged.
|
||||
filterChoices :: Waterdeep Bool -> Waterdeep Bool
|
||||
filterChoices m = do
|
||||
mw' <- filteredChoice =<< (runWaterdeepC Done Cont m <$> get)
|
||||
case mw' of
|
||||
Just w' -> put w' >> return True
|
||||
Nothing -> return False
|
||||
where
|
||||
tryChoice :: ContWD Bool -> Bool
|
||||
tryChoice (Done a) = fst a
|
||||
tryChoice (Cont (NotifyState w) cont) = tryChoice $ cont ()
|
||||
tryChoice (Cont (SolicitChoice w p t cs) cont) =
|
||||
or $ map (tryChoice . cont . snd) cs
|
||||
filteredChoice :: ContWD Bool -> Waterdeep (Maybe WaterdeepState)
|
||||
filteredChoice (Done (a,w)) = if a then return (Just w) else return Nothing
|
||||
filteredChoice (Cont (NotifyState w) cont) = filteredChoice $ cont ()
|
||||
filteredChoice (Cont (SolicitChoice w p t cs) cont) = do
|
||||
let cs' = filter (tryChoice . cont . snd) cs
|
||||
if null cs'
|
||||
then return Nothing
|
||||
else filteredChoice =<< (cont <$> (put w >> solicitChoice p t cs'))
|
||||
|
||||
performAction :: PlayerID -> GameAction -> Waterdeep Bool
|
||||
performAction p a = case a of
|
||||
NoAction -> return True
|
||||
ScorePoints n -> do
|
||||
gamePlayer p . playerScore += n
|
||||
return True
|
||||
TakeResource rs -> do
|
||||
r <- solicitChoice p "Please choose one:" $ map (show &&& id) rs
|
||||
r <- solicitChoice p "Take one item:" $ map (show &&& id) rs
|
||||
gamePlayer p . playerTavern %= flip (M.unionWith (+)) (M.fromList [(r, 1)])
|
||||
return True
|
||||
ReturnResource rs -> do
|
||||
tavern <- use $ gamePlayer p . playerTavern
|
||||
let rs' = filter ((> 0) . maybe 0 id . flip M.lookup tavern) rs
|
||||
if null rs'
|
||||
then return False
|
||||
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
|
||||
return True
|
||||
ChooseQuest -> do
|
||||
qs <- use gameCliffwatchInn
|
||||
if null qs
|
||||
|
|
@ -158,6 +215,8 @@ performAction p a = case a of
|
|||
Just i -> do
|
||||
gamePlayer p . playerIntrigueCards %= (++[i])
|
||||
return True
|
||||
a1 `Then` a2 -> do
|
||||
(&&) <$> performAction p a1 <*> performAction p a2
|
||||
_ -> return False
|
||||
|
||||
scoreFinalPoints :: Waterdeep ()
|
||||
|
|
|
|||
|
|
@ -81,6 +81,7 @@ module Waterdeep.Types
|
|||
import Control.Lens
|
||||
import Data.IntMap (IntMap)
|
||||
import Data.Map (Map)
|
||||
import Data.Monoid
|
||||
import System.Random (StdGen)
|
||||
|
||||
type PlayerID = Int
|
||||
|
|
@ -192,7 +193,8 @@ data AccumulationType = NoAccumulation
|
|||
| AccumulateResource Resource Int
|
||||
deriving (Eq,Show)
|
||||
|
||||
data GameAction = ScorePoints Int
|
||||
data GameAction = NoAction
|
||||
| ScorePoints Int
|
||||
| TakeResource [Resource]
|
||||
| ReturnResource [Resource]
|
||||
| GiveResource [Resource]
|
||||
|
|
@ -201,6 +203,7 @@ data GameAction = ScorePoints Int
|
|||
| DrawQuest
|
||||
| DrawNamedQuestType
|
||||
| DistributeQuests
|
||||
| CompleteQuest
|
||||
| ChooseAndCompleteQuest
|
||||
| DiscardUncompletedQuest
|
||||
| BuyBuilding
|
||||
|
|
@ -220,18 +223,18 @@ data GameAction = ScorePoints Int
|
|||
| TakeAccumulated
|
||||
| TakeResourceFromOpponent [Resource]
|
||||
| AssignMandatoryQuest Quest
|
||||
| Group [GameAction]
|
||||
| Optional GameAction
|
||||
| ChooseFrom [GameAction]
|
||||
| Transaction [GameAction]
|
||||
| Repeat Int GameAction
|
||||
| IfThenElse GameAction GameAction GameAction
|
||||
| ChooseOne [GameAction]
|
||||
| Then GameAction GameAction
|
||||
| OrElse GameAction GameAction
|
||||
| ForEachBuilding GameAction
|
||||
| ForEachControlledBuilding GameAction
|
||||
| OneOpponent GameAction
|
||||
| EachOpponent GameAction
|
||||
| CurrentPlayer GameAction
|
||||
deriving (Show)
|
||||
infixr `Then`
|
||||
infixr `OrElse`
|
||||
|
||||
data PlotQualifier = ActionProvides [Resource]
|
||||
| CompletesQuest [QuestType]
|
||||
|
|
@ -275,3 +278,10 @@ instance Eq Building where
|
|||
|
||||
instance Eq IntrigueCard where
|
||||
a == b = a^.intrigueTitle == b^.intrigueTitle
|
||||
|
||||
instance Monoid GameAction where
|
||||
mempty = NoAction
|
||||
NoAction `mappend` x = x
|
||||
x `mappend` NoAction = x
|
||||
(x `Then` y) `mappend` z = x `Then` (y `mappend` z)
|
||||
x `mappend` y = x `Then` y
|
||||
|
|
|
|||
|
|
@ -0,0 +1,8 @@
|
|||
module Waterdeep.Util
|
||||
( mrepeat
|
||||
) where
|
||||
|
||||
import Data.Monoid
|
||||
|
||||
mrepeat :: (Monoid m) => Int -> m -> m
|
||||
mrepeat n m = mconcat $ replicate n m
|
||||
Loading…
Reference in New Issue