Drawing concurrently in multiple windows with GLUT

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