Continue to work on pathfinding

src/Dodge/Block.hs

@@ -4,13 +4,14 @@ module Dodge.Block (
     destroyDoor,
 ) where
 
+import Dodge.Zoning.Wall
+import Dodge.Base.Collide
+import Control.Monad
+import Dodge.Path
 import Control.Lens
 import Data.Foldable
-import qualified Data.Graph.Inductive as FGL
 import qualified Data.IntSet as IS
 import Data.Maybe
-import Data.Set (Set)
-import Dodge.Base.Collide
 import Dodge.Block.Debris
 import Dodge.Data.MountedObject
 import Dodge.Data.World
@@ -20,7 +21,6 @@ import Dodge.Material.Sound
 import Dodge.Wall.Delete
 import Dodge.Wall.Zone
 import Dodge.WorldEvent.Sound
-import Dodge.Zoning.Wall
 import qualified IntMapHelp as IM
 
 splinterBlock :: Block -> World -> World
@@ -66,16 +66,22 @@ destroyBlock bl w =
 --    ps = replicateM 25 (randInCirc 20) & evalState $ _randGen w
 
 -- this does not handle eg doors blocking the path as well
-maybeClearPaths :: Set PathEdgeNodes -> World -> World
+maybeClearPaths :: [(Int,Int)] -> World -> World
 maybeClearPaths ps w = foldl' maybeClearPath w ps
 
-maybeClearPath :: World -> PathEdgeNodes -> World
-maybeClearPath w (PathEdgeNodes x y pe)
-    | not . null $ overlapSegWalls (_peStart pe) (_peEnd pe) $ wlsNearSeg (_peStart pe) (_peEnd pe) w =
-        w
-    | otherwise =
-        w
-            & cWorld . pathGraph %~ FGL.insEdge (x, y, pe & peObstacles .~ mempty) . FGL.delEdge (x, y)
+maybeClearPath :: World -> (Int,Int) -> World
+maybeClearPath w (i,j) = fromMaybe w $ do
+    x <- getNodePos i w
+    y <- getNodePos j w
+    guard $ null $ overlapSegWalls x y $ wlsNearSeg x y w
+    return $ w & cWorld . incGraph %~ updateEdge f (i,j) 
+  where
+    f = at BlockObstacle .~ Nothing
+----    | not . null $ overlapSegWalls (_peStart pe) (_peEnd pe) $ wlsNearSeg (_peStart pe) (_peEnd pe) w =
+----        w
+----    | otherwise =
+----        w
+----            & cWorld . pathGraph %~ FGL.insEdge (x, y, pe & peObstacles .~ mempty) . FGL.delEdge (x, y)
 
 destroyDoor :: Door -> World -> World
 destroyDoor dr w =