128 lines
3.9 KiB
Haskell
128 lines
3.9 KiB
Haskell
module Units.Components
|
|
( AttackT(..)
|
|
, ProtoEffect
|
|
, anyTarget
|
|
, buildAttack
|
|
, SelfAbilityT(..)
|
|
, mkSelfAbility
|
|
, inflictTokens
|
|
, push
|
|
, pull
|
|
, inflictStatusEffect
|
|
)
|
|
where
|
|
|
|
import GameModel
|
|
( Attack(..)
|
|
, BoardState
|
|
, CharacterIdentifier
|
|
, Choice
|
|
, DamageType
|
|
, Effect(..)
|
|
, ActingUnit(..), TargettedUnit(..)
|
|
, actingUnit
|
|
, mkChoice, Token, forcedMove, ForcedMoveType (..), owner, StatusEffect, DieFace
|
|
)
|
|
|
|
import Numeric.Natural (Natural)
|
|
import Lens.Micro
|
|
|
|
-------------------------
|
|
-- Attacks & Abilities --
|
|
-------------------------
|
|
|
|
data AttackT = AttackT
|
|
{ tName :: String
|
|
, tRange :: (Natural, Natural)
|
|
, tValidTargets :: BoardState -> TargettedUnit -> Bool
|
|
, tMelee :: Bool
|
|
, tDamageType :: DamageType
|
|
, tDamageAmount :: Natural
|
|
, tHeadshotEffects :: [ProtoEffect]
|
|
, tStandardEffects :: [ProtoEffect]
|
|
}
|
|
|
|
anyTarget :: BoardState -> TargettedUnit -> Bool
|
|
anyTarget = const $ const True
|
|
|
|
buildAttack :: AttackT -> ActingUnit -> Choice
|
|
buildAttack (AttackT {..}) attacker = mkChoice tName [targetEffect]
|
|
where
|
|
attackDetails target = Attack
|
|
(mkEffect attacker target tHeadshotEffects)
|
|
tMelee
|
|
(mkEffect attacker target tStandardEffects)
|
|
tDamageType
|
|
tDamageAmount
|
|
attackEffect target = [ResolveAttack attacker (attackDetails target) target]
|
|
targetEffect = Target attacker tRange tValidTargets attackEffect
|
|
|
|
data SelfAbilityT = SelfAbilityT
|
|
{ tName :: String
|
|
, tEffects :: [ProtoEffect]
|
|
}
|
|
|
|
mkSelfAbility :: SelfAbilityT -> ActingUnit -> Choice
|
|
mkSelfAbility (SelfAbilityT {..}) cid = mkChoice tName (mkEffect cid (TargettedUnit $ cid ^. actingUnit) tEffects)
|
|
|
|
-----------------------------
|
|
--------- Effects -----------
|
|
-----------------------------
|
|
|
|
-- | Indicates a possible argument to a protoeffect
|
|
--
|
|
-- A valid argument to a protoeffect is any argument with which provide by placing the
|
|
-- protoeffect in an `Effect`. For example, a `DieFace` is a valid question because there
|
|
-- exists an `Effect` which accepts a type @`DieFace` -> [`Effect`]@.
|
|
--
|
|
-- In additon, the actor and target (respectively) are available in the context, to enable
|
|
-- asking questions about those things
|
|
class Question t where
|
|
askQuestion :: ActingUnit -> TargettedUnit -> (t -> [Effect]) -> [Effect]
|
|
|
|
instance Question ActingUnit where
|
|
askQuestion actor _ f = f actor
|
|
|
|
instance Question TargettedUnit where
|
|
askQuestion _ target f = f target
|
|
|
|
-- | A function which can be converted into a sequence of effects
|
|
--
|
|
-- Used in `buildProtoEffect` to create a `ProtoEffect`
|
|
class ProtoEffectF t where
|
|
mkEffect :: ActingUnit -> TargettedUnit -> t -> [Effect]
|
|
|
|
instance ProtoEffectF f => ProtoEffectF [f] where
|
|
mkEffect a t = (mkEffect a t =<<)
|
|
|
|
instance ProtoEffectF Effect where
|
|
mkEffect _ _ = pure
|
|
|
|
instance ProtoEffectF ProtoEffect where
|
|
mkEffect attacker target pe = mkEffect' attacker target pe
|
|
|
|
instance (ProtoEffectF a, Question q) => ProtoEffectF (q -> a) where
|
|
mkEffect attacker target f = askQuestion attacker target (mkEffect attacker target <$> f)
|
|
|
|
data ProtoEffect = forall f. ProtoEffectF f => MkProtoEffect f
|
|
|
|
mkEffect' :: ActingUnit -> TargettedUnit -> ProtoEffect -> [Effect]
|
|
mkEffect' attacker target (MkProtoEffect pe) = mkEffect attacker target pe
|
|
|
|
mkEffects' :: ActingUnit -> TargettedUnit -> [ProtoEffect] -> [Effect]
|
|
mkEffects' a t = (mkEffect a t =<<)
|
|
|
|
inflictStatusEffect :: StatusEffect -> ProtoEffect
|
|
inflictStatusEffect se = MkProtoEffect $ InflictStatusEffect se
|
|
|
|
inflictTokens :: Num n => Token n -> n -> ProtoEffect
|
|
inflictTokens tokenType tokenCount = MkProtoEffect $ InflictTokens tokenType tokenCount
|
|
|
|
genericShift :: ForcedMoveType -> Natural -> ProtoEffect
|
|
genericShift fmType amount = MkProtoEffect $ (\(ActingUnit puller) -> forcedMove fmType amount (owner puller) (Left puller))
|
|
|
|
push :: Natural -> ProtoEffect
|
|
push = genericShift Push
|
|
|
|
pull :: Natural -> ProtoEffect
|
|
pull = genericShift Pull |