Add skin colors

src/Dodge/Prop/Gib.hs

@@ -40,7 +40,7 @@ drawGib x pr = noPic
     flesh = colorSH (dark $ dark red)
         . translateSHz (negate x)
         $ upperPrismPoly (2*x) $ square x
-    skin = colorSH (light4 $ _pjColor pr)
+    skin = colorSH (_pjColor pr)
         . translateSH (V3 1 1 (1 - x))
         $ upperPrismPoly (2*x) $ square x
 
@@ -72,12 +72,21 @@ updateGib' w pr
         Nothing -> pjPos +~ v
         Just (p,v') -> (pjPos .~ p) . (pjVel .~ v')
 
-addGibsAt :: Color -> Point2 -> World -> World
-addGibsAt col p w = foldr addg w (zip4 vels zspeeds quats hs)
+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
+  where
+    skin = _crSkin cr
+    cpos = _crPos cr
+
+addGibsAt :: Float -> Float -> Color -> Point2 -> World -> World
+addGibsAt 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 (5,15))) & evalState $ _randGen w
+    hs = replicateM 4 (state (randomR (minh,maxh))) & evalState $ _randGen w
     dirs = unitVectorAtAngle <$> (randsOnCirc 4 & evalState $ _randGen w)
     vels = zipWith (*.*) speeds dirs
     zspeeds = replicateM 4 (state (randomR (-8,8))) & evalState $ _randGen w
@@ -92,3 +101,23 @@ addGibsAt col p w = foldr addg w (zip4 vels zspeeds quats hs)
         & pjPosZ .~ h
         )
   
+addGibAt :: Float -> Color -> Point2 -> World -> World
+addGibAt h col p w = w
+    & plNew props pjID gib
+    & randGen .~ newg
+  where
+    (gib,newg) = runState f $ _randGen w
+    f = do
+        s   <- state $ randomR (1,4)
+        dir <- unitVectorAtAngle <$> state (randomR (0,2*pi))
+        zs  <- state $ randomR (-8,8)
+        q <- Q.vToQuat (V3 0 0 1) <$> randOnUnitSphere
+        let v = s *.* dir
+        return $ aGib
+            & pjPos .~ p
+            & pjColor .~ col
+            & pjVel .~ v
+            & pjQuatSpin .~ Q.axisAngle (vNormal v `v2z` 0) (-0.1)
+            & pjQuat .~ q
+            & pjVelZ .~ zs
+            & pjPosZ .~ h