Tweak block sounds

2021-11-18 03:50:54 +00:00
parent 94552ff658
commit 147d6098ab
12 changed files with 114 additions and 89 deletions
@@ -0,0 +1,62 @@
+module Dodge.Block where
+import Dodge.Data
+import Dodge.Data.SoundOrigin
+import Dodge.SoundLogic
+import Dodge.Zone
+import Dodge.WorldEvent.Sound
+import Dodge.Wall.Delete
+import Dodge.Wall.Dust
+import Dodge.RandomHelp
+import Geometry
+import Geometry.ConvexPoly
+
+import Data.Function
+import qualified Data.IntSet as IS
+import qualified Data.IntMap.Strict as IM
+import Control.Lens
+import Control.Monad
+import Control.Monad.State
+
+splinterBlock :: Block -> World -> World
+splinterBlock bl w = foldr unshadowBlock w (_blShadows bl) -- foldr shiftTowardCen w (_blWallIDs bl)
+    & blocks . ix (_blID bl) . blHPs %~ tail
+    & matSplintSound (_blMaterial bl) cen
+  where
+    wls = IM.restrictKeys (_walls w) (_blWallIDs bl)
+    cen = centroid $ fmap (fst . _wlLine) wls
+
+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
+
+matSplintSound :: BlockMaterial -> Point2 -> World -> World
+matSplintSound mat = case mat of
+    GlassBlock -> mkSoundSplinterGlass
+    StoneBlock -> mkSoundSplinterBlock
+    DirtBlock  -> originIDsAt (BlockDegradeSound 1) [impact1S,impact3S]
+    WoodBlock  -> originIDsAt (BlockDegradeSound 1) [impact1S,impact2S,impact3S]
+    MetalBlock -> originIDsAt (BlockDegradeSound 1) [impact2S,impact3S]
+matDesSound :: BlockMaterial -> Point2 -> World -> World
+matDesSound mat = case mat of
+    GlassBlock -> mkSoundBreakGlass
+    StoneBlock -> mkSoundSplinterBlock
+    DirtBlock  -> originIDsAt (BlockDegradeSound 1) [impact1S,impact3S]
+    WoodBlock  -> originIDsAt (BlockDegradeSound 1) [impact1S,impact2S,impact3S]
+    MetalBlock -> originIDsAt (BlockDegradeSound 1) [impact2S,impact3S]
+
+destroyBlock :: Block -> World -> World
+destroyBlock bl w = w
+    & deleteWallIDs wlids
+    & blocks %~ IM.delete (_blID bl)
+    & matDesSound (_blMaterial bl) 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