{-# LINE 1 "src/Graphics/UI/GLFW.hsc" #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LINE 2 "src/Graphics/UI/GLFW.hsc" #-}
{-# LANGUAGE MultiParamTypeClasses    #-}

module Graphics.UI.GLFW
  ( -- *   Initialization and termination
    initialize
  , terminate

    -- *   Video mode information
  , getVideoMode
  , getVideoModes
    --
  , VideoMode(..)

    -- *   Windows
    -- **  Management
  , openWindow
  , closeWindow
  , setWindowTitle
  , setWindowDimensions
  , setWindowPosition
  , iconifyWindow
  , restoreWindow
  , swapBuffers
  , setWindowBufferSwapInterval
    --
  , DisplayMode(..)
  , DisplayOptions(..)
  , defaultDisplayOptions
    -- **  Information
  , windowIsOpen
  , windowIsActive
  , windowIsIconified
  , windowIsResizable
  , windowIsHardwareAccelerated
  , windowSupportsStereoRendering
  , getWindowRefreshRate
  , getWindowDimensions
  , getWindowValue
  , setWindowCloseCallback
  , setWindowSizeCallback
  , setWindowRefreshCallback
    --
  , WindowValue(..)
  , WindowCloseCallback
  , WindowSizeCallback
  , WindowRefreshCallback

    -- *   Input
  , pollEvents
  , waitEvents
    -- **  Keyboard
  , keyIsPressed
  , setCharCallback
  , setKeyCallback
    --
  , Key(..)
  , CharCallback
  , KeyCallback
    -- **  Mouse
  , mouseButtonIsPressed
  , getMousePosition
  , getMouseWheel
  , setMousePosition
  , setMouseWheel
  , setMouseButtonCallback
  , setMousePositionCallback
  , setMouseWheelCallback
    --
  , MouseButton(..)
  , MouseButtonCallback
  , MousePositionCallback
  , MouseWheelCallback
    -- **  Joystick
  , joystickIsPresent
  , getJoystickPosition
  , getNumJoystickAxes
  , getNumJoystickButtons
  , joystickButtonsArePressed
    --
  , Joystick(..)

    -- *   Time
  , getTime
  , setTime
  , resetTime
  , sleep

    -- *   Version information
  , getGlfwVersion
  , getGlVersion
  ) where

-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --

import Control.Monad         (when)
import Data.Char             (chr, ord)
import Data.IORef            (IORef, atomicModifyIORef, newIORef)
import Data.Maybe            (fromJust, isJust)
import Data.Version          (Version(..))
import Foreign.C.String      (CString, withCString)
import Foreign.C.Types       (CDouble, CFloat, CInt, CUChar)
import Foreign.Marshal.Alloc (alloca)
import Foreign.Marshal.Array (allocaArray, peekArray)
import Foreign.Ptr           (FunPtr, Ptr, freeHaskellFunPtr)
import Foreign.Storable      (Storable(..))
import System.IO.Unsafe      (unsafePerformIO)

-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --


{-# LINE 112 "src/Graphics/UI/GLFW.hsc" #-}

foreign import ccall unsafe glfwInit                     :: IO CInt
foreign import ccall unsafe glfwTerminate                :: IO ()
foreign import ccall unsafe glfwGetVersion               :: Ptr CInt -> Ptr CInt -> Ptr CInt -> IO ()

foreign import ccall unsafe glfwOpenWindow               :: CInt -> CInt -> CInt -> CInt -> CInt -> CInt -> CInt -> CInt -> CInt -> IO CInt
foreign import ccall unsafe glfwOpenWindowHint           :: CInt -> CInt -> IO ()
foreign import ccall unsafe glfwCloseWindow              :: IO ()
foreign import ccall unsafe glfwSetWindowCloseCallback   :: FunPtr GlfwWindowCloseCallback -> IO ()
foreign import ccall unsafe glfwSetWindowTitle           :: CString -> IO ()
foreign import ccall unsafe glfwSetWindowSize            :: CInt -> CInt -> IO ()
foreign import ccall unsafe glfwSetWindowPos             :: CInt -> CInt -> IO ()
foreign import ccall unsafe glfwGetWindowSize            :: Ptr CInt -> Ptr CInt -> IO ()
foreign import ccall        glfwSetWindowSizeCallback    :: FunPtr GlfwWindowSizeCallback -> IO ()
foreign import ccall unsafe glfwIconifyWindow            :: IO ()
foreign import ccall unsafe glfwRestoreWindow            :: IO ()
foreign import ccall unsafe glfwGetWindowParam           :: CInt -> IO CInt
foreign import ccall        glfwSwapBuffers              :: IO ()
foreign import ccall unsafe glfwSwapInterval             :: CInt -> IO ()
foreign import ccall unsafe glfwSetWindowRefreshCallback :: FunPtr GlfwWindowRefreshCallback -> IO ()

foreign import ccall unsafe glfwGetVideoModes            :: Ptr VideoMode -> CInt -> IO CInt
foreign import ccall unsafe glfwGetDesktopMode           :: Ptr VideoMode -> IO ()

foreign import ccall unsafe glfwPollEvents               :: IO ()
foreign import ccall unsafe glfwWaitEvents               :: IO ()
foreign import ccall unsafe glfwGetKey                   :: CInt -> IO CInt
foreign import ccall unsafe glfwGetMouseButton           :: CInt -> IO CInt
foreign import ccall unsafe glfwGetMousePos              :: Ptr CInt -> Ptr CInt -> IO ()
foreign import ccall unsafe glfwSetMousePos              :: CInt -> CInt -> IO ()
foreign import ccall unsafe glfwGetMouseWheel            :: IO CInt
foreign import ccall unsafe glfwSetMouseWheel            :: CInt -> IO ()
foreign import ccall        glfwSetKeyCallback           :: FunPtr GlfwKeyCallback -> IO ()
foreign import ccall        glfwSetCharCallback          :: FunPtr GlfwCharCallback -> IO ()
foreign import ccall        glfwSetMouseButtonCallback   :: FunPtr GlfwMouseButtonCallback -> IO ()
foreign import ccall        glfwSetMousePosCallback      :: FunPtr GlfwMousePositionCallback -> IO ()
foreign import ccall        glfwSetMouseWheelCallback    :: FunPtr GlfwMouseWheelCallback -> IO ()
foreign import ccall unsafe glfwGetJoystickParam         :: CInt -> CInt -> IO CInt
foreign import ccall unsafe glfwGetJoystickPos           :: CInt -> Ptr CFloat -> CInt -> IO CInt
foreign import ccall unsafe glfwGetJoystickButtons       :: CInt -> Ptr CUChar -> CInt -> IO CInt

foreign import ccall unsafe glfwGetTime                  :: IO CDouble
foreign import ccall unsafe glfwSetTime                  :: CDouble -> IO ()
foreign import ccall unsafe glfwSleep                    :: CDouble -> IO ()

foreign import ccall unsafe glfwGetGLVersion             :: Ptr CInt -> Ptr CInt -> Ptr CInt -> IO ()

type GlfwCharCallback          = CInt -> CInt -> IO ()
type GlfwKeyCallback           = CInt -> CInt -> IO ()
type GlfwMouseButtonCallback   = CInt -> CInt -> IO ()
type GlfwMousePositionCallback = CInt -> CInt -> IO ()
type GlfwMouseWheelCallback    = CInt         -> IO ()
type GlfwWindowCloseCallback   =                 IO CInt
type GlfwWindowRefreshCallback =                 IO ()
type GlfwWindowSizeCallback    = CInt -> CInt -> IO ()

type CharCallback          = Char -> Bool        -> IO ()
type KeyCallback           = Key -> Bool         -> IO ()
type MouseButtonCallback   = MouseButton -> Bool -> IO ()
type MousePositionCallback = Int -> Int          -> IO ()
type MouseWheelCallback    = Int                 -> IO ()
type WindowCloseCallback   =                        IO Bool
type WindowRefreshCallback =                        IO ()
type WindowSizeCallback    = Int -> Int          -> IO ()

foreign import ccall unsafe "wrapper" wrapCharCallback          :: GlfwCharCallback          -> IO (FunPtr GlfwCharCallback)
foreign import ccall unsafe "wrapper" wrapKeyCallback           :: GlfwKeyCallback           -> IO (FunPtr GlfwKeyCallback)
foreign import ccall unsafe "wrapper" wrapMouseButtonCallback   :: GlfwMouseButtonCallback   -> IO (FunPtr GlfwMouseButtonCallback)
foreign import ccall unsafe "wrapper" wrapMousePositionCallback :: GlfwMousePositionCallback -> IO (FunPtr GlfwMousePositionCallback)
foreign import ccall unsafe "wrapper" wrapMouseWheelCallback    :: GlfwMouseWheelCallback    -> IO (FunPtr GlfwMouseWheelCallback)
foreign import ccall unsafe "wrapper" wrapWindowCloseCallback   :: GlfwWindowCloseCallback   -> IO (FunPtr GlfwWindowCloseCallback)
foreign import ccall unsafe "wrapper" wrapWindowRefreshCallback :: GlfwWindowRefreshCallback -> IO (FunPtr GlfwWindowRefreshCallback)
foreign import ccall unsafe "wrapper" wrapWindowSizeCallback    :: GlfwWindowSizeCallback    -> IO (FunPtr GlfwWindowSizeCallback)

-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
-- Initialization and termination

initialize :: IO Bool
initialize =
    fromC `fmap` glfwInit

terminate :: IO ()
terminate =
    glfwTerminate

-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
-- Video mode information

getVideoMode :: IO VideoMode
getVideoMode =
    alloca $ \ptr -> do
        glfwGetDesktopMode ptr
        peek ptr

getVideoModes :: IO [VideoMode]
getVideoModes =
    allocaArray m $ \ptr -> do
        n <- glfwGetVideoModes ptr (toC m)
        peekArray (fromC n) ptr
  where
    m = 256

-- -- -- -- -- -- -- -- -- --

data VideoMode = VideoMode
  { videoMode_width        :: Int
  , videoMode_height       :: Int
  , videoMode_numRedBits   :: Int
  , videoMode_numGreenBits :: Int
  , videoMode_numBlueBits  :: Int
  } deriving Show

instance Storable VideoMode where
  sizeOf    _ = (20)
{-# LINE 226 "src/Graphics/UI/GLFW.hsc" #-}
  alignment _ = alignment (undefined :: CInt)

  peek ptr = do
      w <- ((\hsc_ptr -> peekByteOff hsc_ptr 0))     ptr :: IO CInt
{-# LINE 230 "src/Graphics/UI/GLFW.hsc" #-}
      h <- ((\hsc_ptr -> peekByteOff hsc_ptr 4))    ptr :: IO CInt
{-# LINE 231 "src/Graphics/UI/GLFW.hsc" #-}
      r <- ((\hsc_ptr -> peekByteOff hsc_ptr 8))   ptr :: IO CInt
{-# LINE 232 "src/Graphics/UI/GLFW.hsc" #-}
      g <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) ptr :: IO CInt
{-# LINE 233 "src/Graphics/UI/GLFW.hsc" #-}
      b <- ((\hsc_ptr -> peekByteOff hsc_ptr 12))  ptr :: IO CInt
{-# LINE 234 "src/Graphics/UI/GLFW.hsc" #-}
      return VideoMode
        { videoMode_width        = fromC w
        , videoMode_height       = fromC h
        , videoMode_numRedBits   = fromC r
        , videoMode_numGreenBits = fromC g
        , videoMode_numBlueBits  = fromC b
        }

-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
-- Window management

openWindow :: DisplayOptions -> IO Bool
openWindow displayOptions = do
    let DisplayOptions
          { displayOptions_width               = _displayOptions_width
          , displayOptions_height              = _displayOptions_height
          , displayOptions_numRedBits          = _displayOptions_numRedBits
          , displayOptions_numGreenBits        = _displayOptions_numGreenBits
          , displayOptions_numBlueBits         = _displayOptions_numBlueBits
          , displayOptions_numAlphaBits        = _displayOptions_numAlphaBits
          , displayOptions_numDepthBits        = _displayOptions_numDepthBits
          , displayOptions_numStencilBits      = _displayOptions_numStencilBits
          , displayOptions_displayMode         = _displayOptions_displayMode
          , displayOptions_refreshRate         = _displayOptions_refreshRate
          , displayOptions_accumNumRedBits     = _displayOptions_accumNumRedBits
          , displayOptions_accumNumGreenBits   = _displayOptions_accumNumGreenBits
          , displayOptions_accumNumBlueBits    = _displayOptions_accumNumBlueBits
          , displayOptions_accumNumAlphaBits   = _displayOptions_accumNumAlphaBits
          , displayOptions_numAuxiliaryBuffers = _displayOptions_numAuxiliaryBuffers
          , displayOptions_numFsaaSamples      = _displayOptions_numFsaaSamples
          , displayOptions_windowIsResizable   = _displayOptions_windowIsResizable
          , displayOptions_stereoRendering     = _displayOptions_stereoRendering
          } = displayOptions

    -- Add hints.
    when (isJust _displayOptions_refreshRate)         $ glfwOpenWindowHint (131083)     (toC (fromJust _displayOptions_refreshRate))
{-# LINE 270 "src/Graphics/UI/GLFW.hsc" #-}
    when (isJust _displayOptions_accumNumRedBits)     $ glfwOpenWindowHint (131084)   (toC (fromJust _displayOptions_accumNumRedBits))
{-# LINE 271 "src/Graphics/UI/GLFW.hsc" #-}
    when (isJust _displayOptions_accumNumGreenBits)   $ glfwOpenWindowHint (131085) (toC (fromJust _displayOptions_accumNumGreenBits))
{-# LINE 272 "src/Graphics/UI/GLFW.hsc" #-}
    when (isJust _displayOptions_accumNumBlueBits)    $ glfwOpenWindowHint (131086)  (toC (fromJust _displayOptions_accumNumBlueBits))
{-# LINE 273 "src/Graphics/UI/GLFW.hsc" #-}
    when (isJust _displayOptions_accumNumAlphaBits)   $ glfwOpenWindowHint (131087) (toC (fromJust _displayOptions_accumNumAlphaBits))
{-# LINE 274 "src/Graphics/UI/GLFW.hsc" #-}
    when (isJust _displayOptions_numAuxiliaryBuffers) $ glfwOpenWindowHint (131088)      (toC (fromJust _displayOptions_numAuxiliaryBuffers))
{-# LINE 275 "src/Graphics/UI/GLFW.hsc" #-}
    when (isJust _displayOptions_numFsaaSamples)      $ glfwOpenWindowHint (131091)     (toC (fromJust _displayOptions_numFsaaSamples))
{-# LINE 276 "src/Graphics/UI/GLFW.hsc" #-}

    glfwOpenWindowHint (131090) (toC (not _displayOptions_windowIsResizable))
{-# LINE 278 "src/Graphics/UI/GLFW.hsc" #-}
    glfwOpenWindowHint (131089)           (toC      _displayOptions_stereoRendering)
{-# LINE 279 "src/Graphics/UI/GLFW.hsc" #-}

    -- Open the window.
    fromC `fmap` glfwOpenWindow
      (toC _displayOptions_width)
      (toC _displayOptions_height)
      (toC _displayOptions_numRedBits)
      (toC _displayOptions_numGreenBits)
      (toC _displayOptions_numBlueBits)
      (toC _displayOptions_numAlphaBits)
      (toC _displayOptions_numDepthBits)
      (toC _displayOptions_numStencilBits)
      (toC _displayOptions_displayMode)

closeWindow :: IO ()
closeWindow =
    glfwCloseWindow

setWindowTitle :: String -> IO ()
setWindowTitle t =
    withCString t glfwSetWindowTitle

setWindowDimensions :: Int -> Int -> IO ()
setWindowDimensions w h =
    glfwSetWindowSize (toC w) (toC h)

setWindowPosition :: Int -> Int -> IO ()
setWindowPosition w h =
    glfwSetWindowPos (toC w) (toC h)

iconifyWindow :: IO ()
iconifyWindow =
    glfwIconifyWindow

restoreWindow :: IO ()
restoreWindow =
    glfwRestoreWindow

swapBuffers :: IO ()
swapBuffers =
    glfwSwapBuffers

setWindowBufferSwapInterval :: Int -> IO ()
setWindowBufferSwapInterval =
    glfwSwapInterval . toC

-- -- -- -- -- -- -- -- -- --

data DisplayMode
  = Window
  | Fullscreen
  deriving (Show)

instance C DisplayMode CInt where
  toC dm = case dm of
      Window     -> 65537
{-# LINE 334 "src/Graphics/UI/GLFW.hsc" #-}
      Fullscreen -> 65538
{-# LINE 335 "src/Graphics/UI/GLFW.hsc" #-}

  fromC i = case i of
      (65537) -> Window
{-# LINE 338 "src/Graphics/UI/GLFW.hsc" #-}
      (65538) -> Fullscreen
{-# LINE 339 "src/Graphics/UI/GLFW.hsc" #-}
      _                        -> makeFromCError "DisplayMode" i

-- -- -- -- -- -- -- -- -- --

data DisplayOptions = DisplayOptions
  { displayOptions_width               :: Int
  , displayOptions_height              :: Int
  , displayOptions_numRedBits          :: Int
  , displayOptions_numGreenBits        :: Int
  , displayOptions_numBlueBits         :: Int
  , displayOptions_numAlphaBits        :: Int
  , displayOptions_numDepthBits        :: Int
  , displayOptions_numStencilBits      :: Int
  , displayOptions_displayMode         :: DisplayMode
  , displayOptions_refreshRate         :: Maybe Int
  , displayOptions_accumNumRedBits     :: Maybe Int
  , displayOptions_accumNumGreenBits   :: Maybe Int
  , displayOptions_accumNumBlueBits    :: Maybe Int
  , displayOptions_accumNumAlphaBits   :: Maybe Int
  , displayOptions_numAuxiliaryBuffers :: Maybe Int
  , displayOptions_numFsaaSamples      :: Maybe Int
  , displayOptions_windowIsResizable   :: Bool
  , displayOptions_stereoRendering     :: Bool
  } deriving (Show)

defaultDisplayOptions :: DisplayOptions
defaultDisplayOptions =
    DisplayOptions
      { displayOptions_width               = 0
      , displayOptions_height              = 0
      , displayOptions_numRedBits          = 0
      , displayOptions_numGreenBits        = 0
      , displayOptions_numBlueBits         = 0
      , displayOptions_numAlphaBits        = 0
      , displayOptions_numDepthBits        = 0
      , displayOptions_numStencilBits      = 0
      , displayOptions_displayMode         = Window
      , displayOptions_refreshRate         = Nothing
      , displayOptions_accumNumRedBits     = Nothing
      , displayOptions_accumNumGreenBits   = Nothing
      , displayOptions_accumNumBlueBits    = Nothing
      , displayOptions_accumNumAlphaBits   = Nothing
      , displayOptions_numAuxiliaryBuffers = Nothing
      , displayOptions_numFsaaSamples      = Nothing
      , displayOptions_windowIsResizable   = True
      , displayOptions_stereoRendering     = False
      }

-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
-- Window information

windowIsOpen :: IO Bool
windowIsOpen =
    fromC `fmap` glfwGetWindowParam (131073)
{-# LINE 393 "src/Graphics/UI/GLFW.hsc" #-}

windowIsActive :: IO Bool
windowIsActive =
    fromC `fmap` glfwGetWindowParam (131074)
{-# LINE 397 "src/Graphics/UI/GLFW.hsc" #-}

windowIsIconified :: IO Bool
windowIsIconified =
    fromC `fmap` glfwGetWindowParam (131075)
{-# LINE 401 "src/Graphics/UI/GLFW.hsc" #-}

windowIsResizable :: IO Bool
windowIsResizable =
    (not . fromC) `fmap` glfwGetWindowParam (131090)
{-# LINE 405 "src/Graphics/UI/GLFW.hsc" #-}

windowIsHardwareAccelerated :: IO Bool
windowIsHardwareAccelerated =
    fromC `fmap` glfwGetWindowParam (131076)
{-# LINE 409 "src/Graphics/UI/GLFW.hsc" #-}

windowSupportsStereoRendering :: IO Bool
windowSupportsStereoRendering =
    fromC `fmap` glfwGetWindowParam (131089)
{-# LINE 413 "src/Graphics/UI/GLFW.hsc" #-}

getWindowRefreshRate :: IO Int
getWindowRefreshRate =
    fromC `fmap` glfwGetWindowParam (131083)
{-# LINE 417 "src/Graphics/UI/GLFW.hsc" #-}

getWindowDimensions :: IO (Int, Int)
getWindowDimensions =
    alloca $ \wp ->
    alloca $ \hp -> do
        glfwGetWindowSize wp hp
        w <- peek wp
        h <- peek hp
        return (fromC w, fromC h)

getWindowValue :: WindowValue -> IO Int
getWindowValue wn =
    fromC `fmap` glfwGetWindowParam (toC wn)

setWindowCloseCallback :: WindowCloseCallback -> IO ()
setWindowCloseCallback cb = do
    ccb <- wrapWindowCloseCallback (toC `fmap` cb)
    glfwSetWindowCloseCallback ccb
    storeCallback windowCloseCallback ccb

setWindowSizeCallback :: WindowSizeCallback -> IO ()
setWindowSizeCallback cb = do
    ccb <- wrapWindowSizeCallback (\w h -> cb (fromC w) (fromC h))
    glfwSetWindowSizeCallback ccb
    storeCallback windowSizeCallback ccb

setWindowRefreshCallback :: WindowRefreshCallback -> IO ()
setWindowRefreshCallback cb = do
    ccb <- wrapWindowRefreshCallback cb
    glfwSetWindowRefreshCallback ccb
    storeCallback windowRefreshCallback ccb

-- -- -- -- -- -- -- -- -- --

data WindowValue
  = NumRedBits
  | NumGreenBits
  | NumBlueBits
  | NumAlphaBits
  | NumDepthBits
  | NumStencilBits
  | NumAccumRedBits
  | NumAccumGreenBits
  | NumAccumBlueBits
  | NumAccumAlphaBits
  | NumAuxBuffers
  | NumFsaaSamples
  deriving (Bounded, Enum, Eq, Show)

instance C WindowValue CInt where
  toC wn = case wn of
      NumRedBits        -> 131077
{-# LINE 469 "src/Graphics/UI/GLFW.hsc" #-}
      NumGreenBits      -> 131078
{-# LINE 470 "src/Graphics/UI/GLFW.hsc" #-}
      NumBlueBits       -> 131079
{-# LINE 471 "src/Graphics/UI/GLFW.hsc" #-}
      NumAlphaBits      -> 131080
{-# LINE 472 "src/Graphics/UI/GLFW.hsc" #-}
      NumDepthBits      -> 131081
{-# LINE 473 "src/Graphics/UI/GLFW.hsc" #-}
      NumStencilBits    -> 131082
{-# LINE 474 "src/Graphics/UI/GLFW.hsc" #-}
      NumAccumRedBits   -> 131084
{-# LINE 475 "src/Graphics/UI/GLFW.hsc" #-}
      NumAccumGreenBits -> 131085
{-# LINE 476 "src/Graphics/UI/GLFW.hsc" #-}
      NumAccumBlueBits  -> 131086
{-# LINE 477 "src/Graphics/UI/GLFW.hsc" #-}
      NumAccumAlphaBits -> 131087
{-# LINE 478 "src/Graphics/UI/GLFW.hsc" #-}
      NumAuxBuffers     -> 131088
{-# LINE 479 "src/Graphics/UI/GLFW.hsc" #-}
      NumFsaaSamples    -> 131091
{-# LINE 480 "src/Graphics/UI/GLFW.hsc" #-}

-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
-- Input

pollEvents :: IO ()
pollEvents =
    glfwPollEvents

waitEvents :: IO ()
waitEvents =
    glfwWaitEvents

-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
-- Keyboard

keyIsPressed :: Key -> IO Bool
keyIsPressed k =
    fromC `fmap` glfwGetKey (toC k)

setCharCallback :: CharCallback -> IO ()
setCharCallback cb = do
    ccb <- wrapCharCallback (\c b -> cb (fromC c) (fromC b))
    glfwSetCharCallback ccb
    storeCallback charCallback ccb

setKeyCallback :: KeyCallback -> IO ()
setKeyCallback cb = do
    ccb <- wrapKeyCallback (\k b -> cb (fromC k) (fromC b))
    glfwSetKeyCallback ccb
    storeCallback keyCallback ccb

-- -- -- -- -- -- -- -- -- --

data Key
  = CharKey Char
  | KeyUnknown
  | KeySpace
  | KeySpecial
  | KeyEsc
  | KeyF1
  | KeyF2
  | KeyF3
  | KeyF4
  | KeyF5
  | KeyF6
  | KeyF7
  | KeyF8
  | KeyF9
  | KeyF10
  | KeyF11
  | KeyF12
  | KeyF13
  | KeyF14
  | KeyF15
  | KeyF16
  | KeyF17
  | KeyF18
  | KeyF19
  | KeyF20
  | KeyF21
  | KeyF22
  | KeyF23
  | KeyF24
  | KeyF25
  | KeyUp
  | KeyDown
  | KeyLeft
  | KeyRight
  | KeyLeftShift
  | KeyRightShift
  | KeyLeftCtrl
  | KeyRightCtrl
  | KeyLeftAlt
  | KeyRightAlt
  | KeyTab
  | KeyEnter
  | KeyBackspace
  | KeyInsert
  | KeyDel
  | KeyPageup
  | KeyPagedown
  | KeyHome
  | KeyEnd
  | KeyPad0
  | KeyPad1
  | KeyPad2
  | KeyPad3
  | KeyPad4
  | KeyPad5
  | KeyPad6
  | KeyPad7
  | KeyPad8
  | KeyPad9
  | KeyPadDivide
  | KeyPadMultiply
  | KeyPadSubtract
  | KeyPadAdd
  | KeyPadDecimal
  | KeyPadEqual
  | KeyPadEnter
  deriving (Eq, Show)

instance C Key CInt where
  toC k = case k of
      CharKey c      -> fromIntegral (ord c)
      KeyUnknown     -> -1
{-# LINE 586 "src/Graphics/UI/GLFW.hsc" #-}
      KeySpace       -> 32
{-# LINE 587 "src/Graphics/UI/GLFW.hsc" #-}
      KeySpecial     -> 256
{-# LINE 588 "src/Graphics/UI/GLFW.hsc" #-}
      KeyEsc         -> 257
{-# LINE 589 "src/Graphics/UI/GLFW.hsc" #-}
      KeyF1          -> 258
{-# LINE 590 "src/Graphics/UI/GLFW.hsc" #-}
      KeyF2          -> 259
{-# LINE 591 "src/Graphics/UI/GLFW.hsc" #-}
      KeyF3          -> 260
{-# LINE 592 "src/Graphics/UI/GLFW.hsc" #-}
      KeyF4          -> 261
{-# LINE 593 "src/Graphics/UI/GLFW.hsc" #-}
      KeyF5          -> 262
{-# LINE 594 "src/Graphics/UI/GLFW.hsc" #-}
      KeyF6          -> 263
{-# LINE 595 "src/Graphics/UI/GLFW.hsc" #-}
      KeyF7          -> 264
{-# LINE 596 "src/Graphics/UI/GLFW.hsc" #-}
      KeyF8          -> 265
{-# LINE 597 "src/Graphics/UI/GLFW.hsc" #-}
      KeyF9          -> 266
{-# LINE 598 "src/Graphics/UI/GLFW.hsc" #-}
      KeyF10         -> 267
{-# LINE 599 "src/Graphics/UI/GLFW.hsc" #-}
      KeyF11         -> 268
{-# LINE 600 "src/Graphics/UI/GLFW.hsc" #-}
      KeyF12         -> 269
{-# LINE 601 "src/Graphics/UI/GLFW.hsc" #-}
      KeyF13         -> 270
{-# LINE 602 "src/Graphics/UI/GLFW.hsc" #-}
      KeyF14         -> 271
{-# LINE 603 "src/Graphics/UI/GLFW.hsc" #-}
      KeyF15         -> 272
{-# LINE 604 "src/Graphics/UI/GLFW.hsc" #-}
      KeyF16         -> 273
{-# LINE 605 "src/Graphics/UI/GLFW.hsc" #-}
      KeyF17         -> 274
{-# LINE 606 "src/Graphics/UI/GLFW.hsc" #-}
      KeyF18         -> 275
{-# LINE 607 "src/Graphics/UI/GLFW.hsc" #-}
      KeyF19         -> 276
{-# LINE 608 "src/Graphics/UI/GLFW.hsc" #-}
      KeyF20         -> 277
{-# LINE 609 "src/Graphics/UI/GLFW.hsc" #-}
      KeyF21         -> 278
{-# LINE 610 "src/Graphics/UI/GLFW.hsc" #-}
      KeyF22         -> 279
{-# LINE 611 "src/Graphics/UI/GLFW.hsc" #-}
      KeyF23         -> 280
{-# LINE 612 "src/Graphics/UI/GLFW.hsc" #-}
      KeyF24         -> 281
{-# LINE 613 "src/Graphics/UI/GLFW.hsc" #-}
      KeyF25         -> 282
{-# LINE 614 "src/Graphics/UI/GLFW.hsc" #-}
      KeyUp          -> 283
{-# LINE 615 "src/Graphics/UI/GLFW.hsc" #-}
      KeyDown        -> 284
{-# LINE 616 "src/Graphics/UI/GLFW.hsc" #-}
      KeyLeft        -> 285
{-# LINE 617 "src/Graphics/UI/GLFW.hsc" #-}
      KeyRight       -> 286
{-# LINE 618 "src/Graphics/UI/GLFW.hsc" #-}
      KeyLeftShift   -> 287
{-# LINE 619 "src/Graphics/UI/GLFW.hsc" #-}
      KeyRightShift  -> 288
{-# LINE 620 "src/Graphics/UI/GLFW.hsc" #-}
      KeyLeftCtrl    -> 289
{-# LINE 621 "src/Graphics/UI/GLFW.hsc" #-}
      KeyRightCtrl   -> 290
{-# LINE 622 "src/Graphics/UI/GLFW.hsc" #-}
      KeyLeftAlt     -> 291
{-# LINE 623 "src/Graphics/UI/GLFW.hsc" #-}
      KeyRightAlt    -> 292
{-# LINE 624 "src/Graphics/UI/GLFW.hsc" #-}
      KeyTab         -> 293
{-# LINE 625 "src/Graphics/UI/GLFW.hsc" #-}
      KeyEnter       -> 294
{-# LINE 626 "src/Graphics/UI/GLFW.hsc" #-}
      KeyBackspace   -> 295
{-# LINE 627 "src/Graphics/UI/GLFW.hsc" #-}
      KeyInsert      -> 296
{-# LINE 628 "src/Graphics/UI/GLFW.hsc" #-}
      KeyDel         -> 297
{-# LINE 629 "src/Graphics/UI/GLFW.hsc" #-}
      KeyPageup      -> 298
{-# LINE 630 "src/Graphics/UI/GLFW.hsc" #-}
      KeyPagedown    -> 299
{-# LINE 631 "src/Graphics/UI/GLFW.hsc" #-}
      KeyHome        -> 300
{-# LINE 632 "src/Graphics/UI/GLFW.hsc" #-}
      KeyEnd         -> 301
{-# LINE 633 "src/Graphics/UI/GLFW.hsc" #-}
      KeyPad0        -> 302
{-# LINE 634 "src/Graphics/UI/GLFW.hsc" #-}
      KeyPad1        -> 303
{-# LINE 635 "src/Graphics/UI/GLFW.hsc" #-}
      KeyPad2        -> 304
{-# LINE 636 "src/Graphics/UI/GLFW.hsc" #-}
      KeyPad3        -> 305
{-# LINE 637 "src/Graphics/UI/GLFW.hsc" #-}
      KeyPad4        -> 306
{-# LINE 638 "src/Graphics/UI/GLFW.hsc" #-}
      KeyPad5        -> 307
{-# LINE 639 "src/Graphics/UI/GLFW.hsc" #-}
      KeyPad6        -> 308
{-# LINE 640 "src/Graphics/UI/GLFW.hsc" #-}
      KeyPad7        -> 309
{-# LINE 641 "src/Graphics/UI/GLFW.hsc" #-}
      KeyPad8        -> 310
{-# LINE 642 "src/Graphics/UI/GLFW.hsc" #-}
      KeyPad9        -> 311
{-# LINE 643 "src/Graphics/UI/GLFW.hsc" #-}
      KeyPadDivide   -> 312
{-# LINE 644 "src/Graphics/UI/GLFW.hsc" #-}
      KeyPadMultiply -> 313
{-# LINE 645 "src/Graphics/UI/GLFW.hsc" #-}
      KeyPadSubtract -> 314
{-# LINE 646 "src/Graphics/UI/GLFW.hsc" #-}
      KeyPadAdd      -> 315
{-# LINE 647 "src/Graphics/UI/GLFW.hsc" #-}
      KeyPadDecimal  -> 316
{-# LINE 648 "src/Graphics/UI/GLFW.hsc" #-}
      KeyPadEqual    -> 317
{-# LINE 649 "src/Graphics/UI/GLFW.hsc" #-}
      KeyPadEnter    -> 318
{-# LINE 650 "src/Graphics/UI/GLFW.hsc" #-}

  fromC i =
      if i < 256
{-# LINE 653 "src/Graphics/UI/GLFW.hsc" #-}
        then CharKey (chr (fromIntegral i))
        else case i of
               (-1) -> KeyUnknown
{-# LINE 656 "src/Graphics/UI/GLFW.hsc" #-}
               (32) -> KeySpace
{-# LINE 657 "src/Graphics/UI/GLFW.hsc" #-}
               (256) -> KeySpecial
{-# LINE 658 "src/Graphics/UI/GLFW.hsc" #-}
               (257) -> KeyEsc
{-# LINE 659 "src/Graphics/UI/GLFW.hsc" #-}
               (258) -> KeyF1
{-# LINE 660 "src/Graphics/UI/GLFW.hsc" #-}
               (259) -> KeyF2
{-# LINE 661 "src/Graphics/UI/GLFW.hsc" #-}
               (260) -> KeyF3
{-# LINE 662 "src/Graphics/UI/GLFW.hsc" #-}
               (261) -> KeyF4
{-# LINE 663 "src/Graphics/UI/GLFW.hsc" #-}
               (262) -> KeyF5
{-# LINE 664 "src/Graphics/UI/GLFW.hsc" #-}
               (263) -> KeyF6
{-# LINE 665 "src/Graphics/UI/GLFW.hsc" #-}
               (264) -> KeyF7
{-# LINE 666 "src/Graphics/UI/GLFW.hsc" #-}
               (265) -> KeyF8
{-# LINE 667 "src/Graphics/UI/GLFW.hsc" #-}
               (266) -> KeyF9
{-# LINE 668 "src/Graphics/UI/GLFW.hsc" #-}
               (267) -> KeyF10
{-# LINE 669 "src/Graphics/UI/GLFW.hsc" #-}
               (268) -> KeyF11
{-# LINE 670 "src/Graphics/UI/GLFW.hsc" #-}
               (269) -> KeyF12
{-# LINE 671 "src/Graphics/UI/GLFW.hsc" #-}
               (270) -> KeyF13
{-# LINE 672 "src/Graphics/UI/GLFW.hsc" #-}
               (271) -> KeyF14
{-# LINE 673 "src/Graphics/UI/GLFW.hsc" #-}
               (272) -> KeyF15
{-# LINE 674 "src/Graphics/UI/GLFW.hsc" #-}
               (273) -> KeyF16
{-# LINE 675 "src/Graphics/UI/GLFW.hsc" #-}
               (274) -> KeyF17
{-# LINE 676 "src/Graphics/UI/GLFW.hsc" #-}
               (275) -> KeyF18
{-# LINE 677 "src/Graphics/UI/GLFW.hsc" #-}
               (276) -> KeyF19
{-# LINE 678 "src/Graphics/UI/GLFW.hsc" #-}
               (277) -> KeyF20
{-# LINE 679 "src/Graphics/UI/GLFW.hsc" #-}
               (278) -> KeyF21
{-# LINE 680 "src/Graphics/UI/GLFW.hsc" #-}
               (279) -> KeyF22
{-# LINE 681 "src/Graphics/UI/GLFW.hsc" #-}
               (280) -> KeyF23
{-# LINE 682 "src/Graphics/UI/GLFW.hsc" #-}
               (281) -> KeyF24
{-# LINE 683 "src/Graphics/UI/GLFW.hsc" #-}
               (282) -> KeyF25
{-# LINE 684 "src/Graphics/UI/GLFW.hsc" #-}
               (283) -> KeyUp
{-# LINE 685 "src/Graphics/UI/GLFW.hsc" #-}
               (284) -> KeyDown
{-# LINE 686 "src/Graphics/UI/GLFW.hsc" #-}
               (285) -> KeyLeft
{-# LINE 687 "src/Graphics/UI/GLFW.hsc" #-}
               (286) -> KeyRight
{-# LINE 688 "src/Graphics/UI/GLFW.hsc" #-}
               (287) -> KeyLeftShift
{-# LINE 689 "src/Graphics/UI/GLFW.hsc" #-}
               (288) -> KeyRightShift
{-# LINE 690 "src/Graphics/UI/GLFW.hsc" #-}
               (289) -> KeyLeftCtrl
{-# LINE 691 "src/Graphics/UI/GLFW.hsc" #-}
               (290) -> KeyRightCtrl
{-# LINE 692 "src/Graphics/UI/GLFW.hsc" #-}
               (291) -> KeyLeftAlt
{-# LINE 693 "src/Graphics/UI/GLFW.hsc" #-}
               (292) -> KeyRightAlt
{-# LINE 694 "src/Graphics/UI/GLFW.hsc" #-}
               (293) -> KeyTab
{-# LINE 695 "src/Graphics/UI/GLFW.hsc" #-}
               (294) -> KeyEnter
{-# LINE 696 "src/Graphics/UI/GLFW.hsc" #-}
               (295) -> KeyBackspace
{-# LINE 697 "src/Graphics/UI/GLFW.hsc" #-}
               (296) -> KeyInsert
{-# LINE 698 "src/Graphics/UI/GLFW.hsc" #-}
               (297) -> KeyDel
{-# LINE 699 "src/Graphics/UI/GLFW.hsc" #-}
               (298) -> KeyPageup
{-# LINE 700 "src/Graphics/UI/GLFW.hsc" #-}
               (299) -> KeyPagedown
{-# LINE 701 "src/Graphics/UI/GLFW.hsc" #-}
               (300) -> KeyHome
{-# LINE 702 "src/Graphics/UI/GLFW.hsc" #-}
               (301) -> KeyEnd
{-# LINE 703 "src/Graphics/UI/GLFW.hsc" #-}
               (302) -> KeyPad0
{-# LINE 704 "src/Graphics/UI/GLFW.hsc" #-}
               (303) -> KeyPad1
{-# LINE 705 "src/Graphics/UI/GLFW.hsc" #-}
               (304) -> KeyPad2
{-# LINE 706 "src/Graphics/UI/GLFW.hsc" #-}
               (305) -> KeyPad3
{-# LINE 707 "src/Graphics/UI/GLFW.hsc" #-}
               (306) -> KeyPad4
{-# LINE 708 "src/Graphics/UI/GLFW.hsc" #-}
               (307) -> KeyPad5
{-# LINE 709 "src/Graphics/UI/GLFW.hsc" #-}
               (308) -> KeyPad6
{-# LINE 710 "src/Graphics/UI/GLFW.hsc" #-}
               (309) -> KeyPad7
{-# LINE 711 "src/Graphics/UI/GLFW.hsc" #-}
               (310) -> KeyPad8
{-# LINE 712 "src/Graphics/UI/GLFW.hsc" #-}
               (311) -> KeyPad9
{-# LINE 713 "src/Graphics/UI/GLFW.hsc" #-}
               (312) -> KeyPadDivide
{-# LINE 714 "src/Graphics/UI/GLFW.hsc" #-}
               (313) -> KeyPadMultiply
{-# LINE 715 "src/Graphics/UI/GLFW.hsc" #-}
               (314) -> KeyPadSubtract
{-# LINE 716 "src/Graphics/UI/GLFW.hsc" #-}
               (315) -> KeyPadAdd
{-# LINE 717 "src/Graphics/UI/GLFW.hsc" #-}
               (316) -> KeyPadDecimal
{-# LINE 718 "src/Graphics/UI/GLFW.hsc" #-}
               (317) -> KeyPadEqual
{-# LINE 719 "src/Graphics/UI/GLFW.hsc" #-}
               (318) -> KeyPadEnter
{-# LINE 720 "src/Graphics/UI/GLFW.hsc" #-}
               _                             -> KeyUnknown

-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
-- Mouse

mouseButtonIsPressed :: MouseButton -> IO Bool
mouseButtonIsPressed mb =
    fromC `fmap` glfwGetMouseButton (toC mb)

getMousePosition :: IO (Int, Int)
getMousePosition =
    alloca $ \px ->
    alloca $ \py -> do
        glfwGetMousePos px py
        x <- peek px
        y <- peek py
        return (fromC x, fromC y)

getMouseWheel :: IO Int
getMouseWheel =
    fromC `fmap` glfwGetMouseWheel

setMousePosition :: Int -> Int -> IO ()
setMousePosition x y =
    glfwSetMousePos (toC x) (toC y)

setMouseWheel :: Int -> IO ()
setMouseWheel =
    glfwSetMouseWheel . toC

setMouseButtonCallback :: MouseButtonCallback -> IO ()
setMouseButtonCallback cb = do
    ccb <- wrapMouseButtonCallback (\b p -> cb (fromC b) (fromC p))
    glfwSetMouseButtonCallback ccb
    storeCallback mouseButtonCallback ccb

setMousePositionCallback :: MousePositionCallback -> IO ()
setMousePositionCallback cb = do
    ccb <- wrapMousePositionCallback (\x y -> cb (fromC x) (fromC y))
    glfwSetMousePosCallback ccb
    storeCallback mousePositionCallback ccb

setMouseWheelCallback :: MouseWheelCallback -> IO ()
setMouseWheelCallback cb = do
    ccb <- wrapMouseWheelCallback (cb . fromC)
    glfwSetMouseWheelCallback ccb
    storeCallback mouseWheelCallback ccb

-- -- -- -- -- -- -- -- -- --

data MouseButton
  = MouseButton0 | MouseButton1 | MouseButton2 | MouseButton3
  | MouseButton4 | MouseButton5 | MouseButton6 | MouseButton7
  deriving (Bounded, Enum, Eq, Show)

instance C MouseButton CInt where
  toC mb = case mb of
      MouseButton0 -> 0
{-# LINE 778 "src/Graphics/UI/GLFW.hsc" #-}
      MouseButton1 -> 1
{-# LINE 779 "src/Graphics/UI/GLFW.hsc" #-}
      MouseButton2 -> 2
{-# LINE 780 "src/Graphics/UI/GLFW.hsc" #-}
      MouseButton3 -> 3
{-# LINE 781 "src/Graphics/UI/GLFW.hsc" #-}
      MouseButton4 -> 4
{-# LINE 782 "src/Graphics/UI/GLFW.hsc" #-}
      MouseButton5 -> 5
{-# LINE 783 "src/Graphics/UI/GLFW.hsc" #-}
      MouseButton6 -> 6
{-# LINE 784 "src/Graphics/UI/GLFW.hsc" #-}
      MouseButton7 -> 7
{-# LINE 785 "src/Graphics/UI/GLFW.hsc" #-}

  fromC i = case i of
      (0) -> MouseButton0
{-# LINE 788 "src/Graphics/UI/GLFW.hsc" #-}
      (1) -> MouseButton1
{-# LINE 789 "src/Graphics/UI/GLFW.hsc" #-}
      (2) -> MouseButton2
{-# LINE 790 "src/Graphics/UI/GLFW.hsc" #-}
      (3) -> MouseButton3
{-# LINE 791 "src/Graphics/UI/GLFW.hsc" #-}
      (4) -> MouseButton4
{-# LINE 792 "src/Graphics/UI/GLFW.hsc" #-}
      (5) -> MouseButton5
{-# LINE 793 "src/Graphics/UI/GLFW.hsc" #-}
      (6) -> MouseButton6
{-# LINE 794 "src/Graphics/UI/GLFW.hsc" #-}
      (7) -> MouseButton7
{-# LINE 795 "src/Graphics/UI/GLFW.hsc" #-}
      _                            -> makeFromCError "MouseButton" i

-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
-- Joystick

joystickIsPresent :: Joystick -> IO Bool
joystickIsPresent j =
    fromC `fmap` glfwGetJoystickParam (toC j) (327681)
{-# LINE 803 "src/Graphics/UI/GLFW.hsc" #-}

getNumJoystickAxes :: Joystick -> IO Int
getNumJoystickAxes j =
    fromC `fmap` glfwGetJoystickParam (toC j) (327682)
{-# LINE 807 "src/Graphics/UI/GLFW.hsc" #-}

getNumJoystickButtons :: Joystick -> IO Int
getNumJoystickButtons j =
    fromC `fmap` glfwGetJoystickParam (toC j) (327683)
{-# LINE 811 "src/Graphics/UI/GLFW.hsc" #-}

getJoystickPosition :: Joystick -> Int -> IO [Float]
getJoystickPosition j m =
    if m < 1
      then return []
      else allocaArray m $ \ptr -> do
               n <- fromC `fmap` glfwGetJoystickPos (toC j) ptr (toC m)
               a <- peekArray n ptr
               return $ map fromC a

joystickButtonsArePressed :: Joystick -> Int -> IO [Bool]
joystickButtonsArePressed j m =
    if m < 1
      then return []
      else allocaArray m $ \ptr -> do
               n <- fromC `fmap` glfwGetJoystickButtons (toC j) ptr (toC m)
               a <- peekArray n ptr :: IO [CUChar]
               return $ map ((glfwPress ==) . fromIntegral) a

-- -- -- -- -- -- -- -- -- --

data Joystick
  = Joystick0  | Joystick1  | Joystick2  | Joystick3
  | Joystick4  | Joystick5  | Joystick6  | Joystick7
  | Joystick8  | Joystick9  | Joystick10 | Joystick11
  | Joystick12 | Joystick13 | Joystick14 | Joystick15
  deriving (Bounded, Enum, Eq, Show)

instance C Joystick CInt where
  toC j = case j of
      Joystick0  -> 0
{-# LINE 842 "src/Graphics/UI/GLFW.hsc" #-}
      Joystick1  -> 1
{-# LINE 843 "src/Graphics/UI/GLFW.hsc" #-}
      Joystick2  -> 2
{-# LINE 844 "src/Graphics/UI/GLFW.hsc" #-}
      Joystick3  -> 3
{-# LINE 845 "src/Graphics/UI/GLFW.hsc" #-}
      Joystick4  -> 4
{-# LINE 846 "src/Graphics/UI/GLFW.hsc" #-}
      Joystick5  -> 5
{-# LINE 847 "src/Graphics/UI/GLFW.hsc" #-}
      Joystick6  -> 6
{-# LINE 848 "src/Graphics/UI/GLFW.hsc" #-}
      Joystick7  -> 7
{-# LINE 849 "src/Graphics/UI/GLFW.hsc" #-}
      Joystick8  -> 8
{-# LINE 850 "src/Graphics/UI/GLFW.hsc" #-}
      Joystick9  -> 9
{-# LINE 851 "src/Graphics/UI/GLFW.hsc" #-}
      Joystick10 -> 10
{-# LINE 852 "src/Graphics/UI/GLFW.hsc" #-}
      Joystick11 -> 11
{-# LINE 853 "src/Graphics/UI/GLFW.hsc" #-}
      Joystick12 -> 12
{-# LINE 854 "src/Graphics/UI/GLFW.hsc" #-}
      Joystick13 -> 13
{-# LINE 855 "src/Graphics/UI/GLFW.hsc" #-}
      Joystick14 -> 14
{-# LINE 856 "src/Graphics/UI/GLFW.hsc" #-}
      Joystick15 -> 15
{-# LINE 857 "src/Graphics/UI/GLFW.hsc" #-}

  fromC i = case i of
      (0) -> Joystick0
{-# LINE 860 "src/Graphics/UI/GLFW.hsc" #-}
      (1) -> Joystick1
{-# LINE 861 "src/Graphics/UI/GLFW.hsc" #-}
      (2) -> Joystick2
{-# LINE 862 "src/Graphics/UI/GLFW.hsc" #-}
      (3) -> Joystick3
{-# LINE 863 "src/Graphics/UI/GLFW.hsc" #-}
      (4) -> Joystick4
{-# LINE 864 "src/Graphics/UI/GLFW.hsc" #-}
      (5) -> Joystick5
{-# LINE 865 "src/Graphics/UI/GLFW.hsc" #-}
      (6) -> Joystick6
{-# LINE 866 "src/Graphics/UI/GLFW.hsc" #-}
      (7) -> Joystick7
{-# LINE 867 "src/Graphics/UI/GLFW.hsc" #-}
      (8) -> Joystick8
{-# LINE 868 "src/Graphics/UI/GLFW.hsc" #-}
      (9) -> Joystick9
{-# LINE 869 "src/Graphics/UI/GLFW.hsc" #-}
      (10) -> Joystick10
{-# LINE 870 "src/Graphics/UI/GLFW.hsc" #-}
      (11) -> Joystick11
{-# LINE 871 "src/Graphics/UI/GLFW.hsc" #-}
      (12) -> Joystick12
{-# LINE 872 "src/Graphics/UI/GLFW.hsc" #-}
      (13) -> Joystick13
{-# LINE 873 "src/Graphics/UI/GLFW.hsc" #-}
      (14) -> Joystick14
{-# LINE 874 "src/Graphics/UI/GLFW.hsc" #-}
      (15) -> Joystick15
{-# LINE 875 "src/Graphics/UI/GLFW.hsc" #-}
      _                         -> makeFromCError "Joystick" i

-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
-- Time

getTime :: IO Double
getTime =
    realToFrac `fmap` glfwGetTime

setTime :: Double -> IO ()
setTime =
    glfwSetTime . realToFrac

resetTime :: IO ()
resetTime =
    setTime (0 :: Double)

sleep :: Double -> IO ()
sleep =
    glfwSleep . realToFrac

-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
-- Version information

getGlfwVersion :: IO Version
getGlfwVersion =
    alloca $ \p0 ->
    alloca $ \p1 ->
    alloca $ \p2 -> do
        glfwGetVersion p0 p1 p2
        v0 <- fromC `fmap` peek p0
        v1 <- fromC `fmap` peek p1
        v2 <- fromC `fmap` peek p2
        return $ Version [v0, v1, v2] []

getGlVersion :: IO Version
getGlVersion =
    alloca $ \p0 ->
    alloca $ \p1 ->
    alloca $ \p2 -> do
        glfwGetGLVersion p0 p1 p2
        v0 <- fromC `fmap` peek p0
        v1 <- fromC `fmap` peek p1
        v2 <- fromC `fmap` peek p2
        return $ Version [v0, v1, v2] []

-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --

glfwPress :: CInt
glfwPress = 1
{-# LINE 925 "src/Graphics/UI/GLFW.hsc" #-}

-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --

class C h c where
  toC   :: h -> c
  fromC :: c -> h

  toC   = undefined
  fromC = undefined

makeFromCError :: (Show c) => String -> c -> a
makeFromCError s c = error (s ++ " fromC: no match for " ++ show c)

-- -- -- -- -- -- -- -- -- --

instance C Bool CInt where
  toC False = 0
{-# LINE 942 "src/Graphics/UI/GLFW.hsc" #-}
  toC True  = 1
{-# LINE 943 "src/Graphics/UI/GLFW.hsc" #-}

  fromC (0) = False
{-# LINE 945 "src/Graphics/UI/GLFW.hsc" #-}
  fromC (1)  = True
{-# LINE 946 "src/Graphics/UI/GLFW.hsc" #-}
  fromC i                 = makeFromCError "Bool" i

-- -- -- -- -- -- -- -- -- --

instance C Char CInt where
  toC   = fromIntegral . ord
  fromC = chr . fromIntegral

-- -- -- -- -- -- -- -- -- --

instance C Float CFloat where
  toC   = realToFrac
  fromC = realToFrac

-- -- -- -- -- -- -- -- -- --

instance C Int CInt where
  toC   = fromIntegral
  fromC = fromIntegral

-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --

charCallback          :: IORef (Maybe (FunPtr GlfwCharCallback))
keyCallback           :: IORef (Maybe (FunPtr GlfwKeyCallback))
mouseButtonCallback   :: IORef (Maybe (FunPtr GlfwMouseButtonCallback))
mousePositionCallback :: IORef (Maybe (FunPtr GlfwMousePositionCallback))
mouseWheelCallback    :: IORef (Maybe (FunPtr GlfwMouseWheelCallback))
windowCloseCallback   :: IORef (Maybe (FunPtr GlfwWindowCloseCallback))
windowRefreshCallback :: IORef (Maybe (FunPtr GlfwWindowRefreshCallback))
windowSizeCallback    :: IORef (Maybe (FunPtr GlfwWindowSizeCallback))

charCallback          = unsafePerformIO (newIORef Nothing)
keyCallback           = unsafePerformIO (newIORef Nothing)
mouseButtonCallback   = unsafePerformIO (newIORef Nothing)
mousePositionCallback = unsafePerformIO (newIORef Nothing)
mouseWheelCallback    = unsafePerformIO (newIORef Nothing)
windowCloseCallback   = unsafePerformIO (newIORef Nothing)
windowRefreshCallback = unsafePerformIO (newIORef Nothing)
windowSizeCallback    = unsafePerformIO (newIORef Nothing)

storeCallback :: IORef (Maybe (FunPtr a)) -> FunPtr a -> IO ()
storeCallback ior cb =
    atomicModifyIORef ior (\mcb -> (Just cb, mcb)) >>= maybe (return ()) freeHaskellFunPtr