Add picture shader container datatype

src/Shader/Poke.hs

@@ -1,9 +1,10 @@
-{-# LANGUAGE TupleSections #-}
+--{-# LANGUAGE TupleSections #-}
 module Shader.Poke
     ( pokeArrayOff
     , pokeShader
     , pokeShaderLayer
     , pokeVX
+    , pokeVX'
     ) where
 import Shader.Data
 import Shader.Parameters
@@ -22,11 +23,9 @@ pokeShader fs = F.FoldM (pokeVertices fls ptr stride)  (return 0) return
   where 
     theVBO = _vaoVBO $ _shaderVAO fs
     ptr = _vboPointer theVBO
-    stride = sum $ _vboAttribSizes theVBO
+    stride = _vboStride theVBO
     fls = _shaderPokeStrategy fs
 
-
-
 pokeVertices 
     :: (RenderType -> [[Float]])
     -> Ptr Float
@@ -36,23 +35,47 @@ pokeVertices
     -> IO Int
 pokeVertices toFs ptr stride n rt = foldM (pokeVertex ptr stride) n (toFs rt)
 
-pokeSL :: [(Int,[VShader])] -> [Verx] -> IO (IM.IntMap [(VShader,Int)])
-pokeSL vslist vxs = do
-    foldM pokeVX (f vslist) vxs
-  where
-    f = IM.map (map (, 0)) . IM.fromList
+getterPicShad :: VertexType -> Getting a (PicShads a) a
+getterPicShad PolyV    = psPoly
+getterPicShad PolyzV{} = psPolyz
+getterPicShad BezV{}   = psBez
+getterPicShad TextV{}  = psText
+getterPicShad ArcV{}   = psArc
+getterPicShad EllV     = psEll
 
-pokeVX :: IM.IntMap [(VShader,Int)] -> Verx -> IO (IM.IntMap [(VShader,Int)])
-pokeVX count vx = do
-    let offset = _vxLayer vx
-        lshads = count IM.! offset
-        (vshad,n) = fromJust $ find (\(s,_) -> _vshaderPokeTest s $ _vxType vx) lshads
-        i = fromJust $ findIndex (\(s,_) -> _vshaderPokeTest s $ _vxType vx) lshads
+--setterPicShad :: VertexType -> ASetter 
+setterPicShad PolyV    = psPoly
+setterPicShad PolyzV{} = psPolyz
+setterPicShad BezV{}   = psBez
+setterPicShad TextV{}  = psText
+setterPicShad ArcV{}   = psArc
+setterPicShad EllV     = psEll
+
+pokeVX' :: PicShads VShader -> PicShads Int -> Verx -> IO (PicShads Int)
+pokeVX' shads count vx = do
+    let f = setterPicShad (_vxType vx)
+        g = getterPicShad (_vxType vx)
+        vshad = shads ^. g
+        n = count ^. g
         theVBO = _vaoVBO $ _vshaderVAO vshad
         ptr = _vboPointer theVBO
-        stride = sum $ _vboAttribSizes theVBO
+        stride = _vboStride theVBO
+    pokeArrayOff ptr (stride * n) (toFls' vx)
+    return $ count & f +~ 1
+
+pokeVX :: PicShads VShader -> IM.IntMap (PicShads Int) -> Verx -> IO (IM.IntMap (PicShads Int))
+pokeVX shads laycounts vx = do
+    let theType = _vxType vx
+        offset = _vxLayer vx
+        counts = laycounts IM.! offset
+        getF = getterPicShad theType
+        vshad = shads ^. getF
+        n = counts ^. getF
+        theVBO = _vaoVBO $ _vshaderVAO vshad
+        ptr = _vboPointer theVBO
+        stride = _vboStride theVBO
     pokeArrayOff ptr (stride * (n+offset * numSubElements)) (toFls' vx)
-    return $ count & ix offset . ix i . _2 +~ 1
+    return $ laycounts & ix offset . setterPicShad theType +~ 1
 
 
 pokeShaderLayer :: (Int,VShader) -> F.FoldM IO Verx Int
@@ -60,7 +83,7 @@ pokeShaderLayer (l,fs) = F.FoldM (pokeVerticesOff ptr (_vshaderPokeTest fs) stri
   where 
     theVBO = _vaoVBO $ _vshaderVAO fs
     ptr = _vboPointer theVBO
-    stride = sum $ _vboAttribSizes theVBO
+    stride = _vboStride theVBO
 
 pokeVerticesOff
     :: Ptr Float
@@ -108,5 +131,6 @@ pokeVertex ptr stride n fs = do
     return $ n + 1
 
 pokeArrayOff :: Storable a => Ptr a -> Int -> [a] -> IO ()
-{-# INLINE pokeArrayOff #-}
-pokeArrayOff ptr i = zipWithM_ (pokeElemOff ptr) [i..]
+--{-# INLINE pokeArrayOff #-}
+--pokeArrayOff ptr i = zipWithM_ (pokeElemOff ptr) [i..]
+pokeArrayOff ptr i = pokeArray (plusPtr ptr (floatSize * i))