From 4e408135d8ba8e56c19a40973e1ddb1efcae28cb Mon Sep 17 00:00:00 2001 From: Emi Simpson Date: Sat, 9 Dec 2023 22:45:39 -0500 Subject: [PATCH] Rework the protoeffect system & Add ActingUnit/TargettedUnit newtypes --- src/GameLogic.hs | 31 +++++----- src/GameModel.hs | 124 ++++++++++++++++++++++++++-------------- src/Units/Carcass.hs | 6 +- src/Units/Components.hs | 68 ++++++++++++++++++---- src/Units/Debug.hs | 19 +++--- 5 files changed, 169 insertions(+), 79 deletions(-) diff --git a/src/GameLogic.hs b/src/GameLogic.hs index 09afae8..4529c65 100644 --- a/src/GameLogic.hs +++ b/src/GameLogic.hs @@ -28,9 +28,10 @@ import Safe (atMay) import Mechanics (universalModifiers, globalHooks) import Data.Monoid (Any(getAny), getSum) +import Data.Coerce -- | A version of `computeStat_` using `universalModifiers` as global modifiers -computeStat :: BoardState -> CharacterIdentifier -> Stat a -> a +computeStat :: (Coercible cid c, c ~ CharacterIdentifier) => BoardState -> cid -> Stat a -> a computeStat = computeStat_ universalModifiers -- | A version of `runHooks_` using `globalHooks` as the global hooks @@ -49,7 +50,7 @@ data EngineState playerChoice :: Player -> [Choice] -> EngineState playerChoice = PlayerChoice -unitChoice :: CharacterIdentifier -> [Choice] -> EngineState +unitChoice :: (Coercible cid c, c ~ CharacterIdentifier) => cid -> [Choice] -> EngineState unitChoice = playerChoice . owner activePlayerChoice :: BoardState -> [Choice] -> EngineState @@ -64,8 +65,8 @@ chooseCharacter board = playerChoice player <$> fmap toList (nonEmpty $ board ^. player :: Player player = board ^. activePlayer possibleActivations :: SimpleFold BoardState Choice - possibleActivations = untappedUnits . filtered ((== player) . owner) . to activateUnit - activateUnit :: CharacterIdentifier -> Choice + possibleActivations = untappedUnits . filtered ((== player) . owner) . to (activateUnit . ActingUnit) + activateUnit :: ActingUnit -> Choice activateUnit cid = mkChoice ("Activate unit " ++ c) [ChooseActMove cid] where c = renderCharacterHandle board cid @@ -109,8 +110,8 @@ computePossibleSteps board (MovementSpecs {..}) currentLocation = mapMaybe getRe endOfMovementEffects :: MovementSpecs -> CharacterIdentifier -> [Effect] endOfMovementEffects (MovementSpecs {..}) cid = [ConfirmMove] - ++ [DropToken SpeedSlow cid | movSpendTokens ] - ++ [Event $ Broadcast EndMove cid | movEndMoveTrigger] + ++ [DropToken SpeedSlow (TargettedUnit cid) | movSpendTokens ] + ++ [Event $ Broadcast EndMove (ActingUnit cid) | movEndMoveTrigger] generateMovementChoice :: BoardState -> MovementSpecs -> CharacterIdentifier -> Point -> (Point, Natural) -> Choice generateMovementChoice board specs@(MovementSpecs {..}) cid originalLocation (dest, remainingMov) = @@ -201,7 +202,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 $ Broadcast EndMove cid + endMoveTrigger = Event $ Broadcast EndMove (ActingUnit cid) choiceBuilder = maybe (unitChoice cid) playerChoice $ movForced ^? _Just . _3 applyEffect (MoveTo dest) board = continue $ moveUnit dest board applyEffect (DropToken token unit) board = continue $ @@ -213,22 +214,22 @@ applyEffect (Act cid) board = case board ^.. ixCharacter cid . baseStats . actio applyEffect (Target fromPerspective range eligability ultimateEffect) board = unitChoice fromPerspective choices where locus = unitPosition board fromPerspective - potentialUnits = maybe [] (cidsInRange board range) locus + potentialUnits = TargettedUnit <$> (maybe [] (cidsInRange board range) locus) eligableUnits = filter (eligability board) potentialUnits buildChoice targetCid = mkChoice ("Target " ++ renderCharacterHandle board targetCid) [BodyBlock targetCid ultimateEffect] choices = buildChoice <$> eligableUnits -applyEffect (BodyBlock targettedUnit ultimateEffect) board = if canBB then allChoices else cantBBResult +applyEffect (BodyBlock originalTarget ultimateEffect) board = if canBB then allChoices else cantBBResult where - potentialBBers = fromMaybe [] $ adjacentAllies board targettedUnit - canBB = isNecromancer targettedUnit && not (null potentialBBers) + potentialBBers = fromMaybe [] $ adjacentAllies board originalTarget + canBB = isNecromancer originalTarget && not (null potentialBBers) buildChoice bber = mkChoice ("Bodyblock with " ++ renderCharacterHandle board bber) (ultimateEffect bber) - dontBodyblock = mkChoice "Take the hit to your necromancer" (ultimateEffect targettedUnit) - bbChoices = buildChoice <$> potentialBBers - allChoices = unitChoice targettedUnit $ dontBodyblock : bbChoices - cantBBResult = continue $ board <++ ultimateEffect targettedUnit + dontBodyblock = mkChoice "Take the hit to your necromancer" (ultimateEffect originalTarget) + bbChoices = buildChoice . TargettedUnit <$> potentialBBers + allChoices = unitChoice originalTarget $ dontBodyblock : bbChoices + cantBBResult = continue $ board <++ ultimateEffect originalTarget applyEffect (ResolveAttack attacker attack defender) board = Roll actualDiceRolled keepHighest consequence where attacker' = board ^? ixCharacter attacker diff --git a/src/GameModel.hs b/src/GameModel.hs index 3add604..5de36ce 100644 --- a/src/GameModel.hs +++ b/src/GameModel.hs @@ -6,6 +6,10 @@ module GameModel , Armor(..) , DamageType(..) , Attack(Attack) + , ActingUnit(..) + , actingUnit + , TargettedUnit(..) + , targettedUnit , headshotEffectsL , meleeL , otherEffectsL @@ -69,6 +73,7 @@ module GameModel , getDefense , statusEffects , CharacterIdentifier + , cidEq , owner , ownerL , isNecromancer @@ -158,6 +163,7 @@ import Lens.Micro.TH (makeLenses, makeLensesWith, generateUpdateableOptics) import Lens.Micro.Extras (preview) import Data.Data ((:~:)(..)) import System.Random (Random(..)) +import Data.Coerce data DieFace = One | Two | Three | Four | Five | Six deriving (Eq, Ord, Enum, Read) @@ -224,14 +230,23 @@ instance Num DieFace where type CharacterIdentifier = (Player, Int) -owner :: CharacterIdentifier -> Player -owner = fst +cidEq :: (Coercible a b, Eq b) => a -> b -> Bool +cidEq = (==) . coerce + +owner :: (Coercible cid c, c ~ CharacterIdentifier) => cid -> Player +owner cid' = fst cid + where + cid :: CharacterIdentifier + cid = coerce cid' ownerL :: Lens' CharacterIdentifier Player ownerL = _1 -isNecromancer :: CharacterIdentifier -> Bool -isNecromancer = snd >>> (== 0) +isNecromancer :: (Coercible cid c, c ~ CharacterIdentifier) => cid -> Bool +isNecromancer cid' = (==0) $ snd cid + where + cid :: CharacterIdentifier + cid = coerce cid' showCID :: CharacterIdentifier -> Char showCID (cidOwner, idx) = (if cidOwner == Max then upperLetters else lowerLetters) !! idx @@ -300,9 +315,9 @@ enumeratePoints w h = Point <$> [0..w * h - 1] data Trigger a where TurnStart :: Trigger () - TookDamage :: Trigger CharacterIdentifier - Died :: Trigger (CharacterIdentifier, Point) - EndMove :: Trigger CharacterIdentifier + TookDamage :: Trigger TargettedUnit + Died :: Trigger (TargettedUnit, Point) + EndMove :: Trigger ActingUnit deriving instance Eq (Trigger a) deriving instance Show (Trigger a) @@ -423,8 +438,8 @@ data ProtoMovementSpecs = ProtoMovementSpecs , movCompelled :: Bool -- ^ If movement can be stopped prematurely } -basicMove :: CharacterIdentifier -> Effect -basicMove = InitMove $ ProtoMovementSpecs +basicMove :: ActingUnit -> Effect +basicMove = (InitMove $ ProtoMovementSpecs { movVerb = "Move" , movFree' = Nothing , movMinimum = True @@ -433,10 +448,10 @@ basicMove = InitMove $ ProtoMovementSpecs , movSpendTokens = True , movEndMoveTrigger = True , movCompelled = False - } + }) . (^. actingUnit) -forcedMove :: ForcedMoveType -> Natural -> Player -> Either CharacterIdentifier Point -> CharacterIdentifier -> Effect -forcedMove fmType amt compeller locus = InitMove $ ProtoMovementSpecs +forcedMove :: ForcedMoveType -> Natural -> Player -> Either CharacterIdentifier Point -> TargettedUnit -> Effect +forcedMove fmType amt compeller locus = (InitMove $ ProtoMovementSpecs { movVerb = show fmType , movFree' = Just True , movMinimum = False @@ -445,7 +460,25 @@ forcedMove fmType amt compeller locus = InitMove $ ProtoMovementSpecs , movSpendTokens = False , movEndMoveTrigger = False , movCompelled = True - } + }) . (^. targettedUnit) + +-- | Designates a character identifier of the unit acting in an effect/event +-- +-- Acting includes moving, attacking, or using an ability +newtype ActingUnit = ActingUnit CharacterIdentifier + deriving (Eq, Show) + +-- | A lens reaching into `ActingUnit` +actingUnit :: Lens' ActingUnit CharacterIdentifier +actingUnit f (ActingUnit au) = ActingUnit <$> f au + +-- | Designates a character identifier of the unit being targetted by an effect/attack +newtype TargettedUnit = TargettedUnit CharacterIdentifier + deriving (Eq, Show) + +-- | A lens reaching into `TargettedUnit` +targettedUnit :: Lens' TargettedUnit CharacterIdentifier +targettedUnit f (TargettedUnit au) = TargettedUnit <$> f au data Effect @@ -458,10 +491,10 @@ data Effect | Event Broadcast -- | Active player chooses whether they want to move or act first - | ChooseActMove CharacterIdentifier + | ChooseActMove ActingUnit -- | Active player may choose whether they want to act or move - | ActOrMove CharacterIdentifier + | ActOrMove ActingUnit -- | Mark the start of movement -- Can be finalized later with FinalizeMove @@ -483,51 +516,51 @@ data Effect -- | Remove up to one token from the given category from a unit | forall n. Num n => DropToken (Token n) -- ^ The token category to drop from - CharacterIdentifier -- ^ Which character drops a token + TargettedUnit -- ^ Which character drops a token -- | Confirms a Move, placing the unit in the target space | ConfirmMove -- | Allow a character to Act - | Act CharacterIdentifier + | Act ActingUnit -- | Target a unit in a given range, then run a different event | Target - CharacterIdentifier -- ^ ACTing unit + ActingUnit -- ^ ACTing unit (Natural, Natural) -- ^ Range - (BoardState -> CharacterIdentifier -> Bool) -- ^ Target filter - (CharacterIdentifier -> [Effect]) -- ^ Ultimate effect + (BoardState -> TargettedUnit -> Bool) -- ^ Target filter + (TargettedUnit -> [Effect]) -- ^ Ultimate effect -- | Check if a character can body block -- If they can, offer a choice of target to the targetted player. Pass result on to -- the effect. - | BodyBlock CharacterIdentifier (CharacterIdentifier -> [Effect]) + | BodyBlock TargettedUnit (TargettedUnit -> [Effect]) -- | Resolve an attack | ResolveAttack - CharacterIdentifier -- ^ Attacker - Attack -- ^ Attack information - CharacterIdentifier -- ^ Target + ActingUnit -- ^ Attacker + Attack -- ^ Attack information + TargettedUnit -- ^ Target | InflictDamage DamageType Natural -- ^ Damage amount - CharacterIdentifier -- ^ Target + TargettedUnit -- ^ Target -- | Add a status effect to a character | InflictStatusEffect StatusEffect -- ^ Effect to inflict - CharacterIdentifier -- ^ Target + TargettedUnit -- ^ Target | forall n. Num n => InflictTokens (Token n) -- ^ Token kind n -- ^ Token amount - CharacterIdentifier -- ^ Target + TargettedUnit -- ^ Target - | Kill CharacterIdentifier + | Kill TargettedUnit -- | Tap the active unit, change the active player - | EndTurn CharacterIdentifier + | EndTurn ActingUnit data Attack = Attack { headshotEffects :: [Effect] @@ -577,7 +610,7 @@ data BaseStats = BaseStats , df :: DieFace , arm :: Armor , traits :: [Trait] - , actions :: [CharacterIdentifier -> Choice] + , actions :: [ActingUnit -> Choice] } -- | Some effect which is activated by some trigger event @@ -838,10 +871,11 @@ untap = movedThisRound .~ False -- -- This includes so called global modifiers, but in order to keep game rules seperate from -- the model, global modifiers must be provided as the first argument. -computeStat_ :: [Modifier] -> BoardState -> CharacterIdentifier -> Stat a -> a -computeStat_ globalModifiers board cid stat = case allStatsAreMonoids stat of +computeStat_ :: (Coercible cid c, c ~ CharacterIdentifier) => [Modifier] -> BoardState -> cid -> Stat a -> a +computeStat_ globalModifiers board cid' stat = case allStatsAreMonoids stat of HasMonoidInstance Refl -> let + cid = coerce cid' queryStatsL = each . to (queryModifier board cid stat) globalBonus = globalModifiers ^. queryStatsL traitBonus = board ^. ixCharacter cid . baseStats . traitsL . each . traitModifiersL . queryStatsL @@ -1016,11 +1050,13 @@ offsetB b = usingBoardDimensions b offset eachCID :: Monoid m => Getting m BoardState CharacterIdentifier eachCID = tiles . each . _1 . _Just -ixCharacter :: CharacterIdentifier -> Traversal' BoardState Character -ixCharacter (player, indx) = characters . forPlayer player . ix indx +ixCharacter :: (Coercible cid c, c ~ CharacterIdentifier) => cid -> Traversal' BoardState Character +ixCharacter cid = case coerce cid of (player, indx) -> characters . forPlayer player . ix indx -renderCharacterHandle :: BoardState -> CharacterIdentifier -> String -renderCharacterHandle board cid = maybe "[💀]" (characterHandle cid) $ board ^? ixCharacter cid +renderCharacterHandle :: (Coercible a b, b ~ CharacterIdentifier) => BoardState -> a -> String +renderCharacterHandle board cid' = maybe "[💀]" (characterHandle cid) $ board ^? ixCharacter cid + where + cid = coerce cid' eachCharacter :: Traversal' BoardState Character eachCharacter = characters . everybody . traverse @@ -1070,14 +1106,14 @@ isAlive board cid = has (eachCID . filtered (== cid)) board pushEffects :: [Effect] -> BoardState -> BoardState pushEffects newEffects = effectStack %~ (newEffects ++) -unitPosition :: BoardState -> CharacterIdentifier -> Maybe Point +unitPosition :: (Coercible cid c, c ~ CharacterIdentifier) => BoardState -> cid -> Maybe Point unitPosition (BoardState {_movingUnit=Just (movingCid, movingPoint)}) cid - | movingCid == cid = Just movingPoint + | movingCid == coerce cid = Just movingPoint unitPosition (BoardState {_tiles}) cid = headMay . catMaybes $ zipWith aux [0..] _tiles where aux :: Natural -> (Maybe CharacterIdentifier, [EnvTile]) -> Maybe Point aux p (potentialCid, _) - | potentialCid == Just cid = Just $ Point p + | potentialCid == Just (coerce cid) = Just $ Point p | otherwise = Nothing atPoint :: Point -> Traversal' BoardState (Maybe CharacterIdentifier, [EnvTile]) @@ -1092,7 +1128,7 @@ characterAt p f board = inner f board inner :: Traversal' BoardState (Maybe CharacterIdentifier) inner = atPoint p . _1 . filtered (/= board ^? movingUnit . _Just . _1) -adjacentUnits :: BoardState -> CharacterIdentifier -> Maybe [CharacterIdentifier] +adjacentUnits :: (Coercible cid c, c ~ CharacterIdentifier) => BoardState -> cid -> Maybe [CharacterIdentifier] adjacentUnits board cid = do originalLocation <- unitPosition board cid let adjacentTiles = usingBoardDimensions board adjacentPoints originalLocation @@ -1100,14 +1136,14 @@ adjacentUnits board cid = do let unitsAdjacent = mapMaybe (flip preview board . characterAt') adjacentTiles return unitsAdjacent -adjacentAllies :: BoardState -> CharacterIdentifier -> Maybe [CharacterIdentifier] +adjacentAllies :: (Coercible cid c, c ~ CharacterIdentifier) => BoardState -> cid -> Maybe [CharacterIdentifier] adjacentAllies board cid = filter (owner >>> (owner cid ==)) <$> adjacentUnits board cid -isElevated :: BoardState -> CharacterIdentifier -> Bool +isElevated :: (Coercible cid c, c ~ CharacterIdentifier) => BoardState -> cid -> Bool isElevated board cid = any (\p -> elem Elevation $ board ^. terrainAt p) $ unitPosition board cid -removeUnit :: CharacterIdentifier -> BoardState -> BoardState -removeUnit cid = tiles . each . _1 %~ mfilter (/= cid) +removeUnit :: (Coercible cid c, c ~ CharacterIdentifier) => cid -> BoardState -> BoardState +removeUnit cid = tiles . each . _1 %~ mfilter (/= coerce cid) setUnit :: CharacterIdentifier -> Point -> BoardState -> BoardState setUnit character point = atPoint point . _1 ?~ character diff --git a/src/Units/Carcass.hs b/src/Units/Carcass.hs index 55b5fe1..cc56a96 100644 --- a/src/Units/Carcass.hs +++ b/src/Units/Carcass.hs @@ -5,8 +5,10 @@ module Units.Carcass import GameModel ( adjacentAllies + , ActingUnit , Armor(..) , BaseStats(..) + , BoardState , CharacterIdentifier , Choice , DamageType(..) @@ -20,6 +22,7 @@ import Units.Components , anyTarget , buildAttack, inflictTokens, push ) +import Data.Monoid (Sum) gunwight :: BaseStats gunwight = BaseStats @@ -32,7 +35,7 @@ gunwight = BaseStats , traits = [formation] } -gunwightActions :: [CharacterIdentifier -> Choice] +gunwightActions :: [ActingUnit -> Choice] gunwightActions = [ buildAttack $ AttackT { tName = "OL45" @@ -63,6 +66,7 @@ formation = Trait , traitModifiers = [formationModifier] } where + formationF :: BoardState -> CharacterIdentifier -> Sum Int formationF board cid = if adjacentAllies board cid /= Just [] then 1 else 0 formationModifier = Modifier { modifierStat = AttackDice diff --git a/src/Units/Components.hs b/src/Units/Components.hs index 8b0d25c..e66c63b 100644 --- a/src/Units/Components.hs +++ b/src/Units/Components.hs @@ -19,10 +19,13 @@ import GameModel , Choice , DamageType , Effect(..) - , mkChoice, Token, forcedMove, ForcedMoveType (..), owner, StatusEffect + , ActingUnit(..), TargettedUnit(..) + , actingUnit + , mkChoice, Token, forcedMove, ForcedMoveType (..), owner, StatusEffect, DieFace ) import Numeric.Natural (Natural) +import Lens.Micro ------------------------- -- Attacks & Abilities -- @@ -31,7 +34,7 @@ import Numeric.Natural (Natural) data AttackT = AttackT { tName :: String , tRange :: (Natural, Natural) - , tValidTargets :: BoardState -> CharacterIdentifier -> Bool + , tValidTargets :: BoardState -> TargettedUnit -> Bool , tMelee :: Bool , tDamageType :: DamageType , tDamageAmount :: Natural @@ -39,16 +42,16 @@ data AttackT = AttackT , tStandardEffects :: [ProtoEffect] } -anyTarget :: BoardState -> CharacterIdentifier -> Bool +anyTarget :: BoardState -> TargettedUnit -> Bool anyTarget = const $ const True -buildAttack :: AttackT -> CharacterIdentifier -> Choice +buildAttack :: AttackT -> ActingUnit -> Choice buildAttack (AttackT {..}) attacker = mkChoice tName [targetEffect] where attackDetails target = Attack - ((sequence $ sequence tHeadshotEffects attacker) target) + (mkEffect attacker target tHeadshotEffects) tMelee - ((sequence $ sequence tStandardEffects attacker) target) + (mkEffect attacker target tStandardEffects) tDamageType tDamageAmount attackEffect target = [ResolveAttack attacker (attackDetails target) target] @@ -59,23 +62,64 @@ data SelfAbilityT = SelfAbilityT , tEffects :: [ProtoEffect] } -mkSelfAbility :: SelfAbilityT -> CharacterIdentifier -> Choice -mkSelfAbility (SelfAbilityT {..}) cid = mkChoice tName (sequence (sequence tEffects cid) cid) +mkSelfAbility :: SelfAbilityT -> ActingUnit -> Choice +mkSelfAbility (SelfAbilityT {..}) cid = mkChoice tName (mkEffect cid (TargettedUnit $ cid ^. actingUnit) tEffects) ----------------------------- --------- Effects ----------- ----------------------------- -type ProtoEffect = CharacterIdentifier -> CharacterIdentifier -> Effect +-- | 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 _ = InflictStatusEffect se +inflictStatusEffect se = MkProtoEffect $ InflictStatusEffect se inflictTokens :: Num n => Token n -> n -> ProtoEffect -inflictTokens tokenType tokenCount _ = InflictTokens tokenType tokenCount +inflictTokens tokenType tokenCount = MkProtoEffect $ InflictTokens tokenType tokenCount genericShift :: ForcedMoveType -> Natural -> ProtoEffect -genericShift fmType amount puller = forcedMove fmType amount (owner puller) (Left puller) +genericShift fmType amount = MkProtoEffect $ (\(ActingUnit puller) -> forcedMove fmType amount (owner puller) (Left puller)) push :: Natural -> ProtoEffect push = genericShift Push diff --git a/src/Units/Debug.hs b/src/Units/Debug.hs index c943bbf..b2410e6 100644 --- a/src/Units/Debug.hs +++ b/src/Units/Debug.hs @@ -4,7 +4,7 @@ module Units.Debug where import GameModel - ( Armor(..) + ( Armor(..), ActingUnit , BaseStats(..) , CharacterIdentifier , Choice @@ -12,6 +12,8 @@ import GameModel , Token(..), StatusEffect (..) , Hook(..), Effect(..) , Trigger(..), BoardState + , TargettedUnit(..) + , targettedUnit ) import Units.Components @@ -23,6 +25,8 @@ import Units.Components , inflictStatusEffect ) +import Lens.Micro + basic :: BaseStats basic = BaseStats { name = "Basic Debug Unit" @@ -34,7 +38,7 @@ basic = BaseStats , traits = [] } -basicActions :: [CharacterIdentifier -> Choice] +basicActions :: [ActingUnit -> Choice] basicActions = [ buildAttack $ AttackT { tName = "Peashooter" @@ -130,10 +134,11 @@ bloodShield = StatusEffect , 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 + damageHookEffect :: TargettedUnit -> BoardState -> Int -> CharacterIdentifier -> [Effect] + damageHookEffect (TargettedUnit injuredUnit) _ _ us = + [InflictTokens VitalVulnr 1 (TargettedUnit us) | injuredUnit == us ] + damageHookDecrement :: TargettedUnit -> BoardState -> Int -> CharacterIdentifier -> Maybe Int damageHookDecrement damagedUnit _ n us - | damagedUnit == us && n > 1 = Just $ pred n - | damagedUnit == us = Nothing + | damagedUnit ^. targettedUnit == us && n > 1 = Just $ pred n + | damagedUnit ^. targettedUnit == us = Nothing | otherwise = Just n \ No newline at end of file