Cleanup

src/Dodge/Room/RezBox.hs

@@ -40,6 +40,18 @@ rezBox ls = roomRect 40 60 1 1
     & restrictOutLinks (\(V2 _ h,_)-> h > 59)
     & rmName .~ "rezBox"
 
+rezBox' :: RandomGen g => State g (MetaTree Room String)
+rezBox' = do
+    col <- rezColor
+    return $ tToBTree "rezBox'" $ treePost
+        [roomRect 40 60 1 1 
+            & rmPmnts .~ [ sPS (V2 20 1) 0 $ PutLS col]
+            & restrictInLinks  (\(V2 _ h,_)-> h < 1)
+            & restrictOutLinks (\(V2 _ h,_)-> h > 59)
+            & rmName .~ "rezBox"
+        , cleatOnward door
+        ]
+
 rezBoxesWp :: RandomGen g => State g (Tree Room)
 rezBoxesWp = do
     w <- state $ randomR (100,400)
@@ -50,7 +62,7 @@ rezBoxesWp = do
     let isnorth = S.member (OnEdge North) . _rlType
     centralRoom <- shuffleLinks $(roomRectAutoLinks w h) {_rmPmnts = []} 
         & rmLinks %~ setLinkType InLink isnorth
-    onwardpassage <- maybeBlockedPassage
+    onwardpassage <- shootOutPassage
     let n = length $ getLinksOfType (OnEdge North) $  _rmLinks centralRoom
     let rezrooms = map adddoor 
             $ wpAdd theweapon aroom : replicate (n-2) aroom
@@ -62,6 +74,10 @@ rezBoxesWp = do
 maybeBlockedPassage :: RandomGen g => State g (Tree Room)
 maybeBlockedPassage = fmap (pure . cleatOnward)
     $ join $ takeOne [return corridor, blockedCorridorCloseBlocks]
+
+shootOutPassage :: RandomGen g => State g (Tree Room)
+shootOutPassage = fmap (pure . cleatOnward)
+    $ join $ takeOne [ blockedCorridorCloseBlocks]
 rezBoxesWpCrit :: RandomGen g => State g (Tree Room)
 rezBoxesWpCrit = do
     w <- state $ randomR (200,400)
@@ -88,7 +104,7 @@ rezBoxesWpCrit = do
 crAdd :: Room -> Room
 crAdd = rmPmnts .:~ sPS (V2 20 10) (0.5*pi) randC1
 
-rezBoxes :: RandomGen g => State g (Tree Room)
+rezBoxes :: RandomGen g => State g (MetaTree Room String)
 rezBoxes = do
     w <- state $ randomR (100,400)
     h <- state $ randomR (40,40)
@@ -99,7 +115,7 @@ rezBoxes = do
     centralRoom <- shuffleLinks $ (roomRectAutoLinks w h) {_rmPmnts = []}
             & rmLinks %~ setInLinks bottomEdgeTest
     let n = length $ filter bottomEdgeTest $_rmLinks centralRoom
-    return $ treeFromTrunk [rezBox thecol,  door] 
+    return $ tToBTree "rezBoxes" $ treeFromTrunk [rezBox thecol,  door] 
         $ Node centralRoom (replicate (n-1) dbox ++ [Node (cleatOnward door) []])
 
 rezColor :: RandomGen g => State g LightSource