Tweak block sounds

src/Dodge/Update.hs

@@ -2,10 +2,9 @@
 Module      : Dodge.Update
 Description : Simulation update
 -}
-module Dodge.Update 
-    ( update
-    ) where
+module Dodge.Update (update) where
 import Dodge.Data
+import Dodge.Block
 import Dodge.Data.SoundOrigin
 import Dodge.SoundLogic
 import Dodge.Menu
@@ -14,15 +13,9 @@ import Dodge.Base
 import Dodge.Zone
 import Dodge.WallCreatureCollisions
 import Dodge.Update.Camera
-import Dodge.SoundLogic
 import Dodge.Inventory
-import Dodge.WorldEvent.Sound
-import Dodge.Wall.Delete
-import Dodge.Wall.Dust
-import Dodge.RandomHelp
 import Sound.Data
 import Geometry
-import Geometry.ConvexPoly
 import Geometry.Vector3D
 
 import SDL (MouseButton (..))
@@ -30,12 +23,9 @@ import Data.List
 import Data.Maybe
 import Data.Function
 import qualified Data.Set as S
-import qualified Data.IntSet as IS
 import qualified Data.IntMap.Strict as IM
 import qualified Data.Map.Strict as M
 import Control.Lens
-import Control.Monad
-import Control.Monad.State
 import Data.Monoid
 import System.Random
 
@@ -93,42 +83,18 @@ functionalUpdate w = case _menuLayers w of
         (x,y) = cloudZoneOfPoint $ stripZ $ _clPos cl
 
 updateCreatureSoundPositions :: World -> World
-updateCreatureSoundPositions w = M.foldrWithKey insertSound w soundsToUpdate
+updateCreatureSoundPositions w = M.foldrWithKey insertSound w 
+    . M.mapMaybeWithKey updateSound 
+    $ _playingSounds w
   where
-    insertSound k s w' = w & toPlaySounds %~ M.insertWith (\_ -> id) k (updateSound k s)
+    insertSound k s = toPlaySounds %~ M.insertWith (const id) k s
     updateSound (CrMouth cid) s = case w ^? creatures . ix cid . crPos of
-        Just p  -> s {_soundPos = p, _soundAngDist = Just (soundAngle p w,0)}
-        Nothing -> s {_soundTime = Just 0}
-    soundsToUpdate = M.filterWithKey (\k _ -> isCrMouth k) $  _playingSounds w
-
-isCrMouth :: SoundOrigin -> Bool
-isCrMouth CrMouth{} = True
-isCrMouth _ = False
+        Just p  -> Just s {_soundPos = p, _soundAngDist = Just (soundAngle p w,0)}
+        Nothing -> Just s {_soundTime = Just 0}
+    updateSound _ _ = Nothing
 
 updateModifications :: World -> World
-updateModifications w = foldr f w (_modifications w)
-  where
-    f md = _mdUpdate md md
-
-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 = IM.restrictKeys (_walls w) (_blWallIDs bl)
-    cen = centroid $ fmap (fst . _wlLine) wls
-    theSoundEffect 
-        | _wlOpacity (snd $ IM.findMin wls) == SeeThrough = mkSoundSplinterGlass
-        | otherwise                           = mkSoundSplinterBlock
-
-unshadowBlock :: Int -> World -> World
-unshadowBlock wlid w = case w ^? walls . ix wlid of
-    Just wl -> w
-        & walls . ix wlid . wlDraw .~ True
-        & wallsZone . znObjects . ix x . ix y . ix wlid . wlDraw .~ True
-      where
-        (x,y) = zoneOfPoint $ uncurry pHalf (_wlLine wl)
-    Nothing -> w
+updateModifications w = foldr (dbArg _mdUpdate) w (_modifications w)
 
 updateBlocks :: World -> World
 updateBlocks w = foldr f w $ _blocks w
@@ -138,17 +104,6 @@ updateBlocks w = foldr f w $ _blocks w
         [x]     | x < 1 -> destroyBlock bl w'
         _ -> w'
 
-destroyBlock :: Block -> World -> World
-destroyBlock bl w = w
-    & deleteWallIDs wlids
-    & blocks %~ IM.delete (_blID bl)
-    & mkSoundBreakGlass pos
-    & flip (foldr (wlDustAt awl)) (map (pos +.+) ps)
-  where
-    wlids = _blWallIDs bl
-    awl = _walls w IM.! IS.findMin wlids
-    pos = fst . _wlLine $ _walls w IM.! IS.findMin wlids
-    ps = replicateM 25 (randInCirc 20) & evalState $ _randGen w
 -- | Note the explict use of record syntax. Using lens created a space leak.
 resetWorldEvents :: World -> World
 resetWorldEvents w = w {_worldEvents = id}