Improve gibs

src/Dodge/Creature/Update.hs

@@ -133,7 +133,7 @@ corpseOrGib cr = case cr ^? crDamage . to maxDamageType . _Just . _1 of
             . dodeathsound PoisonDeath
     Just PhysicalDamage
         | _crPain cr > 200 ->
-            addCrGibs cr
+            makeCrGibs cr
                 . sethp CrIsGibs
                 . dodeathsound GibsDeath
     _ ->

src/Dodge/Prop/Gib.hs

@@ -1,5 +1,7 @@
-module Dodge.Prop.Gib (addCrGibs) where
+{-# LANGUAGE LambdaCase #-}
+module Dodge.Prop.Gib (makeCrGibs) where
 
+import Dodge.Creature.Material
 import Linear
 import Color
 import Control.Monad
@@ -14,32 +16,33 @@ import LensHelp
 import qualified Quaternion as Q
 import RandomHelp
 
-addCrGibs :: Creature -> World -> World
-addCrGibs cr = case damageDirection $ _crDamage cr of
+makeCrGibs :: Creature -> World -> World
+makeCrGibs cr = case damageDirection $ _crDamage cr of
     Nothing ->
-        addGibAt (_skinHead skin) (cpos & _z +~ 25)
-            . addGibsAtDir pi 0 3 7 (_skinLower skin) cpos
-            . addGibsAtDir pi 0 13 20 (_skinUpper skin) cpos
-            . makeDustAt Flesh 50 cpos
-            . makeDustAt Flesh 50 cpos
-            . makeDustAt Flesh 50 cpos
-            . makeDustAt Flesh 50 cpos
+        addGibAt mat (_skinHead skin) (cpos & _z +~ 25)
+            . addGibsAtDir mat pi 0 3 7 (_skinLower skin) cpos
+            . addGibsAtDir mat pi 0 13 20 (_skinUpper skin) cpos
+            . makeDustAt mat 50 cpos
+            . makeDustAt mat 50 cpos
+            . makeDustAt mat 50 cpos
+            . makeDustAt mat 50 cpos
     Just d ->
-        addGibsAtDir (pi / 4) d 3 7 (_skinLower skin) cpos
-            . addGibsAtDir (pi / 4) d 13 20 (_skinUpper skin) cpos
-            . addGibAtDir d (_skinHead skin) (cpos & _z +~ 25)
-            . makeDustAt Flesh 50 cpos
-            . makeDustAt Flesh 50 cpos
-            . makeDustAt Flesh 50 cpos
-            . makeDustAt Flesh 50 cpos
+        addGibsAtDir mat (pi / 4) d 3 7 (_skinLower skin) cpos
+            . addGibsAtDir mat (pi / 4) d 13 20 (_skinUpper skin) cpos
+            . addGibAtDir mat d (_skinHead skin) (cpos & _z +~ 25)
+            . makeDustAt mat 50 cpos
+            . makeDustAt mat 50 cpos
+            . makeDustAt mat 50 cpos
+            . makeDustAt mat 50 cpos
   where
+    mat = crMaterial $ cr ^. crType
     skin = crShape $ _crType cr -- this should be cleaned up
     cpos = _crPos cr
 
 -- this is ugly because it is mostly copy-paste from addGibsAt
-addGibsAtDir :: Float -> Float -> Float -> Float -> Color -> Point3 -> World -> World
-addGibsAtDir spread dir minh maxh col p w =
-    foldl' (flip $ addGib4 p col) w (zip4 vels zspeeds quats hs)
+addGibsAtDir :: Material -> Float -> Float -> Float -> Float -> Color -> Point3 -> World -> World
+addGibsAtDir m spread dir minh maxh col p w =
+    foldl' (flip $ addGib4 m p col) w (zip4 vels zspeeds quats hs)
         & randGen .~ newg
   where
     (speeds, newg) = replicateM 4 (state (randomR (1, 4))) & runState $ _randGen w
@@ -49,26 +52,27 @@ addGibsAtDir spread dir minh maxh col p w =
     zspeeds = replicateM 4 (state (randomR (-8, 8))) & evalState $ _randGen w
     quats = replicateM 4 (Q.vToQuat (V3 0 0 1) <$> randOnUnitSphere) & evalState $ _randGen w
 
-addGib4 :: Point3 -> Color -> (Point2, Float, QFloat, Float) -> World -> World
-addGib4 p col (v, zs, q, h) =
+-- this should be unified with addGibAtDir
+addGib4 :: Material -> Point3 -> Color -> (Point2, Float, QFloat, Float) -> World -> World
+addGib4 m p col (v, zs, q, h) =
     cWorld . lWorld . debris
         .:~ DebrisChunk
             { _dbPos = p & _z +~ h
-            , _dbType = Gib 3 col
+            , _dbType = materialGib m col
             , _dbVel = v `v2z` zs
             , _dbRot = q
             , _dbSpin = Q.axisAngle (vNormal v `v2z` 0) (-0.1)
             }
 
-addGibAt :: Color -> Point3 -> World -> World
+addGibAt :: Material -> Color -> Point3 -> World -> World
 --addGibAt h col p w = addGibAtDir d h col p (w & randGen .~ newg)
-addGibAt col p w = addGibAtDir d col p (w & randGen .~ newg)
+addGibAt m col p w = addGibAtDir m d col p (w & randGen .~ newg)
   where
     (d, newg) = randomR (0, 2 * pi) $ _randGen w
 
-addGibAtDir :: Float -> Color -> Point3 -> World -> World
+addGibAtDir :: Material -> Float -> Color -> Point3 -> World -> World
 --addGibAtDir dir h col p w =
-addGibAtDir dir col p w =
+addGibAtDir m dir col p w =
     w
         & cWorld . lWorld . debris .:~ gib
         & randGen .~ newg
@@ -82,8 +86,14 @@ addGibAtDir dir col p w =
         return $
             DebrisChunk
                 { _dbPos = p
-                , _dbType = Gib 3 col
+                , _dbType = materialGib m col
                 , _dbVel = v `v2z` zs
                 , _dbRot = q
                 , _dbSpin = Q.axisAngle (vNormal v `v2z` 0) (-0.1)
                 }
+
+materialGib :: Material -> Color -> DebrisType
+materialGib = \case
+    Flesh -> Gib 3
+    Metal -> MetalDebris
+    _ -> BlockDebris