Rework annotations

src/Dodge/Annotation.hs

@@ -10,70 +10,79 @@ import Dodge.Tree
 import Dodge.Room
 import Dodge.Data
 import Dodge.Annotation.Data
---import LensHelp
+import LensHelp
 
 --import Control.Lens
-import Data.Maybe
+--import Data.Maybe
 
-addLock :: Int -> Tree [Annotation] -> State StdGen (Tree [Annotation])
-addLock i t = do
-    (beforeLock, afterLock) <- splitTrunk t
-    newBefore <- applyToRandomNode (Key i :) beforeLock
-    return $ addToTrunk newBefore [Node [Lock i] afterLock]
 {- | Add one corridor between each parent-child link of a tree of annotations.  -}
-padWithCorridors :: Tree [Annotation] -> Tree [Annotation]
+--padWithCorridors :: Annotation -> Annotation
-padWithCorridors = padWithAno [Corridor]
+--padWithCorridors = padWithAno [Corridor]
+--
+--padWithAno :: [Annotation] -> Tree [Annotation] -> Tree [Annotation]
+--padWithAno ano (Node x xs) = Node ano [Node x (map (padWithAno ano) xs)]
+--
+--padSucWithCorridors :: Tree [Annotation] -> Tree [Annotation]
+--padSucWithCorridors (Node x xs) = Node x (map padWithCorridors xs)
+--
+--padSucWithDoors :: Tree [Annotation] -> Tree [Annotation]
+--padSucWithDoors (Node x xs) = Node x (map (padWithAno [SpecificRoom thetree]) xs)
+--  where
+--    thetree = do
+--        thecor <- shuffleLinks corridor
+--        takeOne
+--            [ (toOnward "door",     return (cleatOnward door))
+--            , (toOnward "twoDoors" ,treePost [ door,  thecor, cleatOnward door])
+--            ]
+--
+--{- Add one to three corridors between each parent-child link of a tree of annotations.  -}
+--randomPadCorridors :: Tree [Annotation] -> State StdGen (Tree [Annotation])
+--randomPadCorridors  (Node x xs) = do
+--    n <- state $ randomR (1, 3)
+--    xs' <- mapM randomPadCorridors xs
+--    return $ treeFromTrunk (replicate n [Corridor]) (Node x xs')
 
-padWithAno :: [Annotation] -> Tree [Annotation] -> Tree [Annotation]
+annoToRoomTree :: Annotation -> State StdGen (MetaTree Room)
-padWithAno ano (Node x xs) = Node ano [Node x (map (padWithAno ano) xs)]
+annoToRoomTree an = case an of
+    OnwardList ans -> do
+        mts <- mapM annoToRoomTree ans
+        return $ foldr1 attachOnward mts
+    SpecificRoom r -> r
+    PadWith r an -> annoToRoomTree an
+    IntAnno i f -> annoToRoomTree $ f i
 
-padSucWithCorridors :: Tree [Annotation] -> Tree [Annotation]
+attachOnward :: MetaTree Room -> MetaTree Room -> MetaTree Room
-padSucWithCorridors (Node x xs) = Node x (map padWithCorridors xs)
+attachOnward t1 t2 = case t1 of
-
+    MTree {} -> t1 & mtBranches .:~ MBranch "Onward" toOnward' t2
-padSucWithDoors :: Tree [Annotation] -> Tree [Annotation]
+    BTree {} -> t2 & btBranches .:~ t2
-padSucWithDoors (Node x xs) = Node x (map (padWithAno [SpecificRoom thetree]) xs)
-  where
-    thetree = do
-        thecor <- shuffleLinks corridor
-        takeOne
-            [ (toOnward "door",     return (cleatOnward door))
-            , (toOnward "twoDoors" ,treePost [ door,  thecor, cleatOnward door])
-            ]
-
-{- Add one to three corridors between each parent-child link of a tree of annotations.  -}
-randomPadCorridors :: Tree [Annotation] -> State StdGen (Tree [Annotation])
-randomPadCorridors  (Node x xs) = do
-    n <- state $ randomR (1, 3)
-    xs' <- mapM randomPadCorridors xs
-    return $ treeFromTrunk (replicate n [Corridor]) (Node x xs')
 
 {- | Create a random room tree structure from a list of annotations.  -}
-anoToRoomTree :: [Annotation] -> State StdGen (Room -> Maybe ([String],Room), Tree Room)
+--anoToRoomTree :: [Annotation] -> State StdGen (Room -> Maybe ([String],Room), Tree Room)
-anoToRoomTree anos = case anos of
+--anoToRoomTree anos = case anos of
-    [AnoApplyInt i f] -> f i
+--    [AnoApplyInt i f] -> f i
---    [AnoApplyInt' i f str] -> f i <&> (,TreeSubLabelling str Nothing)
+----    [AnoApplyInt' i f str] -> f i <&> (,TreeSubLabelling str Nothing)
-    (SpecificRoom rt:_) -> rt
+--    (SpecificRoom rt:_) -> rt
-    [PassthroughLockKeyLists i ls ks] -> do
+--    [PassthroughLockKeyLists i ls ks] -> do
-        (functionlockroom,randomitemidentity) <- takeOne ls
+--        (functionlockroom,randomitemidentity) <- takeOne ls
-        lr' <- functionlockroom i
+--        lr' <- functionlockroom i
-        ii <- randomitemidentity
+--        ii <- randomitemidentity
-        let lr = snd lr'
+--        let lr = snd lr'
-        keyroom' <- fromJust $ lookup ii ks
+--        keyroom' <- fromJust $ lookup ii ks
-        let keyroom = snd keyroom'
+--        let keyroom = snd keyroom'
-        rToOnward ("PassthroughLockKeyLists-"++show ii) $ overwriteLabel i lr [keyroom]
+--        rToOnward ("PassthroughLockKeyLists-"++show ii) $ overwriteLabel i lr [keyroom]
-    _ -> rToOnward "no label" =<< anoToRoomTree' anos
+--    _ -> rToOnward "no label" =<< anoToRoomTree' anos
 
 {- | Create a random room tree structure from a list of annotations.  -}
 anoToRoomTree' :: [Annotation] -> State StdGen (Tree Room)
 anoToRoomTree' anos = case anos of
-    [OrAno as] -> do
+--    [OrAno as] -> do
-        a <- takeOne as
+--        a <- takeOne as
-        anoToRoomTree' a
+--        anoToRoomTree' a
-    [Corridor] -> pure . cleatOnward <$> shuffleLinks corridor
+--    [Corridor] -> pure . cleatOnward <$> shuffleLinks corridor
-    (BossAno cr : _) -> do
+--    (BossAno cr : _) -> do
-        br <- bossRoom cr
+--        br <- bossRoom cr
-        branchRectWith . pure $ treeFromPost [corridor,corridor] br
+--        branchRectWith . pure $ treeFromPost [corridor,corridor] br
-    (TreasureAno crs loot : _) -> branchRectWith . fmap pure $ lootRoom crs loot
+--    (TreasureAno crs loot : _) -> branchRectWith . fmap pure $ lootRoom crs loot
     _ -> do
         w <- state $ randomR (100,400)
         h <- state $ randomR (200,400)

src/Dodge/Annotation/Data.hs

@@ -10,20 +10,16 @@ import Control.Monad.State
 import Control.Lens
 import System.Random
 data Annotation
-    = Lock Int
+    = -- Corridor
-    | Key  Int
+--    | AirlockAno
-    | Corridor
+    PadWith Room Annotation
-    | AirlockAno
+    | OnwardList [Annotation]
-    | OrAno [[Annotation]]
+    | IntAnno Int (Int -> Annotation)
-    | SpecificRoom (State StdGen (LabTree Room))
+--    | OrAno [[Annotation]]
-    | BossAno Creature
+    | SpecificRoom (State StdGen (MetaTree Room))
-    | TreasureAno [Creature] [Item]
     | AnoApplyInt Int (Int -> State StdGen (LabTree Room))
-    | AnoNewInt (Int -> State StdGen (Tree Room))
     | PassthroughLockKeyLists Int 
         [(Int -> State StdGen (LabTree Room), State StdGen ItemBaseType)]
         [(ItemBaseType, State StdGen (LabTree Room))]
---    | SetLabel Int (State g Room)
---    | useLabel Int (State g Room)
 
 makeLenses ''Annotation

src/Dodge/Floor.hs

@@ -35,68 +35,67 @@ import RandomHelp
 --import Data.Maybe
 --import qualified Data.IntMap.Strict as IM
 
-initialAnoTree :: Tree [Annotation]
+initialAnoTree :: Annotation
-initialAnoTree = padSucWithDoors $ treePost 
+initialAnoTree = PadWith door $ OnwardList 
-    [[AnoApplyInt 110 startRoom]
+    [ IntAnno 0 $ SpecificRoom . startRoom
-    , [PassthroughLockKeyLists 2 keyCardRunPastRand itemRooms]
+--    , PassthroughLockKeyLists 2 keyCardRunPastRand itemRooms
-    , [SpecificRoom $ warningRooms 777777]
+    , SpecificRoom $ warningRooms 1
-    , [SpecificRoom $ rToOnward "chaseCrit+armourChaseCrit rectRoom"
+    , SpecificRoom $ rToOnward "chaseCrit+armourChaseCrit rectRoom"
         $ return . cleatOnward $ roomRectAutoLinks 400 400 & rmPmnts .++~ 
             [ spNoID anyUnusedSpot (PutCrit invisibleChaseCrit)
             , spNoID anyUnusedSpot (PutCrit armourChaseCrit)
             ]
-    ]
+--"--    , [AnoApplyInt 100 healthTest]
---    , [AnoApplyInt 100 healthTest]
+--"    , PassthroughLockKeyLists 23 
-    , [PassthroughLockKeyLists 23 
+--"        [(sensorRoomRunPast ELECTRICAL, takeOne [STATICMODULE,SPARKGUN] )] itemRooms
-        [(sensorRoomRunPast ELECTRICAL, takeOne [STATICMODULE,SPARKGUN] )] itemRooms]
+--"    , SpecificRoom (tanksRoom [] [] >>= rToOnward "empty tanksRoom" . pure . cleatOnward)
-    , [SpecificRoom (tanksRoom [] [] >>= rToOnward "empty tanksRoom" . pure . cleatOnward)]
+--"    , PassthroughLockKeyLists 222 lockRoomKeyItems itemRooms
-    , [PassthroughLockKeyLists 222 lockRoomKeyItems itemRooms]
+--"    , SpecificRoom randomChallenges
-    , [SpecificRoom randomChallenges]
+--"    , AnoApplyInt 1 lasSensorTurretTest
-    , [AnoApplyInt 1 lasSensorTurretTest]
+--"--    ,[SpecificRoom $ fmap pure roomCCrits]
---    ,[SpecificRoom $ fmap pure roomCCrits]
+--"--    ,[AirlockAno]
---    ,[AirlockAno]
+--"--    ,[Corridor]
---    ,[Corridor]
+--"------    ,[SpecificRoom roomCCrits]
-------    ,[SpecificRoom roomCCrits]
+--"------    ,[Corridor]
-------    ,[Corridor]
+--"------    ,[SpecificRoom . pure . pure . useAll $ roomGlassOctogon 400 
-------    ,[SpecificRoom . pure . pure . useAll $ roomGlassOctogon 400 
+--"------        & rmPS %~ ([sPS (V2 0 50) 0 $ PutCrit armourChaseCrit 
-------        & rmPS %~ ([sPS (V2 0 50) 0 $ PutCrit armourChaseCrit 
+--"------                    ,sPS (V2 50 25) 0 $ PutCrit armourChaseCrit 
-------                    ,sPS (V2 50 25) 0 $ PutCrit armourChaseCrit 
+--"------                    ,sPS (V2 50 0) 0 $ PutCrit armourChaseCrit 
-------                    ,sPS (V2 50 0) 0 $ PutCrit armourChaseCrit 
+--"------                    ]++)
-------                    ]++)
+--"------     ]
-------     ]
+--"------    --,[SpecificRoom . pure . pure . useAll $ roomGlassOctogon 400 
-------    --,[SpecificRoom . pure . pure . useAll $ roomGlassOctogon 400 
+--"------    --    & rmPS %~ ([swarmPS 0 (x,y) 0 swarmCrit | x <- [-20,-19.5.. 20] , y <- [200,202] ]++)
-------    --    & rmPS %~ ([swarmPS 0 (x,y) 0 swarmCrit | x <- [-20,-19.5.. 20] , y <- [200,202] ]++)
+--"------    -- ]
-------    -- ]
+--"------    ,[SpecificRoom . pure . pure . useAll $ roomGlassOctogon 400 
-------    ,[SpecificRoom . pure . pure . useAll $ roomGlassOctogon 400 
+--"------        & rmPS %~ ([sPS (V2 0 50) 0 $ PutCrit pistolCrit ]++)
-------        & rmPS %~ ([sPS (V2 0 50) 0 $ PutCrit pistolCrit ]++)
+--"------     ]
-------     ]
+--"------    ,[Corridor]
-------    ,[Corridor]
+--"----    --,[SpecificRoom $ pure . useAll <$> twinSlowDoorChasers]
-----    --,[SpecificRoom $ pure . useAll <$> twinSlowDoorChasers]
+--"-----    ,[SpecificRoom $ pure $ (pure . useAll) (twinSlowDoorRoom 80 200 40)]
------    ,[SpecificRoom $ pure $ (pure . useAll) (twinSlowDoorRoom 80 200 40)]
+--"-----    ,[DoorAno]
------    ,[DoorAno]
+--"-----    ,[SpecificRoom $ pure . useAll <$> centerVaultExplosiveExit]
------    ,[SpecificRoom $ pure . useAll <$> centerVaultExplosiveExit]
+--"-----    ,[SpecificRoom blockedCorridor]
------    ,[SpecificRoom blockedCorridor]
+--"-----    ,[OrAno [[DoorAno]
------    ,[OrAno [[DoorAno]
+--"-----            ,[Corridor]
------            ,[Corridor]
+--"-----            ,[DoorNumAno 0,AirlockAno]] 
------            ,[DoorNumAno 0,AirlockAno]] 
+--"-----            ]
------            ]
+--"-----    ,[FirstWeapon]
------    ,[FirstWeapon]
+--"-----    ,[CorridorDebug]
------    ,[CorridorDebug]
+--"-----    ,[SpecificRoom $ fmap (pure . useAll) randomFourCornerRoom]
------    ,[SpecificRoom $ fmap (pure . useAll) randomFourCornerRoom]
+--"--    ,[OrAno 
---    ,[OrAno 
+--"--        [[SpecificRoom $ branchRectWith $ fmap (fmap ) armouredChasers]
---        [[SpecificRoom $ branchRectWith $ fmap (fmap ) armouredChasers]
+--"--        ,[BossAno $ addArmour launcherCrit & crHP +~ 800
---        ,[BossAno $ addArmour launcherCrit & crHP +~ 800
+--"--            & crState . crDropsOnDeath .~ DropSpecific [0] ]
---            & crState . crDropsOnDeath .~ DropSpecific [0] ]
+--"--        ]
---        ]
+--"--     ]
---     ]
+--"----    ,[SpecificRoom $ fmap (pure . useAll) armouredCorridor]
-----    ,[SpecificRoom $ fmap (pure . useAll) armouredCorridor]
+--"--    ,[Corridor]
---    ,[Corridor]
+--"--    ,[TreasureAno [addArmour autoCrit,addArmour autoCrit] [launcher]]
---    ,[TreasureAno [addArmour autoCrit,addArmour autoCrit] [launcher]]
+--"--    ,[Corridor]
---    ,[Corridor]
+--"    ,SpecificRoom $ randomFourCornerRoom [] >>= rToOnward "randomFourCornerRoom" . pure . cleatOnward 
-    ,[SpecificRoom $ randomFourCornerRoom [] >>= rToOnward "randomFourCornerRoom" . pure . cleatOnward ]
+--"    ,SpecificRoom $ telRoomLev 1 >>= rToOnward "telRoomLev" . pure . cleatOnward
-    ,[SpecificRoom $ telRoomLev 1 >>= rToOnward "telRoomLev" . pure . cleatOnward]
     ]
 
 {- | A test level tree. -}
-initialRoomTree :: State StdGen (Tree (Room -> Maybe ([String],Room), Tree Room))
+initialRoomTree :: State StdGen (MetaTree Room)
-initialRoomTree = mapM anoToRoomTree initialAnoTree
+initialRoomTree = annoToRoomTree initialAnoTree

src/Dodge/LevelGen.hs

@@ -36,7 +36,7 @@ layoutLevelFromSeed i seed = do
     appendFile "log/attemptedSeeds" $ show seed ++ "\n"
     let g = mkStdGen seed
     let treecluster = evalState initialRoomTree g
-    tc <- composeAndLog $ cmpToMT treecluster
+    tc <- composeAndLog $ treecluster
     ----    (strs,tc) = composeTree' treecluster
     ----appendFile "log/TreeCluster" ("Seed: "++ show seed)
     ----mapM_ (appendFile "log/treeCluster" . ('\n':))  strs

src/Dodge/LockAndKey.hs

@@ -17,7 +17,7 @@ import Dodge.Item
 bossKeyItems :: RandomGen g => [ (State g (Tree Room), State g ItemBaseType) ]
 bossKeyItems = [(return . cleatOnward <$> bossRoom autoCrit, takeOne [PISTOL]) ]
 
-lockRoomMultiItems :: RandomGen g => [ ( State g (LabTree Room) , State g [ItemBaseType] ) ]
+lockRoomMultiItems :: RandomGen g => [ ( State g (MetaTree Room) , State g [ItemBaseType] ) ]
 lockRoomMultiItems = 
     [ (blinkAcrossChallenge, takeOne [[BLINKERUNSAFE,AUTODETECTOR WALLDETECTOR]
                                     ,[BLINKERUNSAFE,CLICKDETECTOR WALLDETECTOR]
@@ -25,7 +25,7 @@ lockRoomMultiItems =
         )
     ]
 
-lockRoomKeyItems :: RandomGen g => [ (Int -> State g (LabTree Room) , State g ItemBaseType ) ]
+lockRoomKeyItems :: RandomGen g => [ (Int -> State g (MetaTree Room) , State g ItemBaseType ) ]
 lockRoomKeyItems = 
     [(lasCenSensEdge, takeOne [LAUNCHER,LASGUN,SPARKGUN,FLATSHIELD,FORCEFIELDGUN] )
     ,(sensorRoomRunPast ELECTRICAL, takeOne [STATICMODULE,SPARKGUN] )
@@ -37,10 +37,10 @@ lockRoomKeyItems =
     ,(const $ lasTunnelRunPast 400, takeOne [FLATSHIELD,FORCEFIELDGUN])
     ,(keyCardRoomRunPast 0, return (KEYCARD 0))
     ]
-keyCardRunPastRand :: RandomGen g => [ (Int -> State g (LabTree Room) , State g ItemBaseType ) ]
+keyCardRunPastRand :: RandomGen g => [ (Int -> State g (MetaTree Room) , State g ItemBaseType ) ]
 keyCardRunPastRand = [(keyCardRoomRunPast 0, return (KEYCARD 0)) ]
 
-itemRooms :: RandomGen g => [(ItemBaseType, State g (LabTree Room))]
+itemRooms :: RandomGen g => [(ItemBaseType, State g (MetaTree Room))]
 itemRooms = 
     [ (LAUNCHER , join $ takeOne 
         [corridorBoss launcherCrit
@@ -108,7 +108,7 @@ someCrits = do
 --    return $ roomsContaining crits its
 
 
-corridorBoss :: RandomGen g => Creature -> State g (LabTree Room)
+corridorBoss :: RandomGen g => Creature -> State g (MetaTree Room)
 corridorBoss cr = do
     endroom <- bossRoom cr
     rToOnward ("corridorBoss-"++_crName cr)

src/Dodge/Room/BlinkAcross.hs

@@ -34,7 +34,7 @@ import LensHelp
 import Control.Monad.State
 import System.Random
 
-blinkAcrossChallenge :: RandomGen g => State g (LabTree Room)
+blinkAcrossChallenge :: RandomGen g => State g (MetaTree Room)
 blinkAcrossChallenge = do
     teleFromRoom <- shuffleLinks $ roomRectAutoLinks 200 200
     teleToRoom  <- shuffleLinks $ roomRectAutoLinks 200 200

src/Dodge/Room/Containing.hs

@@ -15,7 +15,7 @@ import Geometry
 
 import Data.List
 
-roomsContaining :: RandomGen g => [Creature] -> [Item] -> State g (LabTree Room)
+roomsContaining :: RandomGen g => [Creature] -> [Item] -> State g (MetaTree Room)
 roomsContaining crs its = do
     endroom <- join $ takeOne
         [ randomFourCornerRoomCrsIts crs its 

src/Dodge/Room/GlassLesson.hs

@@ -53,7 +53,7 @@ glassLesson = do
             , mntLS vShape (V2 180 200) (V3 160 180 50)
             ]
         ]
-glassLessonRunPast :: RandomGen g => State g (LabTree Room)
+glassLessonRunPast :: RandomGen g => State g (MetaTree Room)
-glassLessonRunPast = (f <$> glassLesson) <&> (toOnward "glassLessonRunPast",)
+glassLessonRunPast = (f <$> glassLesson) >>= rToOnward "glassLessonRunPast"
   where
     f (Node r rs) = Node r $ return (cleatLabel 0 $ door & rmConnectsTo .~ S.member (OnEdge West)) : rs

src/Dodge/Room/LasTurret.hs

@@ -71,15 +71,15 @@ lightSensByDoor outplid rm = rm
     covershape = rectNSEW 10 (-10) 20 (-20)
     sensorshift (p,a) = (p +.+ rotateV a (V2 60 (-20)), a)
 
-keyCardRoomRunPast :: RandomGen g => Int -> Int -> State g (LabTree Room)
+keyCardRoomRunPast :: RandomGen g => Int -> Int -> State g (MetaTree Room)
 keyCardRoomRunPast keyid rmid = do
     cenroom <- shuffleLinks $ keyCardAnalyserByDoor keyid rmid $ roomNgon 6 200
     let doorroom = triggerDoorRoom rmid
-    return (toOnward "keyCardRoomRunPast",
+    rToOnward "keyCardRoomRunPast" $
         treeFromTrunk [door] $ Node cenroom
         [ treeFromPost [doorroom] (cleatOnward door)
         , treeFromPost [door]     (cleatLabel rmid corridor)
-        ])
+        ]
 
 keyCardAnalyserByDoor :: Int -> Int -> Room -> Room
 keyCardAnalyserByDoor keyid = analyserByDoor (RequireEquipment (KEYCARD keyid))
@@ -114,13 +114,13 @@ healthTest n = do
         , cleatOnward door
         ]
 
-lasSensorTurretTest :: RandomGen g => Int -> State g (LabTree Room)
+lasSensorTurretTest :: RandomGen g => Int -> State g (MetaTree Room)
 lasSensorTurretTest n = do
     cenroom <- shuffleLinks $ lightSensInsideDoor n cenLasTur
     rToOnward "lasSensorTurretTest" $ treePost 
         [ door, cenroom, triggerDoorRoom n, cleatOnward door]
 
-lasCenSensEdge :: RandomGen g => Int -> State g (LabTree Room)
+lasCenSensEdge :: RandomGen g => Int -> State g (MetaTree Room)
 lasCenSensEdge n = do
     cenroom <- shuffleLinks $ lightSensByDoor n cenLasTur
     let doorroom = triggerDoorRoom n
@@ -165,7 +165,7 @@ lasTunnel y = do
         ]
 
 -- a y value of 400 is probably "unrunnable"
-lasTunnelRunPast :: RandomGen g => Float -> State g (LabTree Room)
+lasTunnelRunPast :: RandomGen g => Float -> State g (MetaTree Room)
 lasTunnelRunPast y = do
     r <- lasTunnel y
     r1 <- takeOne [door,corridor]

src/Dodge/Room/LongDoor.hs

@@ -140,7 +140,7 @@ slowDoorRoom = do
     proom <- southPillarsRoom x y h
     addButtonSlowDoor x h (proom & rmPmnts %~ (++ (crits ++ barrels)))
 
-slowDoorRoomRunPast :: RandomGen g => State g (LabTree Room)
+slowDoorRoomRunPast :: RandomGen g => State g (MetaTree Room)
 slowDoorRoomRunPast = do
     r <- slowDoorRoom
     rToOnward "slowDoorRoomRunPast" $ treeFromTrunk [ door] $ Node r

src/Dodge/Room/LongRoom.hs

@@ -47,7 +47,7 @@ longRoom = do
                 | crx <- [12.5,37.5,62.5] ] ++
         [sPS (V2 25 lampy ) 0 putLamp | lampy <- [20,h-10] ]
 
-longRoomRunPast :: RandomGen g => State g (LabTree Room)
+longRoomRunPast :: RandomGen g => State g (MetaTree Room)
 longRoomRunPast = do
     r <- longRoom
     rToOnward "longRoomRunPast"

src/Dodge/Room/Room.hs

@@ -123,11 +123,11 @@ rot90Around cen p = cen +.+ vNormal (p -.- cen)
 -- So, the idea is to attach outer children to the bottommost right nodes
 -- inside an inner tree
 -- no idea what was going on here...
-roomMiniIntro :: RandomGen g => State g (LabTree Room)
+roomMiniIntro :: RandomGen g => State g (MetaTree Room)
 roomMiniIntro = do
     midroom <- join $ takeOne [miniTree2] --,glassLesson]
-    return ( toOnward "roomMiniIntro" 
+    rToOnward "roomMiniIntro" 
-        , midroom )
+        midroom
 
 roomCenterPillar :: RandomGen g => State g Room
 roomCenterPillar = shuffleLinks . restrictInLinks ((\p -> dist p (V2 120 0) < 10) . fst) 
@@ -396,7 +396,7 @@ pistolerRoom = pillarGrid
         ]
             ++)
 
-shootingRange :: RandomGen g => State g (LabTree Room)
+shootingRange :: RandomGen g => State g (MetaTree Room)
 shootingRange = do
     rm1 <- shootersRoom1 >>= shuffleLinks . restrictInLinks (\(V2 _ y,_) -> y < 40)
             . restrictOutLinks  (\(V2 _ y,r) -> y > 200 && r /= 0)

src/Dodge/Room/SensorDoor.hs

@@ -56,7 +56,7 @@ sensorRoom senseType n = do
         p' = p +.+ rotateV d (V2 0 (negate 100))
         isclose = dist (_rlPos rl) p' < 30
 
-sensorRoomRunPast :: RandomGen g => DamageType -> Int -> State g (LabTree Room)
+sensorRoomRunPast :: RandomGen g => DamageType -> Int -> State g (MetaTree Room)
 sensorRoomRunPast dt n = do
     t <- sensorRoom dt n
     rToOnward "sensorRoomRunPast" $ t & applyToSubforest [0] 

src/Dodge/Room/Start.hs

@@ -48,7 +48,7 @@ powerFakeout = do
                 , keyholeCorridor, corridor])
         `treeFromPost` cleatOnward door
 
-startRoom :: RandomGen g => Int -> State g (LabTree Room)
+startRoom :: RandomGen g => Int -> State g (MetaTree Room)
 startRoom i = join (takeOne
     [-- (,) (0.5::Float) ((chainUses <$> sequence [powerFakeout,fmap fst $weaponRoom i]) 
      --       <&> (,TreeSubLabelling "chainUses <$> sequence [powerFakeout,weaponRoom i]" Nothing))
@@ -56,11 +56,11 @@ startRoom i = join (takeOne
 --      rezBoxesWp                >>= rToOnward "rezBoxesWp"
 --    , rezBoxThenWeaponRoom i
 --    , rezBoxesWpCrit            >>= rToOnward "rezBoxesWpCrit"
-     runPastStart i            >>= rToOnward ("runPastStart " ++ show i)
+     runPastStart i             >>= rToOnward ("runPastStart " ++ show i)
 --    , startCrafts >>= roomsContaining' [] >>= rezBoxThenRooms
 --        >>= rToOnward "startCrafts >>= roomsContaining [] >>= rezBoxThenRooms"
     ])
-randomChallenges :: RandomGen g => State g (LabTree Room)
+randomChallenges :: RandomGen g => State g (MetaTree Room)
 randomChallenges = shootingRange
 --        join (takeOne
 --    [fmap (return . useAll) doubleCorridorBarrels <&> (,TreeSubLabelling "doubleCorridorBarrels" Nothing)
@@ -88,13 +88,12 @@ rezBoxesThenWeaponRoom i = do
     wroom  <- snd <$> weaponRoom i
     return (rboxes `passUntiluseAll` [wroom] , "rezBoxesThenWeaponRoom " ++ show i)
 
-rezBoxThenWeaponRoom :: RandomGen g => Int -> State g (LabTree Room)
+rezBoxThenWeaponRoom :: RandomGen g => Int -> State g (MetaTree Room)
 rezBoxThenWeaponRoom i = do
     rcol <- rezColor
     (_,wroom) <- weaponRoom i
-    return (toOnward ("rezBoxThenWeaponRoom "++ show i)
+    rToOnward ("rezBoxThenWeaponRoom "++ show i)
-        , treeFromTrunk [ rezBox rcol, door] wroom
+        $ treeFromTrunk [ rezBox rcol, door] wroom
-        )
 
 rezBoxThenRoom :: RandomGen g => Room -> State g (Tree Room)
 rezBoxThenRoom r = do

src/Dodge/Room/Warning.hs

@@ -37,7 +37,7 @@ import qualified Data.Map.Strict as M
 --import qualified Data.Text as T
 
 
-warningRooms :: RandomGen g => Int -> State g (LabTree Room)
+warningRooms :: RandomGen g => Int -> State g (MetaTree Room)
 warningRooms n = do
     rm <- takeOne [roomNgon 8 200, roomRectAutoLinks 200 200]
     cenroom <- shuffleLinks $ addWarningTerminal n rm

src/Dodge/UseAll.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE TupleSections #-}
 module Dodge.UseAll where
 import Dodge.Data
+import Dodge.Tree.Compose.Data
 
 import Data.Tree
 import Control.Lens
@@ -15,8 +16,11 @@ toOnward s rm
 toOnward' :: Room -> Maybe Room
 toOnward' = fmap snd . toOnward ""
 
-rToOnward :: Monad m => String -> Tree Room -> m (Room -> Maybe ([String],Room), Tree Room)
+rToOnward :: Monad m => String -> Tree Room -> m (MetaTree Room)
-rToOnward s = return . (toOnward s ,)
+rToOnward s t = return $ MTree s (tToBTree t) []
+
+tToBTree :: Tree Room -> MetaTree Room
+tToBTree (Node r ts) = BTree (_rmName r) r $ map tToBTree ts
 
 toClusterLabel :: Int -> String ->  Room -> Maybe ([String],Room)
 toClusterLabel i s rm