Continue work on generation annotations

src/Dodge/Annotation.hs

@@ -42,14 +42,26 @@ import LensHelp
 --    xs' <- mapM randomPadCorridors xs
 --    return $ treeFromTrunk (replicate n [Corridor]) (Node x xs')
 
-annoToRoomTree :: Annotation -> State StdGen (MetaTree Room)
+annoToRoomTree' :: Annotation -> State (StdGen,Int) (MetaTree Room)
-annoToRoomTree an = case an of
+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
-    SpecificRoom r -> r
+    IntAnno' f -> do 
-    PadWith r an -> annoToRoomTree an
+        (g,i) <- get
-    IntAnno i f -> annoToRoomTree $ f i
+        put (g,i+1)
+        annoToRoomTree' (f i)
+    PadWith r an -> annoToRoomTree' an
+
+--annoToRoomTree :: Annotation -> State StdGen (MetaTree Room)
+--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
 
 attachOnward :: MetaTree Room -> MetaTree Room -> MetaTree Room
 attachOnward t1 t2 = case t1 of

src/Dodge/Annotation/Data.hs

@@ -14,7 +14,8 @@ data Annotation
 --    | AirlockAno
     PadWith Room Annotation
     | OnwardList [Annotation]
-    | IntAnno Int (Int -> Annotation)
+--    | IntAnno Int (Int -> Annotation)
+    | IntAnno' (Int -> Annotation)
 --    | OrAno [[Annotation]]
     | SpecificRoom (State StdGen (MetaTree Room))
     | AnoApplyInt Int (Int -> State StdGen (LabTree Room))

src/Dodge/Floor.hs

@@ -37,9 +37,9 @@ import RandomHelp
 
 initialAnoTree :: Annotation
 initialAnoTree = PadWith door $ OnwardList 
-    [ IntAnno 0 $ SpecificRoom . startRoom
+    [ IntAnno' $ SpecificRoom . startRoom
 --    , PassthroughLockKeyLists 2 keyCardRunPastRand itemRooms
-    , SpecificRoom $ warningRooms 1
+    , IntAnno' $ SpecificRoom . warningRooms
     , SpecificRoom $ rToOnward "chaseCrit+armourChaseCrit rectRoom"
         $ return . cleatOnward $ roomRectAutoLinks 400 400 & rmPmnts .++~ 
             [ spNoID anyUnusedSpot (PutCrit invisibleChaseCrit)
@@ -97,5 +97,5 @@ initialAnoTree = PadWith door $ OnwardList
     ]
 
 {- | A test level tree. -}
-initialRoomTree :: State StdGen (MetaTree Room)
+initialRoomTree :: State (StdGen,Int) (MetaTree Room)
-initialRoomTree = annoToRoomTree initialAnoTree
+initialRoomTree = annoToRoomTree' initialAnoTree

src/Dodge/LevelGen.hs

@@ -35,7 +35,7 @@ layoutLevelFromSeed i seed = do
     putStrLn $ "Generating level with seed " ++ show seed
     appendFile "log/attemptedSeeds" $ show seed ++ "\n"
     let g = mkStdGen seed
-    let treecluster = evalState initialRoomTree g
+    let treecluster = evalState initialRoomTree (g,0)
     tc <- composeAndLog $ treecluster
     ----    (strs,tc) = composeTree' treecluster
     ----appendFile "log/TreeCluster" ("Seed: "++ show seed)