Simplify layout Annotations

src/Dodge/Floor.hs

@@ -4,6 +4,7 @@ module Dodge.Floor (
     tutRoomTree,
 ) where
 
+import Dodge.Annotation.Data
 import Dodge.Room.Tutorial
 import Data.List (intersperse)
 import Dodge.Annotation
@@ -18,11 +19,11 @@ import LensHelp
 import RandomHelp
 
 -- | A test level tree.
-initialRoomTree :: State (StdGen, Int) (MetaTree Room String)
+initialRoomTree :: State LayoutVars (MetaTree Room String)
 initialRoomTree = annoToRoomTree initialAnoTree
 --initialRoomTree = annoToRoomTree startWorldTreeTest
 
-tutRoomTree :: State (StdGen, Int) (MetaTree Room String)
+tutRoomTree :: State LayoutVars (MetaTree Room String)
 tutRoomTree = annoToRoomTree tutAnoTree
 
 --startWorldTreeTest :: Annotation
@@ -35,15 +36,15 @@ initialAnoTree :: Annotation
 initialAnoTree =
     OnwardList $
         intersperse
-            (AnTree corDoor)
-            [ IntAnno $ AnTree . startRoom
-            , IntAnno $
+            (AnTree $ zoom lyGen corDoor)
+            [ AnTree $ intAnno startRoom
+            , --IntAnno $
                 PassthroughLockKeyLists
                     [(sensorRoomRunPast ElectricSensor, takeOne 
                         [-- CRAFT (ENERGYBALLCRAFT TeslaBall) , 
                         HELD SPARKGUN])]
                     itemRooms
-            , IntAnno $ AnTree . lasSensorTurretTest
+            , AnTree $ intAnno lasSensorTurretTest
             , --    , AnRoom $ tanksRoom [] [] <&> rmPmnts .~ []
               --    , AnRoom $ tanksRoom [] []
               --    , AnRoom $ roomCCrits 0
@@ -62,8 +63,8 @@ initialAnoTree =
               --    , AnTree $ tToBTree "spawners" <$> spawnerRoom
               --    , AnRoom pistolerRoom
               --    , AnRoom doubleCorridorBarrels
-              IntAnno $ PassthroughLockKeyLists keyCardRunPastRand itemRooms
-            , IntAnno $ AnTree . warningRooms "INVISIBLE CREATURE AHEAD"
+              PassthroughLockKeyLists keyCardRunPastRand itemRooms
+            , AnTree . intAnno $ warningRooms "INVISIBLE CREATURE AHEAD"
             , AnTree $
                 rToOnward "chaseCrit+armourChaseCrit rectRoom" $
                     return . cleatOnward $
@@ -71,11 +72,12 @@ initialAnoTree =
                             .++~ [ psPtPl anyUnusedSpot (PutCrit invisibleChaseCrit)
                                  , psPtPl anyUnusedSpot (PutCrit armourChaseCrit)
                                  ]
-            , IntAnno $ AnTree . fmap (tToBTree "healthTest") . healthTest
-            , AnTree (tanksRoom [] [] >>= rToOnward "empty tanksRoom" . pure . cleatOnward)
-            , IntAnno $ PassthroughLockKeyLists lockRoomKeyItems itemRooms
+            , AnTree . intAnno $ fmap (tToBTree "healthTest") . healthTest
+            , AnTree . zoom lyGen $ 
+                (tanksRoom [] [] >>= rToOnward "empty tanksRoom" . pure . cleatOnward)
+            ,  PassthroughLockKeyLists lockRoomKeyItems itemRooms
             , AnTree randomChallenges
-            , IntAnno $ AnTree . lasSensorTurretTest
+            , AnTree $ intAnno lasSensorTurretTest
             , --    ,[AnTree $ fmap pure roomCCrits]
               --    ,[AirlockAno]
               --    ,[Corridor]
@@ -119,5 +121,11 @@ initialAnoTree =
               AnTree $ randomFourCornerRoom [] >>= rToOnward "randomFourCornerRoom" . pure . cleatOnward
             ]
 
-anRoom :: StateT StdGen Identity Room -> Annotation
-anRoom t = AnTree $ tToBTree "anRoom" . return . cleatOnward <$> t
+intAnno :: (Int -> State StdGen MTRS) -> State LayoutVars MTRS
+intAnno f = do
+    LayVars g i <- get
+    put $ LayVars g (i+1)
+    zoom lyGen (f i)
+
+anRoom :: State StdGen Room -> Annotation
+anRoom t = AnTree $ zoom lyGen $ (tToBTree "anRoom" . return . cleatOnward <$> t)