Drawing concurrently in multiple windows with GLUT - haskell

Question

When I create two windows and redraw them in two different threads (one per window), it seems like all drawing goes to first created window. It constantly switches between what should be displayed in both windows. And second one remains mostly black.
The code was working well with only one window, and then I updated it - inserted currentWindow $= Just glWindow in the beginning of the functions which set callbacks and call rendering methods.
What do you think is the cause of the problems?
EDIT:
Code skeleton:
module Chart.Window where
import Graphics.UI.GLUT hiding (Window, postRedisplay, <etc>)
import qualified Graphics.UI.GLUT as GLUT
import qualified Graphics.Rendering.OpenGL as GL
data Window = Window
{ glWindow :: GLUT.Window
, viewListRef :: IORef [Line]
}
main = do
forkOS start <params1>
forkOS start <params2>
start <params> = do
win <- new <params>
run win
mainLoop
new :: Strict -> (Int, Int) -> (Int, Int) -> IO Window
new name (posx, posy) (w, h) = do
initGLUT
glWindow <- createWindow name
currentWindow $= Just glWindow
windowSize $= Size (fromIntegral w) (fromIntegral h)
windowPosition $= Position (fromIntegral posx) (fromIntegral posy)
return Window {..}
initGLUT :: IO ()
initGLUT = do
beenInit <- get initState
unless beenInit $ void getArgsAndInitialize
initialDisplayMode $= [WithDepthBuffer, DoubleBuffered, RGBAMode]
initialWindowSize $= Size 100 100
initialWindowPosition $= Position 100 100
actionOnWindowClose $= ContinueExectuion
run :: Window -> IO ()
run win#Window{..} = do
-- this will fork (with forkIO) threads
-- which will call "repaint" when chart needs to be updated
initListeners repaint
initCallbacks win
where
repaint :: [Line] -> IO ()
repaint viewList = do
writeIORef viewListRef viewList
postRedisplay win
postRedisplay Window{..} = GLUT.postRedisplay $ Just glWindow
initCallbacks win#Window{..} = do
currentWindow $= Just glWindow
GLUT.displayCallback $= display win
GLUT.idleCallback $= Just (postRedisplay win)
display Window{..} = do
currentWindow $= Just glWindow
Size w h <- get windowSize
viewList <- readIORef viewListRef
drawChart viewList otherOptions
reshapeCallback :: Window -> GLUT.ReshapeCallback
reshapeCallback win#Window{..} size#(Size w h) = do
currentWindow $= Just glWindow
GL.viewport $= (Position 0 0, size)
GL.matrixMode $= GL.Projection
GL.loadIdentity
GL.ortho2D 0 (fromIntegral w) 0 (fromIntegral h)
GL.matrixMode $= GL.Modelview 0
GL.loadIdentity
... -- send command for listener thread to change internal state and postRedisplay
drawChart viewList otherOptions = do
...
-- chart consists of several horizontal panels. Call this for each panel:
glViewport 0 panelYPosition width winHeight
glScissor 0 panelYPosition (fromIntegral width) (fromIntegral panelHeight)
GL.clear [GL.ColorBuffer]
...
-- and then for each line=(Vertex2 v1 v2) from viewList
GL.renderPrimitive GL.Lines $ do
GL.vertex v1
GL.vertex v2
...
BTW, when I commented the line which sets reshapeCallback (and window is reshaped at the beginning) and launched charting with only one window, I got exactly the same effect as in multi-window launch. I mean, the (only) window was mostly empty as if it was secondly created.

Answer 1

I had a similar problem. I work with a thread that calculates the iterations of a genetic algorithm and in each iteration I call to "GL.postRedisplay (Just window)" but it didn't draw anything.
I solved my problem by calling "GL.postRedisplay (Just window)" from the idle function:
idle window = CC.threadDelay (1000*500) >> GL.postRedisplay (Just window)
Don't forget to setup your idle callback function like this:
GL.idleCallback GL.$= Just (idle window) >>
CC and GL mean:
import qualified Control.Concurrent as CC
import qualified Graphics.UI.GLUT as GL