From 732e5281a8a4ed5b8dffa961da447cd764b519f0 Mon Sep 17 00:00:00 2001
From: jgk <justin.g.kruger@gmail.com>
Date: Tue, 20 Apr 2021 19:45:32 +0200
Subject: [PATCH] Tweak tree level generation

---
 src/Dodge/Floor.hs                         | 10 +++++++++-
 src/Dodge/Layout/Tree/Annotate.hs          | 10 ++++++++++
 src/Dodge/Layout/Tree/GenerateStructure.hs |  2 +-
 3 files changed, 20 insertions(+), 2 deletions(-)

diff --git a/src/Dodge/Floor.hs b/src/Dodge/Floor.hs
index ea527bc73..ae8d86094 100644
--- a/src/Dodge/Floor.hs
+++ b/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
diff --git a/src/Dodge/Layout/Tree/Annotate.hs b/src/Dodge/Layout/Tree/Annotate.hs
index 547fa747a..5d3ddfc15 100644
--- a/src/Dodge/Layout/Tree/Annotate.hs
+++ b/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
diff --git a/src/Dodge/Layout/Tree/GenerateStructure.hs b/src/Dodge/Layout/Tree/GenerateStructure.hs
index 7fc969846..a254e6e38 100644
--- a/src/Dodge/Layout/Tree/GenerateStructure.hs
+++ b/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