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

Move shader compilation over to raw opengl, errors display incorrect

Browse Source
This commit is contained in:
justin
2023-03-07 15:40:29 +00:00
parent e6ec46edce
commit 3e3fd049a9
12 changed files with 338 additions and 121 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Shader.hs
+25 -14
View File
@@ -1,7 +1,9 @@
module Shader
( freeShaderPointers
, freeShaderPointers'
, drawShaderLay
, shadVBOptr
, shadVBOptr'
, drawShader
, pokeBindFoldable
, pokeBindFoldableLayer
@@ -20,41 +22,46 @@ import Foreign
import Graphics.Rendering.OpenGL hiding (Point,translate,scale,imageHeight)
import Graphics.GL.Core43
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
currentProgram $= Just (_shadProg fs)
bindVertexArrayObject $= Just (_vao $ _shadVAO fs)
case _shadTex fs of
--currentProgram $= Just (_shadProg' fs)
glUseProgram (_shadProg' fs)
bindVertexArrayObject $= Just (_vao $ _shadVAO' fs)
case _shadTex' fs of
Just ShaderTexture{_textureObject = txo}
-> textureBinding Texture2D $= Just txo
_ -> return ()
glDrawArrays
(marshalEPrimitiveMode $ _shadPrim fs)
(marshalEPrimitiveMode $ _shadPrim' fs)
(fromIntegral $ l*numSubElements)
(fromIntegral i)
drawShader :: FullShader -> Int -> IO ()
drawShader :: FullShader' -> Int -> IO ()
{-# INLINE drawShader #-}
drawShader fs i = do
currentProgram $= Just (_shadProg fs)
bindVertexArrayObject $= Just (_vao $ _shadVAO fs)
case _shadTex fs of
--currentProgram $= Just (_shadProg fs)
glUseProgram (_shadProg' fs)
bindVertexArrayObject $= Just (_vao $ _shadVAO' fs)
case _shadTex' fs of
Just ShaderTexture{_textureObject = TextureObject txo
, _textureTarget = tt }
-> glBindTexture tt txo
_ -> return ()
glDrawArrays
(marshalEPrimitiveMode $ _shadPrim fs)
(marshalEPrimitiveMode $ _shadPrim' fs)
0
(fromIntegral i)
freeShaderPointers :: FullShader -> IO ()
freeShaderPointers = free . _vboPtr . _vaoVBO . _shadVAO
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 ()
@@ -63,7 +70,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 ()
@@ -71,6 +78,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 = _vboPtr . _vaoVBO . _shadVAO'
shadVBOptr' :: FullShader' -> Ptr Float
{-# INLINE shadVBOptr' #-}
shadVBOptr' = _vboPtr . _vaoVBO . _shadVAO'