Block destruction can update pathing

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