Cleanup

src/Dodge/LevelGen.hs

@@ -36,15 +36,10 @@ layoutLevelFromSeed i seed = do
     appendFile "log/attemptedSeeds" $ show seed ++ "\n"
     let g = mkStdGen seed
     let treecluster = evalState initialRoomTree (g,0)
-    --tc <- composeAndLog [0] (\str -> putStrLn str >> appendFile "log/treeCluster" str) treecluster
---    let labts = decomposeTree $ numMetaTree treecluster
     let labts = decomposeSelfTree $ numSelfTree $ combineTree _rmName treecluster
-    mapM_ (putStrLn . drawTree . fmap show) labts
+    mapM_ ((\str -> putStrLn str >> appendFile "log/treeCluster" str) . smallDrawTree . fmap showIntsString) 
+        labts
     let tc = composeTree treecluster
-    ----    (strs,tc) = composeTree' treecluster
-    ----appendFile "log/TreeCluster" ("Seed: "++ show seed)
-    ----mapM_ (appendFile "log/treeCluster" . ('\n':))  strs
-    ----mapM_ putStrLn strs
     let rmtree = inorderNumberTree tc
     putStrLn "Room layout (compact): "
     putStrLn $ compactDrawTree $ fmap (show . snd) rmtree
@@ -52,6 +47,7 @@ layoutLevelFromSeed i seed = do
     appendFile "log/aGeneratedRoomLayout" ("Seed: "++ show seed)
     appendFile "log/aGeneratedRoomLayout" $ drawTree $ fmap nameshow rmtree
     putStrLn "Layout with room names (also written to log/aGeneratedRoomLayout):"
+    putStrLn $ smallDrawTree $ fmap nameshow rmtree
     mrs <- positionRoomsFromTree rmtree
     case mrs of
         Just (PosRooms bounds rs) -> do
@@ -72,6 +68,9 @@ reversePair (a,b) = (b,a)
 compactDrawTree :: Tree String -> String
 compactDrawTree = unlines . compactDraw
 
+smallDrawTree :: Tree String -> String
+smallDrawTree = 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
@@ -82,3 +81,14 @@ compactDraw (Node x ts0) = lines x ++ drawSubTrees ts0
     drawSubTrees (t:ts) =
         "|" : shift "+- " "|  " (compactDraw t) ++ drawSubTrees ts
     shift first other = zipWith (++) (first : repeat other)
+
+compactDraw' :: Tree String -> [String]
+compactDraw' (Node x [Node y ts]) = lines x ++ ["|"] ++ compactDraw' (Node 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)