justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Create post world load function

Browse Source
This commit is contained in:
justin
2023-03-18 09:37:09 +00:00
parent d8fb7a1f99
commit 77c88f68a7
14 changed files with 80 additions and 48 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Data/CWorld.hs
+3
View File
@@ -9,6 +9,7 @@ module Dodge.Data.CWorld (
module Dodge.Data.CamPos
) where
import Data.Tile
import Geometry.Data
import Dodge.Data.LWorld
import Control.Lens
@@ -30,7 +31,9 @@ data CWorld = CWorld
, _timeFlow :: TimeFlowStatus
, _seenWalls :: IS.IntSet
, _floorTiles :: [(Point3, Point3)]
, _cwTiles :: [Tile]
, _pathGraph :: Gr Point2 PathEdge
, _numberFloorVerxs :: Int
}
data TimeFlowStatus
src/Dodge/Data/World.hs
-1
View File
@@ -48,7 +48,6 @@ data World = World
, _pnZoning :: IntMap (IntMap [(Int, Point2)]) --Zoning IM.IntMap Creature
, _peZoning :: IntMap (IntMap (Set PathEdgeNodes))
, _gsZoning :: IntMap (IntMap IntSet)
, _numberFloorVerxs :: Int
}
-- deriving (Eq, Ord, Show, Read) --Generic, Flat)
src/Dodge/Default/World.hs
+2 -1
View File
@@ -48,7 +48,6 @@ defaultWorld =
, _pnZoning = mempty
, _peZoning = mempty
, _gsZoning = mempty --Zoning IM.empty clZoneSize (zonePos _guPos)
, _numberFloorVerxs = 0
}
defaultCWGen :: CWGen
@@ -88,6 +87,8 @@ defaultCWorld =
, _floorTiles = mempty
--, _pathGraph = mempty
, _pathGraph = Data.Graph.Inductive.Graph.empty
, _cwTiles = mempty
, _numberFloorVerxs = 0
}
defaultLWorld :: LWorld
src/Dodge/Layout.hs
+4
View File
@@ -1,6 +1,7 @@
--{-# LANGUAGE TupleSections #-}
module Dodge.Layout (
generateLevelFromRoomList,
tilesFromRooms,
) where
import Dodge.Path.Translate
@@ -211,6 +212,9 @@ gameRoomFromRoom rm =
floorsFromRooms :: [Room] -> [(Point3, Point3)]
floorsFromRooms = concatMap (concatMap tileToRenderList . getTiles . _rmFloor . doRoomShift)
tilesFromRooms :: [Room] -> [Tile]
tilesFromRooms = concatMap (getTiles . _rmFloor . doRoomShift)
floorsFromGenWorld :: GenWorld -> [(Point3, Point3)]
floorsFromGenWorld = floorsFromRooms . IM.elems . _genRooms
src/Dodge/LevelGen.hs
+17 -9
View File
@@ -1,5 +1,7 @@
module Dodge.LevelGen where
import Dodge.Layout
import Data.Preload.Render
import Control.Lens
import Control.Monad.State
import Data.Foldable
@@ -8,15 +10,14 @@ 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
generateWorldFromSeed :: RenderData -> Int -> IO World
generateWorldFromSeed rdata i = do
createDirectoryIfMissing True "log"
createDirectoryIfMissing True "graph"
writeFile "log/attemptedSeeds" ""
@@ -24,13 +25,20 @@ generateWorldFromSeed i = do
writeFile "log/aGeneratedRoomLayout" ""
generateGraphs
(roomList, bounds) <- layoutLevelFromSeed 0 i
postGenerationProcessing $!
_gwWorld (generateLevelFromRoomList roomList initialWorld{_randGen = mkStdGen i})
& cWorld . cwGen . cwgRoomClipping .~ bounds
& cWorld . cwGen . cwgSeed .~ i
postGenerationProcessing rdata
$! (generateLevelFromRoomList roomList initialWorld{_randGen = mkStdGen i})
& gwWorld . cWorld . cwGen . cwgRoomClipping .~ bounds
& gwWorld . cWorld . cwGen . cwgSeed .~ i
postGenerationProcessing :: World -> IO World
postGenerationProcessing w =
postGenerationProcessing :: RenderData -> GenWorld -> IO World
postGenerationProcessing _ gw = do
let w' = _gwWorld gw
-- nfloorvxs <- foldM (pokeTile (rdata ^. floorVBO . vboPtr))
-- 0
-- (tilesFromRooms . IM.elems $ _genRooms gw)
-- bufferPokedVBO (rdata ^. floorVBO) nfloorvxs
let w = w' -- & cWorld . numberFloorVerxs .~ nfloorvxs
& cWorld . cwTiles .~ (tilesFromRooms . IM.elems $ _genRooms gw)
return $ foldl' assignPushDoors w (w ^. cWorld . lWorld . doors)
generateGraphs :: IO ()
src/Dodge/Render.hs
+17 -13
View File
@@ -56,12 +56,13 @@ doDrawing' win pdata u = do
lightPoints = lightsToRender cfig (w ^. cWorld . camPos) (w ^. cWorld . lWorld)
viewFroms@(V2 vfx vfy) = w ^. cWorld . camPos . camViewFrom
shadV = _pictureShaders pdata
nFls = w ^. cWorld . numberFloorVerxs
-- bind as much data into vbos as feasible at this point
-- count mutable vectors setup
layerCounts <- UMV.replicate (numLayers * 6) 0
-- attempt to poke in parallel
let (ws, wp) = wallSPics <> worldSPic cfig w
((nWalls, nWins, nFls), (nShapeVs, nIndices, nSilIndices)) <-
((nWalls, nWins), (nShapeVs, nIndices, nSilIndices)) <-
MP.bindM3
(\_ a b -> return (a, b))
( pokeLayVerxs
@@ -69,15 +70,11 @@ doDrawing' win pdata u = do
layerCounts
wp
)
( pokeWallsWindowsFloor
--(shadVBOptr $ _wallTextureShader pdata)
--(shadVBOptr $ _windowShader pdata)
( pokeWallsWindows
( pdata ^. vboWalls . vboPtr)
( pdata ^. vboWindows . vboPtr)
(shadVBOptr $ _textureArrayShader pdata)
wallPointsCol
windowPoints
(w ^. cWorld . floorTiles)
)
( pokeShape
(_vboPtr $ _vboShapes pdata)
@@ -92,7 +89,7 @@ doDrawing' win pdata u = do
unzip
[ (pdata ^. vboWalls, nWalls)
, (pdata ^. vboWindows, nWins)
, (snd $ _textureArrayShader pdata, nFls)
, (pdata ^. floorVBO, nFls)
]
bufferPokedVBO (_vboShapes pdata) nShapeVs
glNamedBufferSubData
@@ -158,17 +155,24 @@ doDrawing' win pdata u = do
(fromIntegral nIndices)
GL_UNSIGNED_SHORT
nullPtr
-- glDisable GL_CULL_FACE
glDisable GL_CULL_FACE
--draw floor onto base buffer
glDisable GL_BLEND
glUseProgram (pdata ^. textureArrayShader . _1 . shadName)
glBindVertexArray $ pdata ^. textureArrayShader . _1 . shadVAO . vaoName
-- glUseProgram (pdata ^. textureArrayShader . _1 . shadName)
-- glBindVertexArray $ pdata ^. textureArrayShader . _1 . shadVAO . vaoName
-- glBindTextureUnit 1 (pdata ^. toNormalMaps . unTO)
---- glBindTextureUnit 0 $ pdata ^?! textureArrayShader . _1 . shadTex' . _Just . textureObject
-- glDrawArrays
-- (marshalEPrimitiveMode $ pdata ^. textureArrayShader . _1 . shadPrim' )
-- 0
-- (fromIntegral nFls)
glUseProgram (pdata ^. floorShader . shadName)
glBindVertexArray $ pdata ^. floorShader . shadVAO . vaoName
glBindTextureUnit 1 (pdata ^. toNormalMaps . unTO)
glBindTextureUnit 0 $ pdata ^?! textureArrayShader . _1 . shadTex' . _Just . textureObject
glDrawArrays
(marshalEPrimitiveMode $ pdata ^. textureArrayShader . _1 . shadPrim' )
(marshalEPrimitiveMode $ pdata ^. floorShader . shadPrim' )
0
(fromIntegral nFls)
(fromIntegral $ nFls)
glEnable GL_BLEND
--draw lightmap into its own buffer
createLightMap
src/Dodge/Save.hs
-1
View File
@@ -58,7 +58,6 @@ readSaveSlot ss = do
path uv = uv ^. uvWorld . cWorld . pathGraph
removescreenlayers = Just . (uvScreenLayers .~ [])
saveSlotPath :: SaveSlot -> String
saveSlotPath (SaveSlotNum i) = "saveSlot/" ++ show i
saveSlotPath QuicksaveSlot = "saveSlot/QuickSave"
src/Dodge/StartNewGame.hs
+3 -7
View File
@@ -3,9 +3,7 @@ module Dodge.StartNewGame (
startSeedGame,
) where
import Data.Preload.Render
import Shader.Data
import Shader.Poke -- it would be very nice to remove/rework the poking dependencies
import Dodge.WorldLoad
import Dodge.Menu.Loading
import Dodge.Concurrent
--import Dodge.Menu.Option
@@ -30,12 +28,10 @@ startSeedGame _ i u = blockingLoad "LOADING" (startSeedGameConc i $ u ^. preload
startSeedGameConc :: Int -> PreloadData -> IO (Universe -> Maybe Universe)
startSeedGameConc seed pdata = do
w' <- generateWorldFromSeed seed
nfloorvxs <- pokeFloors (pdata ^?! renderData . textureArrayShader . _2 . vboPtr)
(w' ^. cWorld . floorTiles)
let w = w' & numberFloorVerxs .~ nfloorvxs
w <- generateWorldFromSeed (pdata ^?! renderData) seed
writeFile "saveSlot/seed" $ show seed
return $ Just
. saveWorldInSlot (LevelStartSlot 0)
. (uvScreenLayers .~ [])
. (uvWorld .~ w)
. (uvIOEffects %~ (\f uv -> ( (uvWorld . cWorld) (postWorldLoad (pdata ^?! renderData)) uv >>= f)))