59 lines
2.1 KiB
Haskell
59 lines
2.1 KiB
Haskell
module Dodge.Block where
|
|
import Dodge.Data
|
|
import Dodge.SoundLogic
|
|
import Dodge.Zone
|
|
import Dodge.WorldEvent.Sound
|
|
import Dodge.Wall.Delete
|
|
import Dodge.Wall.Dust
|
|
import 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
|
|
|
|
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
|
|
cen = centroid $ fst . _wlLine <$> IM.restrictKeys (_walls w) (_blWallIDs bl)
|
|
|
|
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
|