Tweak corpses

src/Dodge/Creature/Picture.hs

@@ -39,7 +39,7 @@ basicCrShape cr
     | otherwise =
         scaleSH (V3 crsize crsize crsize) $
             mconcat
-                [ colorSH (_skinHead cskin) $ scalp cr
+                [ colorSH (_skinHead cskin) . overPosSH (translateToES cr OnHead) $ scalp
                 , colorSH (_skinUpper cskin) $ upperBody cr
                 , rotmdir $ colorSH (_skinLower cskin) $ feet cr
                 ]
@@ -79,7 +79,9 @@ arms cr =
     aHand = noPic $ translateSHz (-4) . upperPrismPolyHalfST 4 $ polyCirc 3 4
 
 deadScalp :: Creature -> Shape
-deadScalp cr = deadRot cr . translateSHz 10 . scalp $ cr
+--deadScalp cr = deadRot cr . translateSHz 5 . scalp $ cr
+--deadScalp cr = deadRot cr . translateSHz (-5) . scalp $ cr
+deadScalp _ = translateSH (V3 (-13) 0 0) scalp
 
 deadRot :: Creature -> Shape -> Shape
 deadRot cr = overPosSH (Q.rotateToZ d)
@@ -90,14 +92,9 @@ deadRot cr = overPosSH (Q.rotateToZ d)
             (addZ 0 . unitVectorAtAngle . subtract (_crDir cr + pi))
             (damageDirection $ _crDamage cr)
 
-scalp :: Creature -> Shape
+scalp :: Shape
 {-# INLINE scalp #-}
-scalp cr = overPosSH (translateToES cr OnHead) fhead
+scalp = (colorSH (greyN 0.9) . upperPrismPolyHalfST 5 $ polyCirc 3 5)
---    | twists cr = translateSHxy 0 5 . rotateSH (-1) $ translateSHxy (negate 2.5) 0.25 fhead
---    | oneH cr = rotateSH 0.5 $ translateSHxy 2.5 0 fhead
---    | otherwise = translateSHxy 2.5 0 fhead
-  where
-    fhead = (colorSH (greyN 0.9) . upperPrismPolyHalfST 5 $ polyCirc 3 5)
         & each . sfShadowImportance .~ Unimportant
 
 torso :: Creature -> Shape

src/Dodge/Creature/Update.hs

@@ -73,7 +73,7 @@ crUpdate cid =
     checkDeath cid
         . doDamage cid
         . invItemEffs cid
-        . updateWalkCycle cid
+        . updateWalkCycle cid  -- stride appears to be updated elsewhere as well
 
 checkDeath :: Int -> World -> World
 checkDeath cid w = maybe id checkDeath' (w ^? cWorld . lWorld . creatures . ix cid) w
@@ -140,7 +140,6 @@ chasmTestLiving cr w
         w
             & tocr . crZVel -~ 0.5
             & tocr . crPos . _z +~ _crZVel cr
-    --    | Just (x, y) <- List.find g (foldMap loopPairs $ w ^. cWorld . chasms') = w
     | Just (x, y) <- List.find g (w ^. cWorld . cliffs) =
         w
             & soundContinue (CrChasm (_crID cr)) (cr ^. crPos . _xy) debrisS (Just 100)
@@ -159,7 +158,6 @@ chasmTestCorpse cr w
         w
             & tocr . crZVel -~ 0.5
             & tocr . crPos . _z +~ _crZVel cr
-    --    | Just (x, y) <- List.find g (foldMap loopPairs $ w ^. cWorld . chasms') = w
     | Just (x, y) <- List.find g (w ^. cWorld . cliffs) =
         w
             & soundContinue (CrChasm (_crID cr)) (cr ^. crPos . _xy) debrisS (Just 100)
@@ -177,7 +175,7 @@ chasmRotate cr v w
     | t = rotateTo8 (argV v) w
     | otherwise = w
   where
-    t = cr ^. crID == 0 && isNothing (w ^? input . mouseButtons . ix SDL.ButtonRight)
+    t = cr ^. crID == 0 && null (w ^? input . mouseButtons . ix SDL.ButtonRight)
 
 updatePulse :: Pulse -> Pulse
 updatePulse p

src/Dodge/Creature/Vocalization.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE LambdaCase #-}
+
 module Dodge.Creature.Vocalization (
     crWarningSounds,
     crDeathSounds,
@@ -56,14 +57,7 @@ defaultDeathSounds = \case
     CookDeath -> mempty
     PoisonDeath -> mempty
     PlainDeath -> mempty
-    GibsDeath -> 
+    GibsDeath -> [gut1S, gut2S, gut3S, gut4S, gut5S, gut6S]
-        [gut1S
-        ,gut2S
-        ,gut3S
-        ,gut4S
-        ,gut5S
-        ,gut6S
-        ]
 
 vocalizationTest :: Creature -> Maybe SoundID
 vocalizationTest cr = case cr ^? crVocalization . vcCoolDown of

src/Dodge/WorldEvent/ThingsHit.hs

@@ -185,6 +185,3 @@ isWalkable :: Point2 -> Point2 -> World -> Bool
 isWalkable p1 p2 w = isFlyable p1 p2 w && not (any f (w ^. cWorld . cliffs))
   where
     f = isJust . uncurry (intersectSegSeg p1 p2)
---isWalkable p1 p2 w = isFlyable p1 p2 w && not (getAny $ foldMap f (w ^. cWorld . chasms))
---  where
---    f = foldMap (Any . isJust . uncurry (intersectSegSeg p1 p2)) . loopPairs