Fix pathing for zChasm

src/Dodge/Room/Path.hs

@@ -1,6 +1,8 @@
 {-# LANGUAGE TupleSections #-}
-module Dodge.Room.Path (linksDAGToPath) where
+module Dodge.Room.Path (linksDAGToPath,addNodesCrossing) where
 
+import Linear
+import Data.Maybe
 import Control.Lens
 import Data.Function (on)
 import Data.List
@@ -16,3 +18,14 @@ linksDAGToPath lnks xs
     ys = lnks <&> _rlPos
     subpth = foldMap doublePairSet xs
     linkClosest p = doublePairSet (p, minimumBy (compare `on` dist p) $ S.map fst subpth)
+
+addNodesCrossing :: (Point2,Point2) -> S.Set (Point2,Point2) -> S.Set (Point2,Point2) 
+addNodesCrossing (x,y) = g . foldMap f
+  where
+    g (xs,m) = h xs <> m
+    f (a,b) = fromMaybe (mempty,S.singleton (a,b)) $ do
+        i <- intersectSegSeg x y a b
+        return (S.singleton i, S.fromList [(a,i),(i,b)])
+    h is | null is = mempty
+         | otherwise = let js = sortOn (distance x) $ S.toList is
+                in S.fromList . zip js $ tail js