diff --git a/src/Dodge/Creature/Damage.hs b/src/Dodge/Creature/Damage.hs index 6d5ccf8aa..3e0f68a5d 100644 --- a/src/Dodge/Creature/Damage.hs +++ b/src/Dodge/Creature/Damage.hs @@ -61,12 +61,18 @@ applyIndividualDamage cr w dm = applyDamageEffect dm (_dmEffect dm) cr $ applyIn applyIndividualDamage' :: Creature -> World -> Damage -> World applyIndividualDamage' cr w dm = case _dmType dm of Piercing -> applyPiercingDamage cr dm w - _ -> w & creatures . ix (_crID cr) . crHP -~ _dmAmount dm + _ -> w & damageHP cr (_dmAmount dm) applyPiercingDamage :: Creature -> Damage -> World -> World applyPiercingDamage cr dm | crIsArmouredFrom p cr = colSpark 8 (brightX 10 1.5 orange) p1 (argV (p1 -.- p)) - | otherwise = creatures . ix (_crID cr) . crHP -~ _dmAmount dm + | otherwise = damageHP cr $ _dmAmount dm where p = _dmAt dm p1 = p +.+ 2 *.* squashNormalizeV (p -.- _crPos cr) + +damageHP :: Creature -> Int -> World -> World +damageHP cr x = creatures . ix (_crID cr) %~ + ( (crHP -~ x) + . (crPastDamage +~ x) + ) diff --git a/src/Dodge/Creature/State.hs b/src/Dodge/Creature/State.hs index 300e71535..78a750c72 100644 --- a/src/Dodge/Creature/State.hs +++ b/src/Dodge/Creature/State.hs @@ -8,6 +8,7 @@ import Dodge.Reloading import Dodge.Base import Dodge.Creature.State.WalkCycle +import Dodge.Creature.Impulse.Movement --import Dodge.Creature.Test --import Dodge.Base import Dodge.SoundLogic @@ -93,10 +94,25 @@ dropByState cr w = foldr (copyInvItemToFloor cr) w $ case cr ^. crState . crDrop doDamage :: Creature -> World -> World doDamage cr w = w & creatures . ix (_crID cr) . crState . crDamage .~ [] + & applyPastDamages cr & _crApplyDamage cr dams cr where dams = _crDamage $ _crState cr +-- TODO generalise shake to arbitrary damage amounts +applyPastDamages :: Creature -> World -> World +applyPastDamages cr w + | _crPastDamage cr > 200 = let (p,g) = runState (randInCirc 3) (_randGen w) + in w & creatures . ix (_crID cr) %~ (crMvBy p . (crPastDamage -~ 100)) + & randGen .~ g + | _crPastDamage cr > 20 = let (p,g) = runState (randInCirc 2) (_randGen w) + in w & creatures . ix (_crID cr) %~ (crMvBy p . (crPastDamage -~ 10)) + & randGen .~ g + | _crPastDamage cr > 0 = let (p,g) = runState (randInCirc 1) (_randGen w) + in w & creatures . ix (_crID cr) %~ (crMvBy p . (crPastDamage -~ 1)) + & randGen .~ g + | otherwise = w + movementSideEff :: Creature -> World -> World movementSideEff cr w | hasJetPack = case cr ^? crStance . carriage of diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index fa79ad285..58e32eaaa 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -282,6 +282,7 @@ data Creature = Creature , _crState :: CreatureState , _crCorpse :: Picture , _crApplyDamage :: [Damage] -> Creature -> World -> World + , _crPastDamage :: Int , _crStance :: Stance , _crActionPlan :: ActionPlan , _crMeleeCooldown :: Int diff --git a/src/Dodge/Default.hs b/src/Dodge/Default.hs index 840d8b6e4..809cc3163 100644 --- a/src/Dodge/Default.hs +++ b/src/Dodge/Default.hs @@ -45,6 +45,7 @@ defaultCreature = Creature , _crState = defaultState , _crCorpse = setLayer BottomLayer $ setDepth 5 $ color (greyN 0.5) $ circleSolid 10 , _crApplyDamage = defaultApplyDamage + , _crPastDamage = 0 , _crStance = Stance {_carriage=Walking 0 WasLeftForward ,_posture=AtEase