Start cleanup of shader records

This commit is contained in:
2025-11-12 21:37:28 +00:00
parent be64e786f9
commit cdf998a1e2
5 changed files with 55 additions and 61 deletions
+1 -1
View File
@@ -11,7 +11,7 @@ import Graphics.GL.Core45
import Shader.Data import Shader.Data
data RenderData = RenderData data RenderData = RenderData
{ _lightingWallShadShader :: Shader { _shadWallShader :: GLuint
, _lightingLineShadowShader :: Shader , _lightingLineShadowShader :: Shader
, _lightingCapShader :: Shader , _lightingCapShader :: Shader
, _lightingTextureShader :: Shader , _lightingTextureShader :: Shader
-2
View File
@@ -122,7 +122,6 @@ doDrawing' win pdata u = do
glCullFace GL_BACK glCullFace GL_BACK
unless (debugOn Remove_LOS cfig) $ do unless (debugOn Remove_LOS cfig) $ do
glUseProgram (pdata ^. ceilingStencilShader . shaderUINT) glUseProgram (pdata ^. ceilingStencilShader . shaderUINT)
-- glBindVertexArray $ pdata ^. ceilingStencilShader . shaderVAO . vaoName
glBindVertexArray $ pdata ^. dummyVAO . vaoName glBindVertexArray $ pdata ^. dummyVAO . vaoName
glEnable GL_DEPTH_CLAMP glEnable GL_DEPTH_CLAMP
glDrawArrays glDrawArrays
@@ -368,7 +367,6 @@ doDrawing' win pdata u = do
glUseProgram $ pdata ^. windowPullShader . shaderUINT glUseProgram $ pdata ^. windowPullShader . shaderUINT
glBindVertexArray $ pdata ^. dummyVAO . vaoName glBindVertexArray $ pdata ^. dummyVAO . vaoName
glDrawArrays GL_TRIANGLES 0 (fromIntegral nWins * 6) glDrawArrays GL_TRIANGLES 0 (fromIntegral nWins * 6)
--drawShader (_windowShader pdata) nWins
glDisable GL_DEPTH_CLAMP glDisable GL_DEPTH_CLAMP
glDisable GL_CULL_FACE glDisable GL_CULL_FACE
glInvalidateBufferData (pdata ^. vboShapes . vboName) glInvalidateBufferData (pdata ^. vboShapes . vboName)
+6 -17
View File
@@ -95,8 +95,7 @@ preloadRender = do
cloudshader <- makeShaderUsingVAO "pull/cloud" [vert, frag] pmTriangles (VAO dummyvao) cloudshader <- makeShaderUsingVAO "pull/cloud" [vert, frag] pmTriangles (VAO dummyvao)
putStrLn "Setup lighting shaders" putStrLn "Setup lighting shaders"
lightingWallShadShad <- shadwallshader <- makeSourcedShader "lighting/wallShadow" [vert]
makeShaderUsingVAO "lighting/wallShadow" [vert] pmTriangles (VAO dummyvao)
lightingCapShad <- lightingCapShad <-
makeShaderUsingVAO "lighting/cap" [vert] pmTriangles (VAO dummyvao) makeShaderUsingVAO "lighting/cap" [vert] pmTriangles (VAO dummyvao)
lightingLineShadowShad <- lightingLineShadowShad <-
@@ -199,10 +198,9 @@ preloadRender = do
, _silhouetteEBO = UintBO ieshapessbo ieptr , _silhouetteEBO = UintBO ieshapessbo ieptr
, _lightingCapShader = lightingCapShad , _lightingCapShader = lightingCapShad
, _lightingLineShadowShader = lightingLineShadowShad , _lightingLineShadowShader = lightingLineShadowShad
, _lightingWallShadShader = lightingWallShadShad , _shadWallShader = shadwallshader
, _ceilingStencilShader = ceilingstencilshader , _ceilingStencilShader = ceilingstencilshader
, -- , _windowShader = windowshader , _windowPullShader = winpull
_windowPullShader = winpull
, _pullWallShader = wallpull , _pullWallShader = wallpull
, _fullscreenShader = fsShad , _fullscreenShader = fsShad
, _transparencyCompShader = transcompshader , _transparencyCompShader = transcompshader
@@ -224,25 +222,16 @@ preloadRender = do
, _fboPos = fboPosName , _fboPos = fboPosName
, _rboBaseBloom = rboBaseBloomName , _rboBaseBloom = rboBaseBloomName
, _matUBO = theUBO , _matUBO = theUBO
, -- , _winSSBO = winssbo , _vboShapes = shVBO
-- , _wallSSBO = wallssbo
-- , _shapeSSBO = shapessbo
-- , _ishapeSSBO = ishapessbo
-- , _ieshapeSSBO = ieshapessbo
-- , _lightsUBO = lightsubo
-- , _vboWindows = winvbo
_vboShapes = shVBO
, _floorVBO = floorvbo , _floorVBO = floorvbo
, _floorShader = floorshader , _floorShader = floorshader
, _chasmVBO = chasmvbo , _chasmVBO = chasmvbo
, _chasmShader = chasmshader , _chasmShader = chasmshader
, _wallVBO = wallvbo , _wallVBO = wallvbo
, _winVBO = winvbo , _winVBO = winvbo
, -- , _wallShader = wallshader , _cloudVBO = cloudvbo
_cloudVBO = cloudvbo
, _cloudShader = cloudshader , _cloudShader = cloudshader
, -- , _cloudEBO = cloudebo , _screenTextureVAO = screentexturevao
_screenTextureVAO = screentexturevao
, _dummyVAO = VAO dummyvao , _dummyVAO = VAO dummyvao
} }
+3 -6
View File
@@ -133,7 +133,7 @@ renderShadows shadrendertype nWalls nSils nCaps positiontexture normaltexture li
glBindFramebuffer GL_FRAMEBUFFER $ pdata ^. fboLighting . _1 . unFBO glBindFramebuffer GL_FRAMEBUFFER $ pdata ^. fboLighting . _1 . unFBO
let llinesShad = _lightingLineShadowShader pdata let llinesShad = _lightingLineShadowShader pdata
lcapShad = _lightingCapShader pdata lcapShad = _lightingCapShader pdata
lwallShad = _lightingWallShadShader pdata shadwall = _shadWallShader pdata
ltextShad = _lightingTextureShader pdata ltextShad = _lightingTextureShader pdata
-- we assume that the renderbuffer's depth has been correctly set elsewhere -- we assume that the renderbuffer's depth has been correctly set elsewhere
-- we will not be changing that here -- we will not be changing that here
@@ -173,15 +173,12 @@ renderShadows shadrendertype nWalls nSils nCaps positiontexture normaltexture li
-- the first bit has been used to stencil out "ceilings" under which we never draw -- the first bit has been used to stencil out "ceilings" under which we never draw
glStencilFunc GL_NOTEQUAL 128 255 glStencilFunc GL_NOTEQUAL 128 255
--draw wall shadows --draw wall shadows
glUseProgram (_shaderUINT lwallShad) glUseProgram shadwall
glUniform3f 0 x y z glUniform3f 0 x y z
glUniform1f 1 rad glUniform1f 1 rad
--glBindVertexArray $ lwallShad ^. shaderVAO . vaoName -- Just (_vao $ _shadVAO lwallShad) --glBindVertexArray $ lwallShad ^. shaderVAO . vaoName -- Just (_vao $ _shadVAO lwallShad)
glBindVertexArray $ pdata ^. dummyVAO . vaoName -- Just (_vao $ _shadVAO lwallShad) glBindVertexArray $ pdata ^. dummyVAO . vaoName -- Just (_vao $ _shadVAO lwallShad)
glDrawArrays glDrawArrays GL_TRIANGLES 0 (nWalls * 18)
(_unPrimitiveMode $ _shaderPrimitive lwallShad)
0
(nWalls * 18)
case shadrendertype of case shadrendertype of
GeoObjShads -> do GeoObjShads -> do
--draw silhouette shadows --draw silhouette shadows
+45 -35
View File
@@ -9,19 +9,20 @@ module Shader.Compile (
setupVAOUsingVBO, setupVAOUsingVBO,
setupEBO, setupEBO,
toFloatVAs, toFloatVAs,
setupStaticVBOVAO setupStaticVBOVAO,
makeSourcedShader,
) where ) where
import Foreign.C.Types
import Graphics.GL.Types
import Control.Lens import Control.Lens
import Control.Monad import Control.Monad
import qualified Data.ByteString as BS import qualified Data.ByteString as BS
import qualified Data.ByteString.Unsafe as BU import qualified Data.ByteString.Unsafe as BU
import Foreign import Foreign
import Foreign.C.String import Foreign.C.String
import Foreign.C.Types
import GLHelp import GLHelp
import Graphics.GL.Core45 import Graphics.GL.Core45
import Graphics.GL.Types
import Shader.Data import Shader.Data
import Shader.Parameters import Shader.Parameters
@@ -90,7 +91,7 @@ setupVBO vertexsize = do
glNamedBufferStorage glNamedBufferStorage
vboname vboname
(fromIntegral $ floatSize * numDrawableVertices * vertexsize) (fromIntegral $ floatSize * numDrawableVertices * vertexsize)
-- (fromIntegral $ numDrawableVertices * vertexsize) -- (fromIntegral $ numDrawableVertices * vertexsize)
nullPtr nullPtr
--GL_STREAM_DRAW --GL_STREAM_DRAW
GL_DYNAMIC_STORAGE_BIT 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 input ptr is assumed to contain the correct amount of data according to
-- the specified number and type of vertices -- the specified number and type of vertices
-- note the VBO here does not have a sensible ptr value -- 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 setupStaticVBOVAO vas vdata = withArrayLen vdata $ \i ptr -> do
vboname <- mglCreate glCreateBuffers vboname <- mglCreate glCreateBuffers
glNamedBufferStorage glNamedBufferStorage
@@ -107,13 +108,14 @@ setupStaticVBOVAO vas vdata = withArrayLen vdata $ \i ptr -> do
(CPtrdiff (fromIntegral (i * sizeOf (head vdata)))) (CPtrdiff (fromIntegral (i * sizeOf (head vdata))))
ptr ptr
0 0
let vbo = VBO let vbo =
{ _vboName = vboname VBO
, _vboPtr = nullPtr { _vboName = vboname
, _vboVertexBytes = vasTightStride vas , _vboPtr = nullPtr
} , _vboVertexBytes = vasTightStride vas
}
vao <- setupVAOUsingVBO vas vbo vao <- setupVAOUsingVBO vas vbo
return (vbo,vao) return (vbo, vao)
setupVBOStatic :: Int -> IO VBO setupVBOStatic :: Int -> IO VBO
setupVBOStatic vertexsize = do setupVBOStatic vertexsize = do
@@ -126,7 +128,7 @@ setupVBOStatic vertexsize = do
(fromIntegral $ numDrawableVertices * vertexsize) (fromIntegral $ numDrawableVertices * vertexsize)
nullPtr nullPtr
GL_DYNAMIC_STORAGE_BIT GL_DYNAMIC_STORAGE_BIT
--GL_STATIC_DRAW --GL_STATIC_DRAW
return VBO{_vboName = vboname, _vboPtr = thePtr, _vboVertexBytes = vertexsize} return VBO{_vboName = vboname, _vboPtr = thePtr, _vboVertexBytes = vertexsize}
makeByteStringShaderUsingVAO :: makeByteStringShaderUsingVAO ::
@@ -185,13 +187,16 @@ setupVAOUsingVBO vas vbo = do
let strd = vbo ^. vboVertexBytes let strd = vbo ^. vboVertexBytes
vaoname <- mglCreate glCreateVertexArrays vaoname <- mglCreate glCreateVertexArrays
glBindVertexArray vaoname glBindVertexArray vaoname
setupVertexAttribs (vbo ^. vboName) vaoname vas setupVertexAttribs
(vbo ^. vboName)
vaoname
vas
(fromIntegral strd) (fromIntegral strd)
return VAO{_vaoName = vaoname} return VAO{_vaoName = vaoname}
setupEBO :: VAO -> IO UintBO setupEBO :: VAO -> IO UintBO
setupEBO vao = do 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 eboname <- mglCreate glCreateBuffers
glNamedBufferStorage glNamedBufferStorage
eboname eboname
@@ -208,7 +213,7 @@ setupVBOVAO vas = do
vbo <- setupVBO strd vbo <- setupVBO strd
--vao <- setupVAOvbo (toFloatVAs sizes) (sum sizes) (vbo ^. vboName) --vao <- setupVAOvbo (toFloatVAs sizes) (sum sizes) (vbo ^. vboName)
vao <- setupVAOUsingVBO vas vbo vao <- setupVAOUsingVBO vas vbo
return (vao,vbo) return (vao, vbo)
where where
strd = vasTightStride vas strd = vasTightStride vas
@@ -216,13 +221,14 @@ toFloatVAs :: [Int] -> [VertexAttribute]
toFloatVAs = go 0 toFloatVAs = go 0
where where
go _ [] = [] go _ [] = []
go x (i:is) = VertexAttribute (fromIntegral i) GL_FLOAT GL_FALSE x go x (i : is) =
: go (x + fromIntegral floatSize*fromIntegral i) is VertexAttribute (fromIntegral i) GL_FLOAT GL_FALSE x :
go (x + fromIntegral floatSize * fromIntegral i) is
setupVertexAttribs :: GLuint -> GLuint -> [VertexAttribute] -> GLsizei -> IO () setupVertexAttribs :: GLuint -> GLuint -> [VertexAttribute] -> GLsizei -> IO ()
setupVertexAttribs vbo vao vas strd = do setupVertexAttribs vbo vao vas strd = do
glVertexArrayVertexBuffer vao 0 vbo 0 strd glVertexArrayVertexBuffer vao 0 vbo 0 strd
zipWithM_ (setupVertexAttribPointer vao) [0..] vas zipWithM_ (setupVertexAttribPointer vao) [0 ..] vas
-- | Assumes the correct VBO is bound -- | Assumes the correct VBO is bound
setupVertexAttribPointer :: setupVertexAttribPointer ::
@@ -233,7 +239,9 @@ setupVertexAttribPointer ::
IO () IO ()
setupVertexAttribPointer vao loc va = do setupVertexAttribPointer vao loc va = do
glEnableVertexArrayAttrib vao loc' glEnableVertexArrayAttrib vao loc'
glVertexArrayAttribFormat vao loc' glVertexArrayAttribFormat
vao
loc'
(va ^. vaCount) (va ^. vaCount)
(va ^. vaType) (va ^. vaType)
(va ^. vaNormalize) (va ^. vaNormalize)
@@ -302,26 +310,28 @@ vasTightStride :: [VertexAttribute] -> Int
vasTightStride = go 0 vasTightStride = go 0
where where
go x [] = x go x [] = x
go x (v:vs) go x (v : vs)
| x /= fromIntegral (v ^. vaOffset) = error "vasTightStride: vertex offset incorrect" | x /= fromIntegral (v ^. vaOffset) = error "vasTightStride: vertex offset incorrect"
| otherwise = go (x + fromIntegral (v ^. vaCount * fromIntegral (attribSize (v ^. vaType)))) | otherwise =
vs go
(x + fromIntegral (v ^. vaCount * fromIntegral (attribSize (v ^. vaType))))
vs
attribSize :: GLenum -> Int attribSize :: GLenum -> Int
attribSize x = case x of attribSize x = case x of
GL_BYTE -> sizeOf (0 :: GLbyte ) GL_BYTE -> sizeOf (0 :: GLbyte)
GL_SHORT -> sizeOf (0 :: GLshort) GL_SHORT -> sizeOf (0 :: GLshort)
GL_INT -> sizeOf (0 :: GLint) GL_INT -> sizeOf (0 :: GLint)
GL_FIXED -> sizeOf (0 :: GLfixed) GL_FIXED -> sizeOf (0 :: GLfixed)
GL_FLOAT -> sizeOf (0 :: GLfloat) GL_FLOAT -> sizeOf (0 :: GLfloat)
GL_HALF_FLOAT -> sizeOf (0 :: GLhalf) GL_HALF_FLOAT -> sizeOf (0 :: GLhalf)
GL_DOUBLE -> sizeOf (0 :: GLdouble) GL_DOUBLE -> sizeOf (0 :: GLdouble)
GL_UNSIGNED_BYTE -> sizeOf (0 :: GLubyte) GL_UNSIGNED_BYTE -> sizeOf (0 :: GLubyte)
GL_UNSIGNED_SHORT -> sizeOf (0 :: GLushort) GL_UNSIGNED_SHORT -> sizeOf (0 :: GLushort)
GL_UNSIGNED_INT -> sizeOf (0 :: GLuint) GL_UNSIGNED_INT -> sizeOf (0 :: GLuint)
-- GL_INT_2_10_10_10_REV -> sizeOf (0 :: GL_INT_2_10_10_10_REV) -- 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_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_UNSIGNED_INT_10F_11F_11F_REV -> sizeOf (0 :: GL_UNSIGNED_INT_10F_11F_11F_REV)
_ -> error "attribSize : unkown GLenum attribute size" _ -> 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 -- https://hackage.haskell.org/package/OpenGL-3.0.3.0/docs/src/Graphics.Rendering.OpenGL.GL.ByteString.html#withByteStringP