Emi
/
maleghast-engine
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Rework triggers & add status effects

This commit is contained in:
Emi Simpson 2023-12-09 12:56:43 -05:00
parent a555ed4ea0
commit 7a501ac927
Signed by: Emi
GPG Key ID: A12F2C2FFDC3D847
5 changed files with 111 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
package.yaml
View File

@ -51,6 +51,7 @@ library:
- ScopedTypeVariables
- EmptyCase
- DuplicateRecordFields
- StandaloneDeriving
executables:
maleghast-exe:

13
src/GameLogic.hs
View File

@ -34,7 +34,7 @@ computeStat :: BoardState -> CharacterIdentifier -> Stat a -> a
computeStat = computeStat_ universalModifiers
-- | A version of `runHooks_` using `globalHooks` as the global hooks
runHooks :: Trigger -> BoardState -> BoardState
runHooks :: Broadcast -> BoardState -> BoardState
runHooks = runHooks_ globalHooks
data EngineState
@ -109,8 +109,8 @@ computePossibleSteps board (MovementSpecs {..}) currentLocation = mapMaybe getRe
endOfMovementEffects :: MovementSpecs -> CharacterIdentifier -> [Effect]
endOfMovementEffects (MovementSpecs {..}) cid =
[ConfirmMove]
++ [DropToken SpeedSlow cid | movSpendTokens ]
++ [Event $ EndMove cid | movEndMoveTrigger]
++ [DropToken SpeedSlow cid | movSpendTokens ]
++ [Event $ Broadcast EndMove cid | movEndMoveTrigger]
generateMovementChoice :: BoardState -> MovementSpecs -> CharacterIdentifier -> Point -> (Point, Natural) -> Choice
generateMovementChoice board specs@(MovementSpecs {..}) cid originalLocation (dest, remainingMov) =
@ -201,7 +201,7 @@ applyEffect (Move specs@(MovementSpecs{..}) cid) board = case unitPosition board
dontMoveChoice = mkChoice "Don't move" dontMoveEffects
finishMoveEffects = endOfMovementEffects specs cid
finishMoveChoice = mkChoice "Finish moving" finishMoveEffects
endMoveTrigger = Event $ EndMove cid
endMoveTrigger = Event $ Broadcast EndMove cid
choiceBuilder = maybe (unitChoice cid) playerChoice $ movForced ^? _Just . _3
applyEffect (MoveTo dest) board = continue $ moveUnit dest board
applyEffect (DropToken token unit) board = continue $
@ -284,7 +284,8 @@ applyEffect (InflictDamage damageType incomingAmount recipient) board = continue
else id
updatedHealth = fromMaybe 9999 $ board' ^? ixCharacter recipient . tokenCount . ofToken Health
dead = updatedHealth == 0
damageEffects = [Event $ TookDamage recipient, if dead then Kill recipient else NoOp]
damageEffects = [Event $ Broadcast TookDamage recipient, if dead then Kill recipient else NoOp]
applyEffect (InflictStatusEffect se target) board = continue $ board & ixCharacter target . statusEffects %~ (se :)
applyEffect (InflictTokens tokenType numberToAdd target) board = continue $ board &
ixCharacter target . tokenCount . ofToken tokenType +~ numberToAdd
applyEffect (Kill unit) board = if isNecromancer unit
@ -293,7 +294,7 @@ applyEffect (Kill unit) board = if isNecromancer unit
where
deathLocation = unitPosition board unit
unitRemoved = removeUnit unit board
deathAlert = maybe NoOp (Event . Died unit) deathLocation
deathAlert = maybe NoOp (Event . Broadcast Died . (unit,)) deathLocation
applyEffect (EndTurn cid) board = continue $ afterPlayerSwitched <++ [StartTurn]
where
afterUnitTapped = board & ixCharacter cid %~ tap

87
src/GameModel.hs
View File

@ -47,6 +47,8 @@ module GameModel
, otherPlayer
, Token(..)
, ofToken
, tokenEq
, Broadcast(..)
, Stat(..)
, BaseStats(..)
, nameL
@ -127,8 +129,6 @@ module GameModel
, allStatsAreMonoids
, HasMonoidInstance
, Hook(..)
, hookTriggerL
, hookEffectL
, hookToFunc
, hooksToFunc
, Modifier(..)
@ -298,12 +298,29 @@ newtype Point = Point Natural
enumeratePoints :: Natural -> Natural -> [Point]
enumeratePoints w h = Point <$> [0..w * h - 1]
data Trigger
= TurnStart
| TookDamage CharacterIdentifier
| Died CharacterIdentifier Point
| EndMove CharacterIdentifier
deriving (Eq, Show)
data Trigger a where
TurnStart :: Trigger ()
TookDamage :: Trigger CharacterIdentifier
Died :: Trigger (CharacterIdentifier, Point)
EndMove :: Trigger CharacterIdentifier
deriving instance Eq (Trigger a)
deriving instance Show (Trigger a)
-- | Compare to triggers to check if they're equal
--
-- If they are, you get a proof of the equality of their associated data types.
triggerEq :: Trigger a -> Trigger b -> Maybe (a :~: b)
triggerEq TurnStart TurnStart = Just Refl
triggerEq TookDamage TookDamage = Just Refl
triggerEq Died Died = Just Refl
triggerEq EndMove EndMove = Just Refl
triggerEq _ _ = Nothing
-- | A pair containing a 'Trigger' and its associated data
--
-- Effectively an event as a whole
data Broadcast = forall d. Broadcast (Trigger d) d
data OrthagonalDirection
= North
@ -438,7 +455,7 @@ data Effect
| StartTurn
-- | Send some trigger to every Unit
| Event Trigger
| Event Broadcast
-- | Active player chooses whether they want to move or act first
| ChooseActMove CharacterIdentifier
@ -497,6 +514,11 @@ data Effect
Natural -- ^ Damage amount
CharacterIdentifier -- ^ Target
-- | Add a status effect to a character
| InflictStatusEffect
StatusEffect -- ^ Effect to inflict
CharacterIdentifier -- ^ Target
| forall n. Num n => InflictTokens
(Token n) -- ^ Token kind
n -- ^ Token amount
@ -559,22 +581,22 @@ data BaseStats = BaseStats
}
-- | Some effect which is activated by some trigger event
data Hook h = Hook
{ hookTrigger :: Trigger -- ^ The trigger which should activate this effect
data Hook o = forall d. Hook
{ hookTrigger :: Trigger d -- ^ The trigger which should activate this effect
-- | What this effect does. Recieves board & this character's CID
, hookEffect :: BoardState -> h
, hookEffect :: d -> BoardState -> o
}
-- | Evaluate a hook for a given trigger
--
-- If the trigger does not apply to this hook, then `mempty` is returned.
hookToFunc :: Monoid h => Hook h -> Trigger -> BoardState -> h
hookToFunc (Hook {..}) trigger
| hookTrigger == trigger = hookEffect
| otherwise = mempty
hookToFunc :: Monoid h => Hook h -> Broadcast -> BoardState -> h
hookToFunc (Hook {..}) (Broadcast trigger assocData) = case hookTrigger `triggerEq` trigger of
Just Refl -> hookEffect assocData
Nothing -> mempty
-- | A version of `hookToFunc` which evaluates several hooks at once
hooksToFunc :: Monoid h => [Hook h] -> Trigger -> BoardState -> h
hooksToFunc :: Monoid h => [Hook h] -> Broadcast -> BoardState -> h
hooksToFunc = mconcat . fmap hookToFunc
-- | A modifier which conditionally affects thet value of some stat for a unit
@ -622,8 +644,16 @@ data StatusEffect = forall a. StatusEffect
-- | Whatever internal state is needed by this effect
, seState :: a
-- | Render the internal state
--
-- Suffixed with the name when `show`ing this status effect
, seShowState :: a -> String
}
instance Show StatusEffect where
show (StatusEffect {..}) = '+' : seName ++ ' ' : seShowState seState
instance Show BaseStats where
show stats = "===== " ++ name stats ++ " =====\nMV: " ++ show (mov stats) ++ " DF: " ++ show (df stats) ++ "+ ARM: " ++ show (arm stats)
@ -696,7 +726,12 @@ data Character = Character
}
instance Show Character where
show c = show (_baseStats c) ++ (if _movedThisRound c then "\n(already moved this round)" else "\n") ++ '\n' : show (_tokenCount c)
show c =
show (_baseStats c)
++ (if _movedThisRound c then "\n(already moved this round)" else "\n")
++ '\n' : show (_tokenCount c)
++ '\n' : mconcat (intersperse "\n" (show <$> _statusEffects c))
++ "\n"
noTokens :: TokenCount
noTokens = TokenCount noTokens'
@ -741,21 +776,25 @@ makeLensesWith secondClassLensNames ''Hook
makeLensesWith secondClassLensNames ''Trait
instance Functor Hook where
fmap f hook = hook & hookEffectL . mapped %~ f
v <$ Hook {..} = Hook {hookEffect = const v, ..}
fmap f (Hook {..}) = Hook {hookEffect = hookEffect <&> (<&> f), ..}
v <$ Hook {..} = Hook {hookEffect = const $ const v, ..}
-- | Extract the hooks from a status effect, hiding internal state
seGetHooks :: StatusEffect -> [Hook (CharacterIdentifier -> [Effect])]
seGetHooks (StatusEffect {..}) = seHooks <&> (<&> ($ seState))
seDoUpdate :: Trigger -> BoardState -> CharacterIdentifier -> StatusEffect -> Maybe StatusEffect
seDoUpdate trigger board cid (StatusEffect {..}) = case relevantUpdates of
seDoUpdate :: Broadcast -> BoardState -> CharacterIdentifier -> StatusEffect -> Maybe StatusEffect
seDoUpdate (Broadcast trigger assocData) board cid (StatusEffect {..}) = case relevantUpdates of
[] -> Just $ StatusEffect {..}
Nothing : _ -> Nothing
Just newState : _ -> Just $ StatusEffect {seState = newState, ..}
where
seUpdate' = seUpdate & each . mapped %~ (($ cid) . ($ seState))
relevantHooks = seUpdate' ^.. each . filtered ((trigger==) . hookTrigger) . hookEffectL
getRelevantHookEffects :: Hook t -> Maybe (BoardState -> t)
getRelevantHookEffects (Hook {..}) = case hookTrigger `triggerEq` trigger of
Just Refl -> Just $ hookEffect assocData
Nothing -> Nothing
relevantHooks = seUpdate' ^.. each . to getRelevantHookEffects . _Just
relevantUpdates = sequence relevantHooks board
instantiate :: BaseStats -> Character
@ -815,7 +854,7 @@ computeStat_ globalModifiers board cid stat = case allStatsAreMonoids stat of
-- necessary status effect updates are applied. Similar to `computeStat_`, this is
-- additionall searches so called global hooks, but only recognizes global hooks passed as
-- an argument.
runHooks_ :: [Hook [Effect]] -> Trigger -> BoardState -> BoardState
runHooks_ :: [Hook [Effect]] -> Broadcast -> BoardState -> BoardState
runHooks_ globalHooks trigger board = boardWithUpdates <++ allEffects
where
unitAllEffectHooks :: (CharacterIdentifier, Character) -> [Hook [Effect]]

6
src/Units/Components.hs
View File

@ -8,6 +8,7 @@ module Units.Components
, inflictTokens
, push
, pull
, inflictStatusEffect
)
where
@ -18,7 +19,7 @@ import GameModel
, Choice
, DamageType
, Effect(..)
, mkChoice, Token, forcedMove, ForcedMoveType (..), owner
, mkChoice, Token, forcedMove, ForcedMoveType (..), owner, StatusEffect
)
import Numeric.Natural (Natural)
@ -67,6 +68,9 @@ mkSelfAbility (SelfAbilityT {..}) cid = mkChoice tName (sequence (sequence tEffe
type ProtoEffect = CharacterIdentifier -> CharacterIdentifier -> Effect
inflictStatusEffect :: StatusEffect -> ProtoEffect
inflictStatusEffect se _ = InflictStatusEffect se
inflictTokens :: Num n => Token n -> n -> ProtoEffect
inflictTokens tokenType tokenCount _ = InflictTokens tokenType tokenCount

39
src/Units/Debug.hs
View File

@ -9,7 +9,9 @@ import GameModel
, CharacterIdentifier
, Choice
, DamageType(..)
, Token(..)
, Token(..), StatusEffect (..)
, Hook(..), Effect(..)
, Trigger(..), BoardState
)
import Units.Components
@ -18,6 +20,7 @@ import Units.Components
, buildAttack
, SelfAbilityT(..)
, mkSelfAbility, inflictTokens, pull, push
, inflictStatusEffect
)
basic :: BaseStats
@ -102,7 +105,35 @@ basicActions =
, tEffects = [inflictTokens SpeedSlow 1]
}
, mkSelfAbility $ SelfAbilityT
{ tName = "Get String"
, tEffects = [inflictTokens StrWeak 1]
{ tName = "Blood Shield"
, tEffects = [inflictStatusEffect bloodShield]
}
]
]
bloodShield :: StatusEffect
bloodShield = StatusEffect
{ seName = "Blood Shield"
, seHooks =
[ Hook
{ hookTrigger = TookDamage
, hookEffect = damageHookEffect
}
]
, seModifiers = []
, seUpdate =
[ Hook
{ hookTrigger = TookDamage
, hookEffect = damageHookDecrement
}
]
, seState = 1
, seShowState = \n -> '(' : replicate n '*' ++ ")"
}
where
damageHookEffect :: CharacterIdentifier -> BoardState -> Int -> CharacterIdentifier -> [Effect]
damageHookEffect damagedUnit _ _ us = if damagedUnit == us then [InflictTokens VitalVulnr 1 us] else []
damageHookDecrement :: CharacterIdentifier -> BoardState -> Int -> CharacterIdentifier -> Maybe Int
damageHookDecrement damagedUnit _ n us
| damagedUnit == us && n > 1 = Just $ pred n
| damagedUnit == us = Nothing
| otherwise = Just n