From 8723be7f26149ba90d4e7474a0f0289a9590adae Mon Sep 17 00:00:00 2001 From: jgk Date: Sat, 12 Jun 2021 02:40:45 +0200 Subject: [PATCH] Refactor poking slightly --- src/Dodge/Render.hs | 6 ++++-- src/Picture/Preload.hs | 43 ++++++++++++++++------------------------- src/Picture/Render.hs | 14 ++++++++------ src/Shader.hs | 44 +++--------------------------------------- src/Shader/Poke.hs | 39 +++++++++++++++++++++++++++++++++++++ 5 files changed, 71 insertions(+), 75 deletions(-) create mode 100644 src/Shader/Poke.hs diff --git a/src/Dodge/Render.hs b/src/Dodge/Render.hs index eafa9c96e..1ae3a635c 100644 --- a/src/Dodge/Render.hs +++ b/src/Dodge/Render.hs @@ -18,6 +18,8 @@ import Picture.Render import Picture.Preload import Picture.Data import Shader +import Shader.Data +import Shader.Poke import MatrixHelper import Foreign (Word32) @@ -136,7 +138,7 @@ renderBlankWalls -> GLmatrix GLfloat -> IO () renderBlankWalls pdata wps pmat = do - n <- F.foldM (pokeShader' $ _wallBlankShader pdata) (map Render22x4 wps) + n <- F.foldM (pokeShader $ _wallBlankShader pdata) (map Render22x4 wps) bindShaderBuffers [_wallBlankShader pdata] [n] currentProgram $= Just (_shaderProgram $ _wallBlankShader pdata) uniform (_shaderMatrixUniform $ _wallBlankShader pdata) $= pmat @@ -150,7 +152,7 @@ renderTextureWalls -> GLmatrix GLfloat -> IO () renderTextureWalls pdata wps pmat = do - n <- F.foldM (pokeShader' $ _wallTextureShader pdata) (map Render22x4 wps) + n <- F.foldM (pokeShader $ _wallTextureShader pdata) (map Render22x4 wps) bindShaderBuffers [_wallTextureShader pdata] [n] currentProgram $= Just (_shaderProgram $ _wallTextureShader pdata) uniform (_shaderMatrixUniform $ _wallTextureShader pdata) $= pmat diff --git a/src/Picture/Preload.hs b/src/Picture/Preload.hs index ac9ae01e2..a63a5e8bb 100644 --- a/src/Picture/Preload.hs +++ b/src/Picture/Preload.hs @@ -8,6 +8,7 @@ module Picture.Preload where import Picture.Data import Shader +import Shader.Data import Shader.Compile import Shader.AuxAddition import Geometry.Data @@ -15,7 +16,6 @@ import Geometry.Data import Graphics.Rendering.OpenGL hiding (Point,translate,scale,imageHeight) import Control.Lens import Foreign -import qualified Control.Foldl as F data RenderData = RenderData { _lightingFloorShader :: FullShader @@ -52,33 +52,17 @@ preloadRender = do lslist <- makeShader "twoD/basic" [vert,frag] [3,4] Lines pokeLineStrat aslist <- makeShader "twoD/arc" [vert,geom,frag] [3,4,4] Points pokeArcStrat eslist <- makeShader "twoD/ellipse" [vert,geom,frag] [3,4] Triangles pokeEllStrat - bezierQuadShader <- makeShader - "twoD/bezierQuad" [vert,frag] [3,4,4] TriangleStrip pokeBezQStrat - cslist <- makeShader "twoD/character" [vert,geom,frag] - [3,4,3] Points pokeCharStrat + bezierQuadShader <- makeShader "twoD/bezierQuad" [vert,frag] [3,4,4] TriangleStrip pokeBezQStrat + cslist <- makeShader "twoD/character" [vert,geom,frag] [3,4,3] Points pokeCharStrat >>= addTexture "data/texture/charMap.png" -- texture shaders, no textures attached - fsShad <- makeShader "texture/simple" [vert,frag] [2,2] TriangleStrip $ const - [[-1, 1,0,1] - ,[ 1, 1,1,1] - ,[-1,-1,0,0] - ,[ 1,-1,1,0] - ] - _ <- F.foldM (pokeShader' fsShad) [RenderConst] -- fix fullscreen vertex positions now - boxBlurShad <- makeShader "texture/boxBlur" [vert,frag] [2,2] TriangleStrip $ const - [[-1, 1,0,1] - ,[ 1, 1,1,1] - ,[-1,-1,0,0] - ,[ 1,-1,1,0] - ] - _ <- F.foldM (pokeShader' boxBlurShad) [RenderConst] -- fix fullscreen vertex positions now - grayscaleShad <- makeShader "texture/grayscale" [vert,frag] [2,2] TriangleStrip $ const - [[-1, 1,0,1] - ,[ 1, 1,1,1] - ,[-1,-1,0,0] - ,[ 1,-1,1,0] - ] - _ <- F.foldM (pokeShader' grayscaleShad) [RenderConst] -- fix fullscreen vertex positions now + fsShad <- makeShader "texture/simple" [vert,frag] [2,2] TriangleStrip $ const cornerList + -- note we directly poke the shader vertex data here + pokeArray (_vboPointer $ _vaoVBO $ _shaderVAO fsShad) $ concat cornerList + boxBlurShad <- makeShader "texture/boxBlur" [vert,frag] [2,2] TriangleStrip $ const cornerList + pokeArray (_vboPointer $ _vaoVBO $ _shaderVAO boxBlurShad) $ concat cornerList + grayscaleShad <- makeShader "texture/grayscale" [vert,frag] [2,2] TriangleStrip $ const cornerList + pokeArray (_vboPointer $ _vaoVBO $ _shaderVAO grayscaleShad) $ concat cornerList -- background shader bgShad <- makeShader "background" [vert,geom,frag] [4,2] Points pokeBGStrat >>= addTexture "data/texture/marbleSlabs.png" @@ -118,6 +102,13 @@ preloadRender = do , _fbo3 = framebuf3 } +cornerList :: [[Float]] +cornerList = + [[-1, 1,0,1] + ,[ 1, 1,1,1] + ,[-1,-1,0,0] + ,[ 1,-1,1,0] + ] -- potential drawing setup ---- swapInterval $= ImmediateUpdates -- GL.blend $= GL.Enabled diff --git a/src/Picture/Render.hs b/src/Picture/Render.hs index 97f039d2e..fa6c74e63 100644 --- a/src/Picture/Render.hs +++ b/src/Picture/Render.hs @@ -9,6 +9,8 @@ module Picture.Render where import Shader +import Shader.Data +import Shader.Poke --import MatrixHelper import Picture.Preload import Picture.Data @@ -34,7 +36,7 @@ setWallDepth setWallDepth pdata wallPoints (viewFromx,viewFromy) _ = do startTicks <- SDL.ticks colorMask $= Color4 Disabled Disabled Disabled Disabled - nWalls <- F.foldM (pokeShader' $ _lightingOccludeShader pdata) (map Render22 wallPoints) + nWalls <- F.foldM (pokeShader $ _lightingOccludeShader pdata) (map Render22 wallPoints) bindShaderBuffers [_lightingOccludeShader pdata] [nWalls] currentProgram $= Just (_shaderProgram $ _lightingOccludeShader pdata) @@ -76,9 +78,9 @@ createLightMap pdata resDiv wallPoints lightPoints (viewFromx,viewFromy) pmat _ bindFramebuffer Framebuffer $= _spareFBO pdata -- store wall and light positions into buffer - nWallLights <- F.foldM (pokeShader' $ _lightingWallShader pdata) (map Render22 wallPoints) + nWallLights <- F.foldM (pokeShader $ _lightingWallShader pdata) (map Render22 wallPoints) bindShaderBuffers [_lightingWallShader pdata] [nWallLights] - nWalls <- F.foldM (pokeShader' $ _lightingOccludeShader pdata) (map Render22 wallPoints) + nWalls <- F.foldM (pokeShader $ _lightingOccludeShader pdata) (map Render22 wallPoints) bindShaderBuffers [_lightingOccludeShader pdata] [nWalls] -- set uniforms for shader that draws lights currentProgram $= Just (_shaderProgram $ _lightingWallShader pdata) @@ -246,7 +248,7 @@ renderShader -> IO Word32 renderShader shad dat = do sticks <- SDL.ticks - i <- F.foldM (pokeShader' shad) dat + i <- F.foldM (pokeShader shad) dat bindShaderBuffers [shad] [i] drawShader shad i eticks <- SDL.ticks @@ -257,13 +259,13 @@ renderFoldable => RenderData -> f RenderType -> IO Word32 -renderFoldable pdata tree = do +renderFoldable pdata struct = do pokeStartTicks <- SDL.ticks let slist = _pictureShaders pdata -- poke data, returns list of number of vertices for each shader - is <- F.foldM (pokeShaders slist) tree + is <- F.foldM (pokeShaders slist) struct -- the idea of binding many buffers at once, rather than interweaving with draw -- calls, is to prevent opengl from waiting for a draw call to finish diff --git a/src/Shader.hs b/src/Shader.hs index ba466fa80..9e8312a67 100644 --- a/src/Shader.hs +++ b/src/Shader.hs @@ -1,8 +1,5 @@ module Shader - ( pokeShaders - , pokeArrayOff - , pokeShader' - , bindArrayBuffers' + ( bindArrayBuffers' , bindShaderBuffers , drawShader , drawShaders @@ -11,18 +8,14 @@ module Shader , extractProgAndUnis , freeShaderPointers , setPerpMatUniform - , module Shader.Data - ) - where -import Geometry + ) where +import Geometry.Data import Shader.Data import Shader.Parameters import MatrixHelper -import Picture.Data import Foreign import Control.Monad -import qualified Control.Foldl as F import Graphics.Rendering.OpenGL hiding (Point,translate,scale,imageHeight) --import Text.RawString.QQ import Linear.Matrix @@ -31,37 +24,6 @@ import Linear.V4 extractProgAndUnis :: FullShader -> (Program,UniformLocation) extractProgAndUnis s = (_shaderProgram s, _shaderMatrixUniform s) -pokeShaders :: [FullShader] -> F.FoldM IO RenderType [Int] -pokeShaders = traverse pokeShader' - -pokeShader' :: FullShader -> F.FoldM IO RenderType Int -pokeShader' fs = F.FoldM (pokeRender' fls ptr stride) (return 0) return - where - theVBO = _vaoVBO $ _shaderVAO fs - ptr = _vboPointer theVBO - stride = sum $ _vboAttribSizes theVBO - fls = _shaderPokeStrategy fs - -pokeRender' - :: (RenderType -> [[Float]]) - -> Ptr Float - -> Int -- ^ stride - -> Int - -> RenderType - -> IO Int -pokeRender' toFs ptr stride n rt = pokeList' ptr stride n (toFs rt) - -pokeList' :: Ptr Float -> Int -> Int -> [[Float]] -> IO Int -pokeList' ptr stride = foldM (pokePtrs' ptr stride) - -pokePtrs' :: Ptr Float -> Int -> Int -> [Float] -> IO Int -pokePtrs' ptr stride n fs = do - pokeArrayOff ptr (stride * n) fs - return $ n + 1 - -pokeArrayOff :: Storable a => Ptr a -> Int -> [a] -> IO () -pokeArrayOff ptr i = zipWithM_ (pokeElemOff ptr) [i..] - bindArrayBuffers' :: Int -> VBO -> IO () bindArrayBuffers' numVs theVBO = do bindBuffer ArrayBuffer $= Just (_vbo theVBO) diff --git a/src/Shader/Poke.hs b/src/Shader/Poke.hs new file mode 100644 index 000000000..c91c0d76a --- /dev/null +++ b/src/Shader/Poke.hs @@ -0,0 +1,39 @@ +module Shader.Poke + ( pokeShaders + , pokeArrayOff + , pokeShader + ) where +import Shader.Data +import Picture.Data + +import Foreign +import Control.Monad +import qualified Control.Foldl as F + +pokeShaders :: [FullShader] -> F.FoldM IO RenderType [Int] +pokeShaders = traverse pokeShader + +pokeShader :: FullShader -> F.FoldM IO RenderType Int +pokeShader fs = F.FoldM (pokeRender fls ptr stride) (return 0) return + where + theVBO = _vaoVBO $ _shaderVAO fs + ptr = _vboPointer theVBO + stride = sum $ _vboAttribSizes theVBO + fls = _shaderPokeStrategy fs + +pokeRender + :: (RenderType -> [[Float]]) + -> Ptr Float + -> Int -- ^ stride + -> Int + -> RenderType + -> IO Int +pokeRender toFs ptr stride n rt = foldM (pokePtrs ptr stride) n (toFs rt) + +pokePtrs :: Ptr Float -> Int -> Int -> [Float] -> IO Int +pokePtrs ptr stride n fs = do + pokeArrayOff ptr (stride * n) fs + return $ n + 1 + +pokeArrayOff :: Storable a => Ptr a -> Int -> [a] -> IO () +pokeArrayOff ptr i = zipWithM_ (pokeElemOff ptr) [i..]