diff --git a/src/Dodge/Block.hs b/src/Dodge/Block.hs index aab3b607a..60d5fd3d7 100644 --- a/src/Dodge/Block.hs +++ b/src/Dodge/Block.hs @@ -1,5 +1,6 @@ module Dodge.Block where import Dodge.Data +import Dodge.Base.Collide import Dodge.Material --import Dodge.Block.Debris import Dodge.Zone @@ -10,11 +11,14 @@ import RandomHelp import Geometry --import Geometry.ConvexPoly +import Data.Foldable import Data.Function import Data.Maybe import qualified Data.IntSet as IS import qualified Data.IntMap.Strict as IM import Control.Lens +import qualified Streaming.Prelude as S +import qualified Data.Graph.Inductive as FGL splinterBlock :: Block -> World -> World splinterBlock bl w = foldr unshadowBlock w (_blShadows bl) -- foldr shiftTowardCen w (_blWallIDs bl) @@ -45,6 +49,7 @@ destroyBlock bl w = w & flip (foldr unshadowBlock) (_blShadows bl) & _blDeath bl bl & deleteWallIDs wlids + & maybeClearPaths (_blPaths bl) -- must happen after the walls are deleted & blocks %~ IM.delete (_blID bl) -- & matDesSound (_blMaterial bl) pos & flip (foldr (wlDustAt awl)) (map (pos +.+) ps) @@ -54,6 +59,16 @@ destroyBlock bl w = w pos = fst . _wlLine $ _walls w IM.! IS.findMin wlids ps = replicateM 25 (randInCirc 20) & evalState $ _randGen w +-- this does not handle eg doors blocking the path as well +maybeClearPaths :: [(Int,Int,PathEdge)] -> World -> World +maybeClearPaths ps w = foldl' maybeClearPath w ps + +maybeClearPath :: World -> (Int,Int,PathEdge) -> World +maybeClearPath w (x,y,pe) + | runIdentity . S.any_ (const True) $ overlapSegWalls (_peStart pe) (_peEnd pe) $ wlsNearSeg (_peStart pe) (_peEnd pe) w + = w + | otherwise = w & pathGraph %~ (FGL.insEdge (x,y,pe & peObstacles .~ mempty)) . FGL.delEdge (x,y) + destroyDoor :: Door -> World -> World destroyDoor dr w = w & _drDeath dr dr