[HOpenGL] draw Elements segmentation fault.
Ben Christy
ben.christy at gmail.com
Thu Nov 18 10:37:25 EST 2010
I have tried
drawElements Triangles (fromIntegral 1) UnsignedInt nullPtr--(fromIntegral
count)
Test.withArray [ (i) | i<-[0..count-1] ] $ \p -> drawElements Points10
UnsignedInt p
drawArrays Points 1 10
All three of which cause a segmentation thought. I am kind of at a loss, is
it possible that the buffers are empty? If so what is the best way to check?
On Thu, Nov 18, 2010 at 8:20 AM, Balazs Komuves <bkomuves at gmail.com> wrote:
>
> Hi,
>
> I'm just guessing here, but I believe the problem is with the line
>
>
> drawElements Triangles (fromIntegral count) UnsignedInt nullPtr
>>
>
> Look up 'drawElements' in the OpenGL specification
> (page 29 in
> http://www.opengl.org/documentation/specs/version2.0/glspec20.pdf):
>
> The command
>>
>> void DrawElements( enum mode, sizei count, enum type, void *indices );
>>>
>>
>> constructs a sequence of geometric primitives using the count elements
>> whose indices are stored in indices. type must be one of UNSIGNED BYTE,
>> UNSIGNED SHORT, or UNSIGNED INT, indicating that the values in indices are
>> indices of GL type ubyte, ushort, or uint respectively. Mode specifies what
>> kind of primitives are constructed; it accepts the same token values as the
>> mode
>> parameter of the Begin command. The effect of DrawElements (mode, count,
>> type, indices); is the same as the effect of the command sequence
>>
>> if (mode, count, or type is invalid )
>>> generate appropriate error
>>> else {
>>> Begin(mode);
>>> for (int i = 0; i < count ; i++)
>>> ArrayElement(indices[i]);
>>> End();
>>> }
>>>
>>
> So, I think you actually want to use 'drawArrays' instead. But without
> seeing the full source, I'm again just guessing.
>
> I believe 'drawElements' should be used like this (I'm writing this from
> the top of head, so take it with a grain of salt):
>
> withArray [ (3*i :: GLuint) | i<-[0..count-1] ] $ \p -> drawElements
>> Triangles count UnsignedInt p
>>
>
>
> Balazs
>
>
> On Thu, Nov 18, 2010 at 2:53 AM, Ben Christy <ben.christy at gmail.com>wrote:
>
>> 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
>>
>> _______________________________________________
>> HOpenGL mailing list
>> HOpenGL at haskell.org
>> http://www.haskell.org/mailman/listinfo/hopengl
>>
>>
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://www.haskell.org/pipermail/hopengl/attachments/20101118/22319bff/attachment-0001.html
More information about the HOpenGL
mailing list