/
Abilities.hs
177 lines (138 loc) · 5.74 KB
/
Abilities.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
module Magic.Abilities (
-- * Ability types
Contextual,
ActivatedAbility(..), TapCost(..),
StackItem, ManaPool,
StaticKeywordAbility(..),
ReplacementEffect, TriggeredAbilities,
PriorityAction(..), PayManaAction(..),
-- * Cast speed
instantSpeed, sorcerySpeed,
-- * Play Abilities
playPermanent, playAura, stackTargetlessEffect,
-- * Constructing triggers
mkTriggerObject, mkTargetlessTriggerObject, onSelfETB,
ifSelfWasOrIsOnBattlefield,
-- * Constructing replacement effects
etbWithLoyaltyCounters
) where
import Magic.Core
import Magic.Events
import Magic.IdList (Id)
import Magic.Labels
import Magic.Predicates
import Magic.Some
import Magic.Target
import Magic.Types
import Magic.Utils (gand, emptyObject)
import Control.Applicative ((<$>), pure)
import Control.Monad (void)
import Data.Boolean ((&&*))
import Data.Label.Pure (get, modify)
import Data.Label.PureM (asks)
import Data.Monoid (mempty)
-- CAST SPEED
instantSpeed :: Contextual (View Bool)
instantSpeed rSelf rActivator =
case rSelf of
(Some (Hand rp), _) -> return (rp == rActivator)
_ -> return False
sorcerySpeed :: Contextual (View Bool)
sorcerySpeed rSelf rp = instantSpeed rSelf rp &&* myMainPhase &&* isStackEmpty
where
myMainPhase = do
ap <- asks activePlayer
as <- asks activeStep
return (ap == rp && as == MainPhase)
-- PLAY ABILITIES
-- | Play a nonland, non-aura permanent.
playPermanent :: ManaPool -> ActivatedAbility
playPermanent mc =
ActivatedAbility
{ 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
, isManaAbility = False
}
where
playPermanentEffect :: Contextual (Magic ())
playPermanentEffect rSelf _ = void $
view (willMoveToStack rSelf (pure resolvePermanent)) >>= executeEffect
resolvePermanent _source = return ()
playAura :: ManaPool -> ActivatedAbility
playAura mc =
ActivatedAbility
{ 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
, isManaAbility = False
}
where
playAuraEffect :: Contextual (Magic ())
playAuraEffect rSelf p = do
aura <- view (asks (objectBase rSelf)) -- TODO Reevaluate rSelf on the stack?
let ok i = collectEnchantPredicate aura <$>
asks (object (Battlefield, i) .^ objectPart)
ts <- askMagicTargets p (target permanent <?> ok)
let f :: Id -> ObjectRef TyStackItem -> Magic ()
f i rStackSelf@(Stack, iSelf) = do
self <- view (asks (object rStackSelf .^ objectPart))
void $ executeEffect (WillMoveObject (Just (Some Stack, iSelf)) Battlefield (Permanent self Untapped 0 False (Just (Some Battlefield, i))))
void $ view (willMoveToStack rSelf (f <$> ts)) >>= executeEffect
collectEnchantPredicate :: Object -> Object -> Bool
collectEnchantPredicate aura enchanted = gand
[ hasTypes tys enchanted
| EnchantPermanent tys <- get staticKeywordAbilities aura ]
stackTargetlessEffect :: SomeObjectRef -> (ObjectRef TyStackItem -> Magic ()) -> Magic ()
stackTargetlessEffect rSelf item = do
eff <- view (willMoveToStack rSelf (pure item))
void $ executeEffect eff
-- CONSTRUCTING TRIGGERS
-- | Creates a trigger on the stack under the control of the specified player.
-- The function is applied to the return value of the specified 'TargetList'
-- and put on the stack as a 'StackItem'.
mkTriggerObject :: PlayerRef -> TargetList Target a ->
(a -> ObjectRef TyStackItem -> Magic()) -> Magic ()
mkTriggerObject p ts f = do
t <- tick
void $ executeEffect $ WillMoveObject Nothing Stack $
StackItem (emptyObject t p) (f <$> ts)
-- | Creates a trigger on the stack under the control of the specified player.
-- The specified program is wrapped in an empty 'TargetList' and passed to
-- 'mkTriggerObject'.
mkTargetlessTriggerObject :: PlayerRef -> (ObjectRef TyStackItem -> Magic()) -> Magic ()
mkTargetlessTriggerObject p f = mkTriggerObject p (pure ()) (const f)
-- | Trigger whenever the source object enters the battlefield, executing the
-- argument program.
onSelfETB :: Contextual (Magic ()) -> TriggeredAbilities
onSelfETB mkProgram events rSelf p = return [ mkProgram rSelf p
| DidMoveObject _ rOther@(Some Battlefield, _) <- events, rSelf == rOther ]
-- | Modify a trigger to only fire when the source of the trigger is on the
-- battlefield now, or was before the events took place (i.e. one of the
-- events is the move of the source from the battlefield to another zone).
ifSelfWasOrIsOnBattlefield :: TriggeredAbilities -> TriggeredAbilities
ifSelfWasOrIsOnBattlefield f events rSelf you =
if ok then f events rSelf you else mempty
where
ok = fst rSelf == Some Battlefield
|| not (null ([ () | DidMoveObject (Just (Some Battlefield, _)) newRef <- events, newRef == rSelf ] :: [()]))
-- CONSTRUCTING REPLACEMENT EFFECTS
etbWithLoyaltyCounters :: ReplacementEffect
etbWithLoyaltyCounters (WillMoveObject (Just fromRef) Battlefield perm) rSelf you
| fromRef == rSelf =
case get (objectPart .^ loyalty) perm of
Just n -> Just $ return [WillMoveObject (Just fromRef) Battlefield (modify (objectPart .^ counters) (++ replicate n Loyalty) perm)]
Nothing -> Nothing
etbWithLoyaltyCounters _ _ _ = Nothing