Tweak gibs

src/Dodge/Prop/Gib.hs

@@ -12,14 +12,15 @@ import Dodge.RandomHelp
 
 import System.Random
 import Control.Monad.State
-import qualified Linear.Quaternion as Q
+import qualified Quaternion as Q
+import Data.List (zip4)
 
 aGib :: Prop
 aGib = PropZ
     {_pjPos = 0
     ,_pjStartPos = 0
     ,_pjVel = 0
-    ,_prDraw = drawGib
+    ,_prDraw = drawGib 4
     ,_pjID = 0
     ,_pjUpdate = updateGib
     ,_pjPosZ = 10
@@ -27,15 +28,21 @@ aGib = PropZ
     ,_pjTimer = 20
     ,_pjQuat = Q.axisAngle (V3 1 0 0) 0
     ,_pjQuatSpin = Q.axisAngle (V3 1 1 0) 0.1
+    ,_pjColor = white
     }
-drawGib :: Prop -> SPic
-drawGib pr = noPic
+drawGib :: Float -> Prop -> SPic
+drawGib x pr = noPic
     . translateSHz (_pjPosZ pr)
     . uncurryV translateSHf (_pjPos pr) 
-    . colorSH red
     . overPosSH (Q.rotate (_pjQuat pr))
-    . translateSHz (negate 5)
-    $ upperPrismPoly 10 $ square 5
+    $ flesh <> skin
+  where
+    flesh = colorSH (dark $ dark red)
+        . translateSHz (negate x)
+        $ upperPrismPoly (2*x) $ square x
+    skin = colorSH (light4 $ _pjColor pr)
+        . translateSH (V3 1 1 (1 - x))
+        $ upperPrismPoly (2*x) $ square x
 
 updateGib :: Prop -> World -> World
 updateGib pr w = w & props . ix (_pjID pr) %~ updateGib' w
@@ -65,16 +72,23 @@ updateGib' w pr
         Nothing -> pjPos +~ v
         Just (p,v') -> (pjPos .~ p) . (pjVel .~ v')
 
-addGibsAt :: Point2 -> World -> World
-addGibsAt p w = foldr addg w (zip vels zspeeds)
+addGibsAt :: Color -> Point2 -> World -> World
+addGibsAt col p w = foldr addg w (zip4 vels zspeeds quats hs)
+    & randGen .~ newg
   where
-    speeds = replicateM 4 (state (randomR (1,4))) & evalState $ _randGen w
+    (speeds,newg) = replicateM 4 (state (randomR (1,4))) & runState $ _randGen w
+    hs = replicateM 4 (state (randomR (5,15))) & evalState $ _randGen w
     dirs = unitVectorAtAngle <$> (randsOnCirc 4 & evalState $ _randGen w)
     vels = zipWith (*.*) speeds dirs
-    zspeeds = replicateM 4 (state (randomR (1,8))) & evalState $ _randGen w
-    addg (v,zs) = plNew props pjID (aGib & pjPos .~ p
+    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
         )