diff --git a/src/Dodge/Layout.hs b/src/Dodge/Layout.hs index ad71fe366..72dddd581 100644 --- a/src/Dodge/Layout.hs +++ b/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 gr' w - = initWallZoning - . setupWorldBounds +generateLevelFromRoomList :: IM.IntMap Room -> World -> GenWorld +generateLevelFromRoomList gr' w = over gWorld initWallZoning + . over gWorld randomCompass + . 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] - case _rmFloor r of +setTile r gw = 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 rp - ---addRandomTile :: RandomGen g => Room -> State g Room ---addRandomTile r = do --- z <- state $ randomR (0,63) --- return $ addTile z r + poly = orderPolygon . convexHullSafe . nubBy ((==) `on` roundPoint2) $ concat $ _rmPolys r shuffleRoomPos :: RandomGen g => Room -> State g Room shuffleRoomPos rm = do newPos <- shuffle $ _rmPos rm return $ rm & rmPos .~ newPos -placeWires :: GenWorld -> World -placeWires w = foldr placeRoomWires (_gWorld w) $ _gRooms w +placeWires :: GenWorld -> GenWorld +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 - & worldBounds . bdMinX .~ f minx - & worldBounds . bdMaxX .~ f maxx - & worldBounds . bdMinY .~ f miny - & worldBounds . bdMaxY .~ f maxy +setupWorldBounds w = w & worldBounds %~ + ( (bdMinX .~ f minx) + . (bdMaxX .~ f maxx) + . (bdMinY .~ f miny) + . (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 diff --git a/src/Dodge/LevelGen.hs b/src/Dodge/LevelGen.hs index 7c80f49c0..10387aacd 100644 --- a/src/Dodge/LevelGen.hs +++ b/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 diff --git a/src/Dodge/Menu.hs b/src/Dodge/Menu.hs index 125eabfca..ca7575e83 100644 --- a/src/Dodge/Menu.hs +++ b/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 --- <&> preloadData .~ _preloadData w - ) --- this kills save games etc... +uvWorldSideEffects i w = const (generateWorldFromSeed i <&> config .~ _config w) -- | hacky diff --git a/src/Tile.hs b/src/Tile.hs index f95379008..7bb521774 100644 --- a/src/Tile.hs +++ b/src/Tile.hs @@ -1,12 +1,12 @@ module Tile - ( tToRender + ( tileToRenderList , makeTileFromPoly ) where import Data.Tile import Geometry -tToRender :: Tile -> [(Point3,Point3)] -tToRender t = polyToTris $ zip ps3 coords3 +tileToRenderList :: Tile -> [(Point3,Point3)] +tileToRenderList t = polyToTris $ zip ps3 coords3 where ps = _tilePoly t coords = map (calcTexCoord (_tileZero t) (_tileX t)) ps