Fold in new composing room datatype

src/Dodge/Annotation.hs

@@ -35,12 +35,12 @@ randomPadCorridors  (Node x xs) = do
     xs' <- mapM randomPadCorridors xs
     return $ treeFromTrunk (replicate n [Corridor]) (Node x xs')
 {- | Add a corridor to a random out-link of a room.  -}
-roomThenCorridor :: RandomGen g => Room -> State g (Tree (Either Room Room))
+roomThenCorridor :: RandomGen g => Room -> State g (SubCompTree Room)
-roomThenCorridor theRoom = fmap (\r -> Node (Left theRoom) [(pure . Right) r]) 
+roomThenCorridor theRoom = fmap (\r -> Node (PassDown theRoom) [(pure . UseAll) r]) 
                                 (randomiseOutLinks corridor)
 
 {- | Create a random room tree structure from a list of annotations.  -}
-anoToRoomTree :: RandomGen g => [Annotation g] -> State g (Tree (Either Room Room))
+anoToRoomTree :: RandomGen g => [Annotation g] -> State g (SubCompTree Room)
 anoToRoomTree anos = case anos of
     [AnoApplyInt i f] -> f i
     [SetLabel i randrm] -> do
@@ -55,19 +55,19 @@ anoToRoomTree anos = case anos of
     [OrAno as] -> do
         a <- takeOne as
         anoToRoomTree a
-    [Corridor] -> pure . Right <$> randomiseOutLinks corridor
+    [Corridor] -> pure . UseAll <$> randomiseOutLinks corridor
     [AirlockAno] -> airlock >>=  roomThenCorridor
     [FirstWeapon] -> do
         branchWP <- branchRectWith weaponRoom
         blockedC <- longBlockedCorridor
         join $ takeOne $ return (appendEitherTree branchWP [blockedC]) : replicate 5 weaponRoom
-    [EndRoom] -> fmap (pure . Right) (telRoomLev 1)
+    [EndRoom] -> fmap (pure . UseAll) (telRoomLev 1)
     (SpecificRoom rt:_) -> rt
     (BossAno cr : _) -> do
         br <- bossRoom cr
-        branchRectWith . pure . fmap Left $ treeFromPost [corridor,corridor] br
+        branchRectWith . pure . fmap PassDown $ treeFromPost [corridor,corridor] br
-    (TreasureAno crs loot : _) -> branchRectWith . fmap (pure . Left) $ lootRoom crs loot
+    (TreasureAno crs loot : _) -> branchRectWith . fmap (pure . PassDown) $ lootRoom crs loot
     _ -> do
         w <- state $ randomR (100,400)
         h <- state $ randomR (200,400)
-        fmap (pure . Right) . randomiseOutLinks $ roomRectAutoLinks w h
+        fmap (pure . UseAll) . randomiseOutLinks $ roomRectAutoLinks w h

src/Dodge/Annotation/Data.hs

@@ -3,6 +3,7 @@
 module Dodge.Annotation.Data where
 import Dodge.Data
 import Dodge.Room
+import Dodge.Tree.Compose.Data
 
 import Data.Tree
 import Control.Monad.State
@@ -15,10 +16,10 @@ data Annotation g
     | FirstWeapon
     | EndRoom
     | OrAno [[Annotation g]]
-    | SpecificRoom (State g (Tree (Either Room Room)))
+    | SpecificRoom (State g (SubCompTree Room))
     | BossAno Creature
     | TreasureAno [Creature] [Item]
-    | AnoApplyInt Int (Int -> State g (Tree (Either Room Room)))
+    | AnoApplyInt Int (Int -> State g (SubCompTree Room))
     | SetLabel Int (State g Room)
     | UseLabel Int (State g Room)
     | ChainAnos [[Annotation g]]

src/Dodge/Floor.hs

@@ -53,23 +53,23 @@ initialAnoTree = padSucWithCorridors $ treeFromTrunk
 --    ,[Corridor]
 ------    ,[SpecificRoom roomCCrits]
 ------    ,[Corridor]
-------    ,[SpecificRoom . pure . pure . Right $ roomGlassOctogon 400 
+------    ,[SpecificRoom . pure . pure . UseAll $ roomGlassOctogon 400 
 ------        & rmPS %~ ([sPS (V2 0 50) 0 $ PutCrit armourChaseCrit 
 ------                    ,sPS (V2 50 25) 0 $ PutCrit armourChaseCrit 
 ------                    ,sPS (V2 50 0) 0 $ PutCrit armourChaseCrit 
 ------                    ]++)
 ------     ]
-------    --,[SpecificRoom . pure . pure . Right $ roomGlassOctogon 400 
+------    --,[SpecificRoom . pure . pure . UseAll $ roomGlassOctogon 400 
 ------    --    & rmPS %~ ([swarmPS 0 (x,y) 0 swarmCrit | x <- [-20,-19.5.. 20] , y <- [200,202] ]++)
 ------    -- ]
-------    ,[SpecificRoom . pure . pure . Right $ roomGlassOctogon 400 
+------    ,[SpecificRoom . pure . pure . UseAll $ roomGlassOctogon 400 
 ------        & rmPS %~ ([sPS (V2 0 50) 0 $ PutCrit pistolCrit ]++)
 ------     ]
 ------    ,[Corridor]
-----    --,[SpecificRoom $ pure . Right <$> twinSlowDoorChasers]
+----    --,[SpecificRoom $ pure . UseAll <$> twinSlowDoorChasers]
------    ,[SpecificRoom $ pure $ (pure . Right) (twinSlowDoorRoom 80 200 40)]
+-----    ,[SpecificRoom $ pure $ (pure . UseAll) (twinSlowDoorRoom 80 200 40)]
 -----    ,[DoorAno]
------    ,[SpecificRoom $ pure . Right <$> centerVaultExplosiveExit]
+-----    ,[SpecificRoom $ pure . UseAll <$> centerVaultExplosiveExit]
 -----    ,[SpecificRoom blockedCorridor]
 -----    ,[OrAno [[DoorAno]
 -----            ,[Corridor]
@@ -77,18 +77,18 @@ initialAnoTree = padSucWithCorridors $ treeFromTrunk
 -----            ]
 -----    ,[FirstWeapon]
 -----    ,[CorridorDebug]
------    ,[SpecificRoom $ fmap (pure . Right) randomFourCornerRoom]
+-----    ,[SpecificRoom $ fmap (pure . UseAll) randomFourCornerRoom]
 --    ,[OrAno 
---        [[SpecificRoom $ branchRectWith $ fmap (fmap Left) armouredChasers]
+--        [[SpecificRoom $ branchRectWith $ fmap (fmap PassDown) armouredChasers]
 --        ,[BossAno $ addArmour launcherCrit & crHP +~ 800
 --            & crState . crDropsOnDeath .~ DropSpecific [0] ]
 --        ]
 --     ]
-----    ,[SpecificRoom $ fmap (pure . Right) armouredCorridor]
+----    ,[SpecificRoom $ fmap (pure . UseAll) armouredCorridor]
 --    ,[Corridor]
 --    ,[TreasureAno [addArmour autoCrit,addArmour autoCrit] [launcher]]
     ] 
-    $ treeFromPost [[Corridor,SpecificRoom $ fmap (pure . Right) randomFourCornerRoom]] 
+    $ treeFromPost [[Corridor,SpecificRoom $ fmap (pure . UseAll) randomFourCornerRoom]] 
                                 [EndRoom]
 
 {- | A test level tree. -}

src/Dodge/Room/Branch.hs

@@ -15,14 +15,13 @@ import Control.Monad.State
 import System.Random
 import Data.Tree
 
-branchRectWith :: RandomGen g => State g (Tree (Either Room Room)) ->  State g (Tree (Either Room Room))
+branchRectWith :: RandomGen g => State g (SubCompTree Room) ->  State g (SubCompTree Room)
 branchRectWith t = do
     x <- state $ randomR (100,200)
     y <- state $ randomR (100,200)
     b <- t
     root <- randomiseOutLinks $ roomRectAutoLinks x y
-    return $ Node (Left root) [Node (Right door) [], rToL <$> treeFromTrunk [Left door] b]
+    return $ Node (PassDown root) [Node (UseAll door) [], rToL <$> treeFromTrunk [PassDown door] b]
   where 
-    rToL :: Either a a -> Either a a
+    rToL (UseAll r) = PassDown r
-    rToL (Right r) = Left r
+    rToL (PassDown r)  = PassDown r
-    rToL (Left r)  = Left r

src/Dodge/Room/RoadBlock.hs

@@ -53,25 +53,25 @@ litCorridor90 = do
         }
 
 -- | A random length corridor with a destructible block blocking it.
-longBlockedCorridor :: RandomGen g => State g (Tree (Either Room Room))
+longBlockedCorridor :: RandomGen g => State g (SubCompTree Room)
 longBlockedCorridor = do
     r <- state $ randomR (0,pi)
     n <- state $ randomR (0,3)
     let plmnts = [sPS (V2 20 40) r $ dirtPoly $ square 10
                  ,sPS (V2 20 15) 0 putLamp
                  ]
-    sequence $ treeFromPost (replicate n $ Left <$> randomiseOutLinks corridor) 
+    sequence $ treeFromPost (replicate n $ PassDown <$> randomiseOutLinks corridor) 
-                        $ return $ Right $ set rmPmnts plmnts corridor
+                        $ return $ UseAll $ set rmPmnts plmnts corridor
 
 -- | A single corridor with a destructible block blocking it.
-blockedCorridor :: RandomGen g => State g (Tree (Either Room Room))
+blockedCorridor :: RandomGen g => State g (SubCompTree Room)
 blockedCorridor = do
     r <- state $ randomR (0,pi)
     let plmnts = 
             [sPS (V2 20 40) r $ dirtPoly $ square 10
             ,spanLightI (V2 0 15) (V2 40 15)
             ]
-    sequence $ treeFromPost [] $ return $ Right $ set rmPmnts plmnts corridor
+    sequence $ treeFromPost [] $ return $ UseAll $ set rmPmnts plmnts corridor
 
 dirtPoly :: [Point2] -> PSType
 dirtPoly = PutBlock DirtBlock [1] dirtWall . reverse

src/Dodge/Room/Room.hs

@@ -63,21 +63,21 @@ roomPillars = over rmLinks init $ set rmPmnts plmnts $ roomRect 240 240 2 2
     f a x b y = putBlockRect a x b y
     g a b c d = f a b a b ++ f a b c d ++ f c d a b ++ f c d c d
 
-branchWith :: Room -> [Tree Room] -> Tree (Either Room Room)
+branchWith :: Room -> [Tree Room] -> SubCompTree Room
-branchWith r ts = Node (Left r) $ return (Right door) : fmap (fmap Left) ts
+branchWith r ts = Node (PassDown r) $ return (UseAll door) : fmap (fmap PassDown) ts
 
 
-manyDoors :: Int -> Tree (Either Room Room)
+manyDoors :: Int -> SubCompTree Room
-manyDoors i = treeFromPost (replicate i (Left door)) $ Right door
+manyDoors i = treeFromPost (replicate i (PassDown door)) $ UseAll door
 
 -- TODO: partially combine a room tree into a room
-glassLesson :: RandomGen g => State g (Tree (Either Room Room))
+glassLesson :: RandomGen g => State g (SubCompTree Room)
 glassLesson = do
     i <- takeOne [1,2,3]
-    corridors <- replicateM i $ Left <$> randomiseOutLinks corridor
+    corridors <- replicateM i $ PassDown <$> randomiseOutLinks corridor
-    return $ Node (Left botRoom) [deadRoom door,uppers, treeFromPost (Left door : corridors) $ Right door]
+    return $ Node (PassDown botRoom) [singleUseNone door,uppers, treeFromPost (PassDown door : corridors) $ UseAll door]
   where 
-    uppers = Node (Left door) [deadRoom topRoom]
+    uppers = Node (PassDown door) [deadRoom topRoom]
     botRoom = set rmPmnts botplmnts $ roomRect 200 200 1 1
     topRoom = set rmPmnts topplmnts $ roomRect 200 200 1 1
     botplmnts = 
@@ -136,13 +136,13 @@ glassSwitchBackCrits = glassSwitchBack
                 , spNoID (PSRoomRand 1) randC1
                 ] ++)
 
-miniTree2 :: RandomGen g => State g (Tree (Either Room Room))
+miniTree2 :: RandomGen g => State g (SubCompTree Room)
 miniTree2 = glassSwitchBackCrits 
     >>= randomiseOutLinks 
     >>= changeLinkTo (\p -> (sndV2 . fst) p < 70) 
     <&> flip branchWith (replicate 3 $ treeFromPost [door,corridor] critInDeadEnd)
 
-miniRoom3 :: RandomGen g => State g (Tree (Either Room Room))
+miniRoom3 :: RandomGen g => State g (SubCompTree Room)
 miniRoom3 = do
         w <- state $ randomR (300,400)
         h <- state $ randomR (300,400)
@@ -178,17 +178,17 @@ rot90Around cen p = cen +.+ vNormal (p -.- cen)
 
 -- So, the idea is to attach outer children to the bottommost right nodes
 -- inside an inner tree
-roomMiniIntro :: RandomGen g => State g (Tree (Either Room Room))
+roomMiniIntro :: RandomGen g => State g (SubCompTree Room)
 roomMiniIntro = fmap (g . expandTreeBy f) $ sequence $ treeFromPost
     [return $ connectRoom door
     ,join $ takeOne [miniTree2,glassLesson]
     ]
     $ connectRoom <$> randomiseOutLinks corridor
   where 
-    f (Node (Right x) xs) = Node (Right (Right x)) $ map f xs
+    f (Node (UseAll x) xs) = Node (UseAll (UseAll x)) $ map f xs
-    f (Node (Left x) xs) = Node (Left (Left x)) $ map f xs
+    f (Node (PassDown x) xs) = Node (PassDown (PassDown x)) $ map f xs
-    g (Node (Right x) []) = Node (Right x) []
+    g (Node (UseAll x) []) = Node (UseAll x) []
-    g (Node (Right x) xs) = Node (Left x) $ map g xs
+    g (Node (UseAll x) xs) = Node (PassDown x) $ map g xs
     g (Node y ys) = Node y $ map g ys
 
 roomCenterPillar :: RandomGen g => State g Room
@@ -260,7 +260,7 @@ randFirstWeapon = do
         ++ [launcher]
 
 
-weaponEmptyRoom :: RandomGen g => State g (Tree (Either Room Room))
+weaponEmptyRoom :: RandomGen g => State g (SubCompTree Room)
 weaponEmptyRoom = do
     w <- state $ randomR (220,300)
     h <- state $ randomR (220,300)
@@ -271,12 +271,12 @@ weaponEmptyRoom = do
             --,sPS (V2 (w/2) (h/2))      0 putLamp
             ,mntLightLnkCond unusedLnkToPS
             ]
-    treeFromTrunk [Left corridor] 
+    treeFromTrunk [PassDown corridor] 
         <$> ((fmap connectRoom . randomiseOutLinks) =<< 
         changeLinkTo ((\p -> dist p (V2 (w/2) 0) < 10) . fst) (set rmPmnts plmnts $ roomRect w h 2 2)
         )
      
-weaponUnderCrits :: RandomGen g => State g (Tree (Either Room Room))
+weaponUnderCrits :: RandomGen g => State g (SubCompTree Room)
 weaponUnderCrits = do
     let plmnts = 
             [sPS (V2 20 0)   0 $ RandPS randFirstWeapon
@@ -284,18 +284,18 @@ weaponUnderCrits = do
             ,sPS (V2 20 20) (negate $ pi/2) randC1
             ]
     let continuationRoom = treeFromTrunk 
-            [Left corridorN,Left corridorN] 
+            [PassDown corridorN,PassDown corridorN] 
             (connectRoom (set rmPmnts plmnts corridorN))
     rcp <- roomCenterPillar
     deadEndRoom' <- takeOne [roomPillars,rcp]
-    junctionRoom <- takeOne [Left tEast,Left tWest]
+    junctionRoom <- takeOne [PassDown tEast,PassDown tWest]
-    return $ treeFromTrunk [Left corridorN,Left corridorN] 
+    return $ treeFromTrunk [PassDown corridorN,PassDown corridorN] 
                        $ Node junctionRoom
                               [continuationRoom
                               ,deadRoom deadEndRoom'
                               ]
 
-weaponBehindPillar :: RandomGen g => State g (Tree (Either Room Room))
+weaponBehindPillar :: RandomGen g => State g (SubCompTree Room)
 weaponBehindPillar  = do
     wpa  <- state $ randomR (0,pi)
     wpos <- takeOne [V2 120 160,V2 80 40,V2 160 40,V2 220 200,V2 40 200,V2 120 35]
@@ -307,12 +307,12 @@ weaponBehindPillar  = do
           ]
     rcp <- roomCenterPillar
     return $ treeFromTrunk 
-      [Left corridor
+      [PassDown corridor
-      ,Left $ over rmLinks tail $ over rmPmnts (++ plmnts1) rcp
+      ,PassDown $ over rmLinks tail $ over rmPmnts (++ plmnts1) rcp
       ]
       (connectRoom $ set rmPmnts [sPS (V2 20 60) (negate $ pi/2) randC1] corridorN)
 
-weaponBetweenPillars :: RandomGen g => State g (Tree (Either Room Room))
+weaponBetweenPillars :: RandomGen g => State g (SubCompTree Room)
 weaponBetweenPillars = do
     wpPos <- takeOne [V2 x y | x <- [20,120,220], y <- [20,120,220]]
     (ps,_) <- takeNMore 2 ([], [V2 x y | x <- [20,220], y <- [20,120,220]])
@@ -328,7 +328,7 @@ weaponBetweenPillars = do
   where 
     f (_,a) = a == 0
 
-weaponLongCorridor :: RandomGen g => State g (Tree (Either Room Room))
+weaponLongCorridor :: RandomGen g => State g (SubCompTree Room)
 weaponLongCorridor = do
     root <- takeOne [tEast, tWest]
     connectingRoom <- takeOne 
@@ -336,9 +336,9 @@ weaponLongCorridor = do
         ]
     i1 <- state $ randomR (2,5)
     i2 <- state $ randomR (2,5)
-    let branch1 = treeFromTrunk (replicate i1 $ Left corridorN) (connectRoom $ putCrs connectingRoom)
+    let branch1 = treeFromTrunk (replicate i1 $ PassDown corridorN) (connectRoom $ putCrs connectingRoom)
-    let branch2 = treeFromTrunk (replicate i2 $ Left corridorN) (deadRoom $ putWp corridor)
+    let branch2 = treeFromTrunk (replicate i2 $ PassDown corridorN) (deadRoom $ putWp corridor)
-    return $ Node (Left root) [branch1,branch2]
+    return $ Node (PassDown root) [branch1,branch2]
       where 
         putCrs = over rmPmnts (++ [sPS (V2 10 40) (-pi/2) randC1 ,sPS (V2 (-10) 40) (-pi/2) randC1 ])
         putWp = set rmPmnts [sPS (V2 20 60) 0 $ RandPS randFirstWeapon ,spanLightI (V2 0 40) (V2 40 40)]
@@ -358,7 +358,7 @@ deadEndRoom = defaultRoom
   where 
     lnks = [(V2 0 30  ,0) ]
 {- A random Either tree with a weapon and melee monster challenge.  -}
-weaponRoom :: RandomGen g => State g (Tree (Either Room Room))
+weaponRoom :: RandomGen g => State g (SubCompTree Room)
 weaponRoom = join $ takeOne 
     [ weaponEmptyRoom
     , weaponUnderCrits
@@ -487,7 +487,7 @@ pistolerRoom = pillarGrid
         ]
             ++)
 
-shootingRange :: RandomGen g => State g (Tree (Either Room Room))
+shootingRange :: RandomGen g => State g (SubCompTree Room)
 shootingRange = do
     rm1 <- shootersRoom1 >>= changeLinkTo (\(V2 _ y,_) -> y < 40)
                         >>= changeLinkFrom  (\(V2 _ y,r) -> y > 200 && r /= 0)
@@ -496,20 +496,20 @@ shootingRange = do
     rm3 <- shootersRoom >>= changeLinkTo (\(V2 x y,_) -> y < 10 && x > 20 && x < 180)
                         >>= changeLinkFrom  (\(_,r) -> r == 0)
     return $ treeFromPost 
-        [Left rm1
+        [PassDown rm1
-        ,Left $ roomPadCut (rectNSWE 40 (-40) (-80) 80) (V2 0 20)
+        ,PassDown $ roomPadCut (rectNSWE 40 (-40) (-80) 80) (V2 0 20)
             & rmPmnts %~ (spanLightI (V2 (-80) 10) (V2 80 10) :)
-        ,Left rm2
+        ,PassDown rm2
-        ,Left $ roomPadCut (rectNSWE 40 (-40) (-80) 80) (V2 0 20)
+        ,PassDown $ roomPadCut (rectNSWE 40 (-40) (-80) 80) (V2 0 20)
             & rmPmnts %~ (spanLightI (V2 (-80) 10) (V2 80 10) :)
         ] 
-        (Right rm3)
+        (UseAll rm3)
 
-spawnerRoom :: RandomGen g => State g (Tree (Either Room Room))
+spawnerRoom :: RandomGen g => State g (SubCompTree Room)
 spawnerRoom = do
     x <- state $ randomR (250,300)
     y <- state $ randomR (300,400)
     roomWithSpawner <- roomC x y <&> 
         rmPmnts %~ (spNoID (PSRoomRand 0) (PutCrit spawnerCrit) :)
     aRoom <- airlock
-    return $ treeFromTrunk [Left aRoom,Left corridor] $ connectRoom roomWithSpawner
+    return $ treeFromTrunk [PassDown aRoom,PassDown corridor] $ connectRoom roomWithSpawner

src/Dodge/Room/RunPast.hs

@@ -49,7 +49,7 @@ critRoom = corridorWallN
     { _rmRandPSs = [psRandRanges (15,25) (30,45) (pi,2*pi)]
     }
 
-runPastRoom :: RandomGen g => Int -> State g (Tree (Either Room Room))
+runPastRoom :: RandomGen g => Int -> State g (SubCompTree Room)
 runPastRoom i = do
     h <- state $ randomR (200,400::Float)
     theedgetest <- takeOne [horEdgeTest (<1), horEdgeTest  (>39)]
@@ -71,8 +71,8 @@ runPastRoom i = do
             }
         switchdoor = switchDoorRoom & rmTakeFrom ?~ i
         n = length $ filter theedgetest $ _rmLinks cenroom
-        controom = treeFromPost [Left switchdoor,Left linkcor] (Right door)
+        controom = treeFromPost [PassDown switchdoor,PassDown linkcor] (UseAll door)
-        critrooms :: [Tree (Either Room Room)]
+        critrooms :: [SubCompTree Room]
-        critrooms = treeFromPost [Left switchdoor] (Left critroom) : 
+        critrooms = treeFromPost [PassDown switchdoor] (PassDown critroom) : 
-            replicate (n-2) (treeFromPost [Left switchdoor] (Left linkcor))
+            replicate (n-2) (treeFromPost [PassDown switchdoor] (PassDown linkcor))
-    return $ Node (Left cenroom) (controom : critrooms ++ [return $ Left aswitchroom])
+    return $ Node (PassDown cenroom) (controom : critrooms ++ [return $ PassDown aswitchroom])

src/Dodge/Room/Start.hs

@@ -32,22 +32,22 @@ import Control.Lens
 import System.Random
 --import qualified Data.IntMap.Strict as IM
 
-minigunfakeout :: RandomGen g => State g (Tree (Either Room Room))
+minigunfakeout :: RandomGen g => State g (SubCompTree Room)
 minigunfakeout = do
     rcol <- rezColor
     ncor <- state $ randomR (0,2)
     roomwithmini <- randomiseAllLinks $ roomRectAutoLinks 150 150
         & rmPmnts %~ (plRRpt 0 (PutFlIt miniGun):)
-    randcors <- replicateM ncor $ (fmap Left . randomiseOutLinks) corridor
+    randcors <- replicateM ncor $ (fmap PassDown . randomiseOutLinks) corridor
-    return $ ([Left $ rezBox rcol
+    return $ ([PassDown $ rezBox rcol
-                ,Left door
+                ,PassDown door
-                ,Left roomwithmini 
+                ,PassDown roomwithmini 
-                ,Left door
+                ,PassDown door
                 ] 
             ++ randcors
-            ++ [Left $ corridor & rmPmnts %~ ( plRRpt 0 (PutFlIt shrinkGun) :)
+            ++ [PassDown $ corridor & rmPmnts %~ ( plRRpt 0 (PutFlIt shrinkGun) :)
-                ,Left keyholeCorridor,Left corridor])
+                ,PassDown keyholeCorridor,PassDown corridor])
-        `treeFromPost` Right door
+        `treeFromPost` UseAll door
 
 centralLasTurret :: Room
 centralLasTurret = roomNgon 8 200 & rmPmnts .~
@@ -68,21 +68,21 @@ centralLasTurret = roomNgon 8 200 & rmPmnts .~
     upf trid mc w | _mcSensor mc > 900 = w & triggers . ix trid .~ const True
         | otherwise = w
 
-lasSensorTurretTest :: RandomGen g => Int -> State g (Tree (Either Room Room))
+lasSensorTurretTest :: RandomGen g => Int -> State g (SubCompTree Room)
 lasSensorTurretTest n = do
     cenroom <- randomiseOutLinks $ centralLasTurret {_rmLabel = Just n}
     let doorroom = switchDoorRoom {_rmTakeFrom = Just n}
-    return $ treeFromPost [Left door,Left cenroom,Left doorroom] (Right door)
+    return $ treeFromPost [PassDown door,PassDown cenroom,PassDown doorroom] (UseAll door)
 
-rezThenLasTurret :: RandomGen g => State g (Tree (Either Room Room))
+rezThenLasTurret :: RandomGen g => State g (SubCompTree Room)
 rezThenLasTurret = do
     rbox <- rezBoxStart
     cenroom <- randomiseOutLinks $ centralLasTurret {_rmLabel = Just 0}
     let doorroom = switchDoorRoom {_rmTakeFrom = Just 0}
-        contTree = treeFromPost [Left cenroom,Left doorroom] (Right door)
+        contTree = treeFromPost [PassDown cenroom,PassDown doorroom] (UseAll door)
     return $ rbox `appendEitherTree` [contTree]
 
-startRoom :: RandomGen g => Int -> State g (Tree (Either Room Room))
+startRoom :: RandomGen g => Int -> State g (SubCompTree Room)
 startRoom i = join $ takeOne 
     [ minigunfakeout
     , rezBoxesWp
@@ -92,16 +92,16 @@ startRoom i = join $ takeOne
     , runPastStart i
     ]
 
-runPastStart :: RandomGen g => Int -> State g (Tree (Either Room Room))
+runPastStart :: RandomGen g => Int -> State g (SubCompTree Room)
 runPastStart i = do
     s <- rezBoxStart
     rp <- runPastRoom i
     return $ s `appendEitherTree` [rp]
 
-rezBoxStart :: RandomGen g => State g (Tree (Either Room Room))
+rezBoxStart :: RandomGen g => State g (SubCompTree Room)
 rezBoxStart = do
     ls <- rezColor
-    return $ treeFromPost [Left $ rezBox ls] (Right door)
+    return $ treeFromPost [PassDown $ rezBox ls] (UseAll door)
 
 rezBox :: LightSource -> Room
 rezBox ls = roomRect 40 60 1 1 
@@ -131,28 +131,28 @@ wpAdd wp = rmPmnts %~ f
     g x = x & plIDCont .~ flickerMod
 
 
-rezBoxesThenWeaponRoom :: RandomGen g => State g (Tree (Either Room Room))
+rezBoxesThenWeaponRoom :: RandomGen g => State g (SubCompTree Room)
 rezBoxesThenWeaponRoom = do
     rboxes <- rezBoxes
     wroom  <- weaponRoom
     return $ rboxes `appendEitherTree` [wroom]
 
-rezBoxThenWeaponRoom :: RandomGen g => State g (Tree (Either Room Room))
+rezBoxThenWeaponRoom :: RandomGen g => State g (SubCompTree Room)
 rezBoxThenWeaponRoom = do
     rcol <- rezColor
-    treeFromTrunk [Left $ rezBox rcol,Left door] <$> weaponRoom
+    treeFromTrunk [PassDown $ rezBox rcol,PassDown door] <$> weaponRoom
 
-rezBoxesWpCrit :: RandomGen g => State g (Tree (Either Room Room))
+rezBoxesWpCrit :: RandomGen g => State g (SubCompTree Room)
 rezBoxesWpCrit = do
     w <- state $ randomR (200,400)
     h <- state $ randomR (40,40)
     thecol <- rezColor
     theweapon <- randBlockBreakWeapon
     let bottomEdgeTest (V2 _ y,_) = y < 1
-        bottomLeftTest (V2 x y,_) = y < 1 && x < 21
+        bottomPassDownTest (V2 x y,_) = y < 1 && x < 21
         aroom = rezInvBox thecol
     centralRoom <- filterSortOutLinksOn bottomEdgeTest ((\(V2 a b) -> (b,a)) . fst) <$>
-            (randomiseOutLinks =<< changeLinkTo bottomLeftTest 
+            (randomiseOutLinks =<< changeLinkTo bottomPassDownTest 
                     ((roomRectAutoLinks w h) {_rmPmnts = []}))
     let n = length $ filter bottomEdgeTest $ _rmLinks centralRoom
     i <- state $ randomR (0,n-3)
@@ -162,15 +162,15 @@ rezBoxesWpCrit = do
             $ insertAt i (wpAdd theweapon aroom) 
             $ insertAt j (crAdd aroom)
             $ replicate (n-3) aroom
-    return $ treeFromTrunk [Left $ rezBox thecol
+    return $ treeFromTrunk [PassDown $ rezBox thecol
-        , Left door
+        , PassDown door
         ] 
-        (Node (Left centralRoom) (rezrooms ++ [onwardtree blcor]))
+        (Node (PassDown centralRoom) (rezrooms ++ [onwardtree blcor]))
   where
-    adddoor rm = treeFromPost [Left door] (Left rm)
+    adddoor rm = treeFromPost [PassDown door] (PassDown rm)
-    onwardtree blcor = treeFromPost [Left door] (Right blcor)
+    onwardtree blcor = treeFromPost [PassDown door] (UseAll blcor)
 
-rezBoxesWp :: RandomGen g => State g (Tree (Either Room Room))
+rezBoxesWp :: RandomGen g => State g (SubCompTree Room)
 rezBoxesWp = do
     w <- state $ randomR (100,400)
     h <- state $ randomR (40,40)
@@ -185,31 +185,31 @@ rezBoxesWp = do
     let rezrooms = map adddoor 
             $ wpAdd theweapon aroom : replicate (n-2) aroom
     centralRoom' <- changeLinkFrom bottomEdgeTest centralRoom
-    return $ treeFromTrunk [Left $ rezBox thecol
+    return $ treeFromTrunk [PassDown $ rezBox thecol
-        , Left door
+        , PassDown door
         ] 
-        (Node (Left centralRoom') (rezrooms ++ [onwardtree blcor]))
+        (Node (PassDown centralRoom') (rezrooms ++ [onwardtree blcor]))
   where
-    adddoor rm = treeFromPost [Left door] (Left rm)
+    adddoor rm = treeFromPost [PassDown door] (PassDown rm)
-    onwardtree blcor = treeFromPost [Left door] (Right blcor)
+    onwardtree blcor = treeFromPost [PassDown door] (UseAll blcor)
 
-rezBoxes :: RandomGen g => State g (Tree (Either Room Room))
+rezBoxes :: RandomGen g => State g (SubCompTree Room)
 rezBoxes = do
     w <- state $ randomR (100,400)
     h <- state $ randomR (40,40)
     thecol <- rezColor
     let bottomEdgeTest (V2 _ y,_) = y < 1
-        dbox = treeFromPost [Left door] (Left $ rezInvBox thecol)
+        dbox = treeFromPost [PassDown door] (PassDown $ rezInvBox thecol)
     centralRoom <- randomiseOutLinks =<< changeLinkTo bottomEdgeTest 
         ((roomRectAutoLinks w h) {_rmPmnts = []})
     let n = length $ filter bottomEdgeTest $ _rmLinks centralRoom
     centralRoom' <- changeLinkFrom bottomEdgeTest centralRoom
-    return $ treeFromTrunk [Left $ rezBox thecol
+    return $ treeFromTrunk [PassDown $ rezBox thecol
-        , Left door
+        , PassDown door
         ] 
-        (Node (Left centralRoom') (replicate (n-1) dbox ++ [Node (Right door) []]))
+        (Node (PassDown centralRoom') (replicate (n-1) dbox ++ [Node (UseAll door) []]))
 
-startRoom' :: RandomGen g => State g (Tree (Either Room Room))
+startRoom' :: RandomGen g => State g (SubCompTree Room)
 startRoom' = do
     w <- state $ randomR (100,400)
     h <- state $ randomR (200,400)
@@ -224,7 +224,7 @@ startRoom' = do
             , sps0 $ PutForeground $ colorSH orange $ pipePP 2 (V3 50 50 25) (V3 50 120 25)
             ]
     thecol <- rezColor
-    treeFromPost [Left $ rezBox thecol, Left door] . Right 
+    treeFromPost [PassDown $ rezBox thecol, PassDown door] . UseAll 
         <$> randomiseOutLinks 
             (shiftRoomBy (V2 (-20) (-20),0) 
             ( roomRectAutoLinks w h & rmPmnts %~ (plmnts ++) 

src/Dodge/Tree/Compose.hs

@@ -6,7 +6,6 @@ module Dodge.Tree.Compose
     , connectTrunk
     , deadRoom
     , linkEitherTrees
-
     , expandTree
     , singleUseAll
     , singleUseNone
@@ -26,51 +25,71 @@ expandTree (Node root extChildren) = case root of
     Node (SplitDown x)  xs  -> Node x $ map expandTree $ zipWith Node xs 
             $ map (:[]) extChildren ++ repeat []
 
--- | 'Left' elements get new children as given by the node function, 
+expandTreeBy
--- 'Right' elements inherit the children from the base tree
+    :: (a -> SubCompTree b) -- ^ Node function
-expandTreeBy 
-    :: (a -> Tree (Either b b)) -- ^ Node function
     -> Tree a                   -- ^ Base tree
     -> Tree b
-expandTreeBy f (Node x []) = fmap removeEither (f x)
+expandTreeBy f (Node x []) = fmap _unCompose (f x)
 expandTreeBy f (Node x xs) = appendAndRemove $ f x
   where
-    appendAndRemove (Node (Left y)  ys) = Node y (map appendAndRemove ys)
+    appendAndRemove (Node (PassDown y) ys) = Node y (map appendAndRemove ys)
-    appendAndRemove (Node (Right y) _ ) = Node y (map (expandTreeBy f) xs)
+    appendAndRemove (Node (UseAll y)   _ ) = Node y (map (expandTreeBy f) xs)
+    
+
+---- | 'Left' elements get new children as given by the node function, 
+---- 'Right' elements inherit the children from the base tree
+--expandTreeBy 
+--    :: (a -> Tree (Either b b)) -- ^ Node function
+--    -> Tree a                   -- ^ Base tree
+--    -> Tree b
+--expandTreeBy f (Node x []) = fmap removeEither (f x)
+--expandTreeBy f (Node x xs) = appendAndRemove $ f x
+--  where
+--    appendAndRemove (Node (Left y)  ys) = Node y (map appendAndRemove ys)
+--    appendAndRemove (Node (Right y) _ ) = Node y (map (expandTreeBy f) xs)
 
 -- | Appends a second either forest at the 'Right' elements of a first either
 -- tree.
 -- Makes such 'Right' elements into 'Left's.
-appendEitherTree 
+--appendEitherTree 
-    :: Tree (Either a a)    -- ^ The first tree
+--    :: Tree (Either a a)    -- ^ The first tree
-    -> [Tree (Either a a)]    -- ^ The forest to append
+--    -> [Tree (Either a a)]    -- ^ The forest to append
-    -> Tree (Either a a)
+--    -> Tree (Either a a)
-appendEitherTree (Node (Left x) ts) ts'  = Node (Left x) $ map (`appendEitherTree` ts') ts
+--appendEitherTree (Node (Left x) ts) ts'  = Node (Left x) $ map (`appendEitherTree` ts') ts
-appendEitherTree (Node (Right x) _) ts' = Node (Left x) ts'
+--appendEitherTree (Node (Right x) _) ts' = Node (Left x) ts'
+
+appendEitherTree = passUntilUseAll
+
 passUntilUseAll :: SubCompTree a -> [SubCompTree a] -> SubCompTree a
 passUntilUseAll (Node (UseAll x) _) ts' = Node (PassDown x) ts'
 passUntilUseAll (Node cn ts) ts' = Node (PassDown (_unCompose cn)) $ map (`passUntilUseAll` ts') ts
 
-linkEitherTrees :: [Tree (Either a a)] -> Tree (Either a a)
+--linkEitherTrees :: [Tree (Either a a)] -> Tree (Either a a)
-linkEitherTrees (t:s:ts) = linkEitherTrees (appendEitherTree t [s]:ts)
+--linkEitherTrees (t:s:ts) = linkEitherTrees (appendEitherTree t [s]:ts)
-linkEitherTrees [t] = t
+--linkEitherTrees [t] = t
-linkEitherTrees [] = error "tried to concatenate an empty list of either trees"
+--linkEitherTrees [] = error "tried to concatenate an empty list of either trees"
+
+linkEitherTrees = chainUses
 
 chainUses :: [SubCompTree a] -> SubCompTree a
 chainUses (t:s:ts) = chainUses (passUntilUseAll t [s]:ts)
 chainUses [t] = t
 chainUses []  = error "tried to concatenate an empty list of SubCompTrees"
 
+removeEither = _unCompose
+
 -- this is _unCompose
-removeEither :: Either p p -> p
+--removeEither :: Either p p -> p
-removeEither (Left y)  = y
+--removeEither (Left y)  = y
-removeEither (Right y) = y
+--removeEither (Right y) = y
 
 {-  |
 Make a singleton connection of an Either Tree.
 -}
-connectRoom :: a -> Tree (Either a a)
+--connectRoom :: a -> Tree (Either a a)
-connectRoom r = Node (Right r) [] 
+--connectRoom r = Node (Right r) [] 
+
+connectRoom = singleUseAll
 
 singleUseAll :: a -> Tree (ComposingNode a)
 singleUseAll x = Node (UseAll x) []
@@ -78,10 +97,11 @@ singleUseAll x = Node (UseAll x) []
 {-  |
 Make a single Either connection at the end of a tree.
 -}
-connectTrunk :: Tree a -> Tree (Either a a)
+--connectTrunk :: Tree a -> Tree (Either a a)
-connectTrunk (Node x (t:ts)) = Node (Left x) (connectTrunk t : map (fmap Left) ts)
+--connectTrunk (Node x (t:ts)) = Node (Left x) (connectTrunk t : map (fmap Left) ts)
-connectTrunk (Node x []) = Node (Right x) []
+--connectTrunk (Node x []) = Node (Right x) []
-
+--
+connectTrunk = useAllAtEnd
 useAllAtEnd :: Tree a -> SubCompTree a
 useAllAtEnd tree = case tree of
     Node x (t:ts)   -> Node (PassDown x) (useAllAtEnd t : map (fmap UseNone) ts)
@@ -90,8 +110,10 @@ useAllAtEnd tree = case tree of
 {- |
 Make a singleton dead end of an Either Tree.
 -}
-deadRoom :: a -> Tree (Either a a)
+--deadRoom :: a -> Tree (Either a a)
-deadRoom r = Node (Left r) []
+--deadRoom r = Node (Left r) []
+
+deadRoom = singleUseNone
 
 singleUseNone :: a -> SubCompTree a
 singleUseNone x = Node (UseNone x) []