Assign used links during room generation

src/Dodge/Layout/Tree/Shift.hs

@@ -27,16 +27,23 @@ shiftRoomTreeSearchAll bs (Node r ts :<| ts')
     | roomIsClipping = [] -- this is called too often, but whatever
     | otherwise = case ts of
         [] -> (r :) <$> shiftRoomTreeSearchAll newBounds ts'
-        (s:ss) -> concatMap (\l -> shiftRoomTreeSearchAll bs (Node (rm l) ss <| (ts' |> f l s))) ls
+        (s:ss) -> concatMap (\l -> shiftRoomTreeSearchAll bs (Node (useLink l) ss <| (ts' |> f l s))) ls
   where
     convexBounds = map pointsToPoly $ _rmBound r
     ls = init $ _rmLinks r
     newBounds = convexBounds ++ bs
     roomIsClipping = or (convexPolysOverlap <$> convexBounds <*> bs)
-    rm l = r & rmLinks %~ delete l
+    useLink l = r & rmLinks %~ delete l
+        & rmUsedLinks %~ (l :)
     f l = applyToRoot (shiftRoomToLink l)
 {- |
 Depth first search of trees of rooms, maybe produces a list rooms that are not clipping.
  -}
 shiftExpandTree :: Tree Room -> Maybe [Room]
-shiftExpandTree = listToMaybe . shiftRoomTreeSearchAll [] . singleton
+shiftExpandTree = fmap (map setLastLinkToUsed) . listToMaybe . shiftRoomTreeSearchAll [] . singleton
+  where
+    setLastLinkToUsed rm = case _rmLinks rm of
+        (_:_) -> rm
+            & rmLinks %~ init
+            & rmUsedLinks %~ (last (_rmLinks rm) :)
+        _ -> rm