Refactor poking slightly

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