Working reimplementation of blocks and destruction

src/Dodge/Update.hs

@@ -15,6 +15,7 @@ import Dodge.WallCreatureCollisions
 import Dodge.Update.Camera
 import Dodge.SoundLogic
 import Dodge.Inventory
+import Dodge.WorldEvent.Sound
 import Geometry
 import Geometry.ConvexPoly
 import Geometry.Vector3D
@@ -84,12 +85,14 @@ functionalUpdate w = case _menuLayers w of
 splinterBlock :: Block' -> World -> World
 splinterBlock bl w = foldr unshadowBlock w (_blShadows' bl) -- foldr shiftTowardCen w (_blWallIDs bl)
     & blocks . ix (_blID bl) . blHPs %~ tail
+    & theSoundEffect cen
   where
     wls = map (_walls w IM.!) (_blWallIDs bl)
     ps = map (fst . _wlLine) wls
     cen = centroid ps
-    shiftTowardCen wlid = walls . ix wlid . wlLine %~ bimap f f
+    theSoundEffect 
-    f x = 0.5 *.* (x +.+ cen)
+        | _wlIsSeeThrough (head wls) = mkSoundSplinterGlass
+        | otherwise                  = mkSoundSplinterBlock
 
 unshadowBlock :: Int -> World -> World
 unshadowBlock wlid w = case w ^? walls . ix wlid of
@@ -103,19 +106,25 @@ unshadowBlock wlid w = case w ^? walls . ix wlid of
 updateBlocks :: World -> World
 updateBlocks w = foldr f w $ _blocks w
   where
-    f bl w' = case safeHead $ _blHPs bl of
+    f bl w' = case _blHPs bl of
-        Just x  | x < 1     -> splinterBlock bl w'
+        (x:_:_) | x < 1 -> splinterBlock bl w'
-                | otherwise -> w'
+        (x:[])  | x < 1 -> destroyBlock bl w'
-        Nothing -> w'
+        _ -> w'
-            & walls  %~ removeIDs (_blWallIDs bl)
+
-            & flip (foldr removeFromZone) (_blWallIDs bl)
+destroyBlock :: Block' -> World -> World
-            & blocks %~ IM.delete (_blID bl)
+destroyBlock bl w = w
+    & walls  %~ removeIDs wlids
+    & flip (foldr removeFromZone) wlids
+    & blocks %~ IM.delete (_blID bl)
+    & mkSoundBreakGlass pos
+  where
+    wlids = _blWallIDs bl
+    pos = fst . _wlLine $ _walls w IM.! head wlids
     removeIDs is wls = foldr IM.delete wls is
     removeFromZone wlid w' = over (wallsZone . znObjects . ix x . ix y) (IM.delete (_wlID wl)) w'
       where
         (x,y) = zoneOfPoint $ uncurry pHalf (_wlLine wl)
         wl = _walls w IM.! wlid -- note the use of w not w'
-        setCol = wlColor .~ V4 1 1 0 1
 
 -- | Note the explict use of record syntax. Using lens creates a space leak.
 resetWorldEvents :: World -> World

src/Dodge/WorldEvent/Sound.hs

@@ -21,3 +21,8 @@ mkSoundSplinterGlass :: Point2 -> World -> World
 mkSoundSplinterGlass p w = soundStart (GlassBreakSound 1) p soundid Nothing $ set randGen g w
   where
     (soundid,g) = _randGen w & runState (takeOne [smallGlass1S,smallGlass2S,smallGlass3S,smallGlass4S])
+
+mkSoundSplinterBlock :: Point2 -> World -> World
+mkSoundSplinterBlock p w = soundStart (BlockDegradeSound 1) p soundid Nothing $ set randGen g w
+  where
+    (soundid,g) = _randGen w & runState (takeOne [impact1S,impact2S,impact3S,impact4S])