Allow for complex room bounds for clip checks

src/Dodge/Layout/Tree/Annotate.hs

@@ -83,7 +83,9 @@ annoToRoomTree [StartRoom] = do
     h <- state $ randomR (200,400)
     pure . Right <$> randomiseOutLinks (shiftRoomBy ((-20,-20),0) $ roomRectAutoLinks w h)
 annoToRoomTree (SpecificRoom rt:_) = rt
-annoToRoomTree (BossAno cr : _) = branchRectWith . fmap (pure . Left) $ bossRoom cr
+annoToRoomTree (BossAno cr : _) = do
+    br <- bossRoom cr
+    branchRectWith . pure . fmap (Left) $ treeFromPost [corridor,corridor] br
 annoToRoomTree (TreasureAno crs loot : _) =
     branchRectWith . fmap (pure . Left) $ lootRoom crs loot
 annoToRoomTree _ = do

src/Dodge/Layout/Tree/Shift.hs

@@ -28,8 +28,8 @@ shiftRoomTreeSearch bs (Node r ts :<| ts')
     | roomIsClipping = Nothing
     | otherwise = fmap (r :) $ shiftRoomTreeSearch newBounds $ ts' >< children
   where
-    roomIsClipping = any (polysIntersect (_rmBound r)) bs
-    newBounds = _rmBound r : bs
+    roomIsClipping = or (polysIntersect <$> _rmBound r <*> bs)
+    newBounds = _rmBound r ++ bs
     children = fromList $ zipWith (\l -> applyToRoot (shiftRoomToLink l))
                        (_rmLinks r)
                        ts
@@ -48,8 +48,8 @@ shiftRoomTreeSearchAll bs (Node r ts :<| ts')
         (s:ss) -> concatMap (\l -> shiftRoomTreeSearchAll bs (Node (rm l) ss <| (ts' |> f l s))) ls
   where
     ls = init $ _rmLinks r
-    newBounds = _rmBound r : bs
-    roomIsClipping = any (polysOverlap (_rmBound r)) bs
+    newBounds = _rmBound r ++ bs
+    roomIsClipping = or (polysOverlap <$> _rmBound r <*> bs)
     rm l = r & rmLinks %~ delete l
     f l = applyToRoot (shiftRoomToLink l)
 {- |