Continue to tweak death effects

src/Dodge/Creature/Picture.hs

@@ -20,6 +20,7 @@ import Dodge.Data
 import Dodge.Clock
 import Dodge.Creature.HandPos (translateToRightHand,translateToLeftHand)
 import Dodge.Creature.Test
+import Dodge.Damage
 --import Dodge.Debug.Picture
 import Picture
 import Geometry
@@ -210,7 +211,13 @@ arms cr = fst $ translateToRightHand cr aHand
 --    f i = negate 2 + negate 6 * fromIntegral (sLen - i) / fromIntegral sLen
 
 deadScalp :: Creature -> Shape
-deadScalp = overPosSH (Q.rotateToZ (V3 1 0 0)) . translateSHz 10 . scalp
+deadScalp cr = deadRot cr . translateSHz 10 . scalp $ cr
+
+deadRot :: Creature -> Shape -> Shape
+deadRot cr = overPosSH (Q.rotateToZ d)
+  where
+    d = maybe (V3 1 0 0) (addZ 0 . unitVectorAtAngle . subtract (_crDir cr+pi))
+        (damageDirection . _crDamage $ _crState cr)
 
 scalp :: Creature -> Shape
 {-# INLINE scalp #-}
@@ -246,7 +253,7 @@ torso cr
     aShoulder = scaleSH (V3 10 10 1) baseShoulder
 
 deadUpperBody :: Creature -> Shape
-deadUpperBody = overPosSH (Q.rotateToZ (V3 1 0 0)) . translateSHz (negate 10) . upperBody
+deadUpperBody cr = deadRot cr . translateSHz (negate 10) . upperBody $ cr
 
 baseShoulder :: Shape
 {-# INLINE baseShoulder #-}

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