[HOpenGL] draw Elements segmentation fault.

Balazs Komuves bkomuves at gmail.com
Fri Nov 19 07:26:07 EST 2010


Hi,

Still guessing (I can't try your code at the moment), but it seems that you
want to use vertex arrays, however you set up the vertex *attribute* array
pointer, which are two different things. Vertex attributes are arbitrary
parameters associated with vertices, to be used by vertex shaders.

Balazs

On Fri, Nov 19, 2010 at 3:38 AM, Ben Christy <ben.christy at gmail.com> wrote:

> 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?
>>
>>
>>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://www.haskell.org/pipermail/hopengl/attachments/20101119/7dfd72d8/attachment.html


More information about the HOpenGL mailing list