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

Refactor shaders, vbos and vaos

Browse Source
This commit is contained in:
justin
2023-03-14 20:24:08 +00:00
parent 378af69ca5
commit ed0da4bf1d
11 changed files with 147 additions and 101 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Shader/Bind.hs
+27 -27
View File
@@ -1,25 +1,27 @@
module Shader.Bind
( bindShaderLayers
, bindShaderBuffers
, bindShader
) where
module Shader.Bind (
bindShaderLayers,
--, bindShaderBuffers
bufferPokedVBO,
bufferShaderVector,
) where
import Control.Monad.Primitive
import qualified Data.Vector.Fusion.Stream.Monadic as VFSM
import qualified Data.Vector.Mutable as MV
import qualified Data.Vector.Unboxed.Mutable as UMV
import Foreign hiding (rotate)
--import Control.Monad
import Graphics.GL.Core45
import Shader.Data
import Shader.Parameters
import Foreign hiding (rotate)
import qualified Data.Vector.Unboxed.Mutable as UMV
import qualified Data.Vector.Mutable as MV
import qualified Data.Vector.Fusion.Stream.Monadic as VFSM
import Control.Monad.Primitive
import Control.Monad
import Graphics.GL.Core45
bindArrayBuffers :: Int -> VBO -> IO ()
{-# INLINABLE bindArrayBuffers #-}
bindArrayBuffers numVs theVBO = glNamedBufferSubData
(_vboName theVBO)
0
(fromIntegral $ floatSize * numVs * sum (_vboAttribSizes theVBO))
bufferPokedVBO :: VBO -> Int -> IO ()
{-# INLINEABLE bufferPokedVBO #-}
bufferPokedVBO theVBO numVs =
glNamedBufferSubData
(_vboName theVBO)
0
(fromIntegral $ floatSize * numVs * _vboVertexSize theVBO)
(_vboPtr theVBO)
bindShaderLayers :: MV.MVector (PrimState IO) (FullShader, VBO) -> UMV.MVector (PrimState IO) Int -> IO ()
@@ -27,7 +29,7 @@ bindShaderLayers shads counts = MV.imapM_ f shads
where
f i shad = do
let theVBO = snd shad
stride = sum $ _vboAttribSizes theVBO
stride = _vboVertexSize theVBO
VFSM.mapM_ (g stride theVBO) $ VFSM.enumFromStepN 0 1 6 -- [0..5]
where
g stride theVBO lay = do
@@ -41,12 +43,10 @@ bindShaderLayers shads counts = MV.imapM_ f shads
glNamedBufferSubDataH :: GLuint -> GLintptr -> GLsizeiptr -> Ptr a -> IO ()
glNamedBufferSubDataH = glNamedBufferSubData
bindShader :: MV.MVector (PrimState IO) (FullShader,VBO) -> UMV.MVector (PrimState IO) Int -> IO ()
bindShader shads counts = MV.imapM_ f shads
bufferShaderVector :: MV.MVector (PrimState IO) (FullShader, VBO) -> UMV.MVector (PrimState IO) Int -> IO ()
bufferShaderVector shads counts = MV.imapM_ f shads
where
f i shad = UMV.read counts i >>= flip bindArrayBuffers (snd shad)
f i shad = UMV.read counts i >>= bufferPokedVBO (snd shad)
bindShaderBuffers :: [VBO] -> [Int] -> IO ()
bindShaderBuffers = zipWithM_ f
where
f fs i = bindArrayBuffers i fs
--bindShaderBuffers :: [VBO] -> [Int] -> IO ()
--bindShaderBuffers = zipWithM_ bufferPokedVBO
src/Shader/Compile.hs
+60 -6
View File
@@ -1,5 +1,7 @@
module Shader.Compile (
trueSetupVBO,
makeShader,
makeShader',
makeByteStringShaderUsingVAO,
makeShaderSized,
makeShaderUsingVAO,
@@ -16,6 +18,7 @@ import GLHelp
import Graphics.GL.Core45
import Shader.Data
import Shader.Parameters
--import Graphics.GL.Core45
{- |
Compiles a full shader found within the shader directory.
@@ -35,13 +38,45 @@ makeShader s shaderlist sizes pm = do
(vao,vbo) <- setupVAO sizes
return ( FullShader
{ _shadName = prog
, _shadVAO' = vao
, _shadVAO = vao
, _shadPrim' = pm
, _shadTex' = Nothing
, _shadUnis' = mempty
}
, vbo)
makeShader' ::
-- | First part of the name of the shader
String ->
-- | shader types
[GLenum] ->
-- | The input vertex sizes
[Int] ->
EPrimitiveMode ->
VBO ->
IO FullShader
makeShader' s shaderlist sizes pm vbo = do
prog <- makeSourcedShader s shaderlist
vao <- setupVAOvbo sizes vbo
return $ FullShader
{ _shadName = prog
, _shadVAO = vao
, _shadPrim' = pm
, _shadTex' = Nothing
, _shadUnis' = mempty
}
trueSetupVBO :: Int -> IO VBO
trueSetupVBO vertexsize = do
vboname <- mglCreate glCreateBuffers
thePtr <- mallocArray (vertexsize * numDrawableElements)
-- Allocate space
glNamedBufferData vboname
( fromIntegral $ floatSize * numDrawableElements * vertexsize)
nullPtr
GL_STREAM_DRAW
return VBO {_vboName = vboname, _vboPtr = thePtr, _vboVertexSize = vertexsize}
makeByteStringShaderUsingVAO ::
-- | (Arbitrary) name of the shader
String ->
@@ -55,7 +90,7 @@ makeByteStringShaderUsingVAO s shaderlist pm vao = do
return $
FullShader
{ _shadName = prog
, _shadVAO' = vao
, _shadVAO = vao
, _shadPrim' = pm
, _shadTex' = Nothing
, _shadUnis' = mempty
@@ -75,7 +110,7 @@ makeShaderUsingVAO s shaderlist pm theVAO = do
return $
FullShader
{ _shadName = prog
, _shadVAO' = theVAO
, _shadVAO = theVAO
, _shadPrim' = pm
, _shadTex' = Nothing
, _shadUnis' = mempty
@@ -101,7 +136,7 @@ makeShaderSized s shaderlist sizes ndraw pm = do
(vao,vbo) <- setupVAOSized ndraw sizes
return ( FullShader
{ _shadName = prog
, _shadVAO' = vao
, _shadVAO = vao
, _shadPrim' = pm
, _shadTex' = Nothing
, _shadUnis' = mempty
@@ -127,6 +162,17 @@ shaderTypeExt' _ = undefined
setupVAO :: [Int] -> IO (VAO,VBO)
setupVAO = setupVAOSized numDrawableElements
setupVAOvbo :: [Int] -> VBO -> IO VAO
setupVAOvbo sizes vbo = do
vaoname <- mglCreate glCreateVertexArrays
glBindVertexArray vaoname
setupVertexAttribs vbo vaoname sizes
return $ VAO
{ _vaoName = vaoname
, _vaoAttribSizes = sizes
, _vaoStride = sum sizes
}
setupVAOSized :: Int -> [Int] -> IO (VAO,VBO)
setupVAOSized ndraw sizes = do
vaoname <- mglCreate glCreateVertexArrays
@@ -156,13 +202,21 @@ setupVBOSized ndraw vao sizes = do
VBO
{ _vboName = vboname
, _vboPtr = thePtr
, _vboAttribSizes = sizes
, _vboStride = sum sizes
, _vboVertexSize = sum sizes
}
where
strd = sum sizes
offs = scanl (+) 0 sizes
setupVertexAttribs :: VBO -> GLuint -> [Int] -> IO ()
setupVertexAttribs vbo vao sizes = do
let vboname = _vboName vbo
forM_ (zip3 [0 ..] sizes offs) $ \(loc, siz, off) -> do
setupVertexAttribPointer vao vboname loc siz strd off
where
strd = sum sizes
offs = scanl (+) 0 sizes
-- | Assumes the correct VBO is bound
setupVertexAttribPointer ::
GLuint ->
src/Shader/Data.hs
+4 -6
View File
@@ -17,13 +17,12 @@ module Shader.Data
, vboName
, vboPtr
, vboAttribSizes
, vboStride
, vboVertexSize
, eboName
, eboPtr
, shadName
, shadVAO'
, shadVAO
, shadPrim'
, shadTex'
, shadUnis'
@@ -39,7 +38,7 @@ import Control.Lens
{- | Datatype containing the necessary information for a single shader. -}
data FullShader = FullShader
{ _shadName :: GLuint -- should be shaderID
, _shadVAO' :: VAO
, _shadVAO :: VAO
, _shadPrim' :: EPrimitiveMode
, _shadTex' :: Maybe ShaderTexture
, _shadUnis' :: Vector GLint
@@ -59,8 +58,7 @@ Vertex attributes are interleaved within the vbo. -}
data VBO = VBO
{ _vboName :: GLuint
, _vboPtr :: Ptr Float
, _vboAttribSizes :: [Int] -- ^ It is not clear to me if this is necessary to store or not
, _vboStride :: Int
, _vboVertexSize :: Int
-- add int for AMOUNT of data poked!
}
data EBO = EBO
src/Shader/Poke.hs
+11 -10
View File
@@ -171,18 +171,19 @@ pokeJustV :: Ptr Float
-> IO Int
{-# INLINE pokeJustV #-}
pokeJustV ptr nv sh = do
pokeElemOff ptr (off 0) a
pokeElemOff ptr (off 1) b
pokeElemOff ptr (off 2) c
pokeElemOff ptr (off 3) d
pokeElemOff ptr (off 4) e
pokeElemOff ptr (off 5) f
pokeElemOff ptr (off 6) g
pokeElemOff ptr (off 0) x
pokeElemOff ptr (off 1) y
pokeElemOff ptr (off 2) z
pokeElemOff ptr (off 3) 0
pokeElemOff ptr (off 4) r
pokeElemOff ptr (off 5) g
pokeElemOff ptr (off 6) b
pokeElemOff ptr (off 7) a
return (nv + 1)
where
off i = nv*7 + i
V3 a b c = _svPos sh
V4 d e f g = _svCol sh
off i = nv*8 + i
V3 x y z = _svPos sh
V4 r g b a = _svCol sh
pokeLayVerxs
:: MV.MVector (PrimState IO) (FullShader ,VBO)