Continue to tweak death effects

src/Dodge/Prop/Gib.hs

@@ -2,6 +2,7 @@ module Dodge.Prop.Gib where
 import Dodge.Zone
 import Dodge.Base
 import Dodge.Data
+import Dodge.Damage
 import ShapePicture
 import Shape
 import Geometry
@@ -20,7 +21,7 @@ aGib = PropZ
     {_pjPos = 0
     ,_pjStartPos = 0
     ,_pjVel = 0
-    ,_prDraw = drawGib 4
+    ,_prDraw = drawGib 3
     ,_pjID = 0
     ,_pjUpdate = updateGib
     ,_pjPosZ = 10
@@ -73,10 +74,14 @@ updateGib' w pr
         Just (p,v') -> (pjPos .~ p) . (pjVel .~ v')
 
 addCrGibs :: Creature -> World -> World
-addCrGibs cr w = w
-    & addGibAt 25 (_skinHead skin) cpos
-    & addGibsAt 3 7 (_skinLower skin) cpos
-    & addGibsAt 13 20 (_skinUpper skin) cpos
+addCrGibs cr w = case damageDirection $ _crDamage $ _crState cr of
+    Nothing -> w
+        & addGibAt 25 (_skinHead skin) cpos
+        & addGibsAt 3 7 (_skinLower skin) cpos
+        & addGibsAt 13 20 (_skinUpper skin) cpos
+    Just d -> w
+        & addGibsAtDir d 3 7 (_skinLower skin) cpos
+        & addGibsAtDir d 13 20 (_skinUpper skin) cpos
   where
     skin = _crSkin cr
     cpos = _crPos cr
@@ -100,6 +105,27 @@ addGibsAt minh maxh col p w = foldr addg w (zip4 vels zspeeds quats hs)
         & pjVelZ .~ zs
         & pjPosZ .~ h
         )
+
+-- this is ugly because it is mostly copy-paste from addGibsAt
+addGibsAtDir :: Float -> Float -> Float -> Color -> Point2 -> World -> World
+addGibsAtDir dir minh maxh col p w = foldr addg w (zip4 vels zspeeds quats hs)
+    & randGen .~ newg
+  where
+    (speeds,newg) = replicateM 4 (state (randomR (1,4))) & runState $ _randGen w
+    hs = replicateM 4 (state (randomR (minh,maxh))) & evalState $ _randGen w
+    dirs = unitVectorAtAngle <$> (randsSpread (dir-pi/4,dir+pi/4) 4 & evalState $ _randGen w)
+    vels = zipWith (*.*) speeds dirs
+    zspeeds = replicateM 4 (state (randomR (-8,8))) & evalState $ _randGen w
+    quats :: [Q.Quaternion Float]
+    quats = replicateM 4 (Q.vToQuat (V3 0 0 1) <$> randOnUnitSphere) & evalState $ _randGen w
+    addg (v,zs,q,h) = plNew props pjID (aGib & pjPos .~ p +.+ (5 *.* normalizeV v)
+        & pjColor .~ col
+        & pjVel .~ v
+        & pjQuatSpin .~ Q.axisAngle (vNormal v `v2z` 0) (-0.1)
+        & pjQuat .~ q
+        & pjVelZ .~ zs
+        & pjPosZ .~ h
+        )
   
 addGibAt :: Float -> Color -> Point2 -> World -> World
 addGibAt h col p w = w