Improve room clip testing

src/Dodge/Floor.hs

@@ -33,8 +33,16 @@ roomTreex = do
     struct' <- aTreeStrut
     let struct = Node [EndRoom] []
     let t' = padCorridors struct
-        t = treeTrunk [[StartRoom],[OrAno [--[DoorAno],[Corridor],
-                                           [DoorNumAno 0,AirlockAno]] ],[FirstWeapon],[Corridor]] t'
+        t = treeTrunk 
+                [[StartRoom]
+                ,[OrAno [[DoorAno]
+                        ,[Corridor]
+                        ,[DoorNumAno 0,AirlockAno]] 
+                        ]
+                ,[FirstWeapon]
+                ,[Corridor]
+                ] 
+                t'
     fmap (shiftExpandTree . expandTreeBy id) $ mapM annoToRoomTree t
 
 levx :: RandomGen g => State g [Room]

src/Dodge/Layout/Tree/Shift.hs

@@ -47,7 +47,7 @@ shiftRoomTreeSearchAll bs (Node r ts :<| ts')
   where
     ls = init $ _rmLinks r
     newBounds = _rmBound r : bs
-    roomIsClipping = any (polysIntersect (_rmBound r)) bs
+    roomIsClipping = any (polysOverlap (_rmBound r)) bs
     rm l = r & rmLinks %~ delete l
     f l = applyToRoot (shiftRoomToLink l)
 

src/Geometry.hs

@@ -226,9 +226,14 @@ polysIntersect (p:ps) (q:qs)
   where 
     pairs1 = zip (p:ps) (ps++[p])
     pairs2 = zip (q:qs) (qs++[q])
+polysIntersect _ _ = False
 
-polysIntersect [] _ = False
-polysIntersect _ [] = False
+-- | Test whether two polygons intersect or if one is contained in the other.
+polysOverlap :: [Point2] -> [Point2] -> Bool
+polysOverlap (p:ps) (q:qs) = polysIntersect (p:ps) (q:qs) 
+    || pointInPolygon p (q:qs)
+    || pointInPolygon q (p:ps)
+polysOverlap _ _ = False
 
 -- | Test whether any polygons from a first list intersect with any polygons from
 -- a second list.