Refactor poking slightly

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

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 
+    bezierQuadShader <- makeShader "twoD/bezierQuad" [vert,frag] [3,4,4]  TriangleStrip pokeBezQStrat
-                      "twoD/bezierQuad" [vert,frag] [3,4,4]    TriangleStrip pokeBezQStrat
+    cslist <- makeShader "twoD/character" [vert,geom,frag] [3,4,3] Points pokeCharStrat
-    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
+    fsShad <- makeShader "texture/simple" [vert,frag] [2,2] TriangleStrip $ const cornerList
-        [[-1, 1,0,1]
+    -- note we directly poke the shader vertex data here
-        ,[ 1, 1,1,1]
+    pokeArray (_vboPointer $ _vaoVBO $ _shaderVAO fsShad) $ concat cornerList
-        ,[-1,-1,0,0]
+    boxBlurShad <- makeShader "texture/boxBlur" [vert,frag] [2,2] TriangleStrip $ const cornerList
-        ,[ 1,-1,1,0]
+    pokeArray (_vboPointer $ _vaoVBO $ _shaderVAO boxBlurShad) $ concat cornerList
-        ]
+    grayscaleShad <- makeShader "texture/grayscale" [vert,frag] [2,2] TriangleStrip $ const cornerList
-    _ <- F.foldM (pokeShader' fsShad) [RenderConst] -- fix fullscreen vertex positions now
+    pokeArray (_vboPointer $ _vaoVBO $ _shaderVAO grayscaleShad) $ concat cornerList
-    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
 -- 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

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

src/Shader.hs

@@ -1,8 +1,5 @@
 module Shader
-    ( pokeShaders
+    ( bindArrayBuffers'
-    , pokeArrayOff
-    , pokeShader'
-    , bindArrayBuffers'
     , bindShaderBuffers
     , drawShader
     , drawShaders
@@ -11,18 +8,14 @@ module Shader
     , extractProgAndUnis 
     , freeShaderPointers
     , setPerpMatUniform
-    , module Shader.Data
+    ) where
-    )
+import Geometry.Data
-  where
-import Geometry
 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)

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..]