
Balazs Komuves wrote:
Hello,
I can't reproduce this behaviour (though I didn't try very hard). Could you send some specific code which produces bus error on your setup?
Sure. Code attached below this message. After some playing around minimalising this example, I have come to a stronger conclusion: the code only crashes when the Combiner callback gets invoked. Since I have tolerance 0, that only happens if you have a duplicated vertex. If the vertex (200,200) appears twice (as in the simple example I attach) then you get the bus error, presumably when calling the Combiner. This makes me suspect that the nasty peeking and poking going on in the AnnotatedVertex Storable instance is not quite right, or something else is wrong in withCombineCallback or combineProperties (see http://hackage.haskell.org/packages/archive/OpenGL/2.2.1.1/doc/html/src/Grap... ) Code follows. I'd be interested to hear if it crashes for other people (could it be a bug in my OS's GLU?) Jules -- import Graphics.Rendering.OpenGL import Graphics.UI.GLUT import Control.Monad main = do (progName,args) <- getArgsAndInitialize initialDisplayMode $= [ DoubleBuffered, RGBAMode, WithDepthBuffer] createWindow progName windowSize $= (Size 640 480) blend $= Enabled blendFunc $= (SrcAlpha,OneMinusSrcAlpha) multisample $= Enabled --lineSmooth $= Enabled lineWidth $= 1 reshapeCallback $= Just reshape displayCallback $= display postRedisplay Nothing addTimerCallback 50 (idle) mainLoop idle = do postRedisplay Nothing addTimerCallback 50 (idle) display = do loadIdentity depthMask $= Enabled depthFunc $= Nothing -- Just Lequal clear [ColorBuffer,DepthBuffer] polygonMode $= (Line,Line) let pts = (figure8) -- let pts = (circle 27) pp <- tessRegion pts color $ Color4 1 1 0 (1::GLfloat) renderSimplePolygon pp swapBuffers -- n-point approximation to a circle (does not cause crash whatever n -- you use) circle n = map (\t -> (200 + 200 * sin (t*2*pi), 200 + 200 * cos (t*2*pi))) [0,1/n..1] -- causes crash, presumably because of the duplicated point (200,200) figure8 = [(200,0),(100,100),(200,200),(300,300),(200,400),(100,300),(200,200),(300,100)] -- does not crash, as it has no duplicated point figure8' = [(200,0),(100,100),(200,200),(300,300),(200,400),(100,300),(201,201),(300,100)] -- 2D projection reshape screenSize@(Size w h) = do viewport $= ((Position 0 0), screenSize) matrixMode $= Projection loadIdentity ortho2D 0 (fromIntegral w) 0 (fromIntegral h) matrixMode $= Modelview 0 -- this appears to give a bus error with sufficiently complex input tessRegion :: [(GLfloat,GLfloat)] -> IO (SimplePolygon Int) tessRegion pp = tessellate TessWindingOdd 0 (Normal3 0 0 0) (\vv (WeightedProperties (_,p) _ _ _) -> p) $ ComplexPolygon [ComplexContour (map (\(x,y) -> AnnotatedVertex (Vertex3 (realToFrac x) (realToFrac y) 0) (0::Int)) pp)] renderSimplePolygon (SimplePolygon pp) = mapM_ renderSimplePrimitive pp renderSimplePrimitive (Primitive pm vv) = renderPrimitive pm . forM_ vv $ \(AnnotatedVertex v _) -> vertex v