Display abstract tree of placement, stout

src/Dodge/Floor.hs

@@ -105,14 +105,18 @@ initialRoomTree = do
 
 layoutLevelFromSeed :: Int -> IO [Room]
 layoutLevelFromSeed seed = do
-    putStrLn $ "Generating level with seed: " ++ show seed
+    putStrLn $ "Generating level with seed " ++ show seed
     let g = mkStdGen seed
-    let rmtree = evalState initialRoomTree g
+    let rmtree = inorderNumberTree $ evalState initialRoomTree g
+    putStrLn "Seed layout: "
+    putStrLn $ compactDrawTree $ fmap (show . snd) rmtree
     mrs <- positionRooms rmtree
     case mrs of
-        Just rs -> return (fmap setLastLinkToUsed rs)
+        Just rs -> do
+            putStrLn $ "Successful generation of level with seed " ++ show seed
+            return (fmap setLastLinkToUsed rs)
         Nothing -> do
-            putStrLn "Level generation failed"
+            putStr $ "Level generation with seed " ++ show seed ++ " failed: "
             let (seed',_) = random g
             layoutLevelFromSeed seed'
   where
@@ -121,3 +125,18 @@ layoutLevelFromSeed seed = do
             & rmLinks %~ init
             & rmUsedLinks %~ (last (_rmLinks rm) :)
         _ -> rm
+
+compactDrawTree :: Tree String -> String
+compactDrawTree = unlines . compactDraw
+
+compactDraw :: Tree String -> [String]
+compactDraw (Node x [Node y ts]) = compactDraw (Node (x++","++y) ts)
+compactDraw (Node x ts0) = lines x ++ drawSubTrees ts0
+  where
+    drawSubTrees [] = []
+    drawSubTrees [t] =
+        "|" : compactDraw t
+    drawSubTrees (t:ts) =
+        "|" : shift "+- " "|  " (compactDraw t) ++ drawSubTrees ts
+
+    shift first other = zipWith (++) (first : repeat other)