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

Start cleanup of shader records

Browse Source
This commit is contained in:
justin
2025-11-12 21:37:28 +00:00
parent be64e786f9
commit cdf998a1e2
5 changed files with 55 additions and 61 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Shader/Compile.hs
+45 -35
View File
@@ -9,19 +9,20 @@ module Shader.Compile (
setupVAOUsingVBO,
setupEBO,
toFloatVAs,
setupStaticVBOVAO
setupStaticVBOVAO,
makeSourcedShader,
) where
import Foreign.C.Types
import Graphics.GL.Types
import Control.Lens
import Control.Monad
import qualified Data.ByteString as BS
import qualified Data.ByteString.Unsafe as BU
import Foreign
import Foreign.C.String
import Foreign.C.Types
import GLHelp
import Graphics.GL.Core45
import Graphics.GL.Types
import Shader.Data
import Shader.Parameters
@@ -90,7 +91,7 @@ setupVBO vertexsize = do
glNamedBufferStorage
vboname
(fromIntegral $ floatSize * numDrawableVertices * vertexsize)
-- (fromIntegral $ numDrawableVertices * vertexsize)
-- (fromIntegral $ numDrawableVertices * vertexsize)
nullPtr
--GL_STREAM_DRAW
GL_DYNAMIC_STORAGE_BIT
@@ -99,7 +100,7 @@ setupVBO vertexsize = do
-- the input ptr is assumed to contain the correct amount of data according to
-- the specified number and type of vertices
-- note the VBO here does not have a sensible ptr value
setupStaticVBOVAO :: Storable a => [VertexAttribute] -> [a] -> IO (VBO,VAO)
setupStaticVBOVAO :: Storable a => [VertexAttribute] -> [a] -> IO (VBO, VAO)
setupStaticVBOVAO vas vdata = withArrayLen vdata $ \i ptr -> do
vboname <- mglCreate glCreateBuffers
glNamedBufferStorage
@@ -107,13 +108,14 @@ setupStaticVBOVAO vas vdata = withArrayLen vdata $ \i ptr -> do
(CPtrdiff (fromIntegral (i * sizeOf (head vdata))))
ptr
0
let vbo = VBO
{ _vboName = vboname
, _vboPtr = nullPtr
, _vboVertexBytes = vasTightStride vas
}
let vbo =
VBO
{ _vboName = vboname
, _vboPtr = nullPtr
, _vboVertexBytes = vasTightStride vas
}
vao <- setupVAOUsingVBO vas vbo
return (vbo,vao)
return (vbo, vao)
setupVBOStatic :: Int -> IO VBO
setupVBOStatic vertexsize = do
@@ -126,7 +128,7 @@ setupVBOStatic vertexsize = do
(fromIntegral $ numDrawableVertices * vertexsize)
nullPtr
GL_DYNAMIC_STORAGE_BIT
--GL_STATIC_DRAW
--GL_STATIC_DRAW
return VBO{_vboName = vboname, _vboPtr = thePtr, _vboVertexBytes = vertexsize}
makeByteStringShaderUsingVAO ::
@@ -185,13 +187,16 @@ setupVAOUsingVBO vas vbo = do
let strd = vbo ^. vboVertexBytes
vaoname <- mglCreate glCreateVertexArrays
glBindVertexArray vaoname
setupVertexAttribs (vbo ^. vboName) vaoname vas
setupVertexAttribs
(vbo ^. vboName)
vaoname
vas
(fromIntegral strd)
return VAO{_vaoName = vaoname}
setupEBO :: VAO -> IO UintBO
setupEBO vao = do
eboptr <- mallocArray 65536 -- so we can go back to glushort...
eboptr <- mallocArray 65536 -- so we can go back to glushort...
eboname <- mglCreate glCreateBuffers
glNamedBufferStorage
eboname
@@ -208,7 +213,7 @@ setupVBOVAO vas = do
vbo <- setupVBO strd
--vao <- setupVAOvbo (toFloatVAs sizes) (sum sizes) (vbo ^. vboName)
vao <- setupVAOUsingVBO vas vbo
return (vao,vbo)
return (vao, vbo)
where
strd = vasTightStride vas
@@ -216,13 +221,14 @@ toFloatVAs :: [Int] -> [VertexAttribute]
toFloatVAs = go 0
where
go _ [] = []
go x (i:is) = VertexAttribute (fromIntegral i) GL_FLOAT GL_FALSE x
: go (x + fromIntegral floatSize*fromIntegral i) is
go x (i : is) =
VertexAttribute (fromIntegral i) GL_FLOAT GL_FALSE x :
go (x + fromIntegral floatSize * fromIntegral i) is
setupVertexAttribs :: GLuint -> GLuint -> [VertexAttribute] -> GLsizei -> IO ()
setupVertexAttribs vbo vao vas strd = do
glVertexArrayVertexBuffer vao 0 vbo 0 strd
zipWithM_ (setupVertexAttribPointer vao) [0..] vas
zipWithM_ (setupVertexAttribPointer vao) [0 ..] vas
-- | Assumes the correct VBO is bound
setupVertexAttribPointer ::
@@ -233,7 +239,9 @@ setupVertexAttribPointer ::
IO ()
setupVertexAttribPointer vao loc va = do
glEnableVertexArrayAttrib vao loc'
glVertexArrayAttribFormat vao loc'
glVertexArrayAttribFormat
vao
loc'
(va ^. vaCount)
(va ^. vaType)
(va ^. vaNormalize)
@@ -302,26 +310,28 @@ vasTightStride :: [VertexAttribute] -> Int
vasTightStride = go 0
where
go x [] = x
go x (v:vs)
go x (v : vs)
| x /= fromIntegral (v ^. vaOffset) = error "vasTightStride: vertex offset incorrect"
| otherwise = go (x + fromIntegral (v ^. vaCount * fromIntegral (attribSize (v ^. vaType))))
vs
| otherwise =
go
(x + fromIntegral (v ^. vaCount * fromIntegral (attribSize (v ^. vaType))))
vs
attribSize :: GLenum -> Int
attribSize x = case x of
GL_BYTE -> sizeOf (0 :: GLbyte )
GL_SHORT -> sizeOf (0 :: GLshort)
GL_INT -> sizeOf (0 :: GLint)
GL_FIXED -> sizeOf (0 :: GLfixed)
GL_FLOAT -> sizeOf (0 :: GLfloat)
GL_HALF_FLOAT -> sizeOf (0 :: GLhalf)
GL_DOUBLE -> sizeOf (0 :: GLdouble)
GL_UNSIGNED_BYTE -> sizeOf (0 :: GLubyte)
GL_UNSIGNED_SHORT -> sizeOf (0 :: GLushort)
GL_UNSIGNED_INT -> sizeOf (0 :: GLuint)
-- GL_INT_2_10_10_10_REV -> sizeOf (0 :: GL_INT_2_10_10_10_REV)
-- GL_UNSIGNED_INT_2_10_10_10_REV -> sizeOf (0 :: GL_UNSIGNED_INT_2_10_10_10_REV)
-- GL_UNSIGNED_INT_10F_11F_11F_REV -> sizeOf (0 :: GL_UNSIGNED_INT_10F_11F_11F_REV)
GL_BYTE -> sizeOf (0 :: GLbyte)
GL_SHORT -> sizeOf (0 :: GLshort)
GL_INT -> sizeOf (0 :: GLint)
GL_FIXED -> sizeOf (0 :: GLfixed)
GL_FLOAT -> sizeOf (0 :: GLfloat)
GL_HALF_FLOAT -> sizeOf (0 :: GLhalf)
GL_DOUBLE -> sizeOf (0 :: GLdouble)
GL_UNSIGNED_BYTE -> sizeOf (0 :: GLubyte)
GL_UNSIGNED_SHORT -> sizeOf (0 :: GLushort)
GL_UNSIGNED_INT -> sizeOf (0 :: GLuint)
-- GL_INT_2_10_10_10_REV -> sizeOf (0 :: GL_INT_2_10_10_10_REV)
-- GL_UNSIGNED_INT_2_10_10_10_REV -> sizeOf (0 :: GL_UNSIGNED_INT_2_10_10_10_REV)
-- GL_UNSIGNED_INT_10F_11F_11F_REV -> sizeOf (0 :: GL_UNSIGNED_INT_10F_11F_11F_REV)
_ -> error "attribSize : unkown GLenum attribute size"
-- https://hackage.haskell.org/package/OpenGL-3.0.3.0/docs/src/Graphics.Rendering.OpenGL.GL.ByteString.html#withByteStringP