From 77c88f68a7db4144525791366a894d87dc9dbf81 Mon Sep 17 00:00:00 2001 From: justin Date: Sat, 18 Mar 2023 09:37:09 +0000 Subject: [PATCH] Create post world load function --- shader/texture/arrayPos.frag | 2 +- src/Data/Tile.hs | 3 +++ src/Dodge/Data/CWorld.hs | 3 +++ src/Dodge/Data/World.hs | 1 - src/Dodge/Default/World.hs | 3 ++- src/Dodge/Layout.hs | 4 ++++ src/Dodge/LevelGen.hs | 26 +++++++++++++++++--------- src/Dodge/Render.hs | 30 +++++++++++++++++------------- src/Dodge/Save.hs | 1 - src/Dodge/StartNewGame.hs | 10 +++------- src/Preload/Render.hs | 6 +++--- src/Shader/Compile.hs | 13 +++++++++++++ src/Shader/Poke.hs | 22 +++++++++++++--------- src/Tile.hs | 4 +--- 14 files changed, 80 insertions(+), 48 deletions(-) diff --git a/shader/texture/arrayPos.frag b/shader/texture/arrayPos.frag index 9b5731767..92c586bab 100644 --- a/shader/texture/arrayPos.frag +++ b/shader/texture/arrayPos.frag @@ -4,7 +4,7 @@ in vec3 vPos; layout (location=0) out vec4 fCol; layout (location=1) out vec4 fPos; layout (location=2) out vec4 normal; -layout (binding=0) uniform sampler2DArray tilesetSampler; +//layout (binding=0) uniform sampler2DArray tilesetSampler; layout (binding=1) uniform sampler2D normalSampler; void main() { diff --git a/src/Data/Tile.hs b/src/Data/Tile.hs index 76b7c3fcc..5033c5b07 100644 --- a/src/Data/Tile.hs +++ b/src/Data/Tile.hs @@ -2,6 +2,8 @@ --{-# LANGUAGE StrictData #-} module Data.Tile where import Geometry.Data +import Data.Aeson +import Data.Aeson.TH import Control.Lens @@ -18,3 +20,4 @@ data Tile = Tile deriving (Eq, Ord, Show) makeLenses ''Floor makeLenses ''Tile +deriveJSON defaultOptions ''Tile diff --git a/src/Dodge/Data/CWorld.hs b/src/Dodge/Data/CWorld.hs index 529d9429d..3bbebae77 100644 --- a/src/Dodge/Data/CWorld.hs +++ b/src/Dodge/Data/CWorld.hs @@ -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 diff --git a/src/Dodge/Data/World.hs b/src/Dodge/Data/World.hs index 6340dcc8e..01823c5df 100644 --- a/src/Dodge/Data/World.hs +++ b/src/Dodge/Data/World.hs @@ -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) diff --git a/src/Dodge/Default/World.hs b/src/Dodge/Default/World.hs index c0a839c17..a203ba296 100644 --- a/src/Dodge/Default/World.hs +++ b/src/Dodge/Default/World.hs @@ -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 diff --git a/src/Dodge/Layout.hs b/src/Dodge/Layout.hs index 650e4ea07..2be1483f7 100644 --- a/src/Dodge/Layout.hs +++ b/src/Dodge/Layout.hs @@ -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 diff --git a/src/Dodge/LevelGen.hs b/src/Dodge/LevelGen.hs index 0523f7c5a..dd1b79a0e 100644 --- a/src/Dodge/LevelGen.hs +++ b/src/Dodge/LevelGen.hs @@ -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 () diff --git a/src/Dodge/Render.hs b/src/Dodge/Render.hs index 485745ca9..b528ca611 100644 --- a/src/Dodge/Render.hs +++ b/src/Dodge/Render.hs @@ -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 diff --git a/src/Dodge/Save.hs b/src/Dodge/Save.hs index 32ae00ad2..2684c745f 100644 --- a/src/Dodge/Save.hs +++ b/src/Dodge/Save.hs @@ -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" diff --git a/src/Dodge/StartNewGame.hs b/src/Dodge/StartNewGame.hs index ca428640c..9afc90337 100644 --- a/src/Dodge/StartNewGame.hs +++ b/src/Dodge/StartNewGame.hs @@ -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))) diff --git a/src/Preload/Render.hs b/src/Preload/Render.hs index e6aa1b1f4..aa7f75f23 100644 --- a/src/Preload/Render.hs +++ b/src/Preload/Render.hs @@ -171,8 +171,8 @@ preloadRender = do makeShader "texture/arrayPos" [vert, frag] [3, 3] ETriangles >>= addTextureArray "data/texture/ayene_wooden_floor_transformed.png" let floorverxstrd = 8 - vbofloor <- setupVBO floorverxstrd - floorshader <- makeShader4 "floor/arrayPos" [vert, frag] [4,4] floorverxstrd ETriangles vbofloor + floorvbo <- setupVBO' floorverxstrd + floorshader <- makeShader4 "floor/arrayPos" [vert, frag] [4,4] floorverxstrd ETriangles floorvbo -- bind fixed vertex data bufferPokedVBO (snd fsShad) 4 framebuf2 <- setupTextureFramebuffer 800 600 @@ -257,7 +257,7 @@ preloadRender = do , _vboWalls = wpVBO , _vboWindows = winVBO , _vboShapes = shVBO - , _floorVBO = vbofloor + , _floorVBO = floorvbo , _floorShader = floorshader , _toNormalMaps = tonormalmap } diff --git a/src/Shader/Compile.hs b/src/Shader/Compile.hs index 8cba3b391..e253e7df3 100644 --- a/src/Shader/Compile.hs +++ b/src/Shader/Compile.hs @@ -1,5 +1,6 @@ module Shader.Compile ( setupVBO, + setupVBO', makeShader, makeShader4, makeByteStringShaderUsingVAO, @@ -80,6 +81,17 @@ setupVBO vertexsize = do GL_STREAM_DRAW return VBO {_vboName = vboname, _vboPtr = thePtr, _vboVertexSize = vertexsize} +setupVBO' :: Int -> IO VBO +setupVBO' vertexsize = do + vboname <- mglCreate glCreateBuffers + thePtr <- mallocArray (vertexsize * numDrawableElements) + -- Allocate space + glNamedBufferData vboname + ( fromIntegral $ floatSize * numDrawableElements * vertexsize) + nullPtr + GL_STATIC_DRAW + return VBO {_vboName = vboname, _vboPtr = thePtr, _vboVertexSize = vertexsize} + makeByteStringShaderUsingVAO :: -- | (Arbitrary) name of the shader String -> @@ -269,6 +281,7 @@ checkErrorGL str f g x statustype = char <- peekCString charPtr error $ str ++ show char +-- use glCreateShaderProgramv here compileAndCheckShader :: String -> (GLenum, BS.ByteString) -> IO GLuint compileAndCheckShader str (theShaderType, sourceCode) = do theShader <- glCreateShader theShaderType diff --git a/src/Shader/Poke.hs b/src/Shader/Poke.hs index fb822615b..a36c80d2c 100644 --- a/src/Shader/Poke.hs +++ b/src/Shader/Poke.hs @@ -4,10 +4,12 @@ module Shader.Poke ( pokeArrayOff, pokeShape, pokeWallsWindowsFloor, + pokeWallsWindows, memoTopPrismEdgeIndices, pokeFloors ) where +import Shader.Poke.Triangulate import Control.Monad.Primitive import qualified Data.Vector as V import qualified Data.Vector.Fusion.Stream.Monadic as VFSM @@ -55,6 +57,17 @@ pokeWallsWindowsFloor wlptr wiptr flptr wls wis fls = do flcounts <- VFSM.foldlM' (pokeF flptr) 0 (VFSM.fromList fls) return (wlcounts1, wlcounts2, flcounts) +pokeWallsWindows :: + Ptr Float -> + Ptr Float -> + [((Point2, Point2), Point4)] -> + [((Point2, Point2), Point4)] -> + IO (Int, Int) +pokeWallsWindows wlptr wiptr wls wis = do + wlcounts1 <- VFSM.foldlM' (pokeW wlptr) 0 (VFSM.fromList wls) + wlcounts2 <- VFSM.foldlM' (pokeW wiptr) 0 (VFSM.fromList wis) + return (wlcounts1, wlcounts2) + pokeFloors :: Ptr Float -> [(Point3, Point3)] -> IO Int @@ -240,15 +253,6 @@ pokeIndex nv eiptr ni ioff = do pokeElemOff eiptr ni (fromIntegral $ nv + ioff) return $ ni + 1 -triangulate :: [Int] -> [Int] -triangulate is = V.toList . V.backpermute (V.fromList is) . V.fromList $ triangulateIndices (length is) - -triangulateIndices :: Int -> [Int] -triangulateIndices i = concatMap f [0 .. i -3] - where - f x - | even x = [0, x + 1, x + 2] - | otherwise = [0, x + 2, x + 1] memoFlatIndices :: V.Vector (UV.Vector Int) memoFlatIndices = diff --git a/src/Tile.hs b/src/Tile.hs index 9c71e4359..c15284aac 100644 --- a/src/Tile.hs +++ b/src/Tile.hs @@ -1,7 +1,5 @@ module Tile - ( tileToRenderList - , makeTileFromPoly - ) where + where import Data.Tile import Geometry