Example Haskell application using SDL2 and OpenGL bindinds. Implements main rendering loop with non-blocking event polling.

openglsdl2.hs

module Main where

import Graphics.Rendering.OpenGL
import Graphics.UI.SDL as SDL
import System.Environment
import Foreign.C.String
import Foreign.Marshal.Alloc
import Foreign.Storable
import Data.Bits

data ApplicationEvent = QuitApplication | ContinueApplication

main = do
  SDL.init initFlagVideo
  progname <- getProgName
  window <- withCString progname createAWindow
  createGLContext window
  mainLoop window

mainLoop :: Window -> IO (Bool)
mainLoop window = do
  applicationEvent <- pollAnEvent
  case applicationEvent of
    QuitApplication -> return True
    _ -> continue window
  where continue window = do
          drawGLScreen window
          mainLoop window

pollAnEvent :: IO (ApplicationEvent)
pollAnEvent = alloca doPoll
    where doPoll event = do
            retVal <- pollEvent event
            case retVal of
              1 -> peek event >>= return . interpretEvent
              _ -> return $ ContinueApplication

interpretEvent :: Event -> ApplicationEvent
interpretEvent event =
  case event of
    QuitEvent _ _ -> QuitApplication
    _ -> ContinueApplication

createAWindow :: CString -> IO (Window)
createAWindow name = do
  window <- createWindow name windowPosUndefined windowPosUndefined width height $ windowFlagOpenGL .|. windowFlagResizable
  depthFunc $= Just Less
  clearColor $= Color4 0 0 0 1
  let (w,h) = (fromIntegral width,fromIntegral height)
  viewport $= (Position 0 0,Size w h)
  matrixMode $= Projection
  loadIdentity
  perspective 45 (fromIntegral width / fromIntegral height) 0.1 100
  matrixMode $= Modelview 0
  return window
  where width = 640
        height = 480

createGLContext window = do
  glCreateContext window

drawGLScreen window = do
  clear [ColorBuffer,DepthBuffer]
  loadIdentity
  color $ Color3 0.8 0.4 (0.9 :: GLfloat)
  scale 0.7 0.7 (0.7 :: GLfloat)
  cube 0.3
  glSwapWindow window

cube :: GLfloat -> IO ()
cube w = renderPrimitive Quads $ mapM_ vertex3f
  [ ( w, w, w), ( w, w,-w), ( w,-w,-w), ( w,-w, w),
    ( w, w, w), ( w, w,-w), (-w, w,-w), (-w, w, w),
    ( w, w, w), ( w,-w, w), (-w,-w, w), (-w, w, w),
    (-w, w, w), (-w, w,-w), (-w,-w,-w), (-w,-w, w),
    ( w,-w, w), ( w,-w,-w), (-w,-w,-w), (-w,-w, w),
    ( w, w,-w), ( w,-w,-w), (-w,-w,-w), (-w, w,-w) ]

vertex3f :: (GLfloat, GLfloat, GLfloat) -> IO ()
vertex3f (x, y, z) = vertex $ Vertex3 x y z

Line 17, the createGLContext should be before any of the $= lines in createAWindow . Segmentation fault is the result for me otherwise.