Continue to tweak death effects

src/Dodge/Creature/State.hs

@@ -18,9 +18,11 @@ import Dodge.WorldEvent
 import Dodge.Creature.Action
 --import Dodge.Hammer
 import Geometry
---import Picture
+import Picture
 import qualified IntMapHelp as IM
 --import StrictHelp
+import FoldableHelp
+
 
 --import qualified Data.IntSet as IS
 --import Data.Maybe
@@ -54,7 +56,7 @@ foldCr xs cr w = foldr f w xs
 -- may affect whether the shield moves correctly
 stateUpdate :: (Creature -> World -> World) -> Creature -> World -> World
 stateUpdate f = foldCr
-    [ doDamage
+    [ clearDamage
     , equipmentEffects
     , invSideEff
     , upInv      -- upInv must be called before invSideEff 22.05.23
@@ -62,6 +64,7 @@ stateUpdate f = foldCr
     , f
     , internalUpdate 
     , checkDeath
+    , doDamage
     ]
 
 checkDeath :: Creature -> World -> World
@@ -72,13 +75,24 @@ checkDeath cr w
         & dropByState cr
         & removecr
         & stopSoundFrom (CrWeaponSound (_crID cr) 0) 
-        & plNew corpses cpID thecorpse
+        & corpseOrGib cr
   where
     removecr
         | _crID cr == 0 = (creatures . ix (_crID cr) . crUpdate .~ const id)
             . (creatures . ix (_crID cr) . crPict .~ const mempty)
-            . addCrGibs cr
         | otherwise  = creatures . at (_crID cr) .~ Nothing
+corpseOrGib :: Creature -> World -> World
+corpseOrGib cr w 
+    | _crPastDamage cr > 200 = w & addCrGibs cr
+        & bloodPuddleAt cpos
+        & bloodPuddleAt cpos
+        & bloodPuddleAt cpos
+    | otherwise = w
+        & bloodPuddleAt cpos
+        & bloodPuddleAt cpos
+        & plNew corpses cpID thecorpse
+  where
+    cpos = _crPos cr
     thecorpse = Corpse
         { _cpID = 0
         , _cpPos = _crPos cr
@@ -87,6 +101,15 @@ checkDeath cr w
         , _cpRes = Nothing
         }
 
+
+bloodPuddleAt :: Point2 -> World -> World
+bloodPuddleAt p w = w
+    & snd . plNewID decorations 
+        (color (dark $ dark red) . setDepth 01 . uncurryV translate (p +.+ q) $ circleSolid 10)
+    & randGen .~ g
+  where
+    (q,g) = randInCirc 10 & runState $ _randGen w
+
 internalUpdate :: Creature -> World -> World
 internalUpdate cr = creatures . ix (_crID cr) %~ 
     ( (crHammerPosition %~ moveHammerUp)
@@ -102,9 +125,12 @@ dropByState cr w = foldr (dropItem cr) w $ case cr ^. crState . crDropsOnDeath o
     DropSpecific xs -> xs
     DropAmount n -> take n $ evalState (shuffle $ IM.keys $ _crInv cr) (_randGen w)
 
+clearDamage :: Creature -> World -> World
+clearDamage cr w = w
+    & creatures . ix (_crID cr) . crState . crDamage .~ [] 
+
 doDamage :: Creature -> World -> World
 doDamage cr w = w
-    & creatures . ix (_crID cr) . crState . crDamage .~ [] 
     & applyPastDamages cr
     & _crApplyDamage cr dams cr
   where