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

Continue render refactor

Browse Source
This commit is contained in:
justin
2023-03-14 14:11:14 +00:00
parent 35f401d8c8
commit 378af69ca5
12 changed files with 118 additions and 112 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Data/Preload/Render.hs
+12 -9
View File
@@ -22,23 +22,23 @@ data RenderData = RenderData
, _shadowEdgeShader :: FullShader , _shadowEdgeShader :: FullShader
, _shadowCapShader :: FullShader , _shadowCapShader :: FullShader
, _shadowWallShader :: FullShader , _shadowWallShader :: FullShader
, _shadowLightShader :: FullShader , _shadowLightShader :: (FullShader,VBO)
, _shadowCombineShader :: FullShader , _shadowCombineShader :: (FullShader,VBO)
, _positionalBlankShader :: FullShader , _positionalBlankShader :: (FullShader,VBO)
, _wallBlankShader :: FullShader , _wallBlankShader :: FullShader
, _windowShader :: FullShader , _windowShader :: FullShader
, _wallTextureShader :: FullShader , _wallTextureShader :: FullShader
, _textureArrayShader :: FullShader , _textureArrayShader :: (FullShader,VBO)
, _fullscreenShader :: FullShader , _fullscreenShader :: (FullShader,VBO)
, --, _fullscreenAlphaHalveShader :: FullShader , --, _fullscreenAlphaHalveShader :: (FullShader,VBO)
_bloomBlurShader :: FullShader _bloomBlurShader :: FullShader
, _colorBlurShader :: FullShader , _colorBlurShader :: FullShader
, _barrelShader :: FullShader , _barrelShader :: (FullShader,VBO)
, _grayscaleShader :: FullShader , _grayscaleShader :: FullShader
, _shapeShader :: FullShader , _shapeShader :: (FullShader,VBO)
, _shapeEBO :: EBO , _shapeEBO :: EBO
, _silhouetteEBO :: EBO , _silhouetteEBO :: EBO
, _pictureShaders :: MV.MVector (PrimState IO) FullShader , _pictureShaders :: MV.MVector (PrimState IO) (FullShader,VBO)
, _fbo2 :: (FBO, TO) , _fbo2 :: (FBO, TO)
, _fbo3 :: (FBO, TO) , _fbo3 :: (FBO, TO)
, _fboHalf1 :: (FBO, TO) , _fboHalf1 :: (FBO, TO)
@@ -56,6 +56,9 @@ data RenderData = RenderData
, _matUBO :: GLuint -- BufferObject id , _matUBO :: GLuint -- BufferObject id
, _isoMatUBO :: GLuint -- BufferObject id , _isoMatUBO :: GLuint -- BufferObject id
, _lightsUBO :: GLuint -- BufferObject id , _lightsUBO :: GLuint -- BufferObject id
, _vboWalls :: VBO
, _vboWindows :: VBO
, _vboShapes :: VBO
} }
makeLenses ''RenderData makeLenses ''RenderData
src/Dodge/Render.hs
+20 -18
View File
@@ -70,15 +70,17 @@ doDrawing' win pdata u = do
wp wp
) )
( pokeWallsWindowsFloor ( pokeWallsWindowsFloor
(shadVBOptr $ _wallTextureShader pdata) --(shadVBOptr $ _wallTextureShader pdata)
(shadVBOptr $ _windowShader pdata) --(shadVBOptr $ _windowShader pdata)
( pdata ^. vboWalls . vboPtr)
( pdata ^. vboWindows . vboPtr)
(shadVBOptr $ _textureArrayShader pdata) (shadVBOptr $ _textureArrayShader pdata)
wallPointsCol wallPointsCol
windowPoints windowPoints
(w ^. cWorld . floorTiles) (w ^. cWorld . floorTiles)
) )
( pokeShape ( pokeShape
(_vboPtr $ _vaoVBO $ _shadVAO' $ _shapeShader pdata) (_vboPtr $ _vboShapes pdata)
(_eboPtr $ _shapeEBO pdata) (_eboPtr $ _shapeEBO pdata)
(_eboPtr $ _silhouetteEBO pdata) (_eboPtr $ _silhouetteEBO pdata)
(0, 0, 0) (0, 0, 0)
@@ -88,10 +90,10 @@ doDrawing' win pdata u = do
bindShaderLayers shadV layerCounts bindShaderLayers shadV layerCounts
uncurry bindShaderBuffers $ uncurry bindShaderBuffers $
unzip unzip
[ (_wallTextureShader pdata, nWalls) [ ((pdata ^. vboWalls), nWalls)
, (_shapeShader pdata, nShapeVs) , (_vboShapes pdata, nShapeVs)
, (_windowShader pdata, nWins) , (pdata ^. vboWindows, nWins)
, (_textureArrayShader pdata, nFls) , (snd $ _textureArrayShader pdata, nFls)
] ]
glNamedBufferSubData glNamedBufferSubData
(_eboName $ _shapeEBO pdata) (_eboName $ _shapeEBO pdata)
@@ -134,15 +136,15 @@ doDrawing' win pdata u = do
renderLayer BottomLayer shadV layerCounts renderLayer BottomLayer shadV layerCounts
--draw object shapes onto base buffer --draw object shapes onto base buffer
let fs = _shapeShader pdata let fs = _shapeShader pdata
glUseProgram (_shadName fs) glUseProgram (_shadName $ fst fs)
glBindVertexArray $ fs ^. shadVAO' . vaoName glBindVertexArray $ fs ^. _1 . shadVAO' . vaoName
glDrawElements glDrawElements
(marshalEPrimitiveMode $ _shadPrim' fs) (marshalEPrimitiveMode $ _shadPrim' $ fst fs)
(fromIntegral nIndices) (fromIntegral nIndices)
GL_UNSIGNED_SHORT GL_UNSIGNED_SHORT
nullPtr nullPtr
--draw floor onto base buffer --draw floor onto base buffer
drawShader (_textureArrayShader pdata) nFls drawShader (fst $ _textureArrayShader pdata) nFls
--draw lightmap into its own buffer --draw lightmap into its own buffer
createLightMap createLightMap
cfig cfig
@@ -161,7 +163,7 @@ doDrawing' win pdata u = do
glBindTexture GL_TEXTURE_2D (pdata ^. fboLighting . _2 . unTO) glBindTexture GL_TEXTURE_2D (pdata ^. fboLighting . _2 . unTO)
glEnable GL_BLEND glEnable GL_BLEND
glBlendFunc GL_ZERO GL_ONE_MINUS_SRC_COLOR glBlendFunc GL_ZERO GL_ONE_MINUS_SRC_COLOR
drawShader (_fullscreenShader pdata) 4 drawShader (fst $ _fullscreenShader pdata) 4
with GL_COLOR_ATTACHMENT0 $ \ptr -> with GL_COLOR_ATTACHMENT0 $ \ptr ->
glInvalidateNamedFramebufferData glInvalidateNamedFramebufferData
(pdata ^. fboLighting . _1 . unFBO) (pdata ^. fboLighting . _1 . unFBO)
@@ -231,7 +233,7 @@ doDrawing' win pdata u = do
glBindTexture GL_TEXTURE_2D (_unTO . snd $ _fboLighting pdata) glBindTexture GL_TEXTURE_2D (_unTO . snd $ _fboLighting pdata)
glEnable GL_BLEND glEnable GL_BLEND
glBlendFuncSeparate GL_ZERO GL_ONE_MINUS_SRC_COLOR GL_ZERO GL_ONE glBlendFuncSeparate GL_ZERO GL_ONE_MINUS_SRC_COLOR GL_ZERO GL_ONE
drawShader (_fullscreenShader pdata) 4 drawShader (fst $ _fullscreenShader pdata) 4
glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA
-- bind base buffer for drawing bloom then clouds -- bind base buffer for drawing bloom then clouds
glBindFramebuffer GL_FRAMEBUFFER (_unFBO (fst (_fboBase pdata))) glBindFramebuffer GL_FRAMEBUFFER (_unFBO (fst (_fboBase pdata)))
@@ -239,11 +241,11 @@ doDrawing' win pdata u = do
glEnable GL_BLEND glEnable GL_BLEND
glBlendFunc GL_SRC_ALPHA GL_ONE glBlendFunc GL_SRC_ALPHA GL_ONE
glBindTexture GL_TEXTURE_2D (_unTO . snd $ _fboHalf1 pdata) glBindTexture GL_TEXTURE_2D (_unTO . snd $ _fboHalf1 pdata)
drawShader (_fullscreenShader pdata) 4 drawShader (fst $ _fullscreenShader pdata) 4
glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA
--draw shadowed clouds onto base buffer --draw shadowed clouds onto base buffer
glBindTexture GL_TEXTURE_2D (_unTO . fst . snd $ _fboCloud pdata) glBindTexture GL_TEXTURE_2D (_unTO . fst . snd $ _fboCloud pdata)
drawShader (_fullscreenShader pdata) 4 drawShader (fst $ _fullscreenShader pdata) 4
--set viewport for radial distortion --set viewport for radial distortion
setViewportSize (round winx) (round winy) setViewportSize (round winx) (round winy)
glDepthFunc GL_ALWAYS glDepthFunc GL_ALWAYS
@@ -253,13 +255,13 @@ doDrawing' win pdata u = do
[] -> do [] -> do
bindTO $ fst $ snd $ _fboBase pdata bindTO $ fst $ snd $ _fboBase pdata
glBindFramebuffer GL_FRAMEBUFFER 0 glBindFramebuffer GL_FRAMEBUFFER 0
drawShader (_fullscreenShader pdata) 4 drawShader (fst $ _fullscreenShader pdata) 4
rds -> do rds -> do
let bindDrawDist :: Distortion -> IO () let bindDrawDist :: Distortion -> IO ()
bindDrawDist (RadialDistortion (V2 a b) (V2 c d) (V2 e f) g) = do bindDrawDist (RadialDistortion (V2 a b) (V2 c d) (V2 e f) g) = do
pokeArray (shadVBOptr $ _barrelShader pdata) [a, b, c, d, e, f, g] pokeArray (shadVBOptr $ _barrelShader pdata) [a, b, c, d, e, f, g]
bindShaderBuffers [_barrelShader pdata] [1] bindShaderBuffers [snd $ _barrelShader pdata] [1]
drawShader (_barrelShader pdata) 1 drawShader (fst $ _barrelShader pdata) 1
fboList = fboList =
take (length rds - 1) (concat (repeat [fst $ _fbo2 pdata, fst $ _fbo3 pdata])) take (length rds - 1) (concat (repeat [fst $ _fbo2 pdata, fst $ _fbo3 pdata]))
++ [FBO 0] ++ [FBO 0]
src/Dodge/Render/Shadow.hs
+17 -16
View File
@@ -17,22 +17,23 @@ import Shader.Parameters
import Shape.Data import Shape.Data
drawCPUShadows :: RenderData -> Shape -> Point3 -> Float -> IO () drawCPUShadows :: RenderData -> Shape -> Point3 -> Float -> IO ()
drawCPUShadows pdata s pos rad = do drawCPUShadows _ _ _ _ = return ()
let theshad = pdata ^. positionalBlankShader --drawCPUShadows pdata s pos rad = do
theptr = _vboPtr $ _vaoVBO $ _shadVAO' theshad -- let theshad = pdata ^. positionalBlankShader
i <- VFSM.foldlM' (pokeShapeShad pos rad theptr) 0 $ VFSM.fromList s -- theptr = _vboPtr $ _vaoVBO $ _shadVAO' theshad
glBufferSubData -- i <- VFSM.foldlM' (pokeShapeShad pos rad theptr) 0 $ VFSM.fromList s
(theshad ^. shadVAO' . vaoVBO . vboName) -- glBufferSubData
0 -- (theshad ^. shadVAO' . vaoVBO . vboName)
(fromIntegral $ floatSize * i) -- 0
(theshad ^. shadVAO' . vaoVBO . vboPtr) -- (fromIntegral $ floatSize * i)
glUseProgram (theshad ^. shadName) -- (theshad ^. shadVAO' . vaoVBO . vboPtr)
glBindVertexArray . _vaoName $ _shadVAO' theshad -- glUseProgram (theshad ^. shadName)
glDrawArrays -- glBindVertexArray . _vaoName $ _shadVAO' theshad
(marshalEPrimitiveMode $ _shadPrim' theshad) -- glDrawArrays
0 -- (marshalEPrimitiveMode $ _shadPrim' theshad)
(fromIntegral i) -- 0
return () -- (fromIntegral i)
-- return ()
pokeShapeShad :: Point3 -> Float -> Ptr Float -> Int -> ShapeObj -> IO Int pokeShapeShad :: Point3 -> Float -> Ptr Float -> Int -> ShapeObj -> IO Int
pokeShapeShad pos r theptr i so = do pokeShapeShad pos r theptr i so = do
src/Preload/Render.hs
+19 -15
View File
@@ -59,8 +59,8 @@ preloadRender = do
glBindVertexArray wpColVAOname glBindVertexArray wpColVAOname
setupVertexAttribPointer wpColVAOname wpVBOname 0 4 8 0 setupVertexAttribPointer wpColVAOname wpVBOname 0 4 8 0
setupVertexAttribPointer wpColVAOname wpVBOname 1 4 8 4 setupVertexAttribPointer wpColVAOname wpVBOname 1 4 8 4
let wpVAO = VAO{_vaoName = wpVAOname, _vaoVBO = wpVBO, _vaoAttribSizes = [4], _vaoStride = 8} let wpVAO = VAO{_vaoName = wpVAOname, _vaoAttribSizes = [4], _vaoStride = 8}
wpColVAO = VAO{_vaoName = wpColVAOname, _vaoVBO = wpVBO, _vaoAttribSizes = [4,4], _vaoStride = 8} wpColVAO = VAO{_vaoName = wpColVAOname, _vaoAttribSizes = [4,4], _vaoStride = 8}
-- setup window points VBO, VAOs and shaders -- setup window points VBO, VAOs and shaders
winVBOname <- mglCreate glCreateBuffers winVBOname <- mglCreate glCreateBuffers
winVBOptr <- mallocArray (8 * numDrawableWalls) winVBOptr <- mallocArray (8 * numDrawableWalls)
@@ -76,7 +76,7 @@ preloadRender = do
setupVertexAttribPointer winColVAOname winVBOname 0 4 8 0 setupVertexAttribPointer winColVAOname winVBOname 0 4 8 0
setupVertexAttribPointer winColVAOname winVBOname 1 4 8 4 setupVertexAttribPointer winColVAOname winVBOname 1 4 8 4
let winColVAO = VAO let winColVAO = VAO
{_vaoName = winColVAOname, _vaoVBO = winVBO, _vaoAttribSizes = [4,4], _vaoStride = 8} {_vaoName = winColVAOname, _vaoAttribSizes = [4,4], _vaoStride = 8}
-- setup shape geometry/cap VBO and two VAOs -- setup shape geometry/cap VBO and two VAOs
shEBOptr <- mallocArray numDrawableElements shEBOptr <- mallocArray numDrawableElements
shEBOname <- mglCreate glCreateBuffers shEBOname <- mglCreate glCreateBuffers
@@ -109,8 +109,8 @@ preloadRender = do
--bindBuffer ElementArrayBuffer $= Just shEBOname --bindBuffer ElementArrayBuffer $= Just shEBOname
glVertexArrayElementBuffer shPosVAOname shEBOname glVertexArrayElementBuffer shPosVAOname shEBOname
let shPosColVAO = VAO let shPosColVAO = VAO
{_vaoName = shPosColVAOname, _vaoVBO = shVBO, _vaoAttribSizes = [3,4], _vaoStride = 7} {_vaoName = shPosColVAOname, _vaoAttribSizes = [3,4], _vaoStride = 7}
shPosVAO = VAO{_vaoName = shPosVAOname, _vaoVBO = shVBO, _vaoAttribSizes = [3], _vaoStride = 7} shPosVAO = VAO{_vaoName = shPosVAOname, _vaoAttribSizes = [3], _vaoStride = 7}
--setup silhouette edge VAO --setup silhouette edge VAO
--shEdgeVAOname <- genObjectName --shEdgeVAOname <- genObjectName
--bindVertexArrayObject $= Just shEdgeVAOname --bindVertexArrayObject $= Just shEdgeVAOname
@@ -129,7 +129,7 @@ preloadRender = do
nullPtr nullPtr
GL_STREAM_DRAW GL_STREAM_DRAW
let silEBO = EBO{_eboName = silEBOname, _eboPtr = silEBOptr} let silEBO = EBO{_eboName = silEBOname, _eboPtr = silEBOptr}
shEdgeVAO = VAO{_vaoName = shEdgeVAOname, _vaoVBO = shVBO, _vaoAttribSizes = [3], _vaoStride = 7} shEdgeVAO = VAO{_vaoName = shEdgeVAOname, _vaoAttribSizes = [3], _vaoStride = 7}
-- shEdgeVAO is unecessary? -- shEdgeVAO is unecessary?
-- lighting shaders -- lighting shaders
lightingWallShadShad <- lightingWallShadShad <-
@@ -152,7 +152,7 @@ preloadRender = do
[1] 1 [1] 1
EPoints EPoints
shadowcombineshader <- makeShaderSized "shadow/combine" [vert,geom,frag] [1] 1 EPoints shadowcombineshader <- makeShaderSized "shadow/combine" [vert,geom,frag] [1] 1 EPoints
poke (shadVBOptr' shadowlightshader) 1 poke (shadVBOptr shadowlightshader) 1
-- positional shader -- positional shader
positionalBlankShad <- makeShader "positional/blank" [vert, frag] [3] ETriangles positionalBlankShad <- makeShader "positional/blank" [vert, frag] [3] ETriangles
@@ -164,7 +164,7 @@ preloadRender = do
bezierQuadShader <- makeShader "dualTwoD/bezierQuad" [vert, frag] [3, 4, 4] ETriangleStrip bezierQuadShader <- makeShader "dualTwoD/bezierQuad" [vert, frag] [3, 4, 4] ETriangleStrip
cslist <- cslist <-
makeShader "dualTwoD/character" [vert, frag] [3, 4, 2] ETriangles makeShader "dualTwoD/character" [vert, frag] [3, 4, 2] ETriangles
>>= vaddTextureNoFilter "data/texture/charMap.png" >>= (_1 (vaddTextureNoFilter "data/texture/charMap.png"))
-- this should really be a 2d texture array -- this should really be a 2d texture array
basicTweakZShad <- makeShader "dualTwoD/basicTweakZ" [vert, frag] [4, 4] ETriangles basicTweakZShad <- makeShader "dualTwoD/basicTweakZ" [vert, frag] [4, 4] ETriangles
-- fullscreen shaders -- fullscreen shaders
@@ -174,9 +174,9 @@ preloadRender = do
fsShad <- makeShaderSized "texture/simple" [vert, frag] [2, 2] 4 ETriangleStrip fsShad <- makeShaderSized "texture/simple" [vert, frag] [2, 2] 4 ETriangleStrip
-- note we directly poke the shader vertex data here -- note we directly poke the shader vertex data here
-- could possibly use an indirect draw call -- could possibly use an indirect draw call
pokeArray (shadVBOptr' fsShad) $ concat cornerList pokeArray (shadVBOptr fsShad) $ concat cornerList
let fsshadvao = fsShad ^. shadVAO' let fsshadvao = fsShad ^. _1 . shadVAO'
bloomBlurShad <- makeShaderUsingVAO "texture/bloomBlur" [vert, frag] ETriangleStrip fsshadvao bloomBlurShad <- makeShaderUsingVAO "texture/bloomBlur" [vert, frag] ETriangleStrip fsshadvao
colorBlurShad <- makeShaderUsingVAO "texture/colorBlur" [vert, frag] ETriangleStrip fsshadvao colorBlurShad <- makeShaderUsingVAO "texture/colorBlur" [vert, frag] ETriangleStrip fsshadvao
@@ -199,7 +199,7 @@ preloadRender = do
>>= addTextureArray "data/texture/ayene_wooden_floor_transformed.png" >>= addTextureArray "data/texture/ayene_wooden_floor_transformed.png"
-- >>= addTextureArray "data/texture/ayene_wooden_floor.png" -- >>= addTextureArray "data/texture/ayene_wooden_floor.png"
-- bind fixed vertex data -- bind fixed vertex data
bindShaderBuffers [fsShad] [4, 4] bindShaderBuffers [snd fsShad] [4, 4]
framebuf2 <- setupTextureFramebuffer 800 600 framebuf2 <- setupTextureFramebuffer 800 600
framebuf3 <- setupTextureFramebuffer 800 600 framebuf3 <- setupTextureFramebuffer 800 600
@@ -245,7 +245,7 @@ preloadRender = do
return $ return $
RenderData RenderData
{ _pictureShaders = shadV { _pictureShaders = shadV
, _shapeShader = bslista{_shadVAO' = shPosColVAO} , _shapeShader = bslista & _1 . shadVAO' .~ shPosColVAO
, _shapeEBO = shEBO , _shapeEBO = shEBO
, _silhouetteEBO = silEBO , _silhouetteEBO = silEBO
, _lightingCapShader = lightingCapShad , _lightingCapShader = lightingCapShad
@@ -284,6 +284,9 @@ preloadRender = do
, _matUBO = theUBO , _matUBO = theUBO
, _isoMatUBO = isoUBO , _isoMatUBO = isoUBO
, _lightsUBO = lightsubo , _lightsUBO = lightsubo
, _vboWalls = wpVBO
, _vboWindows = winVBO
, _vboShapes = shVBO
} }
--------------------end preloadRender --------------------end preloadRender
@@ -309,8 +312,9 @@ initializeGLState = do
glEnable GL_DEPTH_TEST glEnable GL_DEPTH_TEST
cleanUpRenderPreload :: RenderData -> IO () cleanUpRenderPreload :: RenderData -> IO ()
cleanUpRenderPreload pd = do cleanUpRenderPreload _ = return ()
--cleanUpRenderPreload pd = do
-- TODO fix this -- TODO fix this
--mapM_ freeShaderPointers $ _pictureShaders pd --mapM_ freeShaderPointers $ _pictureShaders pd
freeShaderPointers' $ _lightingWallShadShader pd --freeShaderPointers' $ _lightingWallShadShader pd
freeShaderPointers' $ _fullscreenShader pd --freeShaderPointers' $ _fullscreenShader pd
src/Preload/Update.hs
+1 -1
View File
@@ -52,5 +52,5 @@ renderDataResizeUpdate xsize ysize xfull yfull rdata = do
"bloomBlur" "bloomBlur"
[(vert, bbVert), (frag, bbFrag')] [(vert, bbVert), (frag, bbFrag')]
ETriangleStrip ETriangleStrip
(rdata ^. fullscreenShader . shadVAO') (rdata ^. fullscreenShader . _1 . shadVAO')
return (rdata'{_bloomBlurShader = bbShad}) return (rdata'{_bloomBlurShader = bbShad})
src/Render.hs
+5 -5
View File
@@ -275,12 +275,12 @@ instanceLightMap cfig pdata lightPoints nWalls nSils nCaps toPos = do
glDepthFunc GL_ALWAYS glDepthFunc GL_ALWAYS
glColorMask GL_TRUE GL_TRUE GL_TRUE GL_TRUE glColorMask GL_TRUE GL_TRUE GL_TRUE GL_TRUE
glStencilFunc GL_EQUAL 0 255 glStencilFunc GL_EQUAL 0 255
glUseProgram (pdata ^. shadowLightShader . shadName) glUseProgram (pdata ^. shadowLightShader . _1 . shadName)
-- bind world position texture -- bind world position texture
bindTO toPos bindTO toPos
-- glBindVertexArray $ pdata ^. shadowLightShader . shadVAO' . vaoName -- glBindVertexArray $ pdata ^. shadowLightShader . shadVAO' . vaoName
glDrawArrays glDrawArrays
(marshalEPrimitiveMode $ pdata ^. shadowLightShader . shadPrim') (marshalEPrimitiveMode $ pdata ^. shadowLightShader . _1 . shadPrim')
0 0
1 1
glDisable GL_CULL_FACE glDisable GL_CULL_FACE
@@ -292,7 +292,7 @@ instanceLightMap cfig pdata lightPoints nWalls nSils nCaps toPos = do
glBindTexture GL_TEXTURE_2D_ARRAY (pdata ^. fboShadow . _2 . _1 . unTO) glBindTexture GL_TEXTURE_2D_ARRAY (pdata ^. fboShadow . _2 . _1 . unTO)
glEnable GL_BLEND glEnable GL_BLEND
glBlendFunc GL_ZERO GL_ONE_MINUS_SRC_COLOR glBlendFunc GL_ZERO GL_ONE_MINUS_SRC_COLOR
glUseProgram (pdata ^. shadowCombineShader . shadName) glUseProgram (pdata ^. shadowCombineShader . _1 . shadName)
glDrawArrays glDrawArrays
(marshalEPrimitiveMode EPoints) (marshalEPrimitiveMode EPoints)
0 0
@@ -322,7 +322,7 @@ pingPongBetween (fb1, to1) (fb2, to2) fs = do
drawShader fs 4 drawShader fs 4
renderFoldable :: renderFoldable ::
MV.MVector (PrimState IO) FullShader -> MV.MVector (PrimState IO) (FullShader,VBO) ->
Picture -> Picture ->
IO () IO ()
renderFoldable shadV struct = do renderFoldable shadV struct = do
@@ -333,7 +333,7 @@ renderFoldable shadV struct = do
------------------------------end renderFoldable ------------------------------end renderFoldable
renderLayer :: renderLayer ::
Layer -> Layer ->
MV.MVector (PrimState IO) FullShader -> MV.MVector (PrimState IO) (FullShader,VBO) ->
UMV.MVector (PrimState IO) Int -> UMV.MVector (PrimState IO) Int ->
IO () IO ()
renderLayer layer shads counts = do renderLayer layer shads counts = do
src/Shader.hs
+11 -16
View File
@@ -2,7 +2,6 @@ module Shader
( freeShaderPointers' ( freeShaderPointers'
, drawShaderLay , drawShaderLay
, shadVBOptr , shadVBOptr
, shadVBOptr'
, drawShader , drawShader
, pokeBindFoldable , pokeBindFoldable
, pokeBindFoldableLayer , pokeBindFoldableLayer
@@ -21,22 +20,22 @@ import Control.Monad.Primitive
import Foreign import Foreign
import Graphics.GL.Core45 import Graphics.GL.Core45
drawShaderLay :: Int -> UMV.MVector (PrimState IO) Int -> Int -> FullShader -> IO () drawShaderLay :: Int -> UMV.MVector (PrimState IO) Int -> Int -> (FullShader,VBO) -> IO ()
{-# INLINE drawShaderLay #-} {-# INLINE drawShaderLay #-}
drawShaderLay l countsVector shadIn fs = do drawShaderLay l countsVector shadIn fs = do
i <- UMV.read countsVector shadIn i <- UMV.read countsVector shadIn
--currentProgram $= Just (_shadProg' fs) --currentProgram $= Just (_shadProg' fs)
glUseProgram (_shadName fs) glUseProgram (_shadName $ fst fs)
glBindVertexArray $ fs ^. shadVAO' . vaoName glBindVertexArray $ fs ^. _1 . shadVAO' . vaoName
--bindVertexArrayObject $= Just (_vaoName $ _shadVAO' fs) --bindVertexArrayObject $= Just (_vaoName $ _shadVAO' fs)
case _shadTex' fs of case _shadTex' $ fst fs of
Just ShaderTexture{_textureObject = txo} --, _textureTarget = tt} Just ShaderTexture{_textureObject = txo} --, _textureTarget = tt}
-- -> textureBinding Texture2D $= Just txo -- -> textureBinding Texture2D $= Just txo
-- -> glBindTexture tt txo -- -> glBindTexture tt txo
-> glBindTextureUnit 0 txo -> glBindTextureUnit 0 txo
_ -> return () _ -> return ()
glDrawArrays glDrawArrays
(marshalEPrimitiveMode $ _shadPrim' fs) (marshalEPrimitiveMode $ _shadPrim' $ fst fs)
(fromIntegral $ l*numSubElements) (fromIntegral $ l*numSubElements)
(fromIntegral i) (fromIntegral i)
@@ -58,11 +57,11 @@ drawShader fs i = do
0 0
(fromIntegral i) (fromIntegral i)
freeShaderPointers' :: FullShader -> IO () freeShaderPointers' :: (FullShader,VBO) -> IO ()
freeShaderPointers' = free . _vboPtr . _vaoVBO . _shadVAO' freeShaderPointers' = free . _vboPtr . snd
pokeBindFoldable pokeBindFoldable
:: MV.MVector (PrimState IO) FullShader :: MV.MVector (PrimState IO) (FullShader,VBO)
-> UMV.MVector (PrimState IO) Int -> UMV.MVector (PrimState IO) Int
-> Picture -> Picture
-> IO () -> IO ()
@@ -71,7 +70,7 @@ pokeBindFoldable shadV counts m = do
bindShader shadV counts bindShader shadV counts
pokeBindFoldableLayer pokeBindFoldableLayer
:: MV.MVector (PrimState IO) FullShader :: MV.MVector (PrimState IO) (FullShader,VBO)
-> UMV.MVector (PrimState IO) Int -> UMV.MVector (PrimState IO) Int
-> Picture -> Picture
-> IO () -> IO ()
@@ -79,10 +78,6 @@ pokeBindFoldableLayer shadV counts m = do
pokeLayVerxs shadV counts m pokeLayVerxs shadV counts m
bindShaderLayers shadV counts bindShaderLayers shadV counts
shadVBOptr :: FullShader -> Ptr Float shadVBOptr :: (FullShader,VBO) -> Ptr Float
{-# INLINE shadVBOptr #-} {-# INLINE shadVBOptr #-}
shadVBOptr = _vboPtr . _vaoVBO . _shadVAO' shadVBOptr = _vboPtr . snd
shadVBOptr' :: FullShader -> Ptr Float
{-# INLINE shadVBOptr' #-}
shadVBOptr' = _vboPtr . _vaoVBO . _shadVAO'
src/Shader/AuxAddition.hs
+4 -3
View File
@@ -62,8 +62,8 @@ addTexture2D nlev minfilt magfilt texpath shad = do
-- | for transforming a 256x256 image containing 64 tiles of 16x16 pixels into -- | for transforming a 256x256 image containing 64 tiles of 16x16 pixels into
-- an image that was directly readable by glTexSubImage3D, used the -- an image that was directly readable by glTexSubImage3D, used the
-- transformation tilesToLine 8 128 on the underlying pixels. -- transformation tilesToLine 8 128 on the underlying pixels.
addTextureArray :: String -> FullShader -> IO FullShader addTextureArray :: String -> (FullShader,VBO) -> IO (FullShader,VBO)
addTextureArray texturePath shad = do addTextureArray texturePath (shad,vbo) = do
err <- glGetError err <- glGetError
print err print err
Right cmap <- readImage texturePath Right cmap <- readImage texturePath
@@ -75,8 +75,9 @@ addTextureArray texturePath shad = do
glGenerateTextureMipmap texname glGenerateTextureMipmap texname
glTextureParameteri texname GL_TEXTURE_MIN_FILTER (unsafeCoerce GL_LINEAR_MIPMAP_LINEAR) glTextureParameteri texname GL_TEXTURE_MIN_FILTER (unsafeCoerce GL_LINEAR_MIPMAP_LINEAR)
glTextureParameteri texname GL_TEXTURE_MAG_FILTER (unsafeCoerce GL_LINEAR) glTextureParameteri texname GL_TEXTURE_MAG_FILTER (unsafeCoerce GL_LINEAR)
return $ shad & shadTex' ?~ ShaderTexture return (shad & shadTex' ?~ ShaderTexture
{ _textureObject = texname} { _textureObject = texname}
, vbo)
-- I am completely unclear on why this works with its current parameters -- I am completely unclear on why this works with its current parameters
tilesToLine tilesToLine
src/Shader/Bind.hs
+6 -6
View File
@@ -22,11 +22,11 @@ bindArrayBuffers numVs theVBO = glNamedBufferSubData
(fromIntegral $ floatSize * numVs * sum (_vboAttribSizes theVBO)) (fromIntegral $ floatSize * numVs * sum (_vboAttribSizes theVBO))
(_vboPtr theVBO) (_vboPtr theVBO)
bindShaderLayers :: MV.MVector (PrimState IO) FullShader -> UMV.MVector (PrimState IO) Int -> IO () bindShaderLayers :: MV.MVector (PrimState IO) (FullShader, VBO) -> UMV.MVector (PrimState IO) Int -> IO ()
bindShaderLayers shads counts = MV.imapM_ f shads bindShaderLayers shads counts = MV.imapM_ f shads
where where
f i shad = do f i shad = do
let theVBO = _vaoVBO $ _shadVAO' shad let theVBO = snd shad
stride = sum $ _vboAttribSizes theVBO stride = sum $ _vboAttribSizes theVBO
VFSM.mapM_ (g stride theVBO) $ VFSM.enumFromStepN 0 1 6 -- [0..5] VFSM.mapM_ (g stride theVBO) $ VFSM.enumFromStepN 0 1 6 -- [0..5]
where where
@@ -41,12 +41,12 @@ bindShaderLayers shads counts = MV.imapM_ f shads
glNamedBufferSubDataH :: GLuint -> GLintptr -> GLsizeiptr -> Ptr a -> IO () glNamedBufferSubDataH :: GLuint -> GLintptr -> GLsizeiptr -> Ptr a -> IO ()
glNamedBufferSubDataH = glNamedBufferSubData glNamedBufferSubDataH = glNamedBufferSubData
bindShader :: MV.MVector (PrimState IO) FullShader -> UMV.MVector (PrimState IO) Int -> IO () bindShader :: MV.MVector (PrimState IO) (FullShader,VBO) -> UMV.MVector (PrimState IO) Int -> IO ()
bindShader shads counts = MV.imapM_ f shads bindShader shads counts = MV.imapM_ f shads
where where
f i shad = UMV.read counts i >>= flip bindArrayBuffers (_vaoVBO . _shadVAO' $ shad) f i shad = UMV.read counts i >>= flip bindArrayBuffers (snd shad)
bindShaderBuffers :: [FullShader] -> [Int] -> IO () bindShaderBuffers :: [VBO] -> [Int] -> IO ()
bindShaderBuffers = zipWithM_ f bindShaderBuffers = zipWithM_ f
where where
f fs i = bindArrayBuffers i $ _vaoVBO $ _shadVAO' fs f fs i = bindArrayBuffers i fs
src/Shader/Compile.hs
+14 -15
View File
@@ -29,18 +29,18 @@ makeShader ::
-- | The input vertex sizes -- | The input vertex sizes
[Int] -> [Int] ->
EPrimitiveMode -> EPrimitiveMode ->
IO FullShader IO (FullShader,VBO)
makeShader s shaderlist sizes pm = do makeShader s shaderlist sizes pm = do
prog <- makeSourcedShader s shaderlist prog <- makeSourcedShader s shaderlist
vaob <- setupVAO sizes (vao,vbo) <- setupVAO sizes
return $ return ( FullShader
FullShader
{ _shadName = prog { _shadName = prog
, _shadVAO' = vaob , _shadVAO' = vao
, _shadPrim' = pm , _shadPrim' = pm
, _shadTex' = Nothing , _shadTex' = Nothing
, _shadUnis' = mempty , _shadUnis' = mempty
} }
, vbo)
makeByteStringShaderUsingVAO :: makeByteStringShaderUsingVAO ::
-- | (Arbitrary) name of the shader -- | (Arbitrary) name of the shader
@@ -95,18 +95,18 @@ makeShaderSized ::
-- | Number of vertexes that can be poked -- | Number of vertexes that can be poked
Int -> Int ->
EPrimitiveMode -> EPrimitiveMode ->
IO FullShader IO (FullShader,VBO)
makeShaderSized s shaderlist sizes ndraw pm = do makeShaderSized s shaderlist sizes ndraw pm = do
prog <- makeSourcedShader s shaderlist prog <- makeSourcedShader s shaderlist
vaob <- setupVAOSized ndraw sizes (vao,vbo) <- setupVAOSized ndraw sizes
return $ return ( FullShader
FullShader
{ _shadName = prog { _shadName = prog
, _shadVAO' = vaob , _shadVAO' = vao
, _shadPrim' = pm , _shadPrim' = pm
, _shadTex' = Nothing , _shadTex' = Nothing
, _shadUnis' = mempty , _shadUnis' = mempty
} }
, vbo)
{- | Compile shader and get its uniform locations. {- | Compile shader and get its uniform locations.
supposes the shader code is in the shader folder, with the string names supposes the shader code is in the shader folder, with the string names
@@ -124,21 +124,20 @@ shaderTypeExt' GL_FRAGMENT_SHADER = ".frag"
shaderTypeExt' _ = undefined shaderTypeExt' _ = undefined
-- I think that this requires that the correct shader program is bound? -- I think that this requires that the correct shader program is bound?
setupVAO :: [Int] -> IO VAO setupVAO :: [Int] -> IO (VAO,VBO)
setupVAO = setupVAOSized numDrawableElements setupVAO = setupVAOSized numDrawableElements
setupVAOSized :: Int -> [Int] -> IO VAO setupVAOSized :: Int -> [Int] -> IO (VAO,VBO)
setupVAOSized ndraw sizes = do setupVAOSized ndraw sizes = do
vaoname <- mglCreate glCreateVertexArrays vaoname <- mglCreate glCreateVertexArrays
glBindVertexArray vaoname glBindVertexArray vaoname
theVBO <- setupVBOSized ndraw vaoname sizes theVBO <- setupVBOSized ndraw vaoname sizes
return $ return ( VAO
VAO
{ _vaoName = vaoname { _vaoName = vaoname
, _vaoAttribSizes = sizes , _vaoAttribSizes = sizes
, _vaoStride = sum sizes , _vaoStride = sum sizes
, _vaoVBO = theVBO
} }
, theVBO)
setupVBOSized :: Int -> GLuint -> [Int] -> IO VBO setupVBOSized :: Int -> GLuint -> [Int] -> IO VBO
setupVBOSized ndraw vao sizes = do setupVBOSized ndraw vao sizes = do
src/Shader/Data.hs
+3 -2
View File
@@ -11,7 +11,7 @@ module Shader.Data
, EPrimitiveMode (..) , EPrimitiveMode (..)
-- | Lens functions -- | Lens functions
, vaoName , vaoName
, vaoVBO -- , vaoVBO
, vaoAttribSizes , vaoAttribSizes
, vaoStride , vaoStride
@@ -50,7 +50,7 @@ data VAO = VAO
{ _vaoName :: GLuint { _vaoName :: GLuint
, _vaoAttribSizes :: [Int] -- ^ It is not clear to me if this is necessary to store or not , _vaoAttribSizes :: [Int] -- ^ It is not clear to me if this is necessary to store or not
, _vaoStride :: Int , _vaoStride :: Int
, _vaoVBO :: VBO -- , _vaoVBO :: VBO
} }
{- | Vertex buffer object: contains the reference to the object, {- | Vertex buffer object: contains the reference to the object,
a pointer to a location with space that can be written to the buffer, a pointer to a location with space that can be written to the buffer,
@@ -61,6 +61,7 @@ data VBO = VBO
, _vboPtr :: Ptr Float , _vboPtr :: Ptr Float
, _vboAttribSizes :: [Int] -- ^ It is not clear to me if this is necessary to store or not , _vboAttribSizes :: [Int] -- ^ It is not clear to me if this is necessary to store or not
, _vboStride :: Int , _vboStride :: Int
-- add int for AMOUNT of data poked!
} }
data EBO = EBO data EBO = EBO
{ _eboName :: GLuint { _eboName :: GLuint
src/Shader/Poke.hs
+6 -6
View File
@@ -25,17 +25,17 @@ import Control.Monad.Primitive
--import qualified Control.Monad.Parallel as MP --import qualified Control.Monad.Parallel as MP
pokeVerxs pokeVerxs
:: MV.MVector (PrimState IO) FullShader :: MV.MVector (PrimState IO) (FullShader,VBO)
-> UMV.MVector (PrimState IO) Int -> UMV.MVector (PrimState IO) Int
-> Picture -> Picture
-> IO () -> IO ()
--pokeVerxs vbos count = S.mapM_ (pokeVerx vbos count) . S.each --pokeVerxs vbos count = S.mapM_ (pokeVerx vbos count) . S.each
pokeVerxs vbos count = VFSM.mapM_ (pokeVerx vbos count) . VFSM.fromList pokeVerxs vbos count = VFSM.mapM_ (pokeVerx vbos count) . VFSM.fromList
pokeVerx :: MV.MVector (PrimState IO) FullShader -> UMV.MVector (PrimState IO) Int -> Verx -> IO () pokeVerx :: MV.MVector (PrimState IO) (FullShader,VBO) -> UMV.MVector (PrimState IO) Int -> Verx -> IO ()
pokeVerx vbos offsets Verx{_vxPos=thePos,_vxCol=theCol,_vxExt=ext,_vxShadNum=theShadNum} = do pokeVerx vbos offsets Verx{_vxPos=thePos,_vxCol=theCol,_vxExt=ext,_vxShadNum=theShadNum} = do
typeOff <- UMV.unsafeRead offsets sn typeOff <- UMV.unsafeRead offsets sn
basePtr <- _vboPtr . _vaoVBO . _shadVAO' <$> MV.unsafeRead vbos sn basePtr <- _vboPtr . snd <$> MV.unsafeRead vbos sn
let thePtr = plusPtr basePtr (typeOff * pokeStride sn * floatSize) let thePtr = plusPtr basePtr (typeOff * pokeStride sn * floatSize)
poke34 thePtr thePos theCol poke34 thePtr thePos theCol
pokeArrayOff thePtr 7 ext pokeArrayOff thePtr 7 ext
@@ -185,18 +185,18 @@ pokeJustV ptr nv sh = do
V4 d e f g = _svCol sh V4 d e f g = _svCol sh
pokeLayVerxs pokeLayVerxs
:: MV.MVector (PrimState IO) FullShader :: MV.MVector (PrimState IO) (FullShader ,VBO)
-> UMV.MVector (PrimState IO) Int -> UMV.MVector (PrimState IO) Int
-> Picture -> Picture
-> IO () -> IO ()
--pokeLayVerxs vbos counts = S.mapM_ (pokeLayVerx vbos counts) . S.each --pokeLayVerxs vbos counts = S.mapM_ (pokeLayVerx vbos counts) . S.each
pokeLayVerxs vbos counts = VFSM.mapM_ (pokeLayVerx vbos counts) . VFSM.fromList pokeLayVerxs vbos counts = VFSM.mapM_ (pokeLayVerx vbos counts) . VFSM.fromList
pokeLayVerx :: MV.MVector (PrimState IO) FullShader -> UMV.MVector (PrimState IO) Int -> Verx -> IO () pokeLayVerx :: MV.MVector (PrimState IO) (FullShader,VBO) -> UMV.MVector (PrimState IO) Int -> Verx -> IO ()
--{-# INLINE pokeLayVerx #-} --{-# INLINE pokeLayVerx #-}
pokeLayVerx vbos counts vx = do pokeLayVerx vbos counts vx = do
theOff <- UMV.unsafeRead counts vecPos theOff <- UMV.unsafeRead counts vecPos
basePtr <- _vboPtr . _vaoVBO . _shadVAO' <$> MV.unsafeRead vbos sn basePtr <- _vboPtr . snd <$> MV.unsafeRead vbos sn
let thePtr = plusPtr basePtr ((theOff + layOff) * theStride * floatSize) let thePtr = plusPtr basePtr ((theOff + layOff) * theStride * floatSize)
poke34 thePtr thePos theCol poke34 thePtr thePos theCol
pokeArrayOff thePtr 7 (_vxExt vx) pokeArrayOff thePtr 7 (_vxExt vx)