content: 
  module GLFWHelpers ( withWindow
                     , GLFWEvent(..)
                     , highDPIScaleFactor
                     ) where
  
  import Control.Exception
  import Control.Monad
  import Control.Concurrent.STM
  import qualified Graphics.UI.GLFW as GLFW
  import qualified Graphics.GL as GLR
  
  -- Various utility functions related to GLFW
  
  withWindow :: Int -> Int -> Bool -> String -> TQueue GLFWEvent -> (GLFW.Window -> IO ()) -> IO ()
  withWindow w h srgb title tq =
      bracket
          ( do GLFW.setErrorCallback . Just $ errorCallback tq
               True <- GLFW.init
               -- GLFW.windowHint $ GLFW.WindowHint'Samples 4
               -- GLFW.windowHint $ GLFW.WindowHint'Decorated False
               GLFW.windowHint $ GLFW.WindowHint'Resizable True
               when srgb . GLFW.windowHint $ GLFW.WindowHint'sRGBCapable True
               modernOpenGL
               Just window <- GLFW.createWindow w h title Nothing Nothing
               registerCallbacks window tq
               GLFW.makeContextCurrent $ Just window
               when srgb $ GLR.glEnable GLR.GL_FRAMEBUFFER_SRGB
               return window
          )
          ( \window -> do GLFW.destroyWindow window
                          GLFW.terminate
          )
  
  -- >2.1, no backwards compatibility on OS X
  -- http://www.glfw.org/faq.html#how-do-i-create-an-opengl-30-context
  modernOpenGL :: IO ()
  modernOpenGL = do
      GLFW.windowHint $ GLFW.WindowHint'OpenGLProfile GLFW.OpenGLProfile'Core
      GLFW.windowHint $ GLFW.WindowHint'OpenGLForwardCompat True
      GLFW.windowHint $ GLFW.WindowHint'ContextVersionMajor 3
      GLFW.windowHint $ GLFW.WindowHint'ContextVersionMinor 3
  
  highDPIScaleFactor :: GLFW.Window -> IO Double
  highDPIScaleFactor win = do
      (scWdh, _) <- GLFW.getWindowSize win
      (pxWdh, _) <- GLFW.getFramebufferSize win
      return $ fromIntegral pxWdh / fromIntegral scWdh
  
  -- Convert GLFW callbacks into events delivered to a queue
  
  data GLFWEvent = GLFWEventError
                       !GLFW.Error
                       !String
                 | GLFWEventKey
                       !GLFW.Window
                       !GLFW.Key
                       !Int
                       !GLFW.KeyState
                       !GLFW.ModifierKeys
                 | GLFWEventWindowSize
                       !GLFW.Window
                       !Int
                       !Int
                 | GLFWEventFramebufferSize
                       !GLFW.Window
                       !Int
                       !Int
                 | GLFWEventMouseButton
                       !GLFW.Window
                       !GLFW.MouseButton
                       !GLFW.MouseButtonState
                       !GLFW.ModifierKeys
                 | GLFWEventCursorPos
                       !GLFW.Window
                       !Double
                       !Double
                 | GLFWEventScroll
                       !GLFW.Window
                       !Double
                       !Double
  
  errorCallback :: TQueue GLFWEvent -> GLFW.Error -> String -> IO ()
  errorCallback tq e s = atomically . writeTQueue tq $ GLFWEventError e s
  
  keyCallback :: TQueue GLFWEvent
              -> GLFW.Window
              -> GLFW.Key
              -> Int
              -> GLFW.KeyState
              -> GLFW.ModifierKeys -> IO ()
  keyCallback tq win k sc ka mk = atomically . writeTQueue tq $ GLFWEventKey win k sc ka mk
  
  windowSizeCallback :: TQueue GLFWEvent -> GLFW.Window -> Int -> Int -> IO ()
  windowSizeCallback tq win w h = atomically . writeTQueue tq $ GLFWEventWindowSize win w h
  
  framebufferSizeCallback :: TQueue GLFWEvent -> GLFW.Window -> Int -> Int -> IO ()
  framebufferSizeCallback tq win w h =
      atomically . writeTQueue tq $ GLFWEventFramebufferSize win w h
  
  mouseButtonCallback :: TQueue GLFWEvent
                      -> GLFW.Window
                      -> GLFW.MouseButton
                      -> GLFW.MouseButtonState
                      -> GLFW.ModifierKeys
                      -> IO ()
  mouseButtonCallback tq win bttn st mk =
      atomically . writeTQueue tq $ GLFWEventMouseButton win bttn st mk
  
  cursorPosCallback :: TQueue GLFWEvent -> GLFW.Window -> Double -> Double -> IO ()
  cursorPosCallback tq win x y = atomically . writeTQueue tq $ GLFWEventCursorPos win x y
  
  scrollCallback :: TQueue GLFWEvent -> GLFW.Window -> Double -> Double -> IO ()
  scrollCallback tq win x y = atomically . writeTQueue tq $ GLFWEventScroll win x y
  
  registerCallbacks :: GLFW.Window -> TQueue GLFWEvent -> IO ()
  registerCallbacks window tq = do
      GLFW.setKeyCallback             window . Just $ keyCallback tq
      GLFW.setWindowSizeCallback      window . Just $ windowSizeCallback tq
      GLFW.setFramebufferSizeCallback window . Just $ framebufferSizeCallback tq
      GLFW.setMouseButtonCallback     window . Just $ mouseButtonCallback tq
      GLFW.setCursorPosCallback       window . Just $ cursorPosCallback tq
      GLFW.setScrollCallback          window . Just $ scrollCallback tq
  
  