From 40c0e3ef0082c315db5e472417413211b1a6fd68 Mon Sep 17 00:00:00 2001
From: Stefan Dresselhaus <sdressel@techfak.uni-bielefeld.de>
Date: Sun, 10 Aug 2014 23:00:53 +0200
Subject: [PATCH] added ArrayBufferObject for TriangleIndex

---
 src/Importer/IQM/Parser.hs | 20 ++++++++++++++------
 src/Importer/IQM/Types.hs  |  1 +
 src/Render/Render.hs       |  6 ++++--
 3 files changed, 19 insertions(+), 8 deletions(-)

diff --git a/src/Importer/IQM/Parser.hs b/src/Importer/IQM/Parser.hs
index 4356e56..5de4a5f 100644
--- a/src/Importer/IQM/Parser.hs
+++ b/src/Importer/IQM/Parser.hs
@@ -19,6 +19,7 @@ import Graphics.Rendering.OpenGL.GL.BufferObjects
 import Graphics.Rendering.OpenGL.GL.VertexArrays
 import Graphics.Rendering.OpenGL.GL.VertexArrayObjects
 import Graphics.Rendering.OpenGL.GL.VertexSpec
+import Graphics.Rendering.OpenGL.GL.ObjectName
 import Data.Word
 import Data.Int
 import Unsafe.Coerce
@@ -213,8 +214,9 @@ parseIQM a =
     do
     f <- B.readFile a
     vao <- makeVAO (return ())
+    tbo <- genObjectName
     -- Parse Headers/Offsets
-    let result = parse (doIQMparse vao) f
+    let result = parse (doIQMparse vao tbo) f
     raw <- case result of
         Done _ x -> return x
         y -> error $ show y
@@ -222,7 +224,7 @@ parseIQM a =
     let va = vertexArrays raw
     va' <- mapM (readInVAO f (num_vertexes.header $ raw)) va
     vbo <- mapM toVBOfromVAO va
-    tris <- copyTriangles raw f
+    (tris, trisbo) <- copyTriangles raw f
     withVAO vao $ createVAO (zip va' vbo)
     putStrLn "Triangles:"
     printPtrAsWord32Array tris ((*3).fromIntegral.num_triangles.header $ raw) 3
@@ -232,6 +234,7 @@ parseIQM a =
         , vertexBufferObjects = vbo
         , vertexArrayObject = vao
         , triangles = tris
+        , triangleBufferObject = trisbo
         }
 
 createVAO :: [(IQMVertexArray, BufferObject)] -> IO ()
@@ -251,16 +254,20 @@ initVAO l t bo = do
 	vertexAttribArray l $= Enabled
 	vertexAttribPointer l $= (ToFloat, VertexArrayDescriptor num Float 0 nullPtr)
 
-copyTriangles :: IQM -> ByteString -> IO (Ptr Word32)
+copyTriangles :: IQM -> ByteString -> IO (Ptr Word32, BufferObject)
 copyTriangles i f =
     do
         let
             len = fromIntegral $ num_triangles $ header i
             byteLen = len * 3 * sizeOf (undefined :: Word32)
             data' = skipDrop (fromIntegral $ ofs_triangles $ header i) byteLen f
+            buf = triangleBufferObject i
         p <- mallocBytes byteLen
         unsafeUseAsCString data' (\s -> copyBytes p s byteLen)
-        return $ castPtr p
+        bindBuffer ElementArrayBuffer $= Just buf
+        bufferData ElementArrayBuffer $= (fromIntegral len*3, p, StaticDraw)
+        bindBuffer ElementArrayBuffer $= Nothing
+        return $ (castPtr p, buf)
 
 
 -- | Creates a BufferObject on the Graphicscard for each BufferObject
@@ -309,8 +316,8 @@ readInVAO d vcount (IQMVertexArray type' a format num offset ptr) =
 --
 --   Consumes the String only once, thus in O(n). But all Data-Structures are
 --   not allocated and copied. readInVAO has to be called on each one.
-doIQMparse :: VertexArrayObject -> Parser IQM
-doIQMparse vao =
+doIQMparse :: VertexArrayObject -> BufferObject -> Parser IQM
+doIQMparse vao tbo =
     flip evalStateT 0 $ --evaluate parser with state starting at 0
         do
             h <- readHeader                                         --read header
@@ -329,6 +336,7 @@ doIQMparse vao =
                     , vertexBufferObjects = [] --initialized later, after vaf get allocated.
                     , vertexArrayObject = vao
                     , triangles = nullPtr      --initialized later, after memory gets allocated.
+                    , triangleBufferObject = tbo
                     }
 
 -- | Helper-Function for Extracting a random substring out of a Bytestring
diff --git a/src/Importer/IQM/Types.hs b/src/Importer/IQM/Types.hs
index 5939cb4..5504978 100644
--- a/src/Importer/IQM/Types.hs
+++ b/src/Importer/IQM/Types.hs
@@ -113,6 +113,7 @@ data IQM = IQM
         , vertexBufferObjects   :: [BufferObject]
         , vertexArrayObject     :: VertexArrayObject
         , triangles             :: Ptr Word32
+        , triangleBufferObject  :: BufferObject
         } deriving (Show, Eq)
 
 -- | Different Vertex-Array-Types in IQM
diff --git a/src/Render/Render.hs b/src/Render/Render.hs
index d96bedc..addf7cf 100644
--- a/src/Render/Render.hs
+++ b/src/Render/Render.hs
@@ -15,7 +15,7 @@ import qualified Control.Monad.RWS.Strict as RWS      (get)
 import           Control.Concurrent.STM               (readTVarIO)
 import           Data.Distributive                    (distribute, collect)
 -- FFI
-import           Foreign                              (Ptr, castPtr, with)
+import           Foreign                              (Ptr, castPtr, with, nullPtr)
 import           Foreign.C                            (CFloat)
 
 import           Map.Graphics
@@ -286,9 +286,11 @@ initRendering = do
 renderIQM :: IQM -> L.V3 CFloat -> L.V3 CFloat -> IO ()
 renderIQM m p@(L.V3 x y z) s@(L.V3 sx sy sz) = do
     bindVertexArrayObject $= Just (vertexArrayObject m)
+    vertexAttribArray (AttribLocation 0) $= Enabled
+    bindBuffer ElementArrayBuffer $= Just (triangleBufferObject m)
     let n = fromIntegral.num_triangles.header $ m
     --print $ concat ["drawing ", show n," triangles"]
-    drawElements Triangles n UnsignedInt (triangles m)
+    drawElements Triangles n UnsignedInt nullPtr
     checkError "drawing model"
     return ()