Improve segment intersection test, tweak room bounding

src/Dodge/Tree/Shift.hs

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