Tweak gibs

src/Dodge/Prop/Gib.hs

@@ -7,8 +7,11 @@ import Shape
 import Geometry
 import Color
 import LensHelp
-import Dodge.Base.NewID
+import Dodge.RandomHelp
+--import Dodge.Base.NewID
 
+import System.Random
+import Control.Monad.State
 import qualified Linear.Quaternion as Q
 
 aGib :: Prop
@@ -52,25 +55,26 @@ updateGib' w pr
         & pjVelZ -~ 1
         & pjPosZ +~ velz
         & updateWithVel vel
-        & pjQuat *~ (_pjQuatSpin pr)
+        & pjQuat *~ _pjQuatSpin pr
   where
     newposz = _pjPosZ pr + velz
     velz = _pjVelZ pr
     vel  = _pjVel pr
     pos  = _pjPos pr
-    --updateWithVel v = case reflectPointWalls pos (pos + v) $ wallsAlongLine pos (pos +v) w of
-    updateWithVel v = case collidePointAnyWallsReflect pos (pos + v) $ wallsAlongLine pos (pos +v) w of
+    updateWithVel v = case reflectPointWallsDamp 0.5 pos (pos + v) $ wallsAlongLine pos (pos +v) w of
         Nothing -> pjPos +~ v
         Just (p,v') -> (pjPos .~ p) . (pjVel .~ v')
 
 addGibsAt :: Point2 -> World -> World
-addGibsAt p w = w & addg (V2 2 2)
-    & addg (V2 (-2) 2)
-    & addg (V2 (-2) (-2))
-    & addg (V2 (2) (-2))
+addGibsAt p w = foldr addg w (zip vels zspeeds)
   where
-    addg v = plNew props pjID (aGib & pjPos .~ p
+    speeds = replicateM 4 (state (randomR (1,4))) & 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
         & pjVel .~ v
         & pjQuatSpin .~ Q.axisAngle (vNormal v `v2z` 0) (-0.1)
+        & pjVelZ .~ zs
         )