From 31f828f7b707a99897551a898a247ee7b17b2686 Mon Sep 17 00:00:00 2001 From: Martijn van Steenbergen Date: Sat, 19 Apr 2014 16:55:15 +0200 Subject: [PATCH] Reworked the way abilities and alternative costs work --- Magic-Cards/src/Magic/BasicLands.hs | 24 ++++++++++----------- Magic-Cards/src/Magic/M13.hs | 26 ++++++++++------------- Magic/src/Magic/Abilities.hs | 14 +++++------- Magic/src/Magic/Engine.hs | 33 +++++++++++++++-------------- Magic/src/Magic/Types.hs | 18 ++++++++++------ Magic/src/Magic/Utils.hs | 1 + 6 files changed, 58 insertions(+), 58 deletions(-) diff --git a/Magic-Cards/src/Magic/BasicLands.hs b/Magic-Cards/src/Magic/BasicLands.hs index 2cefad2..b3e7bc2 100644 --- a/Magic-Cards/src/Magic/BasicLands.hs +++ b/Magic-Cards/src/Magic/BasicLands.hs @@ -26,8 +26,8 @@ mkBasicLandCard ty color = mkCard $ do play =: Just playLand activatedAbilities =: [tapToAddMana (Just color)] -playLand :: ActivatedAbility -playLand = ActivatedAbility +playLand :: Activation +playLand = Activation { available = \rSource rActivator -> case rSource of (Some (Hand _), _) -> do @@ -40,9 +40,7 @@ playLand = ActivatedAbility return (control && ap == rActivator && step == MainPhase && stackEmpty && n < 1) _ -> return False , manaCost = mempty - , tapCost = NoTapCost , effect = \rSource rActivator -> void (executeEffect (Will (PlayLand rActivator rSource))) - , abilityType = ActivatedAb } countLandsPlayedThisTurn :: (PlayerRef -> Bool) -> View Int @@ -54,15 +52,17 @@ countLandsPlayedThisTurn f = length . filter isPlayLand <$> asks turnHistory tapToAddMana :: Maybe Color -> ActivatedAbility tapToAddMana mc = ActivatedAbility - { available = \rSource rActivator -> - case rSource of - (Some Battlefield, _) -> - checkObject rSource (isControlledBy rActivator) - _ -> return False - , manaCost = mempty - , tapCost = TapCost - , effect = \_rSource rActivator -> void (executeEffect (Will (AddToManaPool rActivator [mc]))) + { abilityActivation = Activation + { available = \rSource rActivator -> + case rSource of + (Some Battlefield, _) -> + checkObject rSource (isControlledBy rActivator) + _ -> return False + , manaCost = mempty + , effect = \_rSource rActivator -> void (executeEffect (Will (AddToManaPool rActivator [mc]))) + } , abilityType = ManaAb + , tapCost = TapCost } checkObject :: SomeObjectRef -> (Object -> Bool) -> View Bool diff --git a/Magic-Cards/src/Magic/M13.hs b/Magic-Cards/src/Magic/M13.hs index af7ad65..2c25ec3 100644 --- a/Magic-Cards/src/Magic/M13.hs +++ b/Magic-Cards/src/Magic/M13.hs @@ -56,13 +56,11 @@ angel'sMercy :: Card angel'sMercy = mkCard $ do name =: Just "Angel's Mercy" types =: instantType - play =: Just ActivatedAbility + play =: Just Activation { available = instantSpeed , manaCost = [Nothing, Nothing, Just White, Just White] - , tapCost = NoTapCost , effect = \rSelf rActivator -> stackTargetlessEffect rSelf $ \_ -> void $ executeEffect (Will (GainLife rActivator 7)) - , abilityType = ActivatedAb } angelicBenediction :: Card @@ -176,15 +174,13 @@ captain'sCall :: Card captain'sCall = mkCard $ do name =: Just "Captain's Call" types =: sorceryType - play =: Just ActivatedAbility + play =: Just Activation { available = sorcerySpeed , manaCost = [Nothing, Nothing, Nothing, Just White] - , tapCost = NoTapCost , effect = \rSelf rActivator -> do t <- tick stackTargetlessEffect rSelf $ \_ -> void $ executeEffects $ replicate 3 $ mkSoldierEffect t rActivator - , abilityType = ActivatedAb } divineFavor :: Card @@ -225,12 +221,10 @@ searingSpear :: Card searingSpear = mkCard $ do name =: Just "Searing Spear" types =: instantType - play =: Just ActivatedAbility + play =: Just Activation { available = instantSpeed , manaCost = [Nothing, Just Red] - , tapCost = NoTapCost , effect = searingSpearEffect - , abilityType = ActivatedAb } where searingSpearEffect :: Contextual (Magic ()) @@ -293,13 +287,15 @@ simpleCreatureToken t you tys cs pt' = loyaltyAbility :: Int -> Contextual (Magic ()) -> ActivatedAbility loyaltyAbility cost eff = ActivatedAbility - { available = sorcerySpeed &&* hasAtLeastLoyalty cost - , manaCost = [] + { abilityActivation = Activation + { available = sorcerySpeed &&* hasAtLeastLoyalty cost + , manaCost = [] + , effect = \rSelf you -> do + void $ executeEffects (replicate cost (Will (RemoveCounter rSelf Loyalty))) + eff rSelf you + } , tapCost = NoTapCost - , abilityType = ActivatedAb - , effect = \rSelf you -> do - void $ executeEffects (replicate cost (Will (RemoveCounter rSelf Loyalty))) - eff rSelf you + , abilityType = LoyaltyAb } hasAtLeastLoyalty :: Int -> Contextual (View Bool) diff --git a/Magic/src/Magic/Abilities.hs b/Magic/src/Magic/Abilities.hs index f4dd147..9be11a7 100644 --- a/Magic/src/Magic/Abilities.hs +++ b/Magic/src/Magic/Abilities.hs @@ -4,7 +4,7 @@ module Magic.Abilities ( -- * Ability types Contextual, - ActivatedAbility(..), TapCost(..), AbilityType(..), + ActivatedAbility(..), Activation(..), TapCost(..), AbilityType(..), StackItem, ManaPool, StaticKeywordAbility(..), ReplacementEffect, TriggeredAbilities, @@ -66,18 +66,16 @@ sorcerySpeed rSelf rp = instantSpeed rSelf rp &&* myMainPhase &&* isStackEmpty -- | Play a nonland, non-aura permanent. -playPermanent :: ManaPool -> ActivatedAbility +playPermanent :: ManaPool -> Activation playPermanent mc = - ActivatedAbility + Activation { available = \rSelf rActivator -> do self <- asks (objectBase rSelf) if Flash `elem` get staticKeywordAbilities self then instantSpeed rSelf rActivator else sorcerySpeed rSelf rActivator , manaCost = mc - , tapCost = NoTapCost , effect = playPermanentEffect - , abilityType = ActivatedAb } where playPermanentEffect :: Contextual (Magic ()) @@ -86,18 +84,16 @@ playPermanent mc = resolvePermanent _source = return () -playAura :: ManaPool -> ActivatedAbility +playAura :: ManaPool -> Activation playAura mc = - ActivatedAbility + Activation { available = \rSelf rActivator -> do self <- asks (objectBase rSelf) if Flash `elem` get staticKeywordAbilities self then instantSpeed rSelf rActivator else sorcerySpeed rSelf rActivator , manaCost = mc - , tapCost = NoTapCost , effect = playAuraEffect - , abilityType = ActivatedAb } where playAuraEffect :: Contextual (Magic ()) diff --git a/Magic/src/Magic/Engine.hs b/Magic/src/Magic/Engine.hs index 8845d97..a026d89 100644 --- a/Magic/src/Magic/Engine.hs +++ b/Magic/src/Magic/Engine.hs @@ -239,7 +239,7 @@ executeStep (CombatPhase CombatDamageStep) = do Nothing -> return [] Just (PlayerRef p) -> return [Will (DamagePlayer attackingObject p power True True)] Just (ObjectRef (Some Battlefield, i)) -> return [Will (DamageObject attackingObject (Battlefield, i) power True True)] - executeEffects TurnBasedActions (concat effectses) + _ <- executeEffects TurnBasedActions (concat effectses) offerPriority -- TODO [510.5] possibly introduce extra combat damage step for first/double strike return () @@ -417,8 +417,9 @@ collectAvailableActivatedAbilities predicate p = do execWriterT $ do for objects $ \(r,o) -> do for (zip [0..] (get activatedAbilities o)) $ \(i, ability) -> do - ok <- lift (shouldOfferAbility ability r p) - when (predicate ability && ok) (tell [(r, i)]) + ok <- lift (shouldOfferActivation (abilityActivation ability) r p) + payCostsOk <- lift (canPayTapCost (tapCost ability) r p) + when (predicate ability && ok && payCostsOk) (tell [(r, i)]) collectPlayableCards :: PlayerRef -> Engine [SomeObjectRef] collectPlayableCards p = do @@ -427,31 +428,31 @@ collectPlayableCards p = do forM_ objects $ \(r,o) -> do case get play o of Just playAbility -> do - ok <- lift (shouldOfferAbility playAbility r p) + ok <- lift (shouldOfferActivation playAbility r p) when ok (tell [r]) Nothing -> return () -shouldOfferAbility :: ActivatedAbility -> Contextual (Engine Bool) -shouldOfferAbility ability rSource rActivator = do - abilityOk <- view (available ability rSource rActivator) - payCostsOk <- canPayTapCost (tapCost ability) rSource rActivator - return (abilityOk && payCostsOk) +shouldOfferActivation :: Activation -> Contextual (Engine Bool) +shouldOfferActivation activation rSource rActivator = + view (available activation rSource rActivator) -activateAbility :: EventSource -> ActivatedAbility -> Contextual (Engine ()) -activateAbility source ability rSource rActivator = do +activate :: EventSource -> Activation -> Contextual (Engine ()) +activate source activation rSource rActivator = do --offerManaAbilitiesToPay source rActivator (manaCost ability) - payTapCost source (tapCost ability) rSource rActivator - executeMagic source (effect ability rSource rActivator) + executeMagic source (effect activation rSource rActivator) executePriorityAction :: PlayerRef -> PriorityAction -> Engine () executePriorityAction p a = do case a of PlayCard r -> do Just ability <- gets (objectBase r .^ play) - activateAbility (PriorityActionExecution a) ability r p + activate (PriorityActionExecution a) ability r p ActivateAbility (r, i) -> do abilities <- gets (objectBase r .^ activatedAbilities) - activateAbility (PriorityActionExecution a) (abilities !! i) r p + let ab = abilities !! i + let eventSource = PriorityActionExecution a + payTapCost eventSource (tapCost ab) r p + activate eventSource (abilityActivation ab) r p offerManaAbilitiesToPay :: EventSource -> PlayerRef -> ManaPool -> Engine () offerManaAbilitiesToPay _ _ [] = return () @@ -472,7 +473,7 @@ offerManaAbilitiesToPay source p cost = do else offerManaAbilitiesToPay source p (delete Nothing cost) ActivateManaAbility (r, i) -> do abilities <- gets (objectBase r .^ activatedAbilities) - activateAbility source (abilities !! i) r p + activate source (abilityActivation (abilities !! i)) r p offerManaAbilitiesToPay source p cost canPayTapCost :: TapCost -> Contextual (Engine Bool) diff --git a/Magic/src/Magic/Types.hs b/Magic/src/Magic/Types.hs index f444dd4..c1266ed 100644 --- a/Magic/src/Magic/Types.hs +++ b/Magic/src/Magic/Types.hs @@ -33,7 +33,7 @@ module Magic.Types ( Object(..), name, colors, types, owner, controller, timestamp, counters, pt, loyalty, - play, staticKeywordAbilities, layeredEffects, activatedAbilities, triggeredAbilities, replacementEffects, + play, alternativePlays, staticKeywordAbilities, layeredEffects, activatedAbilities, triggeredAbilities, replacementEffects, temporaryEffects, ObjectOfType(..), cardObject, @@ -51,7 +51,7 @@ module Magic.Types ( -- * Abilities Contextual, - ActivatedAbility(..), TapCost(..), AbilityType(..), + ActivatedAbility(..), Activation(..), TapCost(..), AbilityType(..), StackItem, ManaPool, StaticKeywordAbility(..), ReplacementEffect, TriggeredAbilities, @@ -236,7 +236,8 @@ data Object = Object --, _indestructible :: Bool - , _play :: Maybe ActivatedAbility + , _play :: Maybe Activation + , _alternativePlays :: [Activation] , _staticKeywordAbilities :: Bag StaticKeywordAbility , _layeredEffects :: [LayeredEffect] , _activatedAbilities :: [ActivatedAbility] @@ -408,11 +409,16 @@ data PlaneswalkerSubtype = Chandra | Elspeth | Garruk | Gideon | Jace type Contextual a = SomeObjectRef -> PlayerRef -> a data ActivatedAbility = ActivatedAbility - { available :: Contextual (View Bool) -- check for cost is implied + { abilityActivation :: Activation + , abilityType :: AbilityType + , tapCost :: TapCost + } + +data Activation = Activation + { available :: Contextual (View Bool) + -- check timing, zone, controller , manaCost :: ManaPool - , tapCost :: TapCost , effect :: Contextual (Magic ()) - , abilityType :: AbilityType } data TapCost = NoTapCost | TapCost -- add later: UntapCost diff --git a/Magic/src/Magic/Utils.hs b/Magic/src/Magic/Utils.hs index 8849cfc..de58ed2 100644 --- a/Magic/src/Magic/Utils.hs +++ b/Magic/src/Magic/Utils.hs @@ -39,6 +39,7 @@ emptyObject t rOwner = Object , _loyalty = Nothing , _play = Nothing + , _alternativePlays = [] , _staticKeywordAbilities = [] , _layeredEffects = [] , _activatedAbilities = []