Start to migrate all old level generation to MetaTrees

src/Dodge/Room/GlassLesson.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE TupleSections #-}
+--{-# LANGUAGE TupleSections #-}
 module Dodge.Room.GlassLesson where
 import Dodge.UseAll
 import Dodge.RoomLink
@@ -54,6 +54,6 @@ glassLesson = do
             ]
         ]
 glassLessonRunPast :: RandomGen g => State g (MetaTree Room)
-glassLessonRunPast = (f <$> glassLesson) >>= rToOnward "glassLessonRunPast"
+glassLessonRunPast = glassLesson >>= rToOnward "glassLessonRunPast" . f
   where
     f (Node r rs) = Node r $ return (cleatLabel 0 $ door & rmConnectsTo .~ S.member (OnEdge West)) : rs

src/Dodge/Room/Room.hs

@@ -192,7 +192,7 @@ weaponEmptyRoom = do
         $ restrictRMInLinksPD f (roomRect w h 2 2 & rmPmnts .~ plmnts)
     return $ treeFromTrunk [ corridor] (pure $ cleatOnward rm )
      
-weaponUnderCrits :: RandomGen g => Int -> State g (LabTree Room)
+weaponUnderCrits :: RandomGen g => Int -> State g (MetaTree Room)
 weaponUnderCrits i = do
     let plmnts = 
             [--sPS (V2 20 0)   0 $ RandPS randFirstWeapon
@@ -211,19 +211,7 @@ weaponUnderCrits i = do
     junctionRoom <- takeOne [ tEast, tWest]
     let thetree = treeFromTrunk [ corridorN , corridorN] 
             $ Node junctionRoom [continuationRoom ,pure deadEndRoom' ]
-    return (toOnward "weaponUnderCrits" , thetree  )
--- TODO addSubmessages
-
---composingNodeName :: ComposingNode Room -> TreeSubLabelling
---composingNodeName cn = case cn of
---      rm -> f $ _rmName rm ++ "-"
---    SplitDown rm -> f $ _rmName rm ++ "-SplitDown"
---    useAll    rm -> f $ _rmName rm ++ "-useAll"
---    UseSome   is rm -> f $ _rmName rm ++ "-" ++ show is ++ "-UseSome"
---    UseNone   rm -> f $ _rmName rm ++ "-UseNone"
---    useLabel  i rm -> f $ _rmName rm ++ "-" ++ show i ++ "-useLabel"
---  where
---    f str = TreeSubLabelling str Nothing
+    rToOnward "weaponUnderCrits" thetree
 
 weaponBehindPillar :: RandomGen g => State g (Tree Room)
 weaponBehindPillar  = do
@@ -291,16 +279,14 @@ deadEndRoom = defaultRoom
   where 
     lnks = [(V2 0 30  ,0) ]
 {- A random Either tree with a weapon and melee monster challenge.  -}
-weaponRoom :: RandomGen g => Int -> State g (LabTree Room)
+weaponRoom :: RandomGen g => Int -> State g (MetaTree Room)
 weaponRoom i = join $ takeOne 
-    [ weaponEmptyRoom       <&>  f "weaponEmptyRoom"
+    [ weaponEmptyRoom       >>= rToOnward "weaponEmptyRoom"
     , weaponUnderCrits i
-    , weaponBehindPillar    <&>  f "weaponBehindPillar"
-    , weaponBetweenPillars  <&>  f "weaponBetweenPillars"
-    , weaponLongCorridor    <&>  f "weaponLongCorridor"
+    , weaponBehindPillar    >>= rToOnward "weaponBehindPillar"
+    , weaponBetweenPillars  >>= rToOnward "weaponBetweenPillars"
+    , weaponLongCorridor    >>= rToOnward "weaponLongCorridor"
     ]
-  where
-    f str = ( toOnward str ,)
 
 roomCCrits :: RandomGen g => State g Room
 roomCCrits = roomC 200 200

src/Dodge/Room/RunPast.hs

@@ -43,8 +43,8 @@ roomCritLS = do
 smallRoom :: Room
 smallRoom = corridorWallN & rmRandPSs .~ [psRandRanges (15,25) (30,45) (pi,2*pi)]
 
-runPastRoom :: RandomGen g => Int -> State g (Tree Room)
-runPastRoom i = do
+lookedStart :: RandomGen g => Int -> State g (Tree Room)
+lookedStart i = do
     h           <- state $ randomR (200,400::Float)
     thels       <- roomCritLS
     theweapon   <- randBlockBreakWeapon

src/Dodge/Room/Start.hs

@@ -71,10 +71,8 @@ randomChallenges = shootingRange
 runPastStart :: RandomGen g => Int -> State g (Tree Room)
 runPastStart i = do
     s <- rezBoxStart
-    rp <- runPastRoom i
-    --return $ s `passUntiluseAll` [rp]
+    rp <- lookedStart i
     return . shiftChildren $ attachTree toOnward' rp $ fmap ([],) s
---    return . shiftChildren $ attachTree toOnward' (pure $ useAll corridor) $ fmap ([],) s
     
 
 rezBoxStart :: RandomGen g => State g (Tree Room)
@@ -82,18 +80,17 @@ rezBoxStart = do
     ls <- rezColor
     return $ treePost [ rezBox ls, cleatOnward door ]
 
-rezBoxesThenWeaponRoom :: RandomGen g => Int -> State g (Tree Room,String)
+rezBoxesThenWeaponRoom :: RandomGen g => Int -> State g (MetaTree Room)
 rezBoxesThenWeaponRoom i = do
     rboxes <- rezBoxes
-    wroom  <- snd <$> weaponRoom i
-    return (rboxes `passUntiluseAll` [wroom] , "rezBoxesThenWeaponRoom " ++ show i)
+    wroom  <- weaponRoom i
+    return $ MTree "rezBoxesThenWeaponRoom" (tToBTree rboxes) [MBranch "" toOnward' wroom]
 
 rezBoxThenWeaponRoom :: RandomGen g => Int -> State g (MetaTree Room)
 rezBoxThenWeaponRoom i = do
     rcol <- rezColor
-    (_,wroom) <- weaponRoom i
-    rToOnward ("rezBoxThenWeaponRoom "++ show i)
-        $ treeFromTrunk [ rezBox rcol, door] wroom
+    wroom <- weaponRoom i
+    return $ tToBTree (treePost [ rezBox rcol, cleatOnward door]) `attachOnward` wroom
 
 rezBoxThenRoom :: RandomGen g => Room -> State g (Tree Room)
 rezBoxThenRoom r = do