[HOpenGL] draw Elements segmentation fault.
Ben Christy
ben.christy at gmail.com
Thu Nov 18 21:38:03 EST 2010
Ok I stripped this down to the barest form and I still get segmentation
faults here is the code. I am at a loss as this seems to be identical to C
code posted in examples all over the web. Any thoughts?
main = do
(progname, _) ← getArgsAndInitialize
createWindow "Ben Christy Assignment 2"
windowSize $= Size 800 600
matrixMode $= Projection
loadIdentity
depthFunc $= Just Less
viewport $= (Position 0 0, Size 800 600)
perspective 60 1.333 1 120
changesRef ← newIORef Map.empty
--sceneRef ← newIORef buildSSG
sceneRef ← newIORef (SimpleRootNode "HomeWork3" [
TransformNode "camera" (Rotate 0 90 0) (Translate 0 0 (-1))
[
TransformNode "ground" (Rotate 0 0 0) (Translate (-4) (-1.5)
(-4))
[
ModelNode "groundModel" (Just (buildModel ModernGL
(heightMapToVerts(genHeightMap 2 1 1.6 1.2 1.7) 0.1 0 3)
(0,0,0) (buildShader
defaultVertexShader defaultFragmentShader)))
]
]
])
--pollsRot ← newIORef 0
--evenState ← newIORef BackAgain
--evenPos ← newIORef 0.25
--oddState ← newIORef There
--oddPos ← newIORef 0.15
--balloonNumSteps ← newIORef 100
reshapeCallback $= Just reshape
displayCallback $= (displayScene sceneRef changesRef )
--addTimerCallback 10 (animate sceneRef pollsRot changesRef evenState
evenPos oddState oddPos)
--keyboardMouseCallback $= Just (handleInput sceneRef changesRef)
mainLoop
displayScene sceneRef changesRef= do
--changes ← readIORef changesRef
--oldSceneGraph ← readIORef sceneRef
--sceneGraph ← return $ updateSceneGraph changes oldSceneGraph
--render identityMatrix sceneGraph
--writeIORef changesRef Map.empty
--writeIORef sceneRef sceneGraph
clear [ColorBuffer, DepthBuffer]
lighting $= Enabled
light (Light 0) $= Enabled
matrixMode $= Modelview 0
loadIdentity
[vbo] ← genObjectNames 1 :: IO [BufferObject]
bindBuffer ArrayBuffer $= Just vbo
tempArray ← newListArray (0, 8) [0,0,0,0,0.5,0,0.5,0.5,0.5] ::
IO(StorableArray Int GLfloat)
withStorableArray tempArray (λptr ->
bufferData ArrayBuffer $= ((fromIntegral (9*4), ptr, StaticDraw)))
print " Setting attrib pointer"
vertexAttribArray (AttribLocation 1) $= Enabled
GLRaw.glVertexAttribPointer 1 3 GLRaw.gl_FLOAT 0 0 (plusPtr nullPtr (0))
clientState VertexArray $= Enabled
print "before draw"
drawArrays Triangles 0 3
print "after draw"
--resetAttribPtr program
bindBuffer ArrayBuffer $= Nothing
clientState VertexArray $= Disabled
return ()
reshape (Size w h) = do
print "resize"
matrixMode $= Projection
loadIdentity
depthFunc $= Just Less
viewport $= (Position 0 0, Size w h)
perspective 60 1.333 0.01 120
matrixMode $= Modelview 0
loadIdentity
postRedisplay Nothing
On Thu, Nov 18, 2010 at 10:37 AM, Ben Christy <ben.christy at gmail.com> wrote:
> 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/7589c48e/attachment-0001.html
More information about the HOpenGL
mailing list