Move shader compilation over to raw opengl, errors display incorrect

This commit is contained in:
2023-03-07 15:40:29 +00:00
parent e6ec46edce
commit 3e3fd049a9
12 changed files with 338 additions and 121 deletions
+32 -22
View File
@@ -76,33 +76,40 @@ createLightMap pdata lightPoints nWalls nSils nCaps drawObjShads toPos drawCPUSh
cullFace $= Nothing
stencilFunc $= (Always, 0, 255)
--draw wall shadows
currentProgram $= Just (_shadProg lwallShad)
uniform (_shadUnis lwallShad V.! 0)
$= Vector3 x y z
bindVertexArrayObject $= lwallShad ^? shadVAO . vao -- Just (_vao $ _shadVAO lwallShad)
--currentProgram $= Just (_shadProg lwallShad)
glUseProgram (_shadProg' lwallShad)
--uniform (_shadUnis lwallShad V.! 0)
-- $= Vector3 x y z
glUniform3f (_shadUnis' lwallShad V.! 0) x y z
bindVertexArrayObject $= lwallShad ^? shadVAO' . vao -- Just (_vao $ _shadVAO lwallShad)
glDrawArrays
(marshalEPrimitiveMode $ _shadPrim lwallShad)
(marshalEPrimitiveMode $ _shadPrim' lwallShad)
0
(fromIntegral nWalls)
case drawObjShads of
GeoObjShads -> do
--draw silhouette shadows
currentProgram $= Just (_shadProg llinesShad)
uniform (_shadUnis llinesShad V.! 0) $= Vector3 x y z
uniform (_shadUnis llinesShad V.! 1) $= rad
bindVertexArrayObject $= Just (_vao $ _shadVAO llinesShad)
--currentProgram $= Just (_shadProg llinesShad)
--uniform (_shadUnis llinesShad V.! 0) $= Vector3 x y z
--uniform (_shadUnis llinesShad V.! 1) $= rad
glUseProgram (_shadProg' llinesShad)
glUniform3f (_shadUnis' llinesShad V.! 0) x y z
glUniform1f (_shadUnis' llinesShad V.! 1) rad
bindVertexArrayObject $= Just (_vao $ _shadVAO' llinesShad)
glDrawElements
(marshalEPrimitiveMode $ _shadPrim llinesShad)
(marshalEPrimitiveMode $ _shadPrim' llinesShad)
(fromIntegral nSils)
GL_UNSIGNED_SHORT
nullPtr
--draw caps on the near plane as required
cullFace $= Just Back
currentProgram $= Just (_shadProg lcapShad)
uniform (_shadUnis lcapShad V.! 0) $= Vector3 x y z
bindVertexArrayObject $= lcapShad ^? shadVAO . vao --Just (_vao $ _shadVAO lcapShad)
--currentProgram $= Just (_shadProg lcapShad)
--uniform (_shadUnis lcapShad V.! 0) $= Vector3 x y z
glUseProgram (_shadProg' lcapShad)
glUniform3f (_shadUnis' lcapShad V.! 0) x y z
bindVertexArrayObject $= lcapShad ^? shadVAO' . vao --Just (_vao $ _shadVAO lcapShad)
glDrawElements
(marshalEPrimitiveMode $ _shadPrim lcapShad)
(marshalEPrimitiveMode $ _shadPrim' lcapShad)
(fromIntegral nCaps)
GL_UNSIGNED_SHORT
nullPtr
@@ -115,12 +122,15 @@ createLightMap pdata lightPoints nWalls nSils nCaps drawObjShads toPos drawCPUSh
colorMask $= Color4 Enabled Enabled Enabled Enabled
--stencilOp $= (OpKeep, OpKeep, OpKeep)
stencilFunc $= (Equal, 0, 255)
currentProgram $= ltextShad ^? shadProg --Just (_shadProg ltextShad)
uniform (_shadUnis ltextShad V.! 0) $= Vector3 x y z
uniform (_shadUnis ltextShad V.! 1) $= Vector4 r g b rad
bindVertexArrayObject $= ltextShad ^? shadVAO . vao -- Just (_vao $ _shadVAO ltextShad)
--currentProgram $= ltextShad ^? shadProg --Just (_shadProg ltextShad)
--uniform (_shadUnis ltextShad V.! 0) $= Vector3 x y z
--uniform (_shadUnis ltextShad V.! 1) $= Vector4 r g b rad
glUseProgram (ltextShad ^. shadProg') --Just (_shadProg ltextShad)
glUniform3f (_shadUnis' ltextShad V.! 0) x y z
glUniform4f (_shadUnis' ltextShad V.! 1) r g b rad
bindVertexArrayObject $= ltextShad ^? shadVAO' . vao -- Just (_vao $ _shadVAO ltextShad)
glDrawArrays
(marshalEPrimitiveMode (_shadPrim ltextShad))
(marshalEPrimitiveMode (_shadPrim' ltextShad))
0
(fromIntegral (4 :: Int))
--cleanup: may not be necessary, depending on what comes after...
@@ -131,7 +141,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
@@ -142,7 +152,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
@@ -153,7 +163,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