Improve xIntercepts (still not perfect)

src/Dodge/Room/Path.hs

@@ -4,6 +4,7 @@ module Dodge.Room.Path (
     makeGrid,
     createPathGrid,
     gridPoints'',
+    linksGridToPath',
 ) where
 
 import Control.Lens
@@ -33,11 +34,18 @@ createPathGrid rm = rm & rmPath .~ linksGridToPath (_rmLinks rm) filterGrid
             <*> L.premap sndV2 L.minimum
             <*> L.premap sndV2 L.maximum
 
+-- assumes subpth is symmetric
 linksGridToPath :: [RoomLink] -> [(Point2, Point2)] -> S.Set (Point2, Point2)
 linksGridToPath lnks subpth = S.fromList subpth <> foldMap (linkClosest . (^. rlPos)) lnks
   where
     linkClosest p = doublePairSet (p, minimumBy (compare `on` dist p) $ map fst subpth)
 
+linksGridToPath' :: Foldable f => [RoomLink] -> f (Point2, Point2) -> S.Set (Point2, Point2)
+linksGridToPath' lnks subpth' = subpth <> foldMap (linkClosest . (^. rlPos)) lnks
+  where
+    subpth = foldMap doublePairSet subpth'
+    linkClosest p = doublePairSet (p, minimumBy (compare `on` dist p) $ S.map fst subpth)
+
 testCrossWalls :: [(Point2, Point2)] -> (Point2, Point2) -> Bool
 testCrossWalls wls (a, b) = not $ any (isJust . uncurry (intersectSegSeg a b)) wls