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

Use immutable storage for fullscreen vbo

Browse Source
This commit is contained in:
justin
2023-03-21 12:47:02 +00:00
parent 9bba0a43a4
commit ba240723f3
13 changed files with 105 additions and 40 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Data/Preload/Render.hs
+2 -1
View File
@@ -29,7 +29,7 @@ data RenderData = RenderData
, _windowShader :: FullShader
, _wallTextureShader :: FullShader
-- , _textureArrayShader :: (FullShader,VBO)
, _fullscreenShader :: (FullShader,VBO)
, _fullscreenShader :: FullShader
, _bloomBlurShader :: FullShader
, _colorBlurShader :: FullShader
, _barrelShader :: (FullShader,VBO)
@@ -65,6 +65,7 @@ data RenderData = RenderData
, _cloudVBO :: VBO
, _cloudShader :: Shader
, _cloudEBO :: EBO
, _screenTextureVAO :: VAO
}
makeLenses ''RenderData
src/Dodge/Cloud/Draw.hs
+2 -2
View File
@@ -6,8 +6,8 @@ import Picture
drawCloud :: CloudDraw -> Cloud -> Picture
drawCloud cd = case cd of
CloudColor radmult fadet col -> drawCloudWith radmult fadet col
DrawGasCloud col -> const . setLayer MidLayer . setDepth 30 $ color (withAlpha 0.05 col)
$ circleSolid 20
-- DrawGasCloud col -> const . setLayer MidLayer . setDepth 30 $ color (withAlpha 0.05 col)
-- $ circleSolid 20
drawCloudWith :: Float -> Float -> Color -> Cloud -> Picture
drawCloudWith radMult fadet col cl = setLayer MidLayer
src/Dodge/Data/Cloud.hs
-1
View File
@@ -13,7 +13,6 @@ import Geometry
data CloudDraw
= CloudColor Float Float Color -- radius-multiply fade-time color
| DrawGasCloud Color
deriving (Eq, Ord, Show, Read) --Generic, Flat)
data Cloud = Cloud
src/Dodge/Placement/Instance/Wall.hs
+2 -1
View File
@@ -88,7 +88,8 @@ baseBlockPane =
defaultWall
{ _wlLine = (V2 0 0, V2 50 0)
, _wlID = 0
, _wlColor = greyN 0.5
--, _wlColor = greyN 0.5
, _wlColor = orange
, _wlOpacity = Opaque 10
, _wlUnshadowed = True
, _wlFireThrough = True
src/Dodge/Projectile/Update.hs
+4 -1
View File
@@ -107,8 +107,11 @@ doThrust pj w =
& cWorld . lWorld . projectiles . ix i . prjVel %~ (\v -> accel +.+ frict *.* v)
& soundContinue (ShellSound i) newPos missileLaunchS (Just 1)
& makeFlamelet (oldPos -.- vel) 0 (vel +.+ rotateV (pi + sparkD) accel) 3 10
& shellTrailCloud (addZ 20 (oldPos +.+ r1 +.+ 30 *.* normalizeV (oldPos -.- newPos)))
& shellTrailCloud' trailage trailfadetime
(addZ 20 (oldPos +.+ r1 +.+ 30 *.* normalizeV (oldPos -.- newPos)))
where
trailage = fst . randomR (300, 500) $ _randGen w
trailfadetime = fst . randomR (100, 300) $ _randGen w
accel = _prjAcc pj
i = _prjID pj
oldPos = _prjPos pj
src/Dodge/Render.hs
+25 -10
View File
@@ -5,6 +5,7 @@ module Dodge.Render (
--import qualified Data.Vector as V
import Data.List (sortOn)
import Shader.Poke.Cloud
import GLHelp
import Control.Lens
@@ -96,7 +97,7 @@ doDrawing' win pdata u = do
]
bufferPokedVBO (_vboShapes pdata) nShapeVs
(nCloudVs,nCloudIs) <- foldM (pokeCloud (pdata ^. cloudVBO . vboPtr) (pdata ^. cloudEBO . eboPtr))
(0,0) (w ^. cWorld . lWorld . clouds)
(0,0) (sortOn (^. clPos . _3) $ w ^. cWorld . lWorld . clouds)
bufferPokedVBO (pdata ^. cloudVBO) nCloudVs
glNamedBufferSubData
(_eboName $ _cloudEBO pdata)
@@ -208,7 +209,8 @@ doDrawing' win pdata u = do
glBindTexture GL_TEXTURE_2D (pdata ^. fboLighting . _2 . unTO)
glEnable GL_BLEND
glBlendFunc GL_ZERO GL_ONE_MINUS_SRC_COLOR
drawShader (fst $ _fullscreenShader pdata) 4
drawShader (_fullscreenShader pdata) 4
--drawShader (fst $ _fullscreenShader pdata) 4
with GL_COLOR_ATTACHMENT0 $ \ptr ->
glInvalidateNamedFramebufferData
(pdata ^. fboLighting . _1 . unFBO)
@@ -241,7 +243,14 @@ doDrawing' win pdata u = do
glBindFramebuffer GL_FRAMEBUFFER (_unFBO (fst (_fboCloud pdata)))
glDepthFunc GL_LEQUAL
glDepthMask GL_FALSE
glBlendFuncSeparate GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA GL_ONE GL_ONE_MINUS_SRC_ALPHA
--blendFunc $= (SrcAlphaSaturate,One)
--blendColor $= Color4 0.5 0.5 0.5 0.5
--blendFuncSeparate $= ((SrcAlphaSaturate,One) , (One,OneMinusSrcAlpha))
--blendFuncSeparate $= ((SrcAlpha, OneMinusSrcAlpha), (One, OneMinusSrcAlpha))
--glBlendFuncSeparate GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA GL_ONE GL_ONE_MINUS_SRC_ALPHA
glBlendFuncSeparate GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA GL_ONE_MINUS_DST_ALPHA GL_ONE
--glBlendFuncSeparate GL_SRC_ALPHA_SATURATE GL_ONE_MINUS_SRC_ALPHA GL_ONE GL_ONE_MINUS_SRC_ALPHA
--glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA
withArray [GL_COLOR_ATTACHMENT0, GL_NONE] $ \ptr -> glDrawBuffers 2 ptr
withArray [0.5,0.5,0.5,0] $ \ptr -> glClearNamedFramebufferfv
(pdata ^. fboCloud . _1 . unFBO)
@@ -274,10 +283,15 @@ doDrawing' win pdata u = do
2
ptr
glEnable GL_BLEND
--glDisable GL_BLEND
-- the idea is to (roughly) get the average position
glBlendFunci 1 GL_ONE_MINUS_DST_ALPHA GL_DST_ALPHA
-- and to sum the normals
glBlendFunci 2 GL_ONE GL_ONE
--glBlendFunci 1 GL_ONE_MINUS_DST_ALPHA GL_DST_ALPHA
-- or, if we order the clouds, just get the top pos
glBlendFunci 1 GL_ONE GL_ZERO
-- and to sum the normals (based on the alpha)
glBlendFunci 2 GL_SRC_ALPHA GL_ONE
-- just get the top normal
-- glBlendFunci 2 GL_ONE GL_ZERO
glUseProgram (pdata ^. cloudShader . shaderUINT)
glBindVertexArray $ pdata ^. cloudShader . shaderVAO . vaoName
glDrawElements
@@ -286,6 +300,7 @@ doDrawing' win pdata u = do
GL_UNSIGNED_SHORT
nullPtr
drawShader (_windowShader pdata) nWins
glEnable GL_BLEND
----draw lightmap for cloud buffer
glDepthMask GL_FALSE
glDepthFunc GL_LEQUAL
@@ -310,7 +325,7 @@ doDrawing' win pdata u = do
glBindTexture GL_TEXTURE_2D (_unTO . snd $ _fboLighting pdata)
glEnable GL_BLEND
glBlendFuncSeparate GL_ZERO GL_ONE_MINUS_SRC_COLOR GL_ZERO GL_ONE
drawShader (fst $ _fullscreenShader pdata) 4
drawShader (_fullscreenShader pdata) 4
glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA
-- bind base buffer for drawing bloom then clouds
glBindFramebuffer GL_FRAMEBUFFER (_unFBO (fst (_fboBase pdata)))
@@ -318,11 +333,11 @@ doDrawing' win pdata u = do
glEnable GL_BLEND
glBlendFunc GL_SRC_ALPHA GL_ONE
glBindTexture GL_TEXTURE_2D (_unTO . snd $ _fboHalf1 pdata)
drawShader (fst $ _fullscreenShader pdata) 4
drawShader (_fullscreenShader pdata) 4
glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA
--draw shadowed clouds onto base buffer
glBindTexture GL_TEXTURE_2D (pdata ^. fboCloud . _2 . _1 . unTO)
drawShader (fst $ _fullscreenShader pdata) 4
drawShader (_fullscreenShader pdata) 4
--set viewport for radial distortion
setViewportSize (round winx) (round winy)
glDepthFunc GL_ALWAYS
@@ -332,7 +347,7 @@ doDrawing' win pdata u = do
[] -> do
bindTO $ pdata ^. fboBase . _2 . _1
glBindFramebuffer GL_FRAMEBUFFER 0
drawShader (fst $ _fullscreenShader pdata) 4
drawShader (_fullscreenShader pdata) 4
rds -> do
let bindDrawDist :: Distortion -> IO ()
bindDrawDist (RadialDistortion (V2 a b) (V2 c d) (V2 e f) g) = do
src/Dodge/WorldEvent/Cloud.hs
+6 -3
View File
@@ -3,7 +3,7 @@ module Dodge.WorldEvent.Cloud (
smokeCloudAt,
makeThinSmokeAt,
makeThickSmokeAt,
shellTrailCloud,
shellTrailCloud',
spawnSmokeAtCursor,
makeStartCloudAt,
) where
@@ -60,10 +60,13 @@ makeThinSmokeAt = makeCloudAt (CloudColor 4 400 (withAlpha 0.05 black)) 5 400 50
makeStartCloudAt :: Point3 -> World -> World
--makeStartCloudAt = makeCloudAt (CloudColor 2 800 white) 10 400 5
makeStartCloudAt = makeCloudAt (CloudColor 2 800 white) 10 400 50
makeStartCloudAt = makeCloudAt (CloudColor 2 200 white) 10 400 50
shellTrailCloud :: Point3 -> World -> World
shellTrailCloud = makeCloudAt (CloudColor (4 / 3) 800 (greyN 0.5)) 15 400 40
shellTrailCloud = makeCloudAt (CloudColor (3/2) 100 (greyN 0.5)) 15 400 80
shellTrailCloud' :: Int -> Float -> Point3 -> World -> World
shellTrailCloud' age fadet = makeCloudAt (CloudColor (3/2) fadet (greyN 0.5)) 15 age 80
makeFlamerSmokeAt :: Point3 -> World -> World
makeFlamerSmokeAt p w = makeCloudAt (CloudColor 4 300 (greyN x)) 6 200 40 p w
src/Dodge/WorldEvent/SpawnParticle.hs
+1 -1
View File
@@ -93,7 +93,7 @@ makeGasCloud pos vel w =
Cloud
{ _clPos = addZ 20 pos
, _clVel = addZ 0 vel
, _clPict = DrawGasCloud col
, _clPict = CloudColor 3 50 (withAlpha 0.05 col)
, _clRad = 10
, _clAlt = 25
, _clTimer = 400
src/Preload/Render.hs
+22 -11
View File
@@ -136,18 +136,28 @@ preloadRender = do
-- this should really be a 2d texture array
basicTweakZShad <- makeShader "dualTwoD/basicTweakZ" [vert, frag] [4, 4] ETriangles
-- texture shaders, no textures attached
fsShad <- makeShaderSized "texture/simple" [vert, frag] [2, 2] 4 ETriangleStrip
-- note we directly poke the shader vertex data here
-- could possibly use an indirect draw call
pokeArray (shadVBOptr fsShad) $ concat cornerList
let fsshadvao = fsShad ^. _1 . shadVAO
screentexturevbo <- mglCreate glCreateBuffers
withArray (concat cornerList) $ \ptr ->
glNamedBufferStorage
screentexturevbo
(fromIntegral $ floatSize * length (concat cornerList))
ptr
0
screentexturevao <- setupVAOvbo' [2,2] 4 screentexturevbo
bloomBlurShad <- makeShaderUsingVAO "texture/bloomBlur" [vert, frag] ETriangleStrip fsshadvao
colorBlurShad <- makeShaderUsingVAO "texture/colorBlur" [vert, frag] ETriangleStrip fsshadvao
grayscaleShad <- makeShaderUsingVAO "texture/grayscale" [vert, frag] ETriangleStrip fsshadvao
-- fsShad <- makeShaderSized "texture/simple" [vert, frag] [2, 2] 4 ETriangleStrip
-- -- note we directly poke the shader vertex data here
-- -- could possibly use an indirect draw call
-- pokeArray (shadVBOptr fsShad) $ concat cornerList
fsShad <- makeShaderUsingVAO "texture/simple" [vert, frag] ETriangleStrip screentexturevao
bloomBlurShad <- makeShaderUsingVAO "texture/bloomBlur" [vert, frag] ETriangleStrip screentexturevao
colorBlurShad <- makeShaderUsingVAO "texture/colorBlur" [vert, frag] ETriangleStrip screentexturevao
grayscaleShad <- makeShaderUsingVAO "texture/grayscale" [vert, frag] ETriangleStrip screentexturevao
lightingTextureShad <-
makeShaderUsingVAO "lighting/texture" [vert, frag] ETriangleStrip fsshadvao
makeShaderUsingVAO "lighting/texture" [vert, frag] ETriangleStrip screentexturevao
barrelShad <- makeShader "texture/barrel" [vert, geom, frag] [2, 2, 2, 1] EPoints
-- blank wallShader
wallBlankShad <- makeShaderUsingVAO "wall/blank" [vert, geom, frag] EPoints wpColVAO
@@ -168,8 +178,8 @@ preloadRender = do
(cloudshader, cloudebo)
<- makeShaderEBO "cloud/basic" [vert, frag] cloudverxsizes (sum cloudverxsizes)
GL_TRIANGLES cloudvbo
-- bind fixed vertex data
bufferPokedVBO (snd fsShad) 4
-- -- bind fixed vertex data
-- bufferPokedVBO (snd fsShad) 4
framebuf2 <- setupTextureFramebuffer 800 600
framebuf3 <- setupTextureFramebuffer 800 600
@@ -259,6 +269,7 @@ preloadRender = do
, _cloudVBO = cloudvbo
, _cloudShader = cloudshader
, _cloudEBO = cloudebo
, _screenTextureVAO = screentexturevao
}
--------------------end preloadRender
src/Preload/Update.hs
+1 -1
View File
@@ -52,5 +52,5 @@ renderDataResizeUpdate xsize ysize xfull yfull rdata = do
"bloomBlur"
[(vert, bbVert), (frag, bbFrag')]
ETriangleStrip
(rdata ^. fullscreenShader . _1 . shadVAO)
(rdata ^. screenTextureVAO)
return (rdata'{_bloomBlurShader = bbShad})
src/Shader/Compile.hs
+21 -1
View File
@@ -8,6 +8,8 @@ module Shader.Compile (
makeShaderSized,
makeShaderUsingVAO,
setupVAO,
setupVAOvbo,
setupVAOvbo',
setupEBO,
setupVertexAttribPointer,
) where
@@ -195,6 +197,16 @@ shaderTypeExt' _ = undefined
setupVAO :: [Int] -> IO (VAO,VBO)
setupVAO = setupVAOSized numDrawableElements
setupVAOvbo' :: [Int] -> Int -> GLuint -> IO VAO
setupVAOvbo' sizes strd vbo = do
vaoname <- mglCreate glCreateVertexArrays
glBindVertexArray vaoname
setupVertexAttribs' vbo vaoname sizes strd
return $ VAO
{ _vaoName = vaoname
}
setupVAOvbo :: [Int] -> Int -> VBO -> IO VAO
setupVAOvbo sizes strd vbo = do
vaoname <- mglCreate glCreateVertexArrays
@@ -252,7 +264,15 @@ setupVBOSized ndraw vao sizes = do
setupVertexAttribs :: VBO -> GLuint -> [Int] -> Int -> IO ()
setupVertexAttribs vbo vao sizes strd = do
glVertexArrayVertexBuffer vao 0 (vbo ^. vboName) 0 (fromIntegral $ floatSize * strd)
glVertexArrayVertexBuffer vao 0 (_vboName vbo) 0 (fromIntegral $ floatSize * strd)
forM_ (zip3 [0 ..] sizes offs) $ \(loc, siz, off) -> do
setupVertexAttribPointer vao loc siz off
where
offs = scanl (+) 0 sizes
setupVertexAttribs' :: GLuint -> GLuint -> [Int] -> Int -> IO ()
setupVertexAttribs' vbo vao sizes strd = do
glVertexArrayVertexBuffer vao 0 vbo 0 (fromIntegral $ floatSize * strd)
forM_ (zip3 [0 ..] sizes offs) $ \(loc, siz, off) -> do
setupVertexAttribPointer vao loc siz off
where
src/Shader/Poke/Cloud.hs
+3 -4
View File
@@ -21,10 +21,9 @@ pokeCloudVerx ptr cl nv i (dx, dy) =
where
V3 cx cy cz = _clPos cl
V2 x y = V2 cx cy - rad *.* V2 dx dy
rad = _clRad cl
V4 r g b a = case _clPict cl of
CloudColor _ _ col -> col
DrawGasCloud col -> col
CloudColor rad' fadet col = _clPict cl
(rad,V4 r g b a') = (rad'*_clRad cl, col)
a = a' * min 1 (fromIntegral (_clTimer cl) / fadet)
pokeCloudFloat :: Ptr Float -> Int -> Int -> Float -> IO ()
pokeCloudFloat ptr nv i = pokeElemOff ptr (nv * 16 + i)