Commit mid block refactor

src/Dodge/Block/Debris.hs

@@ -13,27 +13,33 @@ import Color
 import LensHelp
 import RandomHelp
 import qualified Quaternion as Q
---import Data.List (zip4)
 
+import qualified Data.IntSet as IS
+import Data.Maybe
 makeBlockDebris :: Block -> World -> World
-makeBlockDebris bl = makeDebris (_blMaterial bl) (_blPos bl)
+makeBlockDebris bl w = w & makeDebris mt (_blPos bl)
+  where
+    mt = fromMaybe Stone $ do
+        wlids <- w ^? blocks . ix (_blID bl) . blWallIDs
+        (wlid,_) <- IS.minView wlids
+        w ^? walls . ix wlid . wlMaterial
 
-makeDebris :: BlockMaterial -> Point2 -> World -> World
+makeDebris :: Material -> Point2 -> World -> World
 makeDebris = makeDebrisDirected 1 2 (2*pi) 0
 makeDebrisDirected :: Float -> Float 
-    -> Float -> Float -> BlockMaterial -> Point2 -> World -> World
+    -> Float -> Float -> Material -> Point2 -> World -> World
 makeDebrisDirected mindist maxdist arcrad dir bm p w = w
         & flip (foldr (plNew props pjID)) thedebris
         & randGen .~ newg
         & matDesSound bm p
   where
     someDebris = case bm of
-        StoneBlock -> stoneDebris
-        GlassBlock -> glassDebris
-        CrystalBlock -> crystalDebris
-        DirtBlock   -> dirtDebris
-        WoodBlock   -> stoneDebris
-        MetalBlock  -> stoneDebris
+        Stone -> stoneDebris
+        Glass -> glassDebris
+        Crystal -> crystalDebris
+        Dirt   -> dirtDebris
+        Wood   -> stoneDebris
+        Metal  -> stoneDebris
     (thedebris,newg) = runState (mapM f [35,55..95]) $ _randGen w
     f h = do
         v <- rotateV (dir - arcrad/2) <$> randInArcStrip mindist maxdist arcrad
@@ -89,11 +95,11 @@ crystalDebris = glassDebris
 debrisShape :: Float -> Prop -> Shape
 debrisShape size pr = colorSH (_pjColor pr) . translateSHz (-size) $ upperPrismPoly 8 $ square size
 
-matDesSound :: BlockMaterial -> Point2 -> World -> World
+matDesSound :: Material -> Point2 -> World -> World
 matDesSound mat = case mat of
-    GlassBlock -> mkSoundBreakGlass
-    CrystalBlock -> mkSoundBreakGlass -- this should be more crunchy
-    StoneBlock -> mkSoundSplinterBlock
-    DirtBlock  -> originIDsAt (BlockDegradeSound 1) [impact1S,impact3S]
-    WoodBlock  -> originIDsAt (BlockDegradeSound 1) [impact1S,impact2S,impact3S]
-    MetalBlock -> originIDsAt (BlockDegradeSound 1) [impact2S,impact3S]
+    Glass -> mkSoundBreakGlass
+    Crystal -> mkSoundBreakGlass -- this should be more crunchy
+    Stone -> mkSoundSplinterBlock
+    Dirt  -> originIDsAt (BlockDegradeSound 1) [impact1S,impact3S]
+    Wood  -> originIDsAt (BlockDegradeSound 1) [impact1S,impact2S,impact3S]
+    Metal -> originIDsAt (BlockDegradeSound 1) [impact2S,impact3S]