Move toward not shifting rooms during generation

src/Dodge/Layout/Tree/Shift.hs

@@ -21,8 +21,8 @@ positionRooms (Node (r,i) ts) = posRms (map pointsToPoly $ _rmBound r) (r,i) ts
 
 type RoomInt = (Room,Int)
 
-posRms
-    :: [ConvexPoly]
+
+posRms :: [ConvexPoly]
     -> RoomInt
     -> [Tree RoomInt]
     -> Seq (Tree RoomInt)
@@ -32,7 +32,7 @@ posRms bounds (rtoadd,_) [] (Node (r,i) ts :<| tseq)
     = fmap (finalLinksUpdate rtoadd:) <$> posRms bounds (r,i) ts tseq
 posRms bounds (r,i) (t@(Node (_,i') _):ts) tseq = do
     putStr $ "Trying to place room " ++ show i' ++ ": "
-    tryLinks (0::Int) (_rmLinks r)
+    tryLinks (0::Int) (_rmLinks $ doRoomShift r)
   where
     tryLinks _ [] = do
         putStrLn "all links tried"
@@ -41,7 +41,7 @@ posRms bounds (r,i) (t@(Node (_,i') _):ts) tseq = do
         | clipping   = tryLinks (j+1) ls
         | otherwise = do
             putStrLn $ "placing at link " ++ show j
-            mayrs <- posRms (convexBounds ++ bounds) newr ts (tseq |> shiftedt)
+            mayrs <- posRms (convexBounds ++ bounds) newr ts (tseq |> shiftedt')
             case mayrs of
                 Nothing -> do putStr ("Backtracking to room " ++ show i' ++ ": ") >> tryLinks (j+1) ls
                 Just rs -> return (Just rs)
@@ -51,6 +51,7 @@ posRms bounds (r,i) (t@(Node (_,i') _):ts) tseq = do
         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
 
 lnkEff :: (Point2,Float) -> Room -> Room
 lnkEff x rm = case _rmLinkEff rm of