Stop intersectSegSegTest returning True for collinear line pairs

src/Dodge/Tree/Shift.hs

@@ -10,6 +10,7 @@ module Dodge.Tree.Shift (
     PosRooms (..),
 ) where
 
+import Data.Monoid
 import Control.Lens
 import Data.Bifunctor
 import Data.List (delete)
@@ -66,7 +67,9 @@ posRms prs parenti@(parent, _) ((numChild, t@(Node childi _)) : its) tseq = do
       where
         tryChildLinks [] = tryParentLinks ls
         tryChildLinks ((numinlink, il) : ils)
-            | clipping = tryChildLinks ils
+            | Just xs <- clipping' = do
+                putStrLn $ show xs
+                tryChildLinks ils
             | otherwise = do
                 putStrLn $ show j ++ "-" ++ show numinlink
                 mayrs <-
@@ -83,6 +86,7 @@ posRms prs parenti@(parent, _) ((numChild, t@(Node childi _)) : its) tseq = do
           where
             newBounds = map pointsToPoly . _rmBound . doRoomShift . fst $ rootLabel shiftedt
             clipping = or (convexPolysOverlap <$> newBounds <*> _prBounds prs)
+            clipping' = getFirst . foldMap First $ convexPolysOverlapWitness <$> newBounds <*> _prBounds prs
             updateparent rm =
                 _rmLinkEff rm il child numChild outlnk rm
                     & rmLinks %~ delete outlnk