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