Working room generation with less shifting, should be more sensible

src/Dodge/Layout/Tree/Shift.hs

@@ -16,11 +16,10 @@ import Data.List (delete)
 import Data.Bifunctor
 import Control.Lens hiding (Empty, (<|) , (|>))
 
-positionRooms :: Tree RoomInt -> IO (Maybe [Room])
-positionRooms (Node (r,i) ts) = posRms (map pointsToPoly $ _rmBound r) (r,i) ts Empty
-
 type RoomInt = (Room,Int)
 
+positionRooms :: Tree RoomInt -> IO (Maybe [Room])
+positionRooms (Node (r,i) ts) = posRms (map pointsToPoly $ _rmBound r) (r,i) ts Empty
 
 posRms :: [ConvexPoly]
     -> RoomInt
@@ -50,8 +49,8 @@ posRms bounds (r,i) (t@(Node (_,i') _):ts) tseq = do
         clipping = or (convexPolysOverlap <$> convexBounds <*> bounds)
         newr = (lnkEff l $ r & rmLinks %~ delete l & rmPos %~ (uncurry (OutLink j) l :)
             , i)
-        shiftedt@(Node (r',_) _) = applyToRoot (first $ shiftRoomToLink l) t
-        shiftedt'@(Node (r'',_) _) = applyToRoot (first $ shiftRoomShiftToLink l) t
+        (Node (r',_) _) = applyToRoot (first $ shiftRoomToLink l) t
+        shiftedt' = applyToRoot (first $ shiftRoomShiftToLink l) t
 
 lnkEff :: (Point2,Float) -> Room -> Room
 lnkEff x rm = case _rmLinkEff rm of