[HOpenGL] draw Elements segmentation fault.

Ben Christy ben.christy at gmail.com
Wed Nov 17 20:53:11 EST 2010


I am having a issue getting a seg fault with drawElements.  Honestly I can
not tell where the problem is. It seems as far as all I have read that it
should work and being its written in haskell I am asking here first before
asking in an opengl chat room.
I init my VBOs with

initModelIBO :: Int →  IO BufferObject
initModelIBO listLen = do
   print "list length"
   print listLen
   print "gen ibo bytes"
   print sizeOfList
   [ibo] ←  genObjectNames 1 :: IO [BufferObject]
   bindBuffer ElementArrayBuffer $= Just ibo
   tempArray2 ←  newListArray (0, listLen  - 1) indexList ::
IO(StorableArray Int GLuint)
   withStorableArray tempArray2 (λptr ->
        bufferData ElementArrayBuffer $= ((fromIntegral sizeOfList), ptr,
StaticDraw))
   bindBuffer ElementArrayBuffer $= Nothing
   return ibo
   where
    elementSize = 4
    sizeOfList = listLen * elementSize
    indexList = [i | i ←  [0..(fromIntegral listLen)]] :: [GLuint]

initModelVBO :: [Vert] →  IO BufferObject
initModelVBO vertexList = do
   print "list length"
   print listLen
   print "gen vbo bytes"
   print sizeOfList
   [vbo] ←  genObjectNames 1 :: IO [BufferObject]
   bindBuffer ArrayBuffer $= Just vbo
   tempArray ←  newListArray (0, listLen - 1) vertList :: IO(StorableArray
Int GLfloat)
   withStorableArray tempArray (λptr ->
        bufferData ArrayBuffer $= ((fromIntegral sizeOfList), ptr,
StaticDraw))
   bindBuffer ArrayBuffer $= Nothing
   return vbo
   where
    elementsPerVert = 10
    vertList = vertsToList vertexList
    listLen = length vertList
    elementSize = 4
    sizeOfList = listLen * elementSize

My Vert type is
data Vert = Vert {
                vertX   ::GLfloat,
                vertY   ::GLfloat,
                vertZ   ::GLfloat,
                --normalX ::GLfloat,
                --normalY ::GLfloat,
                --normalZ ::GLfloat,
                colorR  ::GLfloat,
                colorG  ::GLfloat,
                colorB  ::GLfloat,
                specR   ::GLfloat,
                specG   ::GLfloat,
                specB   ::GLfloat,
                shiny   ::GLfloat}
    deriving (Show)

I set vertex attributes with
setAttribPtr (Just program) = do
    print " Setting attrib pointer"

     --vertexAttribPointer (AttribLocation 1) $= (KeepIntegral,
(VertexArrayDescriptor 3 Float ((4) *10) (plusPtr nullPtr (0*4))))
    GLRaw.glVertexAttribPointer 1 3 GLRaw.gl_FLOAT 0 stride (plusPtr nullPtr
(0))
    vertexAttribArray (AttribLocation 1) $= Enabled
    --vertexAttribPointer (AttribLocation 2) $= (KeepIntegral,
(VertexArrayDescriptor 3 Float ((4) *10) (plusPtr nullPtr (3*4))))
    GLRaw.glVertexAttribPointer 2 3 GLRaw.gl_FLOAT 0 stride (plusPtr nullPtr
(12))
    vertexAttribArray (AttribLocation 2) $= Enabled
    --vertexAttribPointer (AttribLocation 3) $= (KeepIntegral,
(VertexArrayDescriptor 3 Float ((4) *10) (plusPtr nullPtr (6*4))))
    GLRaw.glVertexAttribPointer 3 3 GLRaw.gl_FLOAT 0 stride (plusPtr nullPtr
(24))
    vertexAttribArray (AttribLocation 3) $= Enabled

    --vertexAttribPointer (AttribLocation 4) $= (KeepIntegral,
(VertexArrayDescriptor 1 Float ((4) *10) (plusPtr nullPtr (9*4))))
    GLRaw.glVertexAttribPointer 4 1 GLRaw.gl_FLOAT 0 stride (plusPtr nullPtr
(36))
    vertexAttribArray (AttribLocation 4) $= Enabled
    return ()
    where
        stride = 40

I build a shader program with
buildShader vertexShader fragmentShader = do
    [vertObj] ←  genObjectNames 1 ::IO [VertexShader]
    shaderSource vertObj  $= [vertexShader]
    compileShader vertObj
    vsLog ←  get (shaderInfoLog vertObj)
    print "vertex shader status"
    print vsLog
    [fragObj] ←  genObjectNames 1 ::IO [FragmentShader]
    shaderSource fragObj  $= [fragmentShader]
    compileShader fragObj
    fsLog ←  get (shaderInfoLog fragObj)
    print "fragment shader status"
    print fsLog
    [programObj] ←  genObjectNames 1 ::IO [Program]
    attachedShaders programObj $= ([vertObj], [fragObj])
    attribLocation programObj "position" $= AttribLocation 1
    attribLocation programObj "color" $= AttribLocation 2
    attribLocation programObj "spec" $= AttribLocation 3
    attribLocation programObj "shiny" $= AttribLocation 4
    linkProgram programObj
    progLog ←  get(programInfoLog programObj)
    print "Shader Program status"
    print progLog
    return (Just programObj)

Finally my render function

instance RenderSimpleSceneGraph Model where
    render matrix (ModernModel vbo ibo shader count) = do
        clientState VertexArray $= Enabled
        version ←  get (majorMinor glVersion)
        tempVBO ←  vbo
        tempIBO ←  ibo
        print "Render Modern Model"
        program ←  shader
        currentProgram $= program
        bindBuffer ArrayBuffer $= Just tempVBO
        setAttribPtr program
        bindBuffer ElementArrayBuffer $= Just tempIBO
        print "here"
        drawElements Triangles (fromIntegral count) UnsignedInt nullPtr
        print "here1"
        resetAttribPtr program
        bindBuffer ArrayBuffer $= Nothing
        clientState VertexArray $= Disabled
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://www.haskell.org/pipermail/hopengl/attachments/20101117/709ffcfc/attachment.html


More information about the HOpenGL mailing list