Skip to content
This repository
Browse code

Implemented applyReplacementEffects

  • Loading branch information...
commit 5eb9ff889320077ecc8e8c51aebbf3cbbab24be1 1 parent 3b9d107
Martijn van Steenbergen authored November 07, 2012

Showing 2 changed files with 53 additions and 5 deletions. Show diff stats Hide diff stats

  1. 50  Engine.hs
  2. 8  Types.hs
50  Engine.hs
@@ -18,11 +18,12 @@ import Control.Monad.State (StateT)
18 18
 import qualified Control.Monad.State as State
19 19
 import Control.Monad.Trans (lift)
20 20
 import Control.Monad.Writer (tell, execWriterT)
  21
+import Data.Either (partitionEithers)
21 22
 import Data.Ord (comparing)
22 23
 import Data.Label.Pure (get, set, (:->))
23 24
 import Data.Label.PureM (gets, puts, (=:))
24 25
 import Data.List (sortBy)
25  
-import Data.Maybe (catMaybes)
  26
+import Data.Maybe (catMaybes, isJust)
26 27
 import Data.Traversable (for)
27 28
 
28 29
 type Engine = StateT World (RandT StdGen (Operational.Program Ask))
@@ -179,8 +180,7 @@ executeStep (EndPhase CleanupStep) = do
179 180
 
180 181
 -- | Execute a one-shot effect, applying replacement effects and triggering abilities.
181 182
 executeEffect :: OneShotEffect -> Engine ()
182  
-executeEffect e = do
183  
-  applyReplacementEffects e >>= mapM_ compileEffect
  183
+executeEffect e = applyReplacementEffects e >>= mapM_ compileEffect
184 184
 
185 185
 
186 186
 -- Compilation of effects
@@ -382,8 +382,50 @@ executeAction ability rSource activatorId = do
382 382
     SpecialAction m -> executeMagic m >>= mapM_ executeEffect
383 383
     StackingAction _ -> return ()
384 384
 
  385
+-- [616] Interaction of Replacement and/or Prevention Effects
  386
+-- TODO Handle multiple effects (in a single event) at once, to be able to adhere
  387
+-- to APNAP order; see http://draw3cards.com/questions/9618
385 388
 applyReplacementEffects :: OneShotEffect -> Engine [OneShotEffect]
386  
-applyReplacementEffects = return . (: [])  -- TODO
  389
+applyReplacementEffects effect = do
  390
+    objects <- map snd <$> executeMagic allObjects
  391
+    go (concatMap (get replacementEffects) objects) effect
  392
+  where
  393
+    go :: [ReplacementEffect] -> OneShotEffect -> Engine [OneShotEffect]
  394
+    go availableEffects effectToReplace = do
  395
+      p <- affectedPlayer effectToReplace
  396
+      let (notApplicable, applicable) =
  397
+            partitionEithers $ map (\f -> maybe (Left f) (\m -> Right (f, m)) (f effectToReplace)) availableEffects
  398
+      if null applicable
  399
+        then return [effectToReplace]
  400
+        else do
  401
+          ((chosen, mReplacements), notChosen) <-
  402
+            liftQuestion (AskPickReplacementEffect p applicable)
  403
+          replacements <- executeMagic mReplacements
  404
+          -- TODO Resolve replacements in affected player APNAP order.
  405
+          fmap concat $ for replacements (go (map fst notChosen ++ notApplicable))
  406
+
  407
+-- [616.1] The affected player chooses which replacement effect to apply first.
  408
+affectedPlayer :: OneShotEffect -> Engine PlayerRef
  409
+affectedPlayer e =
  410
+  case e of
  411
+    WillMoveObject o _ _          -> controllerOf o
  412
+    Will (AdjustLife p _)         -> return p
  413
+    Will (DamageObject _ o _ _ _) -> controllerOf o
  414
+    Will (DamagePlayer _ p _ _ _) -> return p
  415
+    Will (ShuffleLibrary p)       -> return p
  416
+    Will (DrawCard p)             -> return p
  417
+    Will (DestroyPermanent i _)   -> controllerOf (Battlefield, i)
  418
+    Will (TapPermanent i)         -> controllerOf (Battlefield, i)
  419
+    Will (UntapPermanent i)       -> controllerOf (Battlefield, i)
  420
+    Will (AddCounter o _)         -> controllerOf o
  421
+    Will (RemoveCounter o _)      -> controllerOf o
  422
+    Will (CreateObject o)         -> return (get controller o)
  423
+    Will (AddToManaPool p _)      -> return p
  424
+    Will (AttachPermanent o _ _)  -> controllerOf o  -- debatable
  425
+    Will (RemoveFromCombat i)     -> controllerOf (Battlefield, i)
  426
+    Will (PlayLand o)             -> controllerOf o
  427
+    Will (LoseGame p)             -> return p
  428
+  where controllerOf o = gets (object o .^ controller)
387 429
 
388 430
 executeMagic :: Magic a -> Engine a
389 431
 executeMagic m = State.get >>= lift . lift . runReaderT m
8  Types.hs
@@ -48,6 +48,7 @@ module Types (
48 48
     ClosedAbility(..), available, manaCost, additionalCosts, effect,
49 49
     Action(..), StackItem, ManaCost(..), AdditionalCost(..),
50 50
     StaticKeywordAbility(..), ContinuousEffect(..), Layer(..),
  51
+    ReplacementEffect,
51 52
     PriorityAction(..),
52 53
 
53 54
     -- * Events
@@ -197,7 +198,7 @@ data Object = Object
197 198
   , _continuousEffects      :: [ContinuousEffect]  -- special form of static ability
198 199
   , _activatedAbilities     :: [Ability]
199 200
   , _triggeredAbilities     :: [Event -> Action]
200  
-  , _replacementEffects     :: [OneShotEffect -> Magic [OneShotEffect]]
  201
+  , _replacementEffects     :: [ReplacementEffect]
201 202
   }
202 203
 
203 204
 
@@ -376,6 +377,8 @@ data Layer
376 377
   | LayerRules   -- rules-affecting effects
377 378
   deriving (Eq, Ord, Show, Read, Enum, Bounded)
378 379
 
  380
+type ReplacementEffect = OneShotEffect -> Maybe (Magic [OneShotEffect])
  381
+
379 382
 data PriorityAction
380 383
   = PlayCard ObjectRef
381 384
   | ActivateAbility Ability
@@ -463,6 +466,9 @@ data Ask a where
463 466
   AskPriorityAction :: PlayerRef -> [PriorityAction] -> Ask (Maybe PriorityAction)
464 467
   AskTarget         :: PlayerRef -> [Target] -> Ask Target
465 468
   AskReorder          :: PlayerRef -> [a] -> Ask [a]
  469
+  AskPickReplacementEffect :: PlayerRef -> [(ReplacementEffect, Magic [OneShotEffect])] -> Ask (Pick (ReplacementEffect, Magic [OneShotEffect]))
  470
+
  471
+type Pick a = (a, [a])
466 472
 
467 473
 view :: View a -> Magic a
468 474
 view v = ReaderT $ return . runIdentity . runReaderT v

0 notes on commit 5eb9ff8

Please sign in to comment.
Something went wrong with that request. Please try again.