Refactor, try to limit dependencies

src/Dodge/LevelGen.hs

@@ -1,21 +1,19 @@
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE RankNTypes #-}
 module Dodge.LevelGen where
-import Dodge.Data
-import Dodge.Floor
-import Dodge.Layout
-import Dodge.Initialisation
-import Dodge.Tree
-import Geometry.ConvexPoly
-import Dodge.Combine.Graph
 
-import Data.Foldable
-import System.Directory
-import System.Random
 import Control.Lens
 import Control.Monad.State
-import qualified IntMapHelp as IM
+import Data.Foldable
 import qualified Data.Text.IO as TIO
+import Dodge.Combine.Graph
+import Dodge.Data.GenWorld
+import Dodge.Floor
+import Dodge.Initialisation
+import Dodge.Layout
+import Dodge.Tree
+import Geometry.ConvexPoly
+import qualified IntMapHelp as IM
+import System.Directory
+import System.Random
 
 generateWorldFromSeed :: Int -> IO World
 generateWorldFromSeed i = do
@@ -25,11 +23,11 @@ generateWorldFromSeed i = do
     writeFile "log/treeCluster" ""
     writeFile "log/aGeneratedRoomLayout" ""
     generateGraphs
-    (roomList,bounds) <- layoutLevelFromSeed 0 i
-    return -- $ saveLevelStartSlot 
-        $ postGenerationProcessing
-        $ _gwWorld (generateLevelFromRoomList roomList initialWorld{_randGen=mkStdGen i})
-        & cWorld . roomClipping .~ bounds
+    (roomList, bounds) <- layoutLevelFromSeed 0 i
+    return $
+        postGenerationProcessing $
+            _gwWorld (generateLevelFromRoomList roomList initialWorld{_randGen = mkStdGen i})
+                & cWorld . roomClipping .~ bounds
 
 postGenerationProcessing :: World -> World
 postGenerationProcessing w = foldl' assignPushDoors w (_doors (_cWorld w))
@@ -42,42 +40,43 @@ assignPushDoors w dr = case dr ^?! drPushedBy of
     PushedBy i -> w & cWorld . doors . ix i . drPushes ?~ _drID dr
     _ -> w
 
-layoutLevelFromSeed :: Int -> Int -> IO (IM.IntMap Room,[ConvexPoly])
+layoutLevelFromSeed :: Int -> Int -> IO (IM.IntMap Room, [ConvexPoly])
 layoutLevelFromSeed i seed = do
     let i' = i + 1
     putStrLnAppend "log/attemptedSeeds" $ "Generating level with seed " ++ show seed
     appendFile "log/attemptedSeeds" "\n"
     let g = mkStdGen seed
-    let treecluster = evalState initialRoomTree (g,0)
+    let treecluster = evalState initialRoomTree (g, 0)
     let labts = decomposeSelfTree $ numSelfTree $ combineTree _rmName treecluster
-    appendFile "log/treeCluster" ("Seed: "++ show seed ++ "\n")
+    appendFile "log/treeCluster" ("Seed: " ++ show seed ++ "\n")
     mapM_ (putStrLnAppend "log/treeCluster" . smallDrawTree . fmap showIntsString) labts
     let tc = composeTree treecluster
     let rmtree = inorderNumberTree tc
     putStrLn "Room layout (compact): "
     putStrLn $ compactDrawTree $ fmap (show . snd) rmtree
-    let nameshow (r,rid) = _rmName r ++ "-" ++ show rid
-    appendFile "log/aGeneratedRoomLayout" ("Seed: "++ show seed)
+    let nameshow (r, rid) = _rmName r ++ "-" ++ show rid
+    appendFile "log/aGeneratedRoomLayout" ("Seed: " ++ show seed)
     putStrLnAppend "log/aGeneratedRoomLayout" "Layout with room names:"
     putStrLnAppend "log/aGeneratedRoomLayout" $ smallDrawTree $ fmap nameshow rmtree
     mrs <- positionRoomsFromTree rmtree
     case mrs of
         Just (PosRooms bounds rs) -> do
-            putStrLnAppend "log/attemptedSeeds" $ "After " ++ show i' 
-                ++ " attempt(s), Successful generation of level with seed " 
-                ++ show seed
+            putStrLnAppend "log/attemptedSeeds" $
+                "After " ++ show i'
+                    ++ " attempt(s), Successful generation of level with seed "
+                    ++ show seed
             putStrLnAppend "log/attemptedSeeds" $ show (Prelude.length rs) ++ " rooms in total"
-            return (IM.fromList $ map reversePair rs , bounds)
+            return (IM.fromList $ map reversePair rs, bounds)
         Nothing -> do
             putStrLnAppend "log/attemptedSeeds" $ "Level generation with seed " ++ show seed ++ " failed: "
-            let (seed',_) = random g
+            let (seed', _) = random g
             layoutLevelFromSeed i' seed'
 
 putStrLnAppend :: FilePath -> String -> IO ()
 putStrLnAppend fp str = appendFile fp (str ++ "\n") >> putStrLn str
 
-reversePair :: (a,b) -> (b,a)
-reversePair (a,b) = (b,a)
+reversePair :: (a, b) -> (b, a)
+reversePair (a, b) = (b, a)
 
 compactDrawTree :: Tree String -> String
 compactDrawTree = unlines . compactDraw
@@ -86,13 +85,13 @@ 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 [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) =
+    drawSubTrees (t : ts) =
         "|" : shift "+- " "|  " (compactDraw t) ++ drawSubTrees ts
     shift first other = zipWith (++) (first : repeat other)
 
@@ -103,6 +102,6 @@ compactDraw' (Node x ts0) = lines x ++ drawSubTrees ts0
     drawSubTrees [] = []
     drawSubTrees [t] =
         "|" : compactDraw' t
-    drawSubTrees (t:ts) =
+    drawSubTrees (t : ts) =
         "|" : shift "+- " "|  " (compactDraw' t) ++ drawSubTrees ts
     shift first other = zipWith (++) (first : repeat other)