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

Use vertex pulling for clouds

Browse Source
This commit is contained in:
justin
2025-11-12 19:57:07 +00:00
parent ce1937c78e
commit 409180959c
11 changed files with 202 additions and 107 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Data/Preload/Render.hs
+1 -1
View File
@@ -55,7 +55,7 @@ data RenderData = RenderData
, _wallVBO :: VBO
, _cloudVBO :: VBO
, _cloudShader :: Shader
, _cloudEBO :: UintBO
-- , _cloudEBO :: UintBO
, _screenTextureVAO :: VAO
, _dummyVAO :: VAO
}
src/Dodge/Render.hs
+64 -37
View File
@@ -61,6 +61,11 @@ doDrawing' win pdata u = do
let wswp = wallSPics <> worldSPic cfig u
ws = wswp ^. _1
wp = wswp ^. _2
nCloudVs <-
V.foldM'
(pokeCloud (pdata ^. cloudVBO . vboPtr))
0
(V.fromList $ w ^. cWorld . lWorld . clouds)
((nWins, trueNWalls), (nShapeVs, nIndices, nSilIndices)) <-
MP.liftM3
(\_ a b -> (a, b))
@@ -83,28 +88,40 @@ doDrawing' win pdata u = do
(0, 0, 0)
ws
)
(nCloudVs', nCloudIs') <-
-- Might want to sort the clouds based on z depth, not sure
V.foldM'
(pokeCloud (pdata ^. cloudVBO . vboPtr) (pdata ^. cloudEBO . uiboPtr))
(0, 0)
(V.fromList $ w ^. cWorld . lWorld . clouds)
(nCloudVs, nCloudIs) <-
V.foldM'
(pokeDust (pdata ^. cloudVBO . vboPtr) (pdata ^. cloudEBO . uiboPtr))
(nCloudVs', nCloudIs')
(V.fromList $ w ^. cWorld . lWorld . dusts)
-- (nCloudVs', nCloudIs') <-
-- -- Might want to sort the clouds based on z depth, not sure
-- V.foldM'
-- (pokeCloud (pdata ^. cloudVBO . vboPtr) (pdata ^. cloudEBO . uiboPtr))
-- (0, 0)
-- (V.fromList $ w ^. cWorld . lWorld . clouds)
-- (nCloudVs, nCloudIs) <-
-- V.foldM'
-- (pokeDust (pdata ^. cloudVBO . vboPtr) (pdata ^. cloudEBO . uiboPtr))
-- (nCloudVs', nCloudIs')
-- (V.fromList $ w ^. cWorld . lWorld . dusts)
--nCloudVs' <-
-- nCloudVs <-
-- V.foldM'
-- (pokeCloud (pdata ^. cloudVBO . vboPtr))
-- 0
-- (V.fromList $ w ^. cWorld . lWorld . clouds)
-- nCloudVs <-
-- V.foldM'
-- (pokeDust (pdata ^. cloudVBO . vboPtr))
-- nCloudVs'
-- (V.fromList $ w ^. cWorld . lWorld . dusts)
-- bind wall points, silhouette data, surface geometry
bufferShaderLayers shadV pokeCounts
mapM_
(uncurry bufferPokedVBO)
[ (_vboShapes pdata, nShapeVs)
, (pdata ^. cloudVBO, nCloudVs)
-- , (pdata ^. cloudVBO, nCloudVs) should probably do it this way
-- eventually
]
mapM_
(uncurry bufferEBO)
[ (_cloudEBO pdata, nCloudIs)
, (_shapeEBO pdata, nIndices)
[-- (_cloudEBO pdata, nCloudIs)
(_shapeEBO pdata, nIndices)
]
-- set the coordinate uniform ready for drawing elements using world coordinates
bufferPerspectiveMatrixUBO cfig (w ^. wCam) (pdata ^. matUBO)
@@ -115,13 +132,20 @@ doDrawing' win pdata u = do
glNamedBufferSubData (pdata ^. wallVBO . vboName) 0
(fromIntegral $ trueNWalls * sizeOf (0::Float) * 8)
(pdata ^. wallVBO . vboPtr)
glNamedBufferSubData (pdata ^. vboShapes . vboName) 0
(fromIntegral $ nShapeVs * shapeVerxSize)
(pdata ^. vboShapes . vboPtr)
-- glNamedBufferSubData (pdata ^. vboShapes . vboName) 0
-- (fromIntegral $ nShapeVs * shapeVerxSize)
-- (pdata ^. vboShapes . vboPtr)
glNamedBufferSubData (pdata ^. shapeEBO . uiboName) 0
(fromIntegral $ nIndices * (sizeOf (0::GLuint)))
(pdata ^. shapeEBO . uiboPtr)
bufferEBO (pdata ^. silhouetteEBO) nSilIndices
-- withArray [0::Float,0,30,1,1,1,1,1] $
-- glNamedBufferSubData (pdata ^. cloudVBO . vboName) 0
-- (fromIntegral (sizeOf (0::Float)) * 8)
glNamedBufferSubData (pdata ^. cloudVBO . vboName)
0
(fromIntegral $ 8 * nCloudVs * (sizeOf (0::Float)))
(pdata ^. cloudVBO . vboPtr)
setViewport _gr_world_res cfig
glBindFramebuffer GL_FRAMEBUFFER (pdata ^. fboBase . _1 . unFBO)
glDepthMask GL_TRUE
@@ -169,11 +193,8 @@ doDrawing' win pdata u = do
-- 0
-- (fromIntegral trueNWalls)
glUseProgram (pdata ^. pullWallShader . shaderUINT)
glBindVertexArray $ pdata ^. dummyVAO . vaoName
glDrawArrays
GL_TRIANGLES
0
(fromIntegral trueNWalls * 6)
--glBindVertexArray $ pdata ^. dummyVAO . vaoName
glDrawArrays GL_TRIANGLES 0 (fromIntegral trueNWalls * 6)
--draw object shapes onto base buffer
let fs = _shapeShader pdata
glUseProgram (_shaderUINT fs)
@@ -251,11 +272,13 @@ doDrawing' win pdata u = do
glBlendFuncSeparate GL_ZERO GL_ONE GL_CONSTANT_ALPHA GL_ONE_MINUS_SRC_ALPHA
glUseProgram (pdata ^. cloudShader . shaderUINT)
glBindVertexArray $ pdata ^. cloudShader . shaderVAO . vaoName
glDrawElements
(pdata ^. cloudShader . shaderPrimitive . unPrimitiveMode)
(fromIntegral nCloudIs)
GL_UNSIGNED_INT
nullPtr
glDrawArrays GL_TRIANGLES 0 (fromIntegral nCloudVs * 6)
--glDrawArrays GL_TRIANGLES 0 6
-- glDrawElements
-- (pdata ^. cloudShader . shaderPrimitive . unPrimitiveMode)
-- (fromIntegral nCloudIs)
-- GL_UNSIGNED_INT
-- nullPtr
glDepthMask GL_TRUE
--setup downscale viewport for blurring bloom
@@ -295,11 +318,13 @@ doDrawing' win pdata u = do
0
glUseProgram (pdata ^. cloudShader . shaderUINT)
glBindVertexArray $ pdata ^. cloudShader . shaderVAO . vaoName
glDrawElements
(pdata ^. cloudShader . shaderPrimitive . unPrimitiveMode)
(fromIntegral nCloudIs)
GL_UNSIGNED_INT
nullPtr
glDrawArrays GL_TRIANGLES 0 (fromIntegral nCloudVs * 6)
--glDrawArrays GL_TRIANGLES 0 6
---- glDrawElements
---- (pdata ^. cloudShader . shaderPrimitive . unPrimitiveMode)
---- (fromIntegral nCloudIs)
---- GL_UNSIGNED_INT
---- nullPtr
-- glEnable GL_CULL_FACE
-- glEnable GL_DEPTH_CLAMP
-- glCullFace GL_BACK
@@ -327,11 +352,13 @@ doDrawing' win pdata u = do
glUseProgram (pdata ^. cloudShader . shaderUINT)
glBindVertexArray $ pdata ^. cloudShader . shaderVAO . vaoName
-- glDepthMask GL_TRUE
glDrawElements
(pdata ^. cloudShader . shaderPrimitive . unPrimitiveMode)
(fromIntegral nCloudIs)
GL_UNSIGNED_INT
nullPtr
glDrawArrays GL_TRIANGLES 0 (fromIntegral nCloudVs * 6)
--glDrawArrays GL_TRIANGLES 0 6
----glDrawElements
---- (pdata ^. cloudShader . shaderPrimitive . unPrimitiveMode)
---- (fromIntegral nCloudIs)
---- GL_UNSIGNED_INT
---- nullPtr
---
-- glEnable GL_CULL_FACE
-- glEnable GL_DEPTH_CLAMP
src/Preload/Render.hs
+19 -19
View File
@@ -58,7 +58,8 @@ preloadRender = do
let shapessbosize = fromIntegral shapeVerxSize * 65536
glNamedBufferStorage shapessbo shapessbosize nullPtr GL_DYNAMIC_STORAGE_BIT
glBindBufferBase GL_SHADER_STORAGE_BUFFER 3 shapessbo
shptr <- mallocArray (fromIntegral shapessbosize)
--shptr <- mallocArray (fromIntegral shapessbosize)
shptr <- mallocArray (8 * 65536)
let shVBO = VBO shapessbo shptr shapeVerxSize
ishapessbo <- mglCreate glCreateBuffers
@@ -74,27 +75,26 @@ preloadRender = do
glBindBufferBase GL_SHADER_STORAGE_BUFFER 5 ieshapessbo
ieptr <- mallocArray 65536 -- so we can go back to glushort...
cloudbo <- mglCreate glCreateBuffers
let cvsize = (sizeOf (0::Float)) * 8
cloudbosize = fromIntegral cvsize * 65536 -- this should be changed
glNamedBufferStorage cloudbo cloudbosize nullPtr GL_DYNAMIC_STORAGE_BIT
glBindBufferBase GL_SHADER_STORAGE_BUFFER 6 cloudbo
cloudptr <- mallocBytes (fromIntegral cloudbosize)
let cloudvbo = VBO cloudbo cloudptr cvsize
dummyvao <- mglCreate glGenVertexArrays
winpull <- makeShaderUsingVAO "pull/window" [vert,frag] pmTriangles (VAO dummyvao)
wallpull <- makeShaderUsingVAO "pull/wall" [vert,frag] pmTriangles (VAO dummyvao)
putStrLn "Setup shape VBO, VAO, EBO"
-- shVBO <- setupVBO shapeVerxSize
-- shPosVAO <- setupVAOUsingVBO [VertexAttribute 4 GL_FLOAT GL_FALSE 0] shVBO
-- shEBO <- setupEBO shPosVAO
-- note the shape shader vao is distinct from the position vao, but they
-- share an EBO
-- shapeshader <- makeShaderUsingVBO "shape/basic" [vert, frag] shapeVerxAttributes
-- pmTriangles
-- shVBO
-- glVertexArrayElementBuffer (shapeshader ^. shaderVAO . vaoName) (shEBO ^. uiboName)
shapeshader <-
makeShaderUsingVAO "shape/basic" [vert, frag] pmTriangles (VAO dummyvao)
putStrLn "Setup wall/windows VBO, VAO, EBO, shader"
-- winvbo <- setupVBO (floatSize * 8)
cloudshader <- makeShaderUsingVAO "pull/cloud" [vert,frag] pmTriangles (VAO dummyvao)
putStrLn "Setup lighting shaders"
lightingWallShadShad <-
makeShaderUsingVAO "lighting/wallShadow" [vert] pmTriangles (VAO dummyvao)
@@ -158,11 +158,11 @@ preloadRender = do
(toFloatVAs [3])
pmTriangles
chasmvbo
putStrLn "Setup cloud VBO, shader"
let cloudverxsizes = [4, 4, 4]
cloudvbo <- setupVBO (floatSize * sum cloudverxsizes)
(cloudshader, cloudebo) <-
makeShaderEBO "cloud/basic" [vert, frag] (toFloatVAs cloudverxsizes) pmTriangles cloudvbo
-- putStrLn "Setup cloud VBO, shader"
-- let cloudverxsizes = [4, 4, 4]
-- cloudvbo <- setupVBO (floatSize * sum cloudverxsizes)
-- (cloudshader, cloudebo) <-
-- makeShaderEBO "cloud/basic" [vert, frag] (toFloatVAs cloudverxsizes) pmTriangles cloudvbo
framebuf2 <- newTextureFramebuffer
framebuf3 <- newTextureFramebuffer
@@ -240,7 +240,7 @@ preloadRender = do
-- , _wallShader = wallshader
, _cloudVBO = cloudvbo
, _cloudShader = cloudshader
, _cloudEBO = cloudebo
-- , _cloudEBO = cloudebo
, _screenTextureVAO = screentexturevao
, _dummyVAO = VAO dummyvao
}
src/Shader/Poke/Cloud.hs
+47 -28
View File
@@ -4,19 +4,21 @@ module Shader.Poke.Cloud (pokeCloud, pokeDust) where
import Color
import Control.Lens
import qualified Data.Vector.Unboxed as UV
--import qualified Data.Vector.Unboxed as UV
import Dodge.Data.Cloud
import Dodge.Material.Color
import Foreign
import Geometry.Data
import Graphics.GL.Core45
import Linear
--import Graphics.GL.Core45
--import Linear
pokeCloud :: Ptr Float -> Ptr GLuint -> (Int, Int) -> Cloud -> IO (Int, Int)
pokeCloud vptr iptr (nv, ni) = pokeCloudLike vptr iptr (nv, ni) . mkCloudCloudLike
pokeCloud :: Ptr Float -> Int -> Cloud -> IO Int
pokeCloud vptr nv = pokeCloudLike vptr nv . mkCloudCloudLike
--pokeCloud :: Ptr Float -> Ptr GLuint -> (Int, Int) -> Cloud -> IO (Int, Int)
--pokeCloud vptr iptr (nv, ni) = pokeCloudLike vptr iptr (nv, ni) . mkCloudCloudLike
pokeDust :: Ptr Float -> Ptr GLuint -> (Int, Int) -> Dust -> IO (Int, Int)
pokeDust vptr iptr (nv, ni) = pokeCloudLike vptr iptr (nv, ni) . mkDustCloudLike
pokeDust :: Ptr Float -> Int -> Dust -> IO Int
pokeDust vptr nv = pokeCloudLike vptr nv . mkDustCloudLike
mkCloudCloudLike :: Cloud -> (Point3, Point4)
mkCloudCloudLike x = (x ^. clPos, V4 r g b a)
@@ -30,21 +32,38 @@ mkDustCloudLike x = (x ^. dsPos, V4 r g b a)
(V4 r g b a') = dustColor x
a = a' * min 1 (fromIntegral (_dsTimer x) / 100)
pokeCloudLike ::
Ptr Float -> Ptr GLuint -> (Int, Int) -> (Point3, Point4) -> IO (Int, Int)
pokeCloudLike vptr iptr (nv, ni) x = do
UV.imapM_ (pokeCloudLikeVerx vptr x nv) $
UV.fromList [(1, 1), (-1, 1), (-1, -1), (1, -1)]
UV.imapM_ (pokeCloudIndex iptr nv ni) $ UV.fromList [0, 1, 2, 2, 0, 3]
return (nv + 4, ni + 6)
--pokeCloudLike ::
-- Ptr Float -> Ptr GLuint -> (Int, Int) -> (Point3, Point4) -> IO (Int, Int)
--pokeCloudLike vptr iptr (nv, ni) x = do
-- UV.imapM_ (pokeCloudLikeVerx vptr x nv) $
-- UV.fromList [(1, 1), (-1, 1), (-1, -1), (1, -1)]
-- UV.imapM_ (pokeCloudIndex iptr nv ni) $ UV.fromList [0, 1, 2, 2, 0, 3]
-- return (nv + 4, ni + 6)
pokeCloudLike :: Ptr Float -> Int -> (Point3, Point4) -> IO Int
pokeCloudLike ptr nv (V3 x y z, V4 r g b a) = do
pokeElemOff ptr (nv * 8) x
pokeElemOff ptr (nv * 8 + 1) y
pokeElemOff ptr (nv * 8 + 2) z
pokeElemOff ptr (nv * 8 + 3) 1
pokeElemOff ptr (nv * 8 + 4) r
pokeElemOff ptr (nv * 8 + 5) g
pokeElemOff ptr (nv * 8 + 6) b
pokeElemOff ptr (nv * 8 + 7) a
return $ nv + 1
pokeCloudLikeVerx :: Ptr Float -> (Point3, Point4) -> Int -> Int -> (Float, Float) -> IO ()
{-# INLINE pokeCloudLikeVerx #-}
pokeCloudLikeVerx ptr (V3 cx cy cz, V4 r g b a) nv i (dx, dy) =
UV.imapM_ (pokeCloudFloat ptr (nv + i)) $
UV.fromList [x, y, cz, 1, r, g, b, a, dx, dy, 0, 0]
where
V2 x y = V2 cx cy + 20 *^ V2 dx dy
--pokeCloudLikeVerx :: Ptr Float -> (Point3, Point4) -> Int -> Int -> (Float, Float) -> IO ()
--{-# INLINE pokeCloudLikeVerx #-}
--pokeCloudLikeVerx ptr (V3 cx cy cz, V4 r g b a) nv i (dx, dy) =
-- UV.imapM_ (pokeCloudFloat ptr (nv + i)) $
-- UV.fromList [x, y, cz, 1, r, g, b, a, dx, dy, 0, 0]
-- where
-- V2 x y = V2 cx cy + 20 *^ V2 dx dy
--pokeCloudLikeVerx :: Ptr Float -> (Point3, Point4) -> Int -> Int -> (Float, Float) -> IO ()
--{-# INLINE pokeCloudLikeVerx #-}
--pokeCloudLikeVerx ptr (V3 x y z, V4 r g b a) nv i (dx, dy) =
-- UV.imapM_ (pokeCloudFloat ptr (nv + i)) $
-- UV.fromList [x, y, z, 1, r, g, b, a]
clColor :: CloudType -> Color
clColor = \case
@@ -53,13 +72,13 @@ clColor = \case
CryoReleaseCloud -> white
GasCloud -> green
pokeCloudFloat :: Ptr Float -> Int -> Int -> Float -> IO ()
{-# INLINE pokeCloudFloat #-}
pokeCloudFloat ptr nv i = pokeElemOff ptr (nv * 12 + i)
pokeCloudIndex :: Ptr GLuint -> Int -> Int -> Int -> Int -> IO ()
{-# INLINE pokeCloudIndex #-}
pokeCloudIndex ptr nv ni ioff voff = pokeElemOff ptr (ni + ioff) (fromIntegral $ nv + voff)
--pokeCloudFloat :: Ptr Float -> Int -> Int -> Float -> IO ()
--{-# INLINE pokeCloudFloat #-}
--pokeCloudFloat ptr nv i = pokeElemOff ptr (nv * 12 + i)
--
--pokeCloudIndex :: Ptr GLuint -> Int -> Int -> Int -> Int -> IO ()
--{-# INLINE pokeCloudIndex #-}
--pokeCloudIndex ptr nv ni ioff voff = pokeElemOff ptr (ni + ioff) (fromIntegral $ nv + voff)
dustColor :: Dust -> Color
dustColor = materialColor . _dsType
src/Shape/Parameters.hs
-1
View File
@@ -1,5 +1,4 @@
module Shape.Parameters (shapeVerxSize) where
-- ,shapeVerxAttributes) where
import Foreign.Storable