Improve debris slightly

src/Dodge/Block/Debris.hs

@@ -5,14 +5,17 @@ module Dodge.Block.Debris (
     makeBlockDebris,
     makeDebris,
     makeDebrisDirected,
+    makeMachineDebris,
 ) where
 
+import Control.Monad
+import Dodge.Machine.Draw
+import Color
 import Data.Foldable
 import qualified Data.IntMap.Strict as IM
 import qualified Data.IntSet as IS
 import Data.Maybe
 import Dodge.Data.World
-import Dodge.Material.Color
 import Dodge.Material.Sound
 import Dodge.ShiftPoint
 import Dodge.WorldEvent.Sound
@@ -23,8 +26,20 @@ import qualified Quaternion as Q
 import RandomHelp
 import Shape
 
+makeMachineDebris :: Machine -> World -> World
+makeMachineDebris mc w = foldl' (flip $ makeDebrisZ 20 (MetalDebris $ mcColor mc) mt) w ps
+  where
+    pa = (mc ^. mcPos, mc ^. mcDir)
+    dsize = debrisSize mt
+    ps = fmap (shiftPointBy pa) 
+        . gridInPolygon dsize 
+        . shrinkPolyOnEdges dsize 
+        $ reverse (fst <$> mc ^.. mcFootPrint . each)
+    mt = mc ^. mcSkin
+
+
 makeDoorDebris :: Door -> World -> World
-makeDoorDebris dr w = w & makeDebris mt p
+makeDoorDebris dr w = w & makeDebris (BlockDebris drcol) mt p
   where
     p2a = lerpP2A (dr ^. drZeroPos) (dr ^. drOnePos) (dr ^. drLerp)
     p = centroid . fmap fst $ (dr ^. drFootPrint) & each . each %~ shiftPointBy p2a
@@ -32,9 +47,15 @@ makeDoorDebris dr w = w & makeDebris mt p
         wlids <- w ^? cWorld . lWorld . doors . ix (_drID dr) . drFootPrint
         ((wlid, _), _) <- IM.minViewWithKey wlids
         w ^? cWorld . lWorld . walls . ix wlid . wlMaterial
+    drcol = case dr ^. drTrigger of
+        WdBlCrFilterNearPoint {} -> yellow
+        _ -> red
+
+blColor :: Block -> Color
+blColor _ = orange
 
 makeBlockDebris :: Block -> World -> World
-makeBlockDebris bl w = foldl' (flip $ makeDebris mt) w ps
+makeBlockDebris bl w = foldl' (flip $ makeDebris (BlockDebris $ blColor bl) mt) w ps
   where
     dsize = debrisSize mt
     ps = gridInPolygon dsize $ shrinkPolyOnEdges dsize $ reverse (_blFootprint bl)
@@ -45,21 +66,38 @@ makeBlockDebris bl w = foldl' (flip $ makeDebris mt) w ps
         return $ _wlMaterial wl
 
 -- makeDebris :: Material -> Color -> Point2 -> World -> World
-makeDebris :: Material -> Point2 -> World -> World
+makeDebris :: DebrisType -> Material -> Point2 -> World -> World
 makeDebris = makeDebrisDirected (2 * pi) 0
 
-makeDebrisDirected :: Float -> Float -> Material -> Point2 -> World -> World
--- makeDebrisDirected :: Float -> Float -> Material -> Color -> Point2 -> World -> World
--- makeDebrisDirected arcrad dir bm col p w =
-makeDebrisDirected arcrad dir bm p w =
+makeDebrisZ :: Float -> DebrisType -> Material -> Point2 -> World -> World
+makeDebrisZ = makeDebrisDirectedZ (2 * pi) 0
+
+makeDebrisDirectedZ :: Float -> Float -> Float -> DebrisType -> Material -> Point2 -> World -> World
+makeDebrisDirectedZ arcrad dir z dt bm p w =
     w
-        --        & flip (foldl' (flip $ plNew (cWorld . lWorld . props) prID)) thedebris
-        & cWorld
-        . lWorld
-        . debris
-        <>~ thedebris
-        & randGen
-        .~ newg
+        & cWorld . lWorld . debris <>~ thedebris
+        & randGen .~ newg
+        & soundOriginsIDsAt [MaterialSound bm i | i <- [0, 1, 2]] (destroyMatS bm) p
+  where
+    (thedebris, newg) = replicateM 4 f & runState $ _randGen w
+    f = do
+        v <- rotateV (dir - arcrad / 2) <$> randInArcStrip 1 2 arcrad
+        spinspeed <- randomR (-0.2, -0.1) & state
+        --        basedebris <- baseDebris bm
+        return $
+            DebrisChunk
+                { _dbPos = p `v2z` z
+                , _dbType = dt
+                , _dbVel = v `v2z` 0
+                , _dbRot = Q.qID
+                , _dbSpin = Q.axisAngle (vNormal v `v2z` 0) spinspeed
+                }
+
+makeDebrisDirected :: Float -> Float -> DebrisType -> Material -> Point2 -> World -> World
+makeDebrisDirected arcrad dir dt bm p w =
+    w
+        & cWorld . lWorld . debris <>~ thedebris
+        & randGen .~ newg
         & soundOriginsIDsAt [MaterialSound bm i | i <- [0, 1, 2]] (destroyMatS bm) p
   where
     (thedebris, newg) = mapM f [35, 55, 75, 95] & runState $ _randGen w
@@ -70,8 +108,7 @@ makeDebrisDirected arcrad dir bm p w =
         return $
             DebrisChunk
                 { _dbPos = p `v2z` h
-                , --            , _dbType = BlockDebris col
-                  _dbType = BlockDebris (materialColor bm)
+                , _dbType = dt
                 , _dbVel = v `v2z` 0
                 , _dbRot = Q.qID
                 , _dbSpin = Q.axisAngle (vNormal v `v2z` 0) spinspeed