Start refactor of pointers into a vao datatype

src/Picture/Preload.hs

@@ -23,8 +23,11 @@ data PreloadData = PreloadData
     , _textShader :: Program
     , _circShader :: Program
     , _arcShader  :: Program
-    , _lineShader :: Program
     , _fadeCircleShader :: Program
+    , _triVAO :: VAO
+    , _textVAO' :: VAO
+    , _circVAO' :: VAO
+    , _arcVAO'  :: VAO
     , _basicVAO :: VertexArrayObject
     , _textVAO  :: VertexArrayObject
     , _circVAO  :: VertexArrayObject
@@ -56,6 +59,7 @@ data VAO = VAO
     }
 
 makeLenses ''PreloadData
+makeLenses ''VAO
 
 floatSize = sizeOf (0.5 :: GLfloat)
 
@@ -75,6 +79,35 @@ setupVAO ps = do
         vertexAttribArray (AttribLocation aloc) $= Enabled
     return theVAO
 
+setupVAO' :: [(BufferObject,GLuint,Int)] -> IO VAO
+setupVAO' ps = do
+    theVAO <- genObjectName
+    bindVertexArrayObject $= Just theVAO
+    forM_ ps setupArrayBuffer
+    ptrs <- forM ps setupVBOPointers
+    return $ VAO theVAO ptrs
+    
+numDrawableElements :: Int
+numDrawableElements = 50000
+
+setupVBOPointers :: (BufferObject,GLuint,Int) -> IO (BufferObject,Ptr Float,Int)
+setupVBOPointers (vbo,_,vsize) = do
+    thePtr <- mallocArray (vsize * numDrawableElements)
+    return (vbo,thePtr,vsize)
+
+setupArrayBuffer :: (BufferObject,GLuint,Int) -> IO ()
+setupArrayBuffer (vbo,aloc,i) = do
+        bindBuffer ArrayBuffer $= Just vbo
+        vertexAttribPointer (AttribLocation aloc) $=
+            ( ToFloat
+            , VertexArrayDescriptor (fromIntegral i) 
+                                    Float 
+                                    (fromIntegral $ floatSize * i) 
+                                    (bufferOffset 0)
+            )
+        vertexAttribArray (AttribLocation aloc) $= Enabled
+
+
 loadTextures :: IO [Image PixelRGBA8]
 loadTextures = do
 --    echarMap <- readImage "data/texture/smudgedDirt.png"
@@ -125,6 +158,10 @@ doPreload' = do
     generateMipmap' Texture2D
     textureFilter Texture2D $= ((Linear',Just Linear') , Nearest)
 
+    trivao  <- setupVAO' [(posVBO,0,3),(colVBO,1,4)]
+    textvao <- setupVAO' [(posVBO,0,3),(colVBO,1,4),(texVBO,2,2)]
+    circvao <- setupVAO' [(posVBO,0,3),(colVBO,1,4),(texVBO,2,1)]
+    arcvao  <- setupVAO' [(posVBO,0,3),(colVBO,1,4),(texVBO,2,4)]
 -- setup VAOs: basic vao
     basicVAO <- setupVAO [(posVBO,0,3),(colVBO,1,4)]
     textVAO <- setupVAO [(posVBO,0,3),(colVBO,1,4),(texVBO,2,2)]
@@ -158,6 +195,10 @@ doPreload' = do
         , _circShader = cs
         , _arcShader = as
         , _fadeCircleShader = fcs
+        , _triVAO = trivao
+        , _textVAO'  = textvao
+        , _circVAO'  = circvao
+        , _arcVAO'   = arcvao
         , _basicVAO = basicVAO
         , _textVAO  = textVAO
         , _circVAO  = circVAO

src/Picture/Render.hs

@@ -240,24 +240,31 @@ bindArrayBuffers numVs ps = do
         bindBuffer ArrayBuffer $= Just bo
         bufferData ArrayBuffer $= (fromIntegral $ fSize * numVs * i, ptr, StreamDraw)
         
+twoPtrsVAO :: VAO -> (Ptr Float, Ptr Float)
+twoPtrsVAO vao = case (\(_,ps,_) -> ps) $ unzip3 $ _vaoBufferTargets vao of
+    (a:b:_) -> (a,b)
+threePtrsVAO :: VAO -> (Ptr Float, Ptr Float,Ptr Float)
+threePtrsVAO vao = case (\(_,ps,_) -> ps) $ unzip3 $ _vaoBufferTargets vao of
+    (a:b:c:_) -> (a,b,c)
+
 renderPicture' :: PreloadData -> Float -> (Float,Float) -> Picture -> IO ()
 renderPicture' pdata zoom (winx,winy) pic = do
     let firstIndex = 0
 
     (nTriVs,nTextVs,numCircVs,nLineVs,nArcVs) 
-        <- F.foldM (theFold (_ptrPosVBO pdata, _ptrColVBO pdata)  
+--        <- F.foldM (theFold (_ptrPosVBO pdata, _ptrColVBO pdata)  
-                            (_ptrCharPos pdata, _ptrCharCol pdata, _ptrCharTex pdata)
+        <- F.foldM (theFold (twoPtrsVAO $ _triVAO pdata)  
-                            (_ptrCircPos pdata, _ptrCircCol pdata, _ptrCircSca pdata)
+                            (threePtrsVAO $ _textVAO' pdata)
+                            (threePtrsVAO $ _circVAO' pdata)
                             (_ptrLinePos pdata, _ptrLineCol pdata)
-                            (_ptrArcPos pdata, _ptrArcCol pdata, _ptrArcSca pdata)
+                            (threePtrsVAO $ _arcVAO' pdata)
                    ) $ picToFTree pic
 
     depthFunc $= Just Less
 -- draw triangles
     currentProgram $= Just (_basicShader pdata)
-    bindArrayBuffers nTriVs [(_posVBO pdata, _ptrPosVBO pdata, 3)
+    bindVertexArrayObject $= Just (_vao $ _triVAO pdata)
-                            ,(_colVBO pdata, _ptrColVBO pdata, 4)
+    bindArrayBuffers nTriVs $ _vaoBufferTargets $ _triVAO pdata
-                            ]
     drawArrays Triangles (fromIntegral firstIndex) (fromIntegral $ nTriVs)
 -- draw lines, don't need to change the program or vaos, just need to bind the
 -- vbos and draw
@@ -270,32 +277,20 @@ renderPicture' pdata zoom (winx,winy) pic = do
     currentProgram $= Just (_circShader pdata)
     uniform (_uniWinSize pdata) $= Vector2 winx winy
     uniform (_csZoomUni pdata)  $= zoom
-    bindVertexArrayObject $= Just (_circVAO pdata)
+    bindVertexArrayObject $= Just (_vao $ _circVAO' pdata)
-    bindArrayBuffers numCircVs 
+    bindArrayBuffers numCircVs $ _vaoBufferTargets $ _circVAO' pdata
-        [(_posVBO pdata, _ptrCircPos pdata, 3)
-        ,(_colVBO pdata, _ptrCircCol pdata, 4)
-        ,(_texVBO pdata, _ptrCircSca pdata, 1)
-        ]
     drawArrays Points (fromIntegral firstIndex) (fromIntegral $ numCircVs)
 -- draw arcs
     currentProgram $= Just (_arcShader pdata)
     uniform (_asWinUni pdata) $= Vector2 winx winy
     uniform (_asZoomUni pdata)  $= zoom
-    bindVertexArrayObject $= Just (_arcVAO pdata)
+    bindVertexArrayObject $= Just (_vao $ _arcVAO' pdata)
-    bindArrayBuffers nArcVs 
+    bindArrayBuffers nArcVs $ _vaoBufferTargets $ _arcVAO' pdata
-        [(_posVBO pdata, _ptrArcPos pdata, 3)
-        ,(_colVBO pdata, _ptrArcCol pdata, 4)
-        ,(_texVBO pdata, _ptrArcSca pdata, 4)
-        ]
     drawArrays Points (fromIntegral firstIndex) (fromIntegral $ nArcVs)
 -- draw text
     currentProgram $= Just (_textShader pdata)
-    bindVertexArrayObject $= Just (_textVAO pdata)
+    bindVertexArrayObject $= Just (_vao $ _textVAO' pdata)
-    bindArrayBuffers nTextVs 
+    bindArrayBuffers nTextVs $ _vaoBufferTargets $ _textVAO' pdata
-        [(_posVBO pdata, _ptrCharPos pdata, 3)
-        ,(_colVBO pdata, _ptrCharCol pdata, 4)
-        ,(_texVBO pdata, _ptrCharTex pdata, 2)
-        ]
     drawArrays Points (fromIntegral firstIndex) (fromIntegral $ nTextVs)
 
 bufferOffset :: Integral a => a -> Ptr b