Polymorphise meta tree labels

src/Dodge/Room/BlinkAcross.hs

@@ -34,7 +34,7 @@ import LensHelp
 import Control.Monad.State
 import System.Random
 
-blinkAcrossChallenge :: RandomGen g => State g (MetaTree Room)
+blinkAcrossChallenge :: RandomGen g => State g (MetaTree Room String)
 blinkAcrossChallenge = do
     teleFromRoom <- shuffleLinks $ roomRectAutoLinks 200 200
     teleToRoom  <- shuffleLinks $ roomRectAutoLinks 200 200

src/Dodge/Room/Containing.hs

@@ -15,7 +15,7 @@ import Geometry
 
 import Data.List
 
-roomsContaining :: RandomGen g => [Creature] -> [Item] -> State g (MetaTree Room)
+roomsContaining :: RandomGen g => [Creature] -> [Item] -> State g (MetaTree Room String)
 roomsContaining crs its = do
     endroom <- join $ takeOne
         [ randomFourCornerRoomCrsIts crs its 

src/Dodge/Room/GlassLesson.hs

@@ -1,6 +1,7 @@
 --{-# LANGUAGE TupleSections #-}
 module Dodge.Room.GlassLesson where
 import Dodge.UseAll
+import Dodge.Annotation.Data
 import Dodge.RoomLink
 import Dodge.Creature
 import Dodge.LevelGen.Data
@@ -53,7 +54,7 @@ glassLesson = do
             , mntLS vShape (V2 180 200) (V3 160 180 50)
             ]
         ]
-glassLessonRunPast :: RandomGen g => State g (MetaTree Room)
+glassLessonRunPast :: RandomGen g => State g MTRS
 glassLessonRunPast = glassLesson >>= rToOnward "glassLessonRunPast" . f
   where
     f (Node r rs) = Node r $ return (cleatLabel 0 $ door & rmConnectsTo .~ S.member (OnEdge West)) : rs

src/Dodge/Room/LasTurret.hs

@@ -71,7 +71,7 @@ lightSensByDoor outplid rm = rm
     covershape = rectNSEW 10 (-10) 20 (-20)
     sensorshift (p,a) = (p +.+ rotateV a (V2 60 (-20)), a)
 
-keyCardRoomRunPast :: RandomGen g => Int -> Int -> State g (MetaTree Room)
+keyCardRoomRunPast :: RandomGen g => Int -> Int -> State g (MetaTree Room String)
 keyCardRoomRunPast keyid rmid = do
     cenroom <- shuffleLinks $ keyCardAnalyserByDoor keyid rmid $ roomNgon 6 200
     let doorroom = triggerDoorRoom rmid
@@ -114,13 +114,13 @@ healthTest n = do
         , cleatOnward door
         ]
 
-lasSensorTurretTest :: RandomGen g => Int -> State g (MetaTree Room)
+lasSensorTurretTest :: RandomGen g => Int -> State g (MetaTree Room String)
 lasSensorTurretTest n = do
     cenroom <- shuffleLinks $ lightSensInsideDoor n cenLasTur
     rToOnward "lasSensorTurretTest" $ treePost 
         [ door, cenroom, triggerDoorRoom n, cleatOnward door]
 
-lasCenSensEdge :: RandomGen g => Int -> State g (MetaTree Room)
+lasCenSensEdge :: RandomGen g => Int -> State g (MetaTree Room String)
 lasCenSensEdge n = do
     cenroom <- shuffleLinks $ lightSensByDoor n cenLasTur
     let doorroom = triggerDoorRoom n
@@ -165,7 +165,7 @@ lasTunnel y = do
         ]
 
 -- a y value of 400 is probably "unrunnable"
-lasTunnelRunPast :: RandomGen g => Float -> State g (MetaTree Room)
+lasTunnelRunPast :: RandomGen g => Float -> State g (MetaTree Room String)
 lasTunnelRunPast y = do
     r <- lasTunnel y
     r1 <- takeOne [door,corridor]

src/Dodge/Room/LongDoor.hs

@@ -140,7 +140,7 @@ slowDoorRoom = do
     proom <- southPillarsRoom x y h
     addButtonSlowDoor x h (proom & rmPmnts %~ (++ (crits ++ barrels)))
 
-slowDoorRoomRunPast :: RandomGen g => State g (MetaTree Room)
+slowDoorRoomRunPast :: RandomGen g => State g (MetaTree Room String)
 slowDoorRoomRunPast = do
     r <- slowDoorRoom
     rToOnward "slowDoorRoomRunPast" $ treeFromTrunk [ door] $ Node r

src/Dodge/Room/LongRoom.hs

@@ -47,7 +47,7 @@ longRoom = do
                 | crx <- [12.5,37.5,62.5] ] ++
         [sPS (V2 25 lampy ) 0 putLamp | lampy <- [20,h-10] ]
 
-longRoomRunPast :: RandomGen g => State g (MetaTree Room)
+longRoomRunPast :: RandomGen g => State g (MetaTree Room String)
 longRoomRunPast = do
     r <- longRoom
     rToOnward "longRoomRunPast"

src/Dodge/Room/Room.hs

@@ -123,7 +123,7 @@ rot90Around cen p = cen +.+ vNormal (p -.- cen)
 -- So, the idea is to attach outer children to the bottommost right nodes
 -- inside an inner tree
 -- no idea what was going on here...
-roomMiniIntro :: RandomGen g => State g (MetaTree Room)
+roomMiniIntro :: RandomGen g => State g (MetaTree Room String)
 roomMiniIntro = do
     midroom <- join $ takeOne [miniTree2] --,glassLesson]
     rToOnward "roomMiniIntro" midroom
@@ -191,7 +191,7 @@ weaponEmptyRoom = do
         $ restrictRMInLinksPD f (roomRect w h 2 2 & rmPmnts .~ plmnts)
     return $ treeFromTrunk [ corridor] (pure $ cleatOnward rm )
      
-weaponUnderCrits :: RandomGen g => Int -> State g (MetaTree Room)
+weaponUnderCrits :: RandomGen g => Int -> State g (MetaTree Room String)
 weaponUnderCrits i = do
     let plmnts = 
             [--sPS (V2 20 0)   0 $ RandPS randFirstWeapon
@@ -278,7 +278,7 @@ deadEndRoom = defaultRoom
   where 
     lnks = [(V2 0 30  ,0) ]
 {- A random Either tree with a weapon and melee monster challenge.  -}
-weaponRoom :: RandomGen g => Int -> State g (MetaTree Room)
+weaponRoom :: RandomGen g => Int -> State g (MetaTree Room String)
 weaponRoom i = join $ takeOne 
     [ weaponEmptyRoom       >>= rToOnward "weaponEmptyRoom"
     , weaponUnderCrits i
@@ -381,7 +381,7 @@ pistolerRoom = pillarGrid
         ]
             ++)
 
-shootingRange :: RandomGen g => State g (MetaTree Room)
+shootingRange :: RandomGen g => State g (MetaTree Room String)
 shootingRange = do
     rm1 <- shootersRoom1 >>= shuffleLinks . restrictInLinks (\(V2 _ y,_) -> y < 40)
             . restrictOutLinks  (\(V2 _ y,r) -> y > 200 && r /= 0)

src/Dodge/Room/SensorDoor.hs

@@ -1,5 +1,6 @@
 --{-# LANGUAGE TupleSections #-}
 module Dodge.Room.SensorDoor where
+import Dodge.Annotation.Data
 import Dodge.UseAll
 import Dodge.LevelGen.Data
 import Dodge.PlacementSpot
@@ -56,7 +57,7 @@ sensorRoom senseType n = do
         p' = p +.+ rotateV d (V2 0 (negate 100))
         isclose = dist (_rlPos rl) p' < 30
 
-sensorRoomRunPast :: RandomGen g => DamageType -> Int -> State g (MetaTree Room)
+sensorRoomRunPast :: RandomGen g => DamageType -> Int -> State g MTRS
 sensorRoomRunPast dt n = do
     t <- sensorRoom dt n
     rToOnward "sensorRoomRunPast" $ t & applyToSubforest [0] 

src/Dodge/Room/Start.hs

@@ -48,7 +48,7 @@ powerFakeout = do
                 , keyholeCorridor, corridor])
         `treeFromPost` cleatOnward door
 
-startRoom :: RandomGen g => Int -> State g (MetaTree Room)
+startRoom :: RandomGen g => Int -> State g (MetaTree Room String)
 startRoom i = join (takeOne
     [-- (,) (0.5::Float) ((chainUses <$> sequence [powerFakeout,fmap fst $weaponRoom i]) 
      --       <&> (,TreeSubLabelling "chainUses <$> sequence [powerFakeout,weaponRoom i]" Nothing))
@@ -60,7 +60,7 @@ startRoom i = join (takeOne
 --    , startCrafts >>= roomsContaining' [] >>= rezBoxThenRooms
 --        >>= rToOnward "startCrafts >>= roomsContaining [] >>= rezBoxThenRooms"
     ])
-randomChallenges :: RandomGen g => State g (MetaTree Room)
+randomChallenges :: RandomGen g => State g (MetaTree Room String)
 randomChallenges = shootingRange
 --        join (takeOne
 --    [fmap (return . useAll) doubleCorridorBarrels <&> (,TreeSubLabelling "doubleCorridorBarrels" Nothing)
@@ -80,17 +80,17 @@ rezBoxStart = do
     ls <- rezColor
     return $ treePost [ rezBox ls, cleatOnward door ]
 
-rezBoxesThenWeaponRoom :: RandomGen g => Int -> State g (MetaTree Room)
+rezBoxesThenWeaponRoom :: RandomGen g => Int -> State g (MetaTree Room String)
 rezBoxesThenWeaponRoom i = do
     rboxes <- rezBoxes
     wroom  <- weaponRoom i
-    return $ tToBTree rboxes `attachOnward` wroom
+    return $ tToBTree "rboxes" rboxes `attachOnward` wroom
 
-rezBoxThenWeaponRoom :: RandomGen g => Int -> State g (MetaTree Room)
+rezBoxThenWeaponRoom :: RandomGen g => Int -> State g (MetaTree Room String)
 rezBoxThenWeaponRoom i = do
     rcol <- rezColor
     wroom <- weaponRoom i
-    return $ tToBTree (treePost [rezBox rcol, cleatOnward door]) `attachOnward` wroom
+    return $ tToBTree "rezbox" (treePost [rezBox rcol, cleatOnward door]) `attachOnward` wroom
 
 rezBoxThenRoom :: RandomGen g => Room -> State g (Tree Room)
 rezBoxThenRoom r = do

src/Dodge/Room/Warning.hs

@@ -37,7 +37,7 @@ import qualified Data.Map.Strict as M
 --import qualified Data.Text as T
 
 
-warningRooms :: RandomGen g => Int -> State g (MetaTree Room)
+warningRooms :: RandomGen g => Int -> State g (MetaTree Room String)
 warningRooms n = do
     rm <- takeOne [roomNgon 8 200, roomRectAutoLinks 200 200]
     cenroom <- shuffleLinks $ addWarningTerminal n rm