Improve generation logging
This commit is contained in:
+12
-5
@@ -12,6 +12,7 @@ import Dodge.Tree
|
|||||||
import Geometry.ConvexPoly
|
import Geometry.ConvexPoly
|
||||||
--import Dodge.LevelGen.LevelStructure
|
--import Dodge.LevelGen.LevelStructure
|
||||||
|
|
||||||
|
import System.Directory
|
||||||
import System.Random
|
import System.Random
|
||||||
import Control.Lens
|
import Control.Lens
|
||||||
import Control.Monad.State
|
import Control.Monad.State
|
||||||
@@ -19,7 +20,10 @@ import qualified Data.IntMap.Strict as IM
|
|||||||
|
|
||||||
generateWorldFromSeed :: Int -> IO World
|
generateWorldFromSeed :: Int -> IO World
|
||||||
generateWorldFromSeed i = do
|
generateWorldFromSeed i = do
|
||||||
writeFile "attemptedSeeds" ""
|
createDirectoryIfMissing True "log"
|
||||||
|
writeFile "log/attemptedSeeds" ""
|
||||||
|
writeFile "log/treeCluster" ""
|
||||||
|
writeFile "log/aGeneratedRoomLayout" ""
|
||||||
(roomList,bounds) <- layoutLevelFromSeed 0 i
|
(roomList,bounds) <- layoutLevelFromSeed 0 i
|
||||||
return $ saveLevelStartSlot
|
return $ saveLevelStartSlot
|
||||||
$ generateLevelFromRoomList roomList initialWorld{_randGen=mkStdGen i}
|
$ generateLevelFromRoomList roomList initialWorld{_randGen=mkStdGen i}
|
||||||
@@ -29,11 +33,13 @@ layoutLevelFromSeed :: Int -> Int -> IO (IM.IntMap Room,[ConvexPoly])
|
|||||||
layoutLevelFromSeed i seed = do
|
layoutLevelFromSeed i seed = do
|
||||||
let i' = i + 1
|
let i' = i + 1
|
||||||
putStrLn $ "Generating level with seed " ++ show seed
|
putStrLn $ "Generating level with seed " ++ show seed
|
||||||
appendFile "attemptedSeeds" $ show seed ++ "\n"
|
appendFile "log/attemptedSeeds" $ show seed ++ "\n"
|
||||||
let g = mkStdGen seed
|
let g = mkStdGen seed
|
||||||
let treecluster = evalState initialRoomTree g
|
let treecluster = evalState initialRoomTree g
|
||||||
(strs,tc) = composeTree' treecluster
|
(strs,tc) = composeTree' treecluster
|
||||||
mapM putStrLn strs
|
appendFile "log/TreeCluster" ("Seed: "++ show seed)
|
||||||
|
mapM_ (appendFile "log/treeCluster" . ('\n':)) strs
|
||||||
|
mapM_ putStrLn strs
|
||||||
--putStrLn "Room cluster layout:"
|
--putStrLn "Room cluster layout:"
|
||||||
--putStrLn $ drawTreeSubLabelling $ fmap snd treecluster
|
--putStrLn $ drawTreeSubLabelling $ fmap snd treecluster
|
||||||
--let rmtree = inorderNumberTree $ expandTree $ fmap fst treecluster
|
--let rmtree = inorderNumberTree $ expandTree $ fmap fst treecluster
|
||||||
@@ -41,8 +47,9 @@ layoutLevelFromSeed i seed = do
|
|||||||
putStrLn "Room layout (compact): "
|
putStrLn "Room layout (compact): "
|
||||||
putStrLn $ compactDrawTree $ fmap (show . snd) rmtree
|
putStrLn $ compactDrawTree $ fmap (show . snd) rmtree
|
||||||
let nameshow (r,rid) = _rmName r ++ "-" ++ show rid
|
let nameshow (r,rid) = _rmName r ++ "-" ++ show rid
|
||||||
appendFile "aGeneratedRoomLayout" $ drawTree $ fmap nameshow rmtree
|
appendFile "log/aGeneratedRoomLayout" ("Seed: "++ show seed)
|
||||||
putStrLn "Layout with room names (also written to aGeneratedRoomLayout):"
|
appendFile "log/aGeneratedRoomLayout" $ drawTree $ fmap nameshow rmtree
|
||||||
|
putStrLn "Layout with room names (also written to log/aGeneratedRoomLayout):"
|
||||||
mrs <- positionRoomsFromTree rmtree
|
mrs <- positionRoomsFromTree rmtree
|
||||||
case mrs of
|
case mrs of
|
||||||
Just (PosRooms bounds rs) -> do
|
Just (PosRooms bounds rs) -> do
|
||||||
|
|||||||
@@ -16,10 +16,10 @@ module Dodge.Tree.Compose
|
|||||||
-- , compTree
|
-- , compTree
|
||||||
) where
|
) where
|
||||||
import Dodge.Data
|
import Dodge.Data
|
||||||
import Dodge.Tree.Compose.Data
|
--import Dodge.Tree.Compose.Data
|
||||||
import Dodge.RoomCluster.Data
|
--import Dodge.RoomCluster.Data
|
||||||
import TreeHelp
|
import TreeHelp
|
||||||
import Dodge.Base
|
--import Dodge.Base
|
||||||
import LensHelp
|
import LensHelp
|
||||||
|
|
||||||
import Data.Bifunctor
|
import Data.Bifunctor
|
||||||
|
|||||||
Reference in New Issue
Block a user