From eeec9248bb2d23a275fe8bfd077e8b0e77360d77 Mon Sep 17 00:00:00 2001
From: justin <justin.g.kruger@gmail.com>
Date: Sun, 12 Jun 2022 14:37:56 +0100
Subject: [PATCH] Continue work on generation annotations

---
 src/Dodge/Annotation.hs      | 24 ++++++++++++++++++------
 src/Dodge/Annotation/Data.hs |  3 ++-
 src/Dodge/Floor.hs           |  8 ++++----
 src/Dodge/LevelGen.hs        |  2 +-
 4 files changed, 25 insertions(+), 12 deletions(-)

diff --git a/src/Dodge/Annotation.hs b/src/Dodge/Annotation.hs
index 65067a9e0..d4b4ae787 100644
--- a/src/Dodge/Annotation.hs
+++ b/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 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
-    SpecificRoom r -> r
-    PadWith r an -> annoToRoomTree an
-    IntAnno i f -> annoToRoomTree $ f i
+    IntAnno' f -> do 
+        (g,i) <- get
+        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
diff --git a/src/Dodge/Annotation/Data.hs b/src/Dodge/Annotation/Data.hs
index 6eaeb770c..2044fe1a4 100644
--- a/src/Dodge/Annotation/Data.hs
+++ b/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))
diff --git a/src/Dodge/Floor.hs b/src/Dodge/Floor.hs
index aaaa447de..f1d82b12e 100644
--- a/src/Dodge/Floor.hs
+++ b/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 = annoToRoomTree initialAnoTree
+initialRoomTree :: State (StdGen,Int) (MetaTree Room)
+initialRoomTree = annoToRoomTree' initialAnoTree
diff --git a/src/Dodge/LevelGen.hs b/src/Dodge/LevelGen.hs
index 5423da275..dc29b42cc 100644
--- a/src/Dodge/LevelGen.hs
+++ b/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)