Some cleanup, sidetracked from inter-room placements

src/Dodge/Layout/Tree/Annotate.hs

@@ -1,8 +1,5 @@
-{- |
-Annotating tree structures with desired properties for rooms.
--}
-module Dodge.Layout.Tree.Annotate
-    where
+{- | Annotating tree structures with desired properties for rooms.  -}
+module Dodge.Layout.Tree.Annotate where
 import Dodge.Data
 import Dodge.RandomHelp
 import Dodge.Layout.Tree.Polymorphic
@@ -23,6 +20,7 @@ import Dodge.Room.Teleport
 import Data.Tree
 import Control.Monad.State
 import System.Random
+import Control.Lens
 
 data Annotation g
     = Lock Int
@@ -40,6 +38,8 @@ data Annotation g
     | SpecificRoom (State g (Tree (Either Room Room)))
     | BossAno Creature
     | TreasureAno [Creature] [Item]
+    | SetLabel Int (State g Room)
+    | UseLabel Int (State g Room)
 
 addLock :: RandomGen g => Int -> Tree [Annotation g] -> State g (Tree [Annotation g])
 addLock i t = do
@@ -49,6 +49,9 @@ addLock i t = do
 {- | Add one corridor between each parent-child link of a tree of annotations.  -}
 padWithCorridors :: Tree [Annotation g] -> Tree [Annotation g]
 padWithCorridors (Node x xs) = Node [Corridor] [Node x (map padWithCorridors xs)]
+padSucWithCorridors :: Tree [Annotation g] -> Tree [Annotation g]
+padSucWithCorridors (Node x xs) = Node x (map padWithCorridors xs)
+
 {- Add one to three corridors between each parent-child link of a tree of annotations.  -}
 randomPadCorridors :: RandomGen g => Tree [Annotation g] -> State g (Tree [Annotation g])
 randomPadCorridors  (Node x xs) = do
@@ -60,11 +63,17 @@ roomThenCorridor :: RandomGen g => Room -> State g (Tree (Either Room Room))
 roomThenCorridor theRoom = fmap (\r -> Node (Left theRoom) [(pure . Right) r]) 
                                 (randomiseOutLinks corridor)
 {- | Create a random room tree structure from a list of annotations.  -}
-annoToRoomTree :: RandomGen g => [Annotation g] -> State g (Tree (Either Room Room))
-annoToRoomTree anos = case anos of
+anoToRoomTree :: RandomGen g => [Annotation g] -> State g (Tree (Either Room Room))
+anoToRoomTree anos = case anos of
+    [SetLabel i randrm] -> do
+        rm <- randrm
+        return . connectRoom $ rm & rmLabel ?~ i
+    [UseLabel i randrm] -> do
+        rm <- randrm
+        return $ connectRoom $ rm & rmTakeFrom ?~ i
     [OrAno as] -> do
         a <- takeOne as
-        annoToRoomTree a
+        anoToRoomTree a
     [Corridor] -> pure . Right <$> randomiseOutLinks corridor
     [CorridorDebug] -> pure . Right <$> randomiseOutLinks corridorDebug
     [DoorAno] -> roomThenCorridor door

src/Dodge/Layout/Tree/Shift.hs

@@ -47,6 +47,6 @@ posRms bounds (r,i) (t@(Node (_,i') _):ts) tseq = do
       where
         convexBounds = map pointsToPoly $ _rmBound r'
         clipping = or (convexPolysOverlap <$> convexBounds <*> bounds)
-        useLink = (r & rmLinks %~ delete l & rmUsedLinks %~ (uncurry (OutLink (Prelude.length ts)) l :)
+        useLink = (r & rmLinks %~ delete l & rmPos %~ (uncurry (OutLink (Prelude.length ts)) l :)
             , i)
         shiftedt@(Node (r',_) _) = applyToRoot (first $ shiftRoomToLink l) t