Start to migrate all old level generation to MetaTrees

src/Dodge/Annotation.hs

@@ -7,7 +7,8 @@ module Dodge.Annotation
 import Dodge.UseAll
 import RandomHelp
 import Dodge.Tree
-import Dodge.Room
+import Dodge.Tree.Compose
+--import Dodge.Room
 import Dodge.Data
 import Dodge.Annotation.Data
 import LensHelp
@@ -15,44 +16,17 @@ import LensHelp
 --import Control.Lens
 import Data.Maybe
 
-{- | Add one corridor between each parent-child link of a tree of annotations.  -}
---padWithCorridors :: Annotation -> Annotation
---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')
-
-annoToRoomTree' :: Annotation -> State (StdGen,Int) (MetaTree Room)
-annoToRoomTree' an = case an of
+annoToRoomTree :: Annotation -> State (StdGen,Int) (MetaTree Room)
+annoToRoomTree an = case an of
     SpecificRoom r -> zoom _1 r 
     OnwardList ans -> do
-        mts <- mapM annoToRoomTree' ans
+        mts <- mapM annoToRoomTree ans
         return $ foldr1 attachOnward mts
     IntAnno f -> do 
         (g,i) <- get
         put (g,i+1)
-        annoToRoomTree' (f i)
-    PadWith r an -> annoToRoomTree' an
+        annoToRoomTree (f i)
+    ModifyTree f a -> f <$> annoToRoomTree a
     PassthroughLockKeyLists ls ks i -> zoom _1 $ do
         (functionlockroom,randomitemidentity) <- takeOne ls
         lr <- functionlockroom i
@@ -62,7 +36,3 @@ annoToRoomTree' an = case an of
             (MTree "" lr [MBranch "" (toLabel' i) keyroom])
             []
 
-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]