Haskell graphics program closing too early

Question

I'm writing a program using OpenGl and Haskell that should draw a rectangle when and where the mouse is clicked. However, the program closes as soon as I click and before the rectangle is drawn.

import Graphics.Rendering.OpenGL
import Graphics.UI.GLUT
import Graphics.UI.GLUT.Callbacks.Window

main = do
  (progname, _) <- getArgsAndInitialize
  createWindow progname
  keyboardMouseCallback $= Just myKeyboardMouseCallback
  displayCallback $= display
  mainLoop

myKeyboardMouseCallback key keyState modifiers (Position x y) =
  case (key, keyState) of
    (MouseButton LeftButton, Down) -> do
      clear[ColorBuffer]
      let x = x :: GLfloat
      let y = y :: GLfloat
      renderPrimitive Quads $ do
        color $ (Color3 (1.0::GLfloat) 0 0)
        vertex $ (Vertex3 (x::GLfloat) y 0)
        vertex $ (Vertex3 (x::GLfloat) (y+0.2) 0)
        vertex $ (Vertex3 ((x+0.2)::GLfloat) (y+0.2) 0)
        vertex $ (Vertex3 ((x+0.2)::GLfloat) y 0)
      flush
    _ -> return ()

display = do
  clear [ColorBuffer]
  renderPrimitive Lines $ do
  flush

Is there something causing the program to terminate early in one of the methods, or is this just the the computers way of telling me I can't do this?

Answer 1

You can't do what you are trying to do. In an OpenGL program, you are only allowed to issue draw commands in the OpenGL context. This context is always bound to a specific thread, and is only active in the body of the displayCallback in GLUT, because the other callbacks might potentially run from different threads.

However, you might say: On many/most platforms, a separate thread isn't used for input in GLUT, which means that you theoretically could issue drawing commands there. There are, however, many other things that play a role in where and when you can issue drawing commands; for example when the environment requires you to use double-buffered output where the buffers have to be flushed in very specific ways (e.g. when using EGL or GLX for X11).

In short: you should not issue drawing commands outside of the displayCallback. The whole reason for its existence is so that you can let GLUT handle the platform-specific stuff related to native frame buffer management, and it expects you to keep your code in the right places for it to work.

What you want to do instead is to create a mutable variable (Hey, you're using OpenGL; mutable state shouldn't be a worry to you) that indicates whether to draw the rectangle and where. Something like (Using Data.IORef):

main = do
  -- ...

  -- Create a mutable variable that stores a Bool and a pair of floats
  mouseStateRef <- newIORef (False, (0, 0))

  -- Pass a reference to the mutable variable to the callbacks
  keyboardMouseCallback $= Just (myKeyboardMouseCallback mouseStateRef)
  displayCallback $= (display mouseStateRef)

myKeyboardMouseCallback mouseStateRef key keyState modifiers (Position x y) =
  case key of
    MouseButton LeftButton -> do
      -- Store the current mouse pressed state and coords in the reference
      writeIORef mouseStateRef (keyState == Pressed, (x, y))
    _ -> return ()

display mouseStateRef = do
  clear [ColorBuffer]

  -- Read the state stored in the mutable reference
  (pressed, (x, y)) <- readIORef mouseStateRef

  -- Draw the quad if the mouse button is pressed
  when pressed . renderPrimitive Quads $ do
    color $ (Color3 (1.0::GLfloat) 0 0)
    vertex $ (Vertex3 (x::GLfloat) y 0)
    vertex $ (Vertex3 (x::GLfloat) (y+0.2) 0)
    vertex $ (Vertex3 ((x+0.2)::GLfloat) (y+0.2) 0)
    vertex $ (Vertex3 ((x+0.2)::GLfloat) y 0)
  flush