Tweak level generation slightly

src/Dodge/Layout.hs

@@ -36,10 +36,10 @@ import Data.Maybe
 import Data.Function
 import Control.Monad.State
 
-generateLevelFromRoomList :: IM.IntMap Room -> World -> World
+generateLevelFromRoomList :: IM.IntMap Room -> World -> GenWorld
-generateLevelFromRoomList gr' w 
+generateLevelFromRoomList gr' w = over gWorld initWallZoning 
-    = initWallZoning 
+    . over gWorld randomCompass
-    . setupWorldBounds
+    . over gWorld setupWorldBounds
     . placeWires
     . doAfterPlacements
     . doPartialPlacements
@@ -56,15 +56,16 @@ generateLevelFromRoomList gr' w
     path = pairsToGraph dist pairPath
     pairPath = concatMap _rmPath rs
     rs = map doRoomShift $ IM.elems rs'
-    --rs'= mapM (shuffleRoomPos >=> addRandomTile) gr' & evalState $ _randGen w
     rs'= mapM shuffleRoomPos gr' & evalState $ _randGen w
 
+randomCompass :: World -> World
+randomCompass w = w & cameraRot .~ (takeOne [0,0.5*pi,pi,1.5*pi] & evalState $ _randGen w)
+
 putFloorTiles :: GenWorld -> GenWorld
 putFloorTiles gw = gw & gWorld . floorTiles .~ floorsFromGenWorld gw
 
 setFloors :: GenWorld -> GenWorld
 setFloors gw = putFloorTiles $ setTiles gw
---setFloors gw = setTiles gw
 
 -- note the order of traversal of the rooms is important
 -- hence the reverse
@@ -73,29 +74,23 @@ setTiles :: GenWorld -> GenWorld
 setTiles gw = foldr setTile gw . reverse . IM.elems $ _gRooms gw
 
 setTile :: Room -> GenWorld -> GenWorld
-setTile r gw = -- gw & gRooms . ix (fromJust (_rmMID r)) . rmFloor .~ Tiled [Tile poly 0 (V2 1 0) 16]
+setTile r gw = case _rmFloor r of
-        case _rmFloor r of
     Tiled {} -> gw
     InheritFloor -> gw & gRooms . ix (fromJust (_rmMID r)) . rmFloor .~ Tiled [t & tilePoly .~ poly]
   where
     t = case _rmMParent r of
         Nothing -> Tile poly (V2 0 0) (V2 1 0) 16
         Just pid -> head $ _tiles $ _rmFloor $ _gRooms gw IM.! pid
-    rp = _rmPolys r
+    poly = orderPolygon . convexHullSafe . nubBy ((==) `on` roundPoint2) $ concat $ _rmPolys r
-    poly = orderPolygon . convexHullSafe . nubBy ((==) `on` roundPoint2) $ concat rp
-
---addRandomTile :: RandomGen g => Room -> State g Room
---addRandomTile r = do
---    z <- state $ randomR (0,63)
---    return $ addTile z r
 
 shuffleRoomPos :: RandomGen g => Room -> State g Room
 shuffleRoomPos rm = do
     newPos <- shuffle $ _rmPos rm
     return $ rm & rmPos .~ newPos
 
-placeWires :: GenWorld -> World
+placeWires :: GenWorld -> GenWorld
-placeWires w = foldr placeRoomWires (_gWorld w) $ _gRooms w
+placeWires w = w
+    & gWorld .~ foldr placeRoomWires (_gWorld w) (_gRooms w)
 
 placeRoomWires :: Room -> World -> World
 placeRoomWires rm w = IM.foldr ($) w 
@@ -164,11 +159,12 @@ doRoomPlacements :: GenWorld -> Room -> (GenWorld, Room)
 doRoomPlacements w rm = foldl' (\wr -> fst . placeSpot wr) (w,rm) $ _rmPmnts rm
 
 setupWorldBounds :: World -> World
-setupWorldBounds w = w
+setupWorldBounds w = w & worldBounds %~
-    & worldBounds . bdMinX .~ f minx
+    ( (bdMinX .~ f minx)
-    & worldBounds . bdMaxX .~ f maxx
+    . (bdMaxX .~ f maxx)
-    & worldBounds . bdMinY .~ f miny
+    . (bdMinY .~ f miny)
-    & worldBounds . bdMaxY .~ f maxy
+    . (bdMaxY .~ f maxy)
+    )
   where
     f = fromMaybe 0
     ps = IM.map (fst . _wlLine) $ _walls w
@@ -230,7 +226,7 @@ gameRoomFromRoom rm = GameRoom
     getDir _ = 0 -- fallback
 
 floorsFromRooms :: [Room] -> [(Point3,Point3)]
-floorsFromRooms = concatMap (concatMap tToRender . getTiles . _rmFloor . doRoomShift)
+floorsFromRooms = concatMap (concatMap tileToRenderList . getTiles . _rmFloor . doRoomShift)
 
 floorsFromGenWorld :: GenWorld -> [(Point3,Point3)]
 floorsFromGenWorld = floorsFromRooms . IM.elems . _gRooms 

src/Dodge/LevelGen.hs

@@ -7,25 +7,23 @@ import Dodge.Data
 import Dodge.Floor
 import Dodge.Layout
 import Dodge.Initialisation
-import Dodge.RandomHelp
+--import Dodge.RandomHelp
 import Dodge.LevelGen.Data
 import Dodge.Tree
+import Dodge.LevelGen.LevelStructure
 
 import Data.Tree
 import System.Random
-import Control.Lens
+--import Control.Lens
 import Control.Monad.State
 import qualified Data.IntMap.Strict as IM
 
 generateWorldFromSeed :: Int -> IO World
 generateWorldFromSeed i = do
     roomList <- layoutLevelFromSeed 0 i
-    return $ randomCompass $ generateLevelFromRoomList roomList 
+    return $ _gWorld $ generateLevelFromRoomList roomList 
          initialWorld{_randGen=mkStdGen i}
 
-randomCompass :: World -> World
-randomCompass w = w & cameraRot .~ (takeOne [0,0.5*pi,pi,1.5*pi] & evalState $ _randGen w)
-
 layoutLevelFromSeed :: Int -> Int -> IO (IM.IntMap Room)
 layoutLevelFromSeed i seed = do
     let i' = i + 1

src/Dodge/Menu.hs

@@ -165,10 +165,7 @@ startNewGame w = Just $ w
     i = fst $ random (_randGen (_uvWorld w))
 
 uvWorldSideEffects :: Int -> World -> b -> IO World
-uvWorldSideEffects i w = const (generateWorldFromSeed i <&> config .~ _config w
+uvWorldSideEffects i w = const (generateWorldFromSeed i <&> config .~ _config w)
---        <&> preloadData .~ _preloadData w
-      )
--- this kills save games etc...
 
 
 -- | hacky

src/Tile.hs

@@ -1,12 +1,12 @@
 module Tile
-    ( tToRender
+    ( tileToRenderList
     , makeTileFromPoly
     ) where
 import Data.Tile
 import Geometry
 
-tToRender :: Tile -> [(Point3,Point3)]
+tileToRenderList :: Tile -> [(Point3,Point3)]
-tToRender t = polyToTris $ zip ps3 coords3
+tileToRenderList t = polyToTris $ zip ps3 coords3
   where
     ps = _tilePoly t
     coords = map (calcTexCoord (_tileZero t) (_tileX t)) ps