diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index 6d27679de..5157544bb 100644 --- a/src/Dodge/Update.hs +++ b/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 - f x = 0.5 *.* (x +.+ cen) + theSoundEffect + | _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 - Just x | x < 1 -> splinterBlock bl w' - | otherwise -> w' - Nothing -> w' - & walls %~ removeIDs (_blWallIDs bl) - & flip (foldr removeFromZone) (_blWallIDs bl) - & blocks %~ IM.delete (_blID bl) + f bl w' = case _blHPs bl of + (x:_:_) | x < 1 -> splinterBlock bl w' + (x:[]) | x < 1 -> destroyBlock bl w' + _ -> w' + +destroyBlock :: Block' -> World -> World +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 diff --git a/src/Dodge/WorldEvent/Sound.hs b/src/Dodge/WorldEvent/Sound.hs index d487f881a..245aeca88 100644 --- a/src/Dodge/WorldEvent/Sound.hs +++ b/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])