Make obstacles block pathing

src/Dodge/Path.hs

@@ -3,7 +3,6 @@ module Dodge.Path
     ( pointTowardsImpulse
     , makePathBetween
     , makePathBetweenPs
-    , removePathsCrossing
     , pairsToGraph
     , pairsToGraph''
     , walkableNodeNear
@@ -38,7 +37,9 @@ makePathBetween :: Point2 -> Point2 -> World -> Maybe [Int]
 makePathBetween a b w = do -- join $ sp <$> a' <*> b' <*> return (_pathGraph w)
     (na,_) <- walkableNodeNear a w
     (nb,_) <- walkableNodeNear b w
-    sp na nb (second pathDist $ _pgGraph $ _pathGraph w)
+    sp na nb (second pathDist $ efilter noobstacle $ _pgGraph $ _pathGraph w)
+  where
+    noobstacle (_,_,PathEdge _ _ s) = null s
 
 pathDist :: PathEdge -> Float
 pathDist pe = dist (_peStart pe) (_peEnd pe)
@@ -170,33 +171,6 @@ addObstacleCrossing' :: EdgeObstacle -> Point2 -> Point2
     -> World
     -> World
 addObstacleCrossing' eo a b w = w & pathGraph . pgGraph %~ addObstacleCrossing w eo a b
-  where
-    paths = S.filter f $ nearSeg _peZoning a b w
-    f (_,_,PathEdge x y _) = isJust $ intersectSegSeg x y a b
-
-removePathsCrossing :: Point2 -> Point2 -> World -> World
-removePathsCrossing a b w = w
---    & pathGraph . pgGraph %~ deleteEdges
---    & pathGraphP %~ deletePairs
---    & pathGraph  .~ newGraph 
---    & pathGraphP .~ pg'
---    & phZoning   %~ \zn -> foldl' (flip $ updateZoning (:)) (zn & znObjects .~ mempty)
---        (labNodes newGraph)
-  where
-    thegr = _pgGraph (_pathGraph w)
-    ns = nearSeg _pnZoning a b w
-    pairs = S.filter testEdge $ S.for ns (nodePairs thegr)
-    testEdge ((_,p),(_,q)) = isJust $ intersectSegSeg a b p q
-    deleteEdges gr = runIdentity $ S.fold_ deleteEdge gr id pairs
-    deleteEdge gr ((x,_),(y,_)) = delEdge (x,y) $ delEdge (y,x) gr
---    deletePairs s = runIdentity $ S.fold_ deletePair s id pairs
---    deletePair s (x,y) = Set.delete (x,y) $ Set.delete (y,x) s
-
-nodePairs :: Gr a b -> (Int,a) -> StreamOf ((Int,a),(Int,a))
-nodePairs gr (n,p) = S.mapMaybe (fmap ((n,p),) . nodeLabel gr) . S.each $ neighbors gr n
-
-nodeLabel :: Gr a b -> Int -> Maybe (Int, a)
-nodeLabel gr n = (n,) <$> lab gr n
 
 --    pg' = Set.filter (isNothing . uncurry (intersectSegSeg a b)) $ _pathGraphP w
 --   -- insertPoint pp@(_,p) = insertInZoneWith (wlZoneOfPoint p) (++) [pp]