Start to migrate all old level generation to MetaTrees

src/Dodge/Tree/Compose.hs

@@ -9,6 +9,7 @@ module Dodge.Tree.Compose
     --, changeTo
     --, applyToCompRoot
     passUntiluseAll  -- this should be moved, and the dependency on Dodge.Data removed
+    , tToBTree
     , overwriteLabel
     , composeTree
     , composeTree'
@@ -16,8 +17,11 @@ module Dodge.Tree.Compose
     , attachTree
     , composeTreeRand
     , composeAndLog
+    , toOnward'
+    , attachOnward
 --    , cmpToMT
 --    , compTree
+    , module Dodge.Tree.Compose.Data
     ) where
 import Dodge.Data
 import Dodge.Tree.Compose.Data
@@ -179,15 +183,23 @@ composeAndLog dolog mt = case mt of
     MTree{} -> do
         dolog $ drawTree $ logMT mt
         rt <- composeAndLog dolog $ _mtTree mt
-        brs <- mapM (\mb -> (_mbAttach mb,) <$> (composeAndSubLog dolog) (_mbTree mb)) $ _mtBranches mt
+        brs <- mapM (\mb -> (_mbAttach mb,) <$> composeAndSubLog dolog (_mbTree mb)) $ _mtBranches mt
         return $ attachList rt $ map pure brs
     BTree{} -> do
         dolog $ drawTree $ logMT mt
         brs <- mapM (composeAndSubLog dolog) $ _btBranches mt
         return $ Node (_btValue mt) brs
 
-cmpToMT :: Tree (a-> Maybe (b,a), Tree a) -> MetaTree a
-cmpToMT (Node (_,t) ts) = MTree "A" (tToBT t) (map tToMB ts)
-  where
-    tToMB (Node (f,t') ts') = MBranch "C" (fmap snd . f) $ MTree "D" (tToBT t') (map tToMB ts')
-    tToBT (Node x xs) = BTree "B" x $ map tToBT xs
+tToBTree :: Tree Room -> MetaTree Room
+tToBTree (Node r ts) = BTree (_rmName r) r $ map tToBTree ts
+
+attachOnward :: MetaTree Room -> MetaTree Room -> MetaTree Room
+attachOnward t1 t2 = case t1 of
+    MTree {} -> t1 & mtBranches .:~ MBranch "Onward" toOnward' t2
+    BTree {} -> MTree "ConstructedOnward" t1 [MBranch "Onward" toOnward' t2]
+
+toOnward' :: Room -> Maybe Room
+toOnward' rm
+    | OnwardCluster `elem` rm ^?! rmClusterStatus . csLinks 
+        = Just (rm & rmClusterStatus . csLinks . at OnwardCluster .~ Nothing)
+    | otherwise = Nothing