Work on creature destruction/damage update

src/Dodge/Barreloid.hs

@@ -26,7 +26,6 @@ updateExpBarrel ps cr w = case cr ^. crHP of
             & cWorld . lWorld . creatures . ix (_crID cr) %~ damsToExpBarrel damages
             & cWorld . lWorld . creatures . ix (_crID cr) . crHP . _HP
                 -~ length (_piercedPoints . _barrelType $ _crType cr)
-            & cWorld . lWorld . creatures . ix (_crID cr) . crDamage .~ mempty
             & flip (foldl' f) ps
     HP _ ->
         w

src/Dodge/Creature/Update.hs

@@ -3,6 +3,7 @@
 module Dodge.Creature.Update (updateCreature) where
 
 --import Dodge.WorldEvent.ThingsHit
+import Dodge.Creature.Damage
 import Color
 import Control.Monad
 import qualified IntMapHelp as IM
@@ -39,12 +40,17 @@ import ShapePicture.Data
 updateCreature :: Creature -> World -> World
 updateCreature cr
     | cr ^. crPos . _z < negate 300 = (tocr . crHP .~ CrDestroyed Pitted) . destroyAllInvItems cr
-    | CrIsCorpse _ <- cr ^. crHP = updateCarriage (_crID cr)
-    | null (cr ^? crHP . _HP) = id
-    | otherwise = updateLivingCreature cr
+    | otherwise = case cr ^. crHP of
+        CrIsCorpse{} -> cleardamage . updateCarriage (_crID cr) . damageCorpse (_crID cr) cr
+        CrDestroyed{} -> id
+        HP{} -> cleardamage . updateLivingCreature cr
   where
+    cleardamage = tocr . crDamage .~ mempty
     tocr = cWorld . lWorld . creatures . ix (_crID cr)
 
+damageCorpse :: Int -> Creature -> World -> World
+damageCorpse _ cr w = w & applyCreatureDamage (cr ^. crDamage) cr
+
 updateLivingCreature :: Creature -> World -> World
 updateLivingCreature cr = case _crType cr of
     Avatar{} ->
@@ -226,31 +232,20 @@ checkDeath cid w = maybe id checkDeath' (w ^? cWorld . lWorld . creatures . ix c
 
 checkDeath' :: Creature -> World -> World
 checkDeath' cr w = case cr ^. crHP of
-    HP x | x > 0 -> w & tocr . crDamage .~ []
+    HP x | x > 0 -> w
     HP x
         | x > -200 && null (cr ^. crDeathTimer) ->
             w & tocr %~ startDeathTimer
     HP x
         | x > -200
         , Just y <- cr ^. crDeathTimer
-        , y > 0 ->
-            w
-                & tocr
-                . crDamage
-                .~ []
-                & tocr
-                . crDeathTimer
-                . _Just
-                -~ 1
+        , y > 0 -> w & tocr . crDeathTimer . _Just -~ 1
     HP _ ->
         w
             & dropAll cr -- the order of these is possibly important
             & stopSoundFrom (CrWeaponSound (_crID cr) 0)
             & corpseOrGib cr
-            & tocr
-            . crStance
-            . carriage
-            %~ toDeathCarriage
+            & tocr . crStance . carriage %~ toDeathCarriage
     _ -> w
   where
     tocr = cWorld . lWorld . creatures . ix (_crID cr)

src/Dodge/Damage.hs

@@ -66,7 +66,7 @@ damageInCircle f p r w =
         & cWorld . lWorld . creatures %~ docrdams
   where
     dowldams wds = foldl' g wds (wlsHitRadial p r w)
-    docrdams crs = foldl' h crs (crsHitRadial p r w)
+    docrdams crs = foldl' h crs (bodiesHitRadial p r w)
     g wds (x, wl) = wds & at (_wlID wl) . non mempty .:~ f x
     h crs (x, cr) = crs & ix (_crID cr) . crDamage .:~ f x
 

src/Dodge/Update.hs

@@ -608,7 +608,13 @@ setOldPos cr = cr & crOldPos .~ _crPos cr
 
 zoneCreatures :: World -> World
 zoneCreatures w =
-    w & crZoning .~ foldl' zoneCreature mempty (w ^. cWorld . lWorld . creatures)
+    w & crZoning .~ foldl' zoneCreature mempty (IM.filter zonableCreature $ w ^. cWorld . lWorld . creatures)
+
+zonableCreature :: Creature -> Bool
+zonableCreature cr = case cr ^. crHP of
+    HP{} -> True
+    CrIsCorpse{} -> True
+    CrDestroyed{} -> False
 
 updateCreatureSoundPositions :: World -> World
 updateCreatureSoundPositions w =

src/Dodge/Update/Cloud.hs

@@ -1,5 +1,6 @@
 module Dodge.Update.Cloud (cloudPoisonDamage) where
 
+import Data.Maybe
 import Data.Foldable
 import Dodge.Creature.Radius
 import Dodge.Data.World
@@ -15,4 +16,5 @@ cloudPoisonDamage c w = foldl' (flip doDam) w (filter f $ crsNearPoint clpos w)
     doDam cr =
         cWorld . lWorld . creatures . ix (_crID cr) . crDamage .:~ Poison 1
     f cr = dist3 (_crPos cr & _z +~ 20) (_gsPos c) < crRad (cr ^. crType) + 20
+        && isJust (cr ^? crHP . _HP)
     clpos = stripZ $ _gsPos c

src/Dodge/WorldEvent/ThingsHit.hs

@@ -10,7 +10,7 @@ module Dodge.WorldEvent.ThingsHit (
     thingHit,
     thingHitFilt,
     thingsHitExceptCr,
-    crsHitRadial,
+    bodiesHitRadial,
     wlsHitRadial,
     wlHitPos,
     crHit,
@@ -211,12 +211,21 @@ wlsHitRadial p r = IM.mapMaybe f . wlsNearCirc p r
         mhp = orthp <|> t (return x) <|> t (return y)
 --        v = normalizeV . vNormal . uncurry (-) $ _wlLine wl
 
-crsHitRadial :: Point2 -> Float -> World -> [(Point2, Creature)]
-crsHitRadial p r = mapMaybe f . IM.elems . crsNearCirc p r
+--crsHitRadial :: Point2 -> Float -> World -> [(Point2, Creature)]
+--crsHitRadial p r = mapMaybe f . IM.elems . crsNearCirc p r
+--  where
+--    f cr = do
+--        let cp = cr ^. crPos . _xy
+--        guard $ dist p cp < r + crRad (_crType cr)
+--        return (cp + (1 + crRad (_crType cr)) *^ (cp - p), cr)
+
+bodiesHitRadial :: Point2 -> Float -> World -> [(Point2, Creature)]
+bodiesHitRadial p r = mapMaybe f . IM.elems . crsNearCirc p r
   where
     f cr = do
         let cp = cr ^. crPos . _xy
         guard $ dist p cp < r + crRad (_crType cr)
+            && (isJust (cr ^? crHP . _HP) || isJust (cr ^? crHP . _CrIsCorpse))
         return (cp + (1 + crRad (_crType cr)) *^ (cp - p), cr)
 
 isFlyable :: Point2 -> Point2 -> World -> Bool