Tweak creature update

2025-08-06 13:10:37 +01:00
parent af5bdf59b9
commit 9fb7440776
11 changed files with 196 additions and 191 deletions
@@ -1,47 +1,140 @@
-module Dodge.Creature.Update (
-    updateCreature,
-) where
+module Dodge.Creature.Update (updateCreature) where

-import Dodge.Inventory
-import LensHelp
-import Geometry
-import Dodge.SoundLogic
-import Dodge.Creature.Radius
-import Dodge.Creature.YourControl
-import Dodge.Creature.State
+import Color
+import qualified Data.IntMap.Strict as IM
+import qualified Data.List as List
 import Dodge.Barreloid
+import Dodge.Base.NewID
+import Dodge.Corpse.Make
+import Dodge.Creature.Action
+import Dodge.Creature.Radius
+import Dodge.Creature.State
+import Dodge.Creature.State.WalkCycle
+import Dodge.Creature.YourControl
+import Dodge.Damage
+import Dodge.Data.Damage.Type
 import Dodge.Data.World
 import Dodge.Humanoid
+import Dodge.Inventory
 import Dodge.Lampoid
-import qualified Data.List as List
+import Dodge.Prop.Gib
+import Dodge.SoundLogic
+import FoldableHelp
+import Geometry
+import LensHelp
+import Shape
+import ShapePicture.Data

 -- Should separate out creature movement from other parts here
+-- allow for knockbacks etc to be determined as well as intended movements

 updateCreature :: Creature -> World -> World
 updateCreature cr
    | _crZ cr < negate 100 = destroyAllInvItems cr
-    | _crZ cr < 0 = (tocr . crZVel -~ 0.5)
+    | _crZ cr < 0 =
+        (tocr . crZVel -~ 0.5)
            . (tocr . crZ +~ _crZVel cr)
    | otherwise = updateCreature' cr
  where
    tocr = cWorld . lWorld . creatures . ix (_crID cr)

 updateCreature' :: Creature -> World -> World
-updateCreature' cr = chasmTest cr . case _crType cr of
-    Avatar{} -> (cWorld . lWorld . creatures . ix 0 . crType . avatarPulse %~ updatePulse) 
-        . crUpdate yourControl cr
-    LampCrit{} -> updateLampoid cr
-    BarrelCrit bt -> updateBarreloid bt cr
-    AvatarDead -> id
-    _ -> crUpdate updateHumanoid cr
+updateCreature' cr =
+    chasmTest cr . case _crType cr of
+        Avatar{} ->
+            (cWorld . lWorld . creatures . ix 0 . crType . avatarPulse %~ updatePulse)
+                . crUpdate' yourControl cr
+        LampCrit{} -> updateLampoid cr
+        BarrelCrit bt -> updateBarreloid bt cr
+        AvatarDead -> id
+        _ -> crUpdate' updateHumanoid cr
+
+{- | this seems to work, but I am not sure about the ordering:
+ previously, the movement was updated before the ai in order to correctly set the oldpos.
+ This should be made more sensible: should the movement side effects apply to
+ the creature before or after it has moved?
+ at what point invSideEffects is applied wrt to when the creature moves
+ may affect whether the shield moves correctly
+-}
+crUpdate' :: (Creature -> World -> World) -> Creature -> World -> World
+crUpdate' f cr =
+    checkDeath cid
+        . doDamage cid
+        . invItemEffs cid
+        . g
+        . updateWalkCycle cid
+  where
+    cid = (cr ^. crID)
+    g w' = maybe id f (w' ^? cWorld . lWorld . creatures . ix cid) w'
+
+checkDeath :: Int -> World -> World
+checkDeath cid w = maybe id checkDeath' (w ^? cWorld . lWorld . creatures . ix cid) w
+
+checkDeath' :: Creature -> World -> World
+checkDeath' cr w
+    | _crHP cr > 0 =
+        w
+            & cWorld . lWorld . creatures . ix (_crID cr) . crDamage .~ []
+    | _crHP cr <= -200 =
+        w
+            & dropAll cr -- the order of
+            & destroyCreature cr -- these is important
+            & stopSoundFrom (CrWeaponSound (_crID cr) 0)
+            & addCrGibs cr
+    | _crHP cr > -200 && _crDeathTimer cr < 5 =
+        w
+            & cWorld . lWorld . creatures . ix (_crID cr) . crDamage .~ []
+            & cWorld . lWorld . creatures . ix (_crID cr) . crDeathTimer +~ 1
+    | otherwise =
+        w
+            & dropAll cr -- the order of
+            & removecr -- these is important
+            & stopSoundFrom (CrWeaponSound (_crID cr) 0)
+            & corpseOrGib cr
+  where
+    removecr
+        | _crID cr == 0 = id
+        --                 cWorld . lWorld . creatures . ix (_crID cr) . crHP .~ 0
+        -- hack to get around player creature being killed but left with more than 0 hp
+        | otherwise = cWorld . lWorld . creatures . at (_crID cr) .~ Nothing
+
+destroyCreature :: Creature -> World -> World
+destroyCreature cr
+    | _crID cr == 0 = id
+    --                 cWorld . lWorld . creatures . ix (_crID cr) . crHP .~ 0
+    -- hack to get around player creature being killed but left with more than 0 hp
+    | otherwise = cWorld . lWorld . creatures . at (_crID cr) .~ Nothing
+
+-- could look at the amount of damage here (given by maxDamage) too
+corpseOrGib :: Creature -> World -> World
+corpseOrGib cr = case cr ^? crDamage . to maxDamageType . _Just . _1 of
+    Just CookingDamage -> addcorpse (thecorpse & cpSPic %~ scorchSPic)
+    Just PoisonDamage -> addcorpse (thecorpse & cpSPic %~ poisonSPic)
+    Just PhysicalDamage | _crPain cr > 200 -> addCrGibs cr
+    _ -> addcorpse thecorpse
+  where
+    addcorpse ctype = plNew (cWorld . lWorld . corpses) cpID ctype
+    thecorpse = makeCorpse cr
+
+scorchSPic :: SPic -> SPic
+scorchSPic = _1 %~ overColSH (mixColors 0.9 0.1 black . normalizeColor)
+
+poisonSPic :: SPic -> SPic
+poisonSPic = _1 %~ overColSH (mixColors 0.5 0.5 green . normalizeColor)
+
+-- reverse keys, otherwise two or more inv items will cause errors
+dropAll :: Creature -> World -> World
+dropAll cr w = foldl' (flip (dropItem cr)) w . reverse . IM.keys $ _crInv cr

 chasmTest :: Creature -> World -> World
 chasmTest cr w
-    | _crZVel cr < 0 = w & cWorld . lWorld . creatures . ix (_crID cr) . crZVel -~ 0.5
-        & cWorld . lWorld . creatures . ix (_crID cr) . crZ +~ _crZVel cr
-    | Just (x,y) <- List.find g (foldMap loopPairs $ w ^. cWorld . chasms) = w
-        & soundContinue (CrChasm (_crID cr)) (_crPos cr) debrisS (Just 100)
-        & cWorld . lWorld . creatures . ix (_crID cr) . crPos -~ normalizeV (vNormal (x-y))
+    | _crZVel cr < 0 =
+        w & cWorld . lWorld . creatures . ix (_crID cr) . crZVel -~ 0.5
+            & cWorld . lWorld . creatures . ix (_crID cr) . crZ +~ _crZVel cr
+    | Just (x, y) <- List.find g (foldMap loopPairs $ w ^. cWorld . chasms) =
+        w
+            & soundContinue (CrChasm (_crID cr)) (_crPos cr) debrisS (Just 100)
+            & cWorld . lWorld . creatures . ix (_crID cr) . crPos -~ normalizeV (vNormal (x - y))
    | any f (w ^. cWorld . chasms) = w & cWorld . lWorld . creatures . ix (_crID cr) . crZVel -~ 0.5
    | otherwise = w
  where
@@ -49,6 +142,6 @@ chasmTest cr w
    f = circInPolygon (_crPos cr) (crRad $ cr ^. crType)

 updatePulse :: Pulse -> Pulse
-updatePulse PulseStatus {_pulseRate = pr, _pulseProgress = pp}
+updatePulse PulseStatus{_pulseRate = pr, _pulseProgress = pp}
    | pp >= pr = PulseStatus pr 0
    | otherwise = PulseStatus pr (pp + 1)