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

Use DSA for renderbuffers

Browse Source
This commit is contained in:
justin
2023-03-09 14:58:38 +00:00
parent 0b698e5f5d
commit 76a8b05433
11 changed files with 81 additions and 74 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Data/Preload/Render.hs
+19 -19
View File
@@ -12,25 +12,25 @@ import qualified Data.Vector.Mutable as MV
import Control.Monad.Primitive
data RenderData = RenderData
{ _lightingWallShadShader :: FullShader'
, _lightingLineShadowShader :: FullShader'
, _positionalBlankShader :: FullShader'
, _lightingCapShader :: FullShader'
, _wallBlankShader :: FullShader'
, _windowShader :: FullShader'
, _wallTextureShader :: FullShader'
, _textureArrayShader :: FullShader'
, _fullscreenShader :: FullShader'
, _lightingTextureShader :: FullShader'
--, _fullscreenAlphaHalveShader :: FullShader'
, _bloomBlurShader :: FullShader'
, _colorBlurShader :: FullShader'
, _barrelShader :: FullShader'
, _grayscaleShader :: FullShader'
, _shapeShader :: FullShader'
{ _lightingWallShadShader :: FullShader
, _lightingLineShadowShader :: FullShader
, _positionalBlankShader :: FullShader
, _lightingCapShader :: FullShader
, _wallBlankShader :: FullShader
, _windowShader :: FullShader
, _wallTextureShader :: FullShader
, _textureArrayShader :: FullShader
, _fullscreenShader :: FullShader
, _lightingTextureShader :: FullShader
--, _fullscreenAlphaHalveShader :: FullShader
, _bloomBlurShader :: FullShader
, _colorBlurShader :: FullShader
, _barrelShader :: FullShader
, _grayscaleShader :: FullShader
, _shapeShader :: FullShader
, _shapeEBO :: EBO
, _silhouetteEBO :: EBO
, _pictureShaders :: MV.MVector (PrimState IO) FullShader'
, _pictureShaders :: MV.MVector (PrimState IO) FullShader
, _fbo2 :: (FramebufferObject, TextureObject)
, _fbo3 :: (FramebufferObject, TextureObject)
, _fboHalf1 :: (FramebufferObject, TextureObject)
@@ -41,11 +41,11 @@ data RenderData = RenderData
, _fboBloom :: (FramebufferObject, TextureObject)
, _fboColor :: (FramebufferObject, TextureObject)
, _fboPos :: (FramebufferObject, TextureObject)
, _rboBaseBloom :: RenderbufferObject
, _rboBaseBloom :: GLuint -- RenderbufferObject id
, _fboLighting :: (FramebufferObject, TextureObject)
, _fboLightingHigh :: (FramebufferObject, TextureObject)
, _fboShadow :: (FramebufferObject, (TextureObject,TextureObject))
, _matUBO :: GLuint
, _matUBO :: GLuint -- BufferObject id
}
makeLenses ''RenderData
src/Framebuffer/Setup.hs
+6 -4
View File
@@ -40,28 +40,30 @@ setupShadowFramebuffer = do
return (fboName,(toName,toName2))
setupFramebufferGivenStencil
:: RenderbufferObject
:: GLuint -- RenderbufferObject
-> IO (FramebufferObject, TextureObject)
{-# INLINE setupFramebufferGivenStencil #-}
setupFramebufferGivenStencil rboName = do
fboName <- genObjectName
bindFramebuffer Framebuffer $= fboName
toName <- genObjectName
framebufferRenderbuffer Framebuffer DepthStencilAttachment Renderbuffer rboName
--framebufferRenderbuffer Framebuffer DepthStencilAttachment Renderbuffer rboName
glFramebufferRenderbuffer GL_FRAMEBUFFER GL_DEPTH_STENCIL_ATTACHMENT GL_RENDERBUFFER rboName
fboStatus <- framebufferStatus Framebuffer
case fboStatus of
Complete -> return ()
_ -> putStrLn $ "Framebuffer with given stencil status: " ++ show fboStatus
return (fboName,toName)
setupFramebuffer2GivenStencil
:: RenderbufferObject
:: GLuint -- RenderbufferObject
-> IO (FramebufferObject, (TextureObject,TextureObject))
setupFramebuffer2GivenStencil rboName = do
fboName <- genObjectName
bindFramebuffer Framebuffer $= fboName
toName <- genObjectName
toName2 <- genObjectName
framebufferRenderbuffer Framebuffer DepthStencilAttachment Renderbuffer rboName
--framebufferRenderbuffer Framebuffer DepthStencilAttachment Renderbuffer rboName
glFramebufferRenderbuffer GL_FRAMEBUFFER GL_DEPTH_STENCIL_ATTACHMENT GL_RENDERBUFFER rboName
fboStatus <- framebufferStatus Framebuffer
case fboStatus of
Complete -> return ()
src/Framebuffer/Update.hs
+9 -4
View File
@@ -9,7 +9,7 @@ where
import Data.Preload.Render
import Graphics.Rendering.OpenGL
import Graphics.GL.Core43
import Graphics.GL.Core45
--import Foreign
import Control.Lens
import Control.Monad
@@ -37,15 +37,20 @@ sizeFBOs xsize ysize xfull yfull rdata = do
-- return rdata4
resizeRBO
:: RenderbufferObject
:: GLuint -- RenderbufferObject
-> Int
-> Int
-> IO ()
resizeRBO rboName xsize ysize = do
let xsize' = fromIntegral xsize
ysize' = fromIntegral ysize
bindRenderbuffer Renderbuffer $= rboName
renderbufferStorage Renderbuffer Depth24Stencil8 (RenderbufferSize xsize' ysize')
--bindRenderbuffer Renderbuffer $= rboName
--renderbufferStorage Renderbuffer Depth24Stencil8 (RenderbufferSize xsize' ysize')
glNamedRenderbufferStorage
rboName
GL_DEPTH24_STENCIL8
xsize'
ysize'
updateFBOTO
:: Int
-> Int
src/Preload/Render.hs
+12 -12
View File
@@ -28,11 +28,7 @@ preloadRender :: IO RenderData
preloadRender = do
-- set up uniform buffer object
theUBO <- mglCreateSingle glCreateBuffers
--glBindBuffer GL_UNIFORM_BUFFER theUBO
--bindBuffer UniformBuffer $= Just theUBO
glNamedBufferData theUBO 64 nullPtr GL_STREAM_DRAW
--bufferData UniformBuffer $= (64, nullPtr, StreamDraw)
--bindBufferBase IndexedUniformBuffer 0 $= Just theUBO
glBindBufferBase GL_UNIFORM_BUFFER 0 theUBO
-- setup wall points VBO, VAOs and shaders
wpVBOname <- mglCreateSingle glCreateBuffers
@@ -58,11 +54,10 @@ preloadRender = do
-- setup window points VBO, VAOs and shaders
winVBOname <- mglCreateSingle glCreateBuffers
winVBOptr <- mallocArray (8 * numDrawableWalls)
bufferData ArrayBuffer
$= ( fromIntegral $ floatSize * numDrawableWalls * 8
, nullPtr
, StreamDraw
)
glNamedBufferData wpVBOname
( fromIntegral $ floatSize * numDrawableWalls * 8)
nullPtr
GL_STREAM_DRAW
let winVBO = VBO{_vboName = winVBOname, _vboPtr = winVBOptr, _vboAttribSizes = [4, 4], _vboStride = 8}
--winColVAOname <- genObjectName
--bindVertexArrayObject $= Just winColVAOname
@@ -180,9 +175,14 @@ preloadRender = do
framebuf2 <- setupTextureFramebuffer 800 600
framebuf3 <- setupTextureFramebuffer 800 600
rboBaseBloomName <- genObjectName
bindRenderbuffer Renderbuffer $= rboBaseBloomName
renderbufferStorage Renderbuffer Depth24Stencil8 (RenderbufferSize 800 600)
rboBaseBloomName <- mglCreateSingle glCreateRenderbuffers
--bindRenderbuffer Renderbuffer $= rboBaseBloomName
--renderbufferStorage Renderbuffer Depth24Stencil8 (RenderbufferSize 800 600)
glNamedRenderbufferStorage
rboBaseBloomName
GL_DEPTH24_STENCIL8
800
600
fboBaseName <- setupFramebuffer2GivenStencil rboBaseBloomName
fboCloudName <- setupFramebuffer2GivenStencil rboBaseBloomName
src/Render.hs
+3 -3
View File
@@ -145,7 +145,7 @@ createLightMap pdata lightPoints nWalls nSils nCaps drawObjShads toPos drawCPUSh
pingPongBetween ::
(FramebufferObject, TextureObject) ->
(FramebufferObject, TextureObject) ->
FullShader' ->
FullShader ->
IO ()
pingPongBetween (fb1, to1) (fb2, to2) fs = do
bindFramebuffer Framebuffer $= fb2
@@ -156,7 +156,7 @@ pingPongBetween (fb1, to1) (fb2, to2) fs = do
drawShader fs 4
renderFoldable ::
MV.MVector (PrimState IO) FullShader' ->
MV.MVector (PrimState IO) FullShader ->
Picture ->
IO ()
renderFoldable shadV struct = do
@@ -167,7 +167,7 @@ renderFoldable shadV struct = do
------------------------------end renderFoldable
renderLayer ::
Layer ->
MV.MVector (PrimState IO) FullShader' ->
MV.MVector (PrimState IO) FullShader ->
UMV.MVector (PrimState IO) Int ->
IO ()
renderLayer layer shads counts = do
src/Shader.hs
+7 -7
View File
@@ -21,7 +21,7 @@ import Control.Monad.Primitive
import Foreign
import Graphics.GL.Core45
drawShaderLay :: Int -> UMV.MVector (PrimState IO) Int -> Int -> FullShader' -> IO ()
drawShaderLay :: Int -> UMV.MVector (PrimState IO) Int -> Int -> FullShader -> IO ()
{-# INLINE drawShaderLay #-}
drawShaderLay l countsVector shadIn fs = do
i <- UMV.read countsVector shadIn
@@ -40,7 +40,7 @@ drawShaderLay l countsVector shadIn fs = do
(fromIntegral $ l*numSubElements)
(fromIntegral i)
drawShader :: FullShader' -> Int -> IO ()
drawShader :: FullShader -> Int -> IO ()
{-# INLINE drawShader #-}
drawShader fs i = do
--currentProgram $= Just (_shadProg fs)
@@ -58,11 +58,11 @@ drawShader fs i = do
0
(fromIntegral i)
freeShaderPointers' :: FullShader' -> IO ()
freeShaderPointers' :: FullShader -> IO ()
freeShaderPointers' = free . _vboPtr . _vaoVBO . _shadVAO'
pokeBindFoldable
:: MV.MVector (PrimState IO) FullShader'
:: MV.MVector (PrimState IO) FullShader
-> UMV.MVector (PrimState IO) Int
-> Picture
-> IO ()
@@ -71,7 +71,7 @@ pokeBindFoldable shadV counts m = do
bindShader shadV counts
pokeBindFoldableLayer
:: MV.MVector (PrimState IO) FullShader'
:: MV.MVector (PrimState IO) FullShader
-> UMV.MVector (PrimState IO) Int
-> Picture
-> IO ()
@@ -79,10 +79,10 @@ pokeBindFoldableLayer shadV counts m = do
pokeLayVerxs shadV counts m
bindShaderLayers shadV counts
shadVBOptr :: FullShader' -> Ptr Float
shadVBOptr :: FullShader -> Ptr Float
{-# INLINE shadVBOptr #-}
shadVBOptr = _vboPtr . _vaoVBO . _shadVAO'
shadVBOptr' :: FullShader' -> Ptr Float
shadVBOptr' :: FullShader -> Ptr Float
{-# INLINE shadVBOptr' #-}
shadVBOptr' = _vboPtr . _vaoVBO . _shadVAO'
src/Shader/AuxAddition.hs
+6 -6
View File
@@ -21,10 +21,10 @@ import GLHelp
-- I am not sure if this assumes that the shader is constructed directly before
-- the texture is added...
addTexture :: String -> FullShader' -> IO FullShader'
addTexture :: String -> FullShader -> IO FullShader
addTexture = addTexture2D 3 GL_LINEAR_MIPMAP_LINEAR GL_LINEAR
vaddTextureNoFilter :: String -> FullShader' -> IO FullShader'
vaddTextureNoFilter :: String -> FullShader -> IO FullShader
vaddTextureNoFilter = addTexture2D 1 GL_NEAREST GL_NEAREST
addTexture2D
@@ -32,7 +32,7 @@ addTexture2D
-> GLenum -- minfilter
-> GLenum -- magfilter
-> String -- path to image
-> FullShader' -> IO FullShader'
-> FullShader -> IO FullShader
addTexture2D nlev minfilt magfilt texpath shad = do
Right cmap <- readImage texpath
let texdata = convertRGBA8 cmap
@@ -63,7 +63,7 @@ addTexture2D nlev minfilt magfilt texpath shad = do
-- | for transforming a 256x256 image containing 64 tiles of 16x16 pixels into
-- an image that was directly readable by glTexSubImage3D, used the
-- transformation tilesToLine 8 128 on the underlying pixels.
addTextureArray :: String -> FullShader' -> IO FullShader'
addTextureArray :: String -> FullShader -> IO FullShader
addTextureArray texturePath shad = do
err <- glGetError
print err
@@ -87,10 +87,10 @@ tilesToLine
-> [a]
tilesToLine n w = concat . concat . transpose . chunksOf n . chunksOf w
addUniforms :: [String] -> FullShader' -> IO FullShader'
addUniforms :: [String] -> FullShader -> IO FullShader
addUniforms uniStrings shad = do foldM addUniform shad uniStrings
addUniform :: FullShader' -> String -> IO FullShader'
addUniform :: FullShader -> String -> IO FullShader
addUniform shad unistr = BS.useAsCString (pack unistr) $ \cstr -> do
loc <- glGetUniformLocation (_shadProg' shad) cstr
return $ shad & shadUnis' %~ (V.++ V.fromList [loc])
src/Shader/Bind.hs
+4 -4
View File
@@ -27,7 +27,7 @@ bindArrayBuffers numVs theVBO = do
(fromIntegral $ floatSize * numVs * sum (_vboAttribSizes theVBO))
(_vboPtr theVBO)
bindShaderLayers :: MV.MVector (PrimState IO) FullShader' -> UMV.MVector (PrimState IO) Int -> IO ()
bindShaderLayers :: MV.MVector (PrimState IO) FullShader -> UMV.MVector (PrimState IO) Int -> IO ()
bindShaderLayers shads counts = MV.imapM_ f shads
where
f i shad = do
@@ -47,17 +47,17 @@ bindShaderLayers shads counts = MV.imapM_ f shads
(fromIntegral $ floatSize * numVs * stride)
(_vboPtr theVBO `plusPtr` (floatSize * stride * numSubElements * lay))
bindShader :: MV.MVector (PrimState IO) FullShader' -> UMV.MVector (PrimState IO) Int -> IO ()
bindShader :: MV.MVector (PrimState IO) FullShader -> UMV.MVector (PrimState IO) Int -> IO ()
bindShader shads counts = MV.imapM_ f shads
where
f i shad = UMV.read counts i >>= flip bindArrayBuffers (_vaoVBO . _shadVAO' $ shad)
bindShaderBuffers :: [FullShader'] -> [Int] -> IO ()
bindShaderBuffers :: [FullShader] -> [Int] -> IO ()
bindShaderBuffers = zipWithM_ f
where
f fs i = bindArrayBuffers i $ _vaoVBO $ _shadVAO' fs
bindShaderBuffers' :: [FullShader'] -> [Int] -> IO ()
bindShaderBuffers' :: [FullShader] -> [Int] -> IO ()
bindShaderBuffers' = zipWithM_ f
where
f fs i = bindArrayBuffers i $ _vaoVBO $ _shadVAO' fs
src/Shader/Compile.hs
+8 -8
View File
@@ -29,12 +29,12 @@ makeShader ::
-- | The input vertex sizes
[Int] ->
EPrimitiveMode ->
IO FullShader'
IO FullShader
makeShader s shaderlist sizes pm = do
prog <- makeSourcedShader s shaderlist
vaob <- setupVAO sizes
return $
FullShader'
FullShader
{ _shadProg' = prog
, _shadVAO' = vaob
, _shadPrim' = pm
@@ -49,11 +49,11 @@ makeByteStringShaderUsingVAO ::
[(GLenum, BS.ByteString)] ->
EPrimitiveMode ->
VAO ->
IO FullShader'
IO FullShader
makeByteStringShaderUsingVAO s shaderlist pm vao = do
prog <- makeShaderProgram s shaderlist
return $
FullShader'
FullShader
{ _shadProg' = prog
, _shadVAO' = vao
, _shadPrim' = pm
@@ -69,11 +69,11 @@ makeShaderUsingVAO ::
[GLenum] ->
EPrimitiveMode ->
VAO ->
IO FullShader'
IO FullShader
makeShaderUsingVAO s shaderlist pm theVAO = do
prog <- makeSourcedShader s shaderlist
return $
FullShader'
FullShader
{ _shadProg' = prog
, _shadVAO' = theVAO
, _shadPrim' = pm
@@ -95,12 +95,12 @@ makeShaderSized ::
-- | Number of vertexes that can be poked
Int ->
EPrimitiveMode ->
IO FullShader'
IO FullShader
makeShaderSized s shaderlist sizes ndraw pm = do
prog <- makeSourcedShader s shaderlist
vaob <- setupVAOSized ndraw sizes
return $
FullShader'
FullShader
{ _shadProg' = prog
, _shadVAO' = vaob
, _shadPrim' = pm
src/Shader/Data.hs
+3 -3
View File
@@ -6,7 +6,7 @@ module Shader.Data
, VBO (..)
, EBO (..)
-- , FullShader (..)
, FullShader' (..)
, FullShader (..)
, ShaderTexture (..)
, EPrimitiveMode (..)
-- | Lens functions
@@ -35,7 +35,7 @@ import Graphics.GL.Core43
import Foreign
import Control.Lens
{- | Datatype containing the necessary information for a single shader. -}
data FullShader' = FullShader'
data FullShader = FullShader
{ _shadProg' :: GLuint -- should be shaderID
, _shadVAO' :: VAO
, _shadPrim' :: EPrimitiveMode
@@ -87,5 +87,5 @@ geom' = GL_GEOMETRY_SHADER
frag' = GL_FRAGMENT_SHADER
makeLenses ''VAO
makeLenses ''VBO
makeLenses ''FullShader'
makeLenses ''FullShader
makeLenses ''EBO
src/Shader/Poke.hs
+4 -4
View File
@@ -25,14 +25,14 @@ import Control.Monad.Primitive
--import qualified Control.Monad.Parallel as MP
pokeVerxs
:: MV.MVector (PrimState IO) FullShader'
:: MV.MVector (PrimState IO) FullShader
-> UMV.MVector (PrimState IO) Int
-> Picture
-> IO ()
--pokeVerxs vbos count = S.mapM_ (pokeVerx vbos count) . S.each
pokeVerxs vbos count = VFSM.mapM_ (pokeVerx vbos count) . VFSM.fromList
pokeVerx :: MV.MVector (PrimState IO) FullShader' -> UMV.MVector (PrimState IO) Int -> Verx -> IO ()
pokeVerx :: MV.MVector (PrimState IO) FullShader -> UMV.MVector (PrimState IO) Int -> Verx -> IO ()
pokeVerx vbos offsets Verx{_vxPos=thePos,_vxCol=theCol,_vxExt=ext,_vxShadNum=theShadNum} = do
typeOff <- UMV.unsafeRead offsets sn
basePtr <- _vboPtr . _vaoVBO . _shadVAO' <$> MV.unsafeRead vbos sn
@@ -183,14 +183,14 @@ pokeJustV ptr nv sh = do
V4 d e f g = _svCol sh
pokeLayVerxs
:: MV.MVector (PrimState IO) FullShader'
:: MV.MVector (PrimState IO) FullShader
-> UMV.MVector (PrimState IO) Int
-> Picture
-> IO ()
--pokeLayVerxs vbos counts = S.mapM_ (pokeLayVerx vbos counts) . S.each
pokeLayVerxs vbos counts = VFSM.mapM_ (pokeLayVerx vbos counts) . VFSM.fromList
pokeLayVerx :: MV.MVector (PrimState IO) FullShader' -> UMV.MVector (PrimState IO) Int -> Verx -> IO ()
pokeLayVerx :: MV.MVector (PrimState IO) FullShader -> UMV.MVector (PrimState IO) Int -> Verx -> IO ()
--{-# INLINE pokeLayVerx #-}
pokeLayVerx vbos counts vx = do
theOff <- UMV.unsafeRead counts vecPos