reworked loader. causes OutOfMemory-Errors on GPU.

shaders/mapobjects/vertex.shader

@@ -15,6 +15,6 @@ out vec3 vNormal;
 
 void main () {
    vPosition = Position;
-   gl_Position = vec4(10*Position,1);//ProjectionMatrix * ViewMatrix * vec4(PositionOffset + Position, 1);
+   gl_Position = vec4(Position,1);//ProjectionMatrix * ViewMatrix * vec4(PositionOffset + Position, 1);
    vNormal = Normal;
 }

src/Importer/IQM/Parser.hs

@@ -33,7 +33,7 @@ import Foreign.Storable (sizeOf)
 
 import Prelude as P hiding (take, null)
 
-import Render.Misc (printPtrAsFloatArray, printPtrAsUByteArray, printPtrAsWord32Array)
+import Render.Misc (printPtrAsFloatArray, printPtrAsUByteArray, printPtrAsWord32Array, withVBO)
 
 -- | helper-function for creating an integral out of [8-Bit Ints]
 _w8ToInt :: Integral a => a -> a -> a
@@ -213,28 +213,58 @@ parseIQM :: String -> IO IQM
 parseIQM a =
     do
     f <- B.readFile a
-    vao <- makeVAO (return ())
+    -- Parse Headers/Offsets to BareIQM
-    tbo <- genObjectName
+    let result = parse doIQMparse f
-    -- Parse Headers/Offsets
+    bare <- case result of
-    let result = parse (doIQMparse vao tbo) f
-    raw <- case result of
         Done _ x -> return x
         y -> error $ show y
-    -- Fill Vertex-Arrays with data of Offsets
+    -- Fill Vertex-Array with buffer objects and data of Offsets
-    let va = vertexArrays raw
+    va' <- mapM (readInVAO f (num_vertexes.bareheader $ bare)) (barevertexArrays bare)
-    va' <- mapM (readInVAO f (num_vertexes.header $ raw)) va
+
-    vbo <- mapM toVBOfromVAO va
+    -- create VAO with attached vbos
-    (tris, trisbo) <- copyTriangles raw f
+    vao <- makeVAO $ do
-    withVAO vao $ createVAO (zip va' vbo)
+        -- generate array buffers
+        --
+        --for pos,normal,tex:
+        let initBuffer :: AttribLocation -> IQMVertexArrayType -> [IQMVertexArray] -> IO ()
+            initBuffer l t vas =
+                do
+                let (IQMVertexArray _ _ _ num _ dat) = case filter (\(IQMVertexArray ty _ _ _ _ _) -> ty == t) vas of
+                                                    [b] -> b
+                                                    _ -> error $ "Current object does not support " ++ (show t)
+                buf <- genObjectName
+                withVBO buf (toBufferTargetfromVAType t) $ do
+                    -- copy data
+                    bufferData (toBufferTargetfromVAType t) $= ((fromIntegral num),dat,StaticDraw)
+                    -- tell layout
+                    vertexAttribPointer l $= (ToFloat, VertexArrayDescriptor num Float 0 nullPtr)
+        initBuffer (AttribLocation 0) IQMPosition va'
+        initBuffer (AttribLocation 1) IQMNormal   va'
+        initBuffer (AttribLocation 2) IQMTexCoord va'
+
+    -- for indices
+    tbo <- genObjectName
+    tris <- withVBO tbo ArrayBuffer $ do
+        let
+            len = (fromIntegral.num_triangles.bareheader) bare
+            byteLen = len * 3 * sizeOf (undefined :: Word32)
+            data' = skipDrop ((fromIntegral.ofs_triangles.bareheader) bare) byteLen f
+        p <- mallocBytes byteLen
+        unsafeUseAsCString data' (\s -> copyBytes p s byteLen)
+        bufferData ElementArrayBuffer $= (fromIntegral len*3, p, StaticDraw)
+        return $ castPtr p
     putStrLn "Triangles:"
-    printPtrAsWord32Array tris ((*3).fromIntegral.num_triangles.header $ raw) 3
+    printPtrAsWord32Array tris ((*3).fromIntegral.num_triangles.bareheader $ bare) 3
-    print raw
+    print bare
-    return $ raw
+    return $ IQM
-        { vertexArrays = va'
+        { header               = bareheader bare
-        , vertexBufferObjects = vbo
+        , texts                = baretexts bare
-        , vertexArrayObject = vao
+        , meshes               = baremeshes bare
-        , triangles = tris
+        , vertexArrays         = va'
-        , triangleBufferObject = trisbo
+        , vertexBufferObjects  = []
+        , vertexArrayObject    = vao
+        , triangles            = tris
+        , triangleBufferObject = tbo
         }
 
 createVAO :: [(IQMVertexArray, BufferObject)] -> IO ()
@@ -254,22 +284,6 @@ initVAO l t bo = do
 	vertexAttribArray l $= Enabled
 	vertexAttribPointer l $= (ToFloat, VertexArrayDescriptor num Float 0 nullPtr)
 
-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)
-        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
 
 toVBOfromVAO :: IQMVertexArray -> IO BufferObject
@@ -316,8 +330,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 -> BufferObject -> Parser IQM
+doIQMparse :: Parser BareIQM
-doIQMparse vao tbo =
+doIQMparse =
     flip evalStateT 0 $ --evaluate parser with state starting at 0
         do
             h <- readHeader                                         --read header
@@ -328,15 +342,11 @@ doIQMparse vao tbo =
             meshes' <- readMeshes $ fromIntegral $ num_meshes h     --read meshes
             skipToCounter $ ofs_vertexarrays h            --skip 0-n bytes to get to Vertex-Arrays
             vaf <- readVAFs $ fromIntegral $ num_vertexarrays h     --read Vertex-Arrays
-            return IQM
+            return BareIQM
-                    { header = h
+                    { bareheader = h
-                    , texts = filter (not.null) (split (unsafeCoerce '\0') text)
+                    , baretexts = filter (not.null) (split (unsafeCoerce '\0') text)
-                    , meshes = meshes'
+                    , baremeshes = meshes'
-                    , vertexArrays = vaf
+                    , barevertexArrays = vaf
-                    , 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

src/Importer/IQM/Types.hs

@@ -116,6 +116,18 @@ data IQM = IQM
         , triangleBufferObject  :: BufferObject
         } deriving (Show, Eq)
 
+-- | Internal format of an unprocessed IQM
+--
+-- for internal and temporary use only
+
+data BareIQM = BareIQM
+             { bareheader           :: IQMHeader
+             , baretexts            :: [ByteString]
+             , baremeshes           :: [IQMMesh]
+             , barevertexArrays     :: [IQMVertexArray]
+             } deriving (Show, Eq)
+            
+
 -- | Different Vertex-Array-Types in IQM
 --
 --   Custom Types have to be > 0x10 as of specification

src/Render/Misc.hs

@@ -8,6 +8,8 @@ import           Graphics.Rendering.OpenGL.GL.Shaders
 import           Graphics.Rendering.OpenGL.GL.StateVar
 import           Graphics.Rendering.OpenGL.GL.StringQueries
 import           Graphics.Rendering.OpenGL.GLU.Errors
+import           Graphics.Rendering.OpenGL.GL.VertexArrayObjects
+import           Graphics.Rendering.OpenGL.GL.BufferObjects
 import           Graphics.UI.SDL.Types                      (Texture)
 import           System.IO                                  (hPutStrLn, stderr)
 import Linear
@@ -163,3 +165,18 @@ genColorData n c = take (length c*n) (cycle c)
 chunksOf :: Int -> [a] -> [[a]]
 chunksOf _ [] = []
 chunksOf a xs = take a xs : chunksOf a (drop a xs)
+
+
+withVAO :: VertexArrayObject -> IO a -> IO a
+withVAO v a = do
+                bindVertexArrayObject $= Just v
+                ret <- a
+                bindVertexArrayObject $= Nothing
+                return ret
+
+withVBO :: BufferObject -> BufferTarget -> IO a -> IO a
+withVBO b t a = do
+                bindBuffer t $= Just b
+                ret <- a
+                bindBuffer t $= Nothing
+                return ret

src/Render/Render.hs

@@ -184,6 +184,9 @@ initMapShader tessFac (buf, vertDes) = do
    uni' <- get (activeUniforms objProgram)
    putStrLn $ unlines $ "Model-Uniforms: ":map show uni'
    putStrLn $ unlines $ ["Model-Indices: ", show (texIndex', normalIndex', vertexIndex')]
+   
+   currentProgram $= Nothing
+
    checkError "initShader"
    let sdata = MapShaderData
             { shdrVertexIndex      = vertexIndex
@@ -285,12 +288,12 @@ initRendering = do
 -- | renders an IQM-Model at Position with scaling
 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)
+    withVAO (vertexArrayObject m) $ do
-    vertexAttribArray (AttribLocation 0) $= Enabled
+        vertexAttribArray (AttribLocation 0) $= Enabled
-    bindBuffer ElementArrayBuffer $= Just (triangleBufferObject m)
+        bindBuffer ElementArrayBuffer $= Just (triangleBufferObject m)
-    let n = fromIntegral.num_triangles.header $ m
+        let n = fromIntegral.num_triangles.header $ m
-    --print $ concat ["drawing ", show n," triangles"]
+        --print $ concat ["drawing ", show n," triangles"]
-    drawElements Triangles n UnsignedInt nullPtr
+        drawElements Triangles n UnsignedInt nullPtr
     checkError "drawing model"
     return ()