Improve segment intersection test, tweak room bounding

src/Geometry/Intersect.hs

@@ -139,22 +139,18 @@ intersectSegSegFullTest x y z w =
 
 {- | It is not always necessary to find a point of intersection, sometimes a
  test may suffice.
+This should intersect on endpoints.
 -}
-intersectSegSegTest ::
-    Point2 ->
-    Point2 ->
-    Point2 ->
-    Point2 ->
-    Bool
+intersectSegSegTest :: Point2 -> Point2 -> Point2 -> Point2 -> Bool
 {-# INLINE intersectSegSegTest #-}
 intersectSegSegTest x y z w =
     f x y z w && f z w x y && x /= y && z /= w
   where
-    f a b c d =
+    f a b c d = compareLHS a b c /= compareLHS a b d
 --        (not (isRHS a b c) && not (isLHS a b d))
 --            || (not (isLHS a b c) && not (isRHS a b d))
-        (isRHS a b c && isLHS a b d)
-            || (isLHS a b c && isRHS a b d)
+--        (isRHS a b c && isLHS a b d)
+--            || (isLHS a b c && isRHS a b d)
 
 intersectSegSegPreTest ::
     Point2 ->

src/Geometry/LHS.hs

@@ -1,6 +1,7 @@
 module Geometry.LHS (
     isLHS,
     isRHS,
+    compareLHS,
 ) where
 
 import Geometry.Data
@@ -26,6 +27,17 @@ isLHS (V2 x y) (V2 x' y') (V2 x'' y'')
     b1 = x'' - x
     b2 = y'' - y
 
+compareLHS :: Point2 -> Point2 -> Point2 -> Ordering
+{-# INLINE compareLHS #-}
+compareLHS (V2 x y) (V2 x' y') (V2 x'' y'')
+    | (x, y) == (x', y') = EQ
+    | otherwise = compare (a1 * b2 - a2 * b1) 0
+  where
+    a1 = x' - x
+    a2 = y' - y
+    b1 = x'' - x
+    b2 = y'' - y
+
 {- | Test whether a point is on the RHS of a line.
  Returns False if the line is of zero length.
 -}