Working element buffer object

src/Shader/Compile.hs

@@ -148,7 +148,7 @@ setupVBO sizes = do
     bufferData ArrayBuffer $=
         (fromIntegral $ floatSize * numDrawableElements * strd
         , nullPtr
-        , DynamicDraw
+        , StreamDraw
         )
     return $ VBO
         { _vbo = vboName
@@ -171,7 +171,7 @@ setupVBOSized sizes ndraw = do
     bufferData ArrayBuffer $=
         (fromIntegral $ floatSize * ndraw * strd
         , nullPtr
-        , DynamicDraw
+        , StreamDraw
         )
     return $ VBO
         { _vbo = vboName

src/Shader/Data.hs

@@ -4,6 +4,7 @@
 module Shader.Data
     ( VAO (..)
     , VBO (..)
+    , EBO (..)
     , FullShader (..)
     , ShaderTexture (..)
     , EPrimitiveMode (..)
@@ -19,6 +20,8 @@ module Shader.Data
     , vboPtr
     , vboAttribSizes
     , vboStride
+    , ebo
+    , eboPtr
 -- | Synonyms
     , vert
     , geom
@@ -51,6 +54,10 @@ data VBO = VBO
     , _vboAttribSizes :: [Int]  -- ^ It is not clear to me if this is necessary to store or not
     , _vboStride      :: Int
     }
+data EBO = EBO
+    { _ebo      :: BufferObject
+    , _eboPtr   :: Ptr GLushort
+    }
 {- | Datatype containing the reference to a texture object.  -}
 newtype ShaderTexture = ShaderTexture
     { _textureObject :: TextureObject }
@@ -75,3 +82,4 @@ frag = FragmentShader
 makeLenses ''VAO
 makeLenses ''VBO
 makeLenses ''FullShader
+makeLenses ''EBO

src/Shader/Parameters.hs

@@ -2,6 +2,7 @@ module Shader.Parameters
     ( floatSize
     , numDrawableElements
     , numSubElements
+    , glushortSize
     ) where
 import Graphics.Rendering.OpenGL hiding (Point,translate,scale,imageHeight)
 import Foreign
@@ -10,6 +11,14 @@ floatSize :: Int
 floatSize = sizeOf (0.5 :: GLfloat)
 {-# INLINE floatSize #-}
 
+--intSize :: Int
+--intSize = sizeOf (1 :: GLuint)
+--{-# INLINE intSize #-}
+
+glushortSize :: Int
+glushortSize = sizeOf (0 :: GLushort)
+{-# INLINE glushortSize #-}
+
 numDrawableElements :: Int
 {-# INLINE numDrawableElements #-}
 numDrawableElements = 60000

src/Shader/Poke.hs

@@ -7,7 +7,6 @@ module Shader.Poke
     , pokePoint33s
     , poke224s
     , pokeShape
-    , pokeShapeVs
     , pokePoint3s
     ) where
 import Shader.Data
@@ -16,11 +15,13 @@ import Picture.Data
 import Shape.Data
 import Geometry.Data
 
+import Graphics.Rendering.OpenGL hiding (color,scale,translate,rotate)
 import Foreign
 import qualified Data.Vector.Unboxed.Mutable as UMV
 import qualified Data.Vector.Mutable as MV
 import qualified Data.Vector.Fusion.Stream.Monadic as VS
 import Control.Monad.Primitive
+import Data.Bifoldable
 --import qualified Data.DList as DL
 
 pokeVerxs 
@@ -41,17 +42,25 @@ pokeVerx vbos offsets Verx{_vxPos=thePos,_vxCol=theCol,_vxExt=ext,_vxShadNum=the
   where
     sn = _unShadNum theShadNum
 
-pokeShape :: Ptr Float -> Ptr Float -> Shape -> IO (Int,Int)
-pokeShape vptr eptr sh = do
-    nVs <- pokeShapeVs vptr (VS.fromList $ shVList sh)
-    nEs <- pokePoint3s eptr (VS.fromList $ shEList sh)
-    return (nVs,nEs)
+pokeShape :: Ptr Float -> Ptr Float -> Ptr GLushort -> Shape -> IO (Int,Int)
+pokeShape vptr eptr iptr = bifoldlM (pokeShapeVs' vptr iptr) (pokeShapeEs' eptr) (0,0)
 
-pokeShapeVs :: Ptr Float -> VS.Stream IO ShapeV -> IO Int
-pokeShapeVs ptr = VS.foldlM' (pokeShapeV ptr) 0
+pokeShapeVs' :: Ptr Float -> Ptr GLushort -> (Int,Int) -> [ShapeV] -> IO (Int, Int)
+pokeShapeVs' ptr iptr count = VS.foldlM' (pokeShapeV' ptr iptr) count . VS.fromList
 
-pokeShapeV :: Ptr Float -> Int -> ShapeV -> IO Int
-pokeShapeV ptr n sh = do
+pokeShapeEs' :: Ptr Float -> (Int,Int) -> [Point3] -> IO (Int, Int)
+pokeShapeEs' ptr count = VS.foldlM' (pokeShapeE' ptr) count . VS.fromList
+
+
+pokeShapeE' :: Ptr Float -> (Int,Int) -> Point3 -> IO (Int,Int)
+pokeShapeE' ptr (nv,n) (V3 a b c) = do
+    pokeElemOff ptr (n * 3) a
+    pokeElemOff ptr (n * 3 + 1) b
+    pokeElemOff ptr (n * 3 + 2) c
+    return $ (nv,n + 1)
+
+pokeShapeV' :: Ptr Float -> Ptr GLushort -> (Int,Int) -> ShapeV -> IO (Int,Int)
+pokeShapeV' ptr iptr (n,ne) sh = do
     pokeElemOff ptr (off 0) a
     pokeElemOff ptr (off 1) b
     pokeElemOff ptr (off 2) c
@@ -59,12 +68,14 @@ pokeShapeV ptr n sh = do
     pokeElemOff ptr (off 4) e
     pokeElemOff ptr (off 5) f
     pokeElemOff ptr (off 6) g
-    return (n+1)
+    pokeElemOff iptr n (fromIntegral n)
+    return (n+1,ne)
   where
     off i = n*7 + i
     V3 a b c    = _svPos sh
     V4 d e f g  = _svCol sh
 
+
 pokePoint3s :: Ptr Float -> VS.Stream IO Point3 -> IO Int
 pokePoint3s ptr = VS.foldlM' (pokePoint3 ptr) 0