Continue refactoring shaders

src/Picture/Data.hs

@@ -2,6 +2,7 @@
 --{-# LANGUAGE Strict #-}
 module Picture.Data
     where
+import Shader.Data
 import Data.Monoid
 import qualified Data.Foldable as F
 import qualified Data.Sequence as Se
@@ -24,63 +25,14 @@ import Data.Traversable
 data RenderType
     = RenderPoly [(Point3,Point4)]
     | RenderText [(Point3,Point4,Point3)]
---    | RenderCirc (Point3,Point4,Float)
     | RenderArc  (Point3,Point4,Point4)
     | RenderLine [(Point3,Point4)]
     | RenderEllipse [(Point3,Point4)]
 
-
-data VAO = VAO
-    { _vao :: VertexArrayObject
-    , _vaoBufferTargets :: [(BufferObject,Ptr Float,Int)]
-    }
-data FullShader = FullShader
-    { _shaderProgram :: Program
-    , _shaderUniforms :: [UniformLocation]
-    , _shaderVAO :: VAO
-    , _shaderPokeStrategy :: RenderType -> [[[Float]]]-- -> F.FoldM IO RenderType Int
-    , _shaderDrawPrimitive :: PrimitiveMode
-    , _shaderTexture :: Maybe ShaderTexture
-    }
-data ShaderTexture = ShaderTexture
-    { _textureObject :: TextureObject }
-
-makeLenses ''VAO
-makeLenses ''FullShader
-
-
-drawShaders :: [FullShader] -> [Int] -> IO ()
-drawShaders fss is =
-    zipWithM_ f fss is
-        where f fs i = do 
-                        currentProgram $= Just (_shaderProgram fs)
-                        bindVertexArrayObject $= (Just (_vao $ _shaderVAO fs))
-                        case _shaderTexture fs of 
-                            Just (ShaderTexture {_textureObject = to})
-                                -> textureBinding Texture2D $= Just to
-                            _   -> return ()
-                        drawArrays (_shaderDrawPrimitive fs) 0 (fromIntegral i)
-                            
-
-bindShaderBuffers :: [FullShader] -> [Int] -> IO ()
-bindShaderBuffers fss is =
-    zipWithM_ f fss is
-        where f fs i = bindArrayBuffers i $ _vaoBufferTargets $ _shaderVAO fs
-
-fSize = sizeOf (0 :: Float)
-
-bindArrayBuffers :: Int -> [(BufferObject,Ptr Float,Int)] -> IO ()
-{-# INLINE bindArrayBuffers #-}
-bindArrayBuffers numVs ps = do
-    forM_ ps $ \(bo,ptr,i) -> do
-        bindBuffer ArrayBuffer $= Just bo
-        bufferData ArrayBuffer $= (fromIntegral $ fSize * numVs * i, ptr, StreamDraw)
-        
-
-pokeShaders :: [FullShader] -> F.FoldM IO RenderType [Int]
+pokeShaders :: [FullShader RenderType] -> F.FoldM IO RenderType [Int]
 pokeShaders fss = traverse pokeShader fss
 
-pokeShader :: FullShader -> F.FoldM IO RenderType Int
+pokeShader :: FullShader RenderType -> F.FoldM IO RenderType Int
 pokeShader fs = F.FoldM (pokeRender fls (zip ptrs nAtss))  (return 0) return
   where vao = _shaderVAO fs
         (_,ptrs,nAtss) = unzip3 $ _vaoBufferTargets $ vao
@@ -104,6 +56,7 @@ pokeArrayOff ptr i xs =
     zipWithM_ (pokeElemOff ptr) [i..] xs
 
 
+
 type RGBA = (Float,Float,Float,Float)
 type Color = (Float,Float,Float,Float)