Tweak tree level generation

src/Dodge/Floor.hs

@@ -34,11 +34,19 @@ import System.Random
 roomTreex :: RandomGen g => State g (Maybe [Room])
 roomTreex = do
     struct <- aTreeStrut
+    -- t <- randomPadCorridors $ fmap (const []) struct
     let t = padCorridors $ fmap (const []) struct
     fmap shiftExpandTree $ mapM annoToRoom t
 
+roomTreex' :: RandomGen g => State g (Maybe [Room])
+roomTreex' = do
+    struct <- aTreeStrut
+    let t = padCorridors $ fmap (const []) struct
+    return . shiftExpandTree $ fmap annoToRoom' t
+
+
 levx :: RandomGen g => State g [Room]
-levx = fmap fromJust $ iterateWhile isNothing roomTreex
+levx = untilJust roomTreex
 
 lev1 :: RandomGen g => State g (Tree Room)
 lev1 = do

src/Dodge/Layout/Tree/Annotate.hs

@@ -28,6 +28,16 @@ addLock i t = do
 padCorridors :: Tree [Annotation] -> Tree [Annotation]
 padCorridors (Node x xs) = Node [Corridor] [Node x (map padCorridors xs)]
 
+randomPadCorridors :: RandomGen g => Tree [Annotation] -> State g (Tree [Annotation])
+randomPadCorridors  (Node x xs) = do
+    n <- state $ randomR (1, 3)
+    xs' <- mapM randomPadCorridors xs
+    return $ treeTrunk (replicate n [Corridor]) (Node x xs')
+
 annoToRoom :: RandomGen g => [Annotation] -> State g Room
 annoToRoom [Corridor] = takeOne [corridor]
 annoToRoom _ = randLinks $ roomRectAutoLinks 200 200
+
+annoToRoom' :: [Annotation] -> Room
+annoToRoom' [Corridor] = corridor
+annoToRoom' _          = roomRectAutoLinks 200 200

src/Dodge/Layout/Tree/GenerateStructure.hs

@@ -47,7 +47,7 @@ Randomly generate a small tree.
 aTreeStrut :: RandomGen g => State g (Tree ())
 aTreeStrut = do
     d <- state $ randomR (9,11:: Int)
-    nbs <- state $ randomR (2,5)
+    nbs <- state $ randomR (2,4)
     bds <- takeN nbs [1 .. d - 1]
     bs  <- replicateM nbs smallBranch
     let trunk = treePath d