Add new files

src/Dodge/Layout/Tree/Shift.hs

@@ -4,11 +4,14 @@ links connect and that none of them clip.
 Returns a list; after this step the structure is determined by the actual positions of rooms.
  -}
 module Dodge.Layout.Tree.Shift
-    where
+    ( shiftRoomTreeSearchAll
+    , shiftExpandTree
+    ) where
 import Dodge.Room.Data
 import Dodge.Room.Link
 import Dodge.Layout.Tree.Polymorphic
 import Geometry
+import Geometry.ConvexPoly
 --import Geometry.Data
 
 import Data.Tree
@@ -16,25 +19,7 @@ import Data.Sequence hiding (zipWith)
 import Data.List (delete)
 import Data.Maybe (listToMaybe)
 import Control.Lens hiding (Empty, (<|) , (|>))
-
-{- |
-Helper: Depth first search of trees of rooms, maybe produces a list rooms that are not clipping.
- -}
-shiftRoomTreeSearch 
-    :: [[Point2]]       -- ^ Clipping bounds
-    -> Seq (Tree Room)  -- ^ Rooms to be added
-    -> Maybe [Room]
-shiftRoomTreeSearch _  Empty = Just []
-shiftRoomTreeSearch bs (Node r ts :<| ts')
-    | roomIsClipping = Nothing
-    | otherwise = fmap (r :) . shiftRoomTreeSearch newBounds $ ts' >< chldren
-  where
-    roomIsClipping = or (polysIntersect <$> _rmBound r <*> bs)
-    newBounds = _rmBound r ++ bs
-    chldren = fromList $ zipWith (applyToRoot . shiftRoomToLink) (_rmLinks r) ts
-{- |
-All: Depth first search of trees of rooms, produces a list of lists of rooms that are not clipping.
- -}
+{- | All: Depth first search of trees of rooms, produces a list of lists of rooms that are not clipping.  -}
 shiftRoomTreeSearchAll 
     :: [[Point2]]       -- ^ Clipping bounds
     -> Seq (Tree Room)  -- ^ Rooms to be added
@@ -46,6 +31,7 @@ shiftRoomTreeSearchAll bs (Node r ts :<| ts')
         [] -> (r :) <$> shiftRoomTreeSearchAll newBounds ts'
         (s:ss) -> concatMap (\l -> shiftRoomTreeSearchAll bs (Node (rm l) ss <| (ts' |> f l s))) ls
   where
+    convexBounds = map pointsToPoly $ _rmBound r
     ls = init $ _rmLinks r
     newBounds = _rmBound r ++ bs
     roomIsClipping = or (polysOverlap <$> _rmBound r <*> bs)