{-# 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(..)

    -- *   OpenGL context
  , OpenGLProfile(..)
    -- **  Information
  , openGLContextIsForwardCompatible
  , openGLContextIsDebugContext
  , openGLProfile

    -- *   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
  , enableAutoPoll
  , enableKeyRepeat
  , disableKeyRepeat
  , disableAutoPoll
    -- **  Keyboard
  , keyIsPressed
  , setCharCallback
  , setKeyCallback
    --
  , Key(..)
  , CharCallback
  , KeyCallback
    -- **  Mouse
  , mouseButtonIsPressed
  , getMousePosition
  , getMouseWheel
  , setMousePosition
  , setMouseWheel
  , setMouseButtonCallback
  , setMousePositionCallback
  , setMouseWheelCallback
  , enableMouseCursor
  , disableMouseCursor
    --
  , 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 125 "src/Graphics/UI/GLFW.hsc" #-}

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

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

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

foreign import ccall glfwPollEvents               :: IO ()
foreign import ccall glfwWaitEvents               :: IO ()
foreign import ccall glfwGetKey                   :: CInt -> IO CInt
foreign import ccall glfwGetMouseButton           :: CInt -> IO CInt
foreign import ccall glfwGetMousePos              :: Ptr CInt -> Ptr CInt -> IO ()
foreign import ccall glfwSetMousePos              :: CInt -> CInt -> IO ()
foreign import ccall glfwGetMouseWheel            :: IO CInt
foreign import ccall 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 glfwGetJoystickParam         :: CInt -> CInt -> IO CInt
foreign import ccall glfwGetJoystickPos           :: CInt -> Ptr CFloat -> CInt -> IO CInt
foreign import ccall glfwGetJoystickButtons       :: CInt -> Ptr CUChar -> CInt -> IO CInt

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

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

foreign import ccall glfwEnable                   :: CInt -> IO ()
foreign import ccall glfwDisable                  :: 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 "wrapper" wrapCharCallback          :: GlfwCharCallback          -> IO (FunPtr GlfwCharCallback)
foreign import ccall "wrapper" wrapKeyCallback           :: GlfwKeyCallback           -> IO (FunPtr GlfwKeyCallback)
foreign import ccall "wrapper" wrapMouseButtonCallback   :: GlfwMouseButtonCallback   -> IO (FunPtr GlfwMouseButtonCallback)
foreign import ccall "wrapper" wrapMousePositionCallback :: GlfwMousePositionCallback -> IO (FunPtr GlfwMousePositionCallback)
foreign import ccall "wrapper" wrapMouseWheelCallback    :: GlfwMouseWheelCallback    -> IO (FunPtr GlfwMouseWheelCallback)
foreign import ccall "wrapper" wrapWindowCloseCallback   :: GlfwWindowCloseCallback   -> IO (FunPtr GlfwWindowCloseCallback)
foreign import ccall "wrapper" wrapWindowRefreshCallback :: GlfwWindowRefreshCallback -> IO (FunPtr GlfwWindowRefreshCallback)
foreign import ccall "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 (Eq, Ord, Read, Show)

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

  peek ptr = do
      w <- ((\hsc_ptr -> peekByteOff hsc_ptr 0))     ptr :: IO CInt
{-# LINE 246 "src/Graphics/UI/GLFW.hsc" #-}
      h <- ((\hsc_ptr -> peekByteOff hsc_ptr 4))    ptr :: IO CInt
{-# LINE 247 "src/Graphics/UI/GLFW.hsc" #-}
      r <- ((\hsc_ptr -> peekByteOff hsc_ptr 8))   ptr :: IO CInt
{-# LINE 248 "src/Graphics/UI/GLFW.hsc" #-}
      g <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) ptr :: IO CInt
{-# LINE 249 "src/Graphics/UI/GLFW.hsc" #-}
      b <- ((\hsc_ptr -> peekByteOff hsc_ptr 12))  ptr :: IO CInt
{-# LINE 250 "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
        }

-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
-- OpenGL context

data OpenGLProfile
  = DefaultProfile
  | CoreProfile
  | CompatibilityProfile
  deriving (Eq, Ord, Bounded, Enum, Read, Show)

instance C OpenGLProfile CInt where
  toC op = case op of
      DefaultProfile       -> 0
      CoreProfile          -> 327681
{-# LINE 271 "src/Graphics/UI/GLFW.hsc" #-}
      CompatibilityProfile -> 327682
{-# LINE 272 "src/Graphics/UI/GLFW.hsc" #-}
  fromC i = case i of
      (327681)   -> CoreProfile
{-# LINE 274 "src/Graphics/UI/GLFW.hsc" #-}
      (327682) -> CompatibilityProfile
{-# LINE 275 "src/Graphics/UI/GLFW.hsc" #-}
      (0)                                 -> DefaultProfile
      _                                   -> makeFromCError "OpenGLProfile" i

-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
-- OpenGL information

openGLContextIsForwardCompatible :: IO Bool
openGLContextIsForwardCompatible =
    fromC `fmap` glfwGetWindowParam (131094)
{-# LINE 284 "src/Graphics/UI/GLFW.hsc" #-}

openGLContextIsDebugContext :: IO Bool
openGLContextIsDebugContext =
    fromC `fmap` glfwGetWindowParam (131095)
{-# LINE 288 "src/Graphics/UI/GLFW.hsc" #-}

openGLProfile :: IO OpenGLProfile
openGLProfile =
    fromC `fmap` glfwGetWindowParam (131096)
{-# LINE 292 "src/Graphics/UI/GLFW.hsc" #-}

-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
-- 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_openGLVersion           = _displayOptions_openGLVersion
          , displayOptions_openGLForwardCompatible = _displayOptions_openGLForwardCompatible
          , displayOptions_openGLDebugContext      = _displayOptions_openGLDebugContext
          , displayOptions_openGLProfile           = _displayOptions_openGLProfile
          } = displayOptions

    -- Add hints.
    when (isJust _displayOptions_refreshRate)              $ glfwOpenWindowHint (131083)     (toC (fromJust _displayOptions_refreshRate))
{-# LINE 325 "src/Graphics/UI/GLFW.hsc" #-}
    when (isJust _displayOptions_accumNumRedBits)          $ glfwOpenWindowHint (131084)   (toC (fromJust _displayOptions_accumNumRedBits))
{-# LINE 326 "src/Graphics/UI/GLFW.hsc" #-}
    when (isJust _displayOptions_accumNumGreenBits)        $ glfwOpenWindowHint (131085) (toC (fromJust _displayOptions_accumNumGreenBits))
{-# LINE 327 "src/Graphics/UI/GLFW.hsc" #-}
    when (isJust _displayOptions_accumNumBlueBits)         $ glfwOpenWindowHint (131086)  (toC (fromJust _displayOptions_accumNumBlueBits))
{-# LINE 328 "src/Graphics/UI/GLFW.hsc" #-}
    when (isJust _displayOptions_accumNumAlphaBits)        $ glfwOpenWindowHint (131087) (toC (fromJust _displayOptions_accumNumAlphaBits))
{-# LINE 329 "src/Graphics/UI/GLFW.hsc" #-}
    when (isJust _displayOptions_numAuxiliaryBuffers)      $ glfwOpenWindowHint (131088)      (toC (fromJust _displayOptions_numAuxiliaryBuffers))
{-# LINE 330 "src/Graphics/UI/GLFW.hsc" #-}
    when (isJust _displayOptions_numFsaaSamples)           $ glfwOpenWindowHint (131091)     (toC (fromJust _displayOptions_numFsaaSamples))
{-# LINE 331 "src/Graphics/UI/GLFW.hsc" #-}

    glfwOpenWindowHint (131090)      (toC (not _displayOptions_windowIsResizable))
{-# LINE 333 "src/Graphics/UI/GLFW.hsc" #-}
    glfwOpenWindowHint (131089)                (toC      _displayOptions_stereoRendering)
{-# LINE 334 "src/Graphics/UI/GLFW.hsc" #-}
    glfwOpenWindowHint (131092)  (toC (fst _displayOptions_openGLVersion))
{-# LINE 335 "src/Graphics/UI/GLFW.hsc" #-}
    glfwOpenWindowHint (131093)  (toC (snd _displayOptions_openGLVersion))
{-# LINE 336 "src/Graphics/UI/GLFW.hsc" #-}
    glfwOpenWindowHint (131094) (toC _displayOptions_openGLForwardCompatible)
{-# LINE 337 "src/Graphics/UI/GLFW.hsc" #-}
    glfwOpenWindowHint (131095)  (toC _displayOptions_openGLDebugContext)
{-# LINE 338 "src/Graphics/UI/GLFW.hsc" #-}
    glfwOpenWindowHint (131096)        (toC _displayOptions_openGLProfile)
{-# LINE 339 "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 (Eq, Ord, Bounded, Enum, Read, Show)

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

  fromC i = case i of
      (65537) -> Window
{-# LINE 398 "src/Graphics/UI/GLFW.hsc" #-}
      (65538) -> Fullscreen
{-# LINE 399 "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
  , displayOptions_openGLVersion           :: (Int, Int)
  , displayOptions_openGLForwardCompatible :: Bool
  , displayOptions_openGLDebugContext      :: Bool
  , displayOptions_openGLProfile           :: OpenGLProfile

  } deriving (Eq, Ord, Read, 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
      , displayOptions_openGLVersion           = (1,1)
      , displayOptions_openGLForwardCompatible = False
      , displayOptions_openGLDebugContext      = False
      , displayOptions_openGLProfile           = DefaultProfile
      }

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

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

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

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

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

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

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

getWindowRefreshRate :: IO Int
getWindowRefreshRate =
    fromC `fmap` glfwGetWindowParam (131083)
{-# LINE 486 "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 (Eq, Ord, Bounded, Enum, Read, Show)

instance C WindowValue CInt where
  toC wn = case wn of
      NumRedBits        -> 131077
{-# LINE 538 "src/Graphics/UI/GLFW.hsc" #-}
      NumGreenBits      -> 131078
{-# LINE 539 "src/Graphics/UI/GLFW.hsc" #-}
      NumBlueBits       -> 131079
{-# LINE 540 "src/Graphics/UI/GLFW.hsc" #-}
      NumAlphaBits      -> 131080
{-# LINE 541 "src/Graphics/UI/GLFW.hsc" #-}
      NumDepthBits      -> 131081
{-# LINE 542 "src/Graphics/UI/GLFW.hsc" #-}
      NumStencilBits    -> 131082
{-# LINE 543 "src/Graphics/UI/GLFW.hsc" #-}
      NumAccumRedBits   -> 131084
{-# LINE 544 "src/Graphics/UI/GLFW.hsc" #-}
      NumAccumGreenBits -> 131085
{-# LINE 545 "src/Graphics/UI/GLFW.hsc" #-}
      NumAccumBlueBits  -> 131086
{-# LINE 546 "src/Graphics/UI/GLFW.hsc" #-}
      NumAccumAlphaBits -> 131087
{-# LINE 547 "src/Graphics/UI/GLFW.hsc" #-}
      NumAuxBuffers     -> 131088
{-# LINE 548 "src/Graphics/UI/GLFW.hsc" #-}
      NumFsaaSamples    -> 131091
{-# LINE 549 "src/Graphics/UI/GLFW.hsc" #-}

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

pollEvents :: IO ()
pollEvents =
    glfwPollEvents

waitEvents :: IO ()
waitEvents =
    glfwWaitEvents

-- Make 'swapBuffers' implicitly call 'pollEvents' (Default)
enableAutoPoll :: IO ()
enableAutoPoll = glfwEnable (196614)
{-# LINE 564 "src/Graphics/UI/GLFW.hsc" #-}

-- Disable 'swapBuffers' implicitly calling 'pollEvents'
disableAutoPoll :: IO ()
disableAutoPoll = glfwDisable (196614)
{-# LINE 568 "src/Graphics/UI/GLFW.hsc" #-}

enableKeyRepeat :: IO ()
enableKeyRepeat = glfwEnable (196613)
{-# LINE 571 "src/Graphics/UI/GLFW.hsc" #-}

disableKeyRepeat :: IO ()
disableKeyRepeat = glfwDisable (196613)
{-# LINE 574 "src/Graphics/UI/GLFW.hsc" #-}

-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
-- 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, Ord, Read, Show)

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

  fromC i =
      if i < 256
{-# LINE 736 "src/Graphics/UI/GLFW.hsc" #-}
        then CharKey (chr (fromIntegral i))
        else case i of
               (-1) -> KeyUnknown
{-# LINE 739 "src/Graphics/UI/GLFW.hsc" #-}
               (32) -> KeySpace
{-# LINE 740 "src/Graphics/UI/GLFW.hsc" #-}
               (256) -> KeySpecial
{-# LINE 741 "src/Graphics/UI/GLFW.hsc" #-}
               (257) -> KeyEsc
{-# LINE 742 "src/Graphics/UI/GLFW.hsc" #-}
               (258) -> KeyF1
{-# LINE 743 "src/Graphics/UI/GLFW.hsc" #-}
               (259) -> KeyF2
{-# LINE 744 "src/Graphics/UI/GLFW.hsc" #-}
               (260) -> KeyF3
{-# LINE 745 "src/Graphics/UI/GLFW.hsc" #-}
               (261) -> KeyF4
{-# LINE 746 "src/Graphics/UI/GLFW.hsc" #-}
               (262) -> KeyF5
{-# LINE 747 "src/Graphics/UI/GLFW.hsc" #-}
               (263) -> KeyF6
{-# LINE 748 "src/Graphics/UI/GLFW.hsc" #-}
               (264) -> KeyF7
{-# LINE 749 "src/Graphics/UI/GLFW.hsc" #-}
               (265) -> KeyF8
{-# LINE 750 "src/Graphics/UI/GLFW.hsc" #-}
               (266) -> KeyF9
{-# LINE 751 "src/Graphics/UI/GLFW.hsc" #-}
               (267) -> KeyF10
{-# LINE 752 "src/Graphics/UI/GLFW.hsc" #-}
               (268) -> KeyF11
{-# LINE 753 "src/Graphics/UI/GLFW.hsc" #-}
               (269) -> KeyF12
{-# LINE 754 "src/Graphics/UI/GLFW.hsc" #-}
               (270) -> KeyF13
{-# LINE 755 "src/Graphics/UI/GLFW.hsc" #-}
               (271) -> KeyF14
{-# LINE 756 "src/Graphics/UI/GLFW.hsc" #-}
               (272) -> KeyF15
{-# LINE 757 "src/Graphics/UI/GLFW.hsc" #-}
               (273) -> KeyF16
{-# LINE 758 "src/Graphics/UI/GLFW.hsc" #-}
               (274) -> KeyF17
{-# LINE 759 "src/Graphics/UI/GLFW.hsc" #-}
               (275) -> KeyF18
{-# LINE 760 "src/Graphics/UI/GLFW.hsc" #-}
               (276) -> KeyF19
{-# LINE 761 "src/Graphics/UI/GLFW.hsc" #-}
               (277) -> KeyF20
{-# LINE 762 "src/Graphics/UI/GLFW.hsc" #-}
               (278) -> KeyF21
{-# LINE 763 "src/Graphics/UI/GLFW.hsc" #-}
               (279) -> KeyF22
{-# LINE 764 "src/Graphics/UI/GLFW.hsc" #-}
               (280) -> KeyF23
{-# LINE 765 "src/Graphics/UI/GLFW.hsc" #-}
               (281) -> KeyF24
{-# LINE 766 "src/Graphics/UI/GLFW.hsc" #-}
               (282) -> KeyF25
{-# LINE 767 "src/Graphics/UI/GLFW.hsc" #-}
               (283) -> KeyUp
{-# LINE 768 "src/Graphics/UI/GLFW.hsc" #-}
               (284) -> KeyDown
{-# LINE 769 "src/Graphics/UI/GLFW.hsc" #-}
               (285) -> KeyLeft
{-# LINE 770 "src/Graphics/UI/GLFW.hsc" #-}
               (286) -> KeyRight
{-# LINE 771 "src/Graphics/UI/GLFW.hsc" #-}
               (287) -> KeyLeftShift
{-# LINE 772 "src/Graphics/UI/GLFW.hsc" #-}
               (288) -> KeyRightShift
{-# LINE 773 "src/Graphics/UI/GLFW.hsc" #-}
               (289) -> KeyLeftCtrl
{-# LINE 774 "src/Graphics/UI/GLFW.hsc" #-}
               (290) -> KeyRightCtrl
{-# LINE 775 "src/Graphics/UI/GLFW.hsc" #-}
               (291) -> KeyLeftAlt
{-# LINE 776 "src/Graphics/UI/GLFW.hsc" #-}
               (292) -> KeyRightAlt
{-# LINE 777 "src/Graphics/UI/GLFW.hsc" #-}
               (293) -> KeyTab
{-# LINE 778 "src/Graphics/UI/GLFW.hsc" #-}
               (294) -> KeyEnter
{-# LINE 779 "src/Graphics/UI/GLFW.hsc" #-}
               (295) -> KeyBackspace
{-# LINE 780 "src/Graphics/UI/GLFW.hsc" #-}
               (296) -> KeyInsert
{-# LINE 781 "src/Graphics/UI/GLFW.hsc" #-}
               (297) -> KeyDel
{-# LINE 782 "src/Graphics/UI/GLFW.hsc" #-}
               (298) -> KeyPageup
{-# LINE 783 "src/Graphics/UI/GLFW.hsc" #-}
               (299) -> KeyPagedown
{-# LINE 784 "src/Graphics/UI/GLFW.hsc" #-}
               (300) -> KeyHome
{-# LINE 785 "src/Graphics/UI/GLFW.hsc" #-}
               (301) -> KeyEnd
{-# LINE 786 "src/Graphics/UI/GLFW.hsc" #-}
               (302) -> KeyPad0
{-# LINE 787 "src/Graphics/UI/GLFW.hsc" #-}
               (303) -> KeyPad1
{-# LINE 788 "src/Graphics/UI/GLFW.hsc" #-}
               (304) -> KeyPad2
{-# LINE 789 "src/Graphics/UI/GLFW.hsc" #-}
               (305) -> KeyPad3
{-# LINE 790 "src/Graphics/UI/GLFW.hsc" #-}
               (306) -> KeyPad4
{-# LINE 791 "src/Graphics/UI/GLFW.hsc" #-}
               (307) -> KeyPad5
{-# LINE 792 "src/Graphics/UI/GLFW.hsc" #-}
               (308) -> KeyPad6
{-# LINE 793 "src/Graphics/UI/GLFW.hsc" #-}
               (309) -> KeyPad7
{-# LINE 794 "src/Graphics/UI/GLFW.hsc" #-}
               (310) -> KeyPad8
{-# LINE 795 "src/Graphics/UI/GLFW.hsc" #-}
               (311) -> KeyPad9
{-# LINE 796 "src/Graphics/UI/GLFW.hsc" #-}
               (312) -> KeyPadDivide
{-# LINE 797 "src/Graphics/UI/GLFW.hsc" #-}
               (313) -> KeyPadMultiply
{-# LINE 798 "src/Graphics/UI/GLFW.hsc" #-}
               (314) -> KeyPadSubtract
{-# LINE 799 "src/Graphics/UI/GLFW.hsc" #-}
               (315) -> KeyPadAdd
{-# LINE 800 "src/Graphics/UI/GLFW.hsc" #-}
               (316) -> KeyPadDecimal
{-# LINE 801 "src/Graphics/UI/GLFW.hsc" #-}
               (317) -> KeyPadEqual
{-# LINE 802 "src/Graphics/UI/GLFW.hsc" #-}
               (318) -> KeyPadEnter
{-# LINE 803 "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

-- |Make the mouse cursor visible.
enableMouseCursor :: IO ()
enableMouseCursor = glfwEnable (196609)
{-# LINE 854 "src/Graphics/UI/GLFW.hsc" #-}

-- |Make the mouse cursor invisible.
disableMouseCursor :: IO ()
disableMouseCursor = glfwDisable (196609)
{-# LINE 858 "src/Graphics/UI/GLFW.hsc" #-}

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

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

instance C MouseButton CInt where
  toC mb = case mb of
      MouseButton0 -> 0
{-# LINE 869 "src/Graphics/UI/GLFW.hsc" #-}
      MouseButton1 -> 1
{-# LINE 870 "src/Graphics/UI/GLFW.hsc" #-}
      MouseButton2 -> 2
{-# LINE 871 "src/Graphics/UI/GLFW.hsc" #-}
      MouseButton3 -> 3
{-# LINE 872 "src/Graphics/UI/GLFW.hsc" #-}
      MouseButton4 -> 4
{-# LINE 873 "src/Graphics/UI/GLFW.hsc" #-}
      MouseButton5 -> 5
{-# LINE 874 "src/Graphics/UI/GLFW.hsc" #-}
      MouseButton6 -> 6
{-# LINE 875 "src/Graphics/UI/GLFW.hsc" #-}
      MouseButton7 -> 7
{-# LINE 876 "src/Graphics/UI/GLFW.hsc" #-}

  fromC i = case i of
      (0) -> MouseButton0
{-# LINE 879 "src/Graphics/UI/GLFW.hsc" #-}
      (1) -> MouseButton1
{-# LINE 880 "src/Graphics/UI/GLFW.hsc" #-}
      (2) -> MouseButton2
{-# LINE 881 "src/Graphics/UI/GLFW.hsc" #-}
      (3) -> MouseButton3
{-# LINE 882 "src/Graphics/UI/GLFW.hsc" #-}
      (4) -> MouseButton4
{-# LINE 883 "src/Graphics/UI/GLFW.hsc" #-}
      (5) -> MouseButton5
{-# LINE 884 "src/Graphics/UI/GLFW.hsc" #-}
      (6) -> MouseButton6
{-# LINE 885 "src/Graphics/UI/GLFW.hsc" #-}
      (7) -> MouseButton7
{-# LINE 886 "src/Graphics/UI/GLFW.hsc" #-}
      _                            -> makeFromCError "MouseButton" i

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

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

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

getNumJoystickButtons :: Joystick -> IO Int
getNumJoystickButtons j =
    fromC `fmap` glfwGetJoystickParam (toC j) (327683)
{-# LINE 902 "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, Ord, Read, Show)

instance C Joystick CInt where
  toC j = case j of
      Joystick0  -> 0
{-# LINE 933 "src/Graphics/UI/GLFW.hsc" #-}
      Joystick1  -> 1
{-# LINE 934 "src/Graphics/UI/GLFW.hsc" #-}
      Joystick2  -> 2
{-# LINE 935 "src/Graphics/UI/GLFW.hsc" #-}
      Joystick3  -> 3
{-# LINE 936 "src/Graphics/UI/GLFW.hsc" #-}
      Joystick4  -> 4
{-# LINE 937 "src/Graphics/UI/GLFW.hsc" #-}
      Joystick5  -> 5
{-# LINE 938 "src/Graphics/UI/GLFW.hsc" #-}
      Joystick6  -> 6
{-# LINE 939 "src/Graphics/UI/GLFW.hsc" #-}
      Joystick7  -> 7
{-# LINE 940 "src/Graphics/UI/GLFW.hsc" #-}
      Joystick8  -> 8
{-# LINE 941 "src/Graphics/UI/GLFW.hsc" #-}
      Joystick9  -> 9
{-# LINE 942 "src/Graphics/UI/GLFW.hsc" #-}
      Joystick10 -> 10
{-# LINE 943 "src/Graphics/UI/GLFW.hsc" #-}
      Joystick11 -> 11
{-# LINE 944 "src/Graphics/UI/GLFW.hsc" #-}
      Joystick12 -> 12
{-# LINE 945 "src/Graphics/UI/GLFW.hsc" #-}
      Joystick13 -> 13
{-# LINE 946 "src/Graphics/UI/GLFW.hsc" #-}
      Joystick14 -> 14
{-# LINE 947 "src/Graphics/UI/GLFW.hsc" #-}
      Joystick15 -> 15
{-# LINE 948 "src/Graphics/UI/GLFW.hsc" #-}

  fromC i = case i of
      (0) -> Joystick0
{-# LINE 951 "src/Graphics/UI/GLFW.hsc" #-}
      (1) -> Joystick1
{-# LINE 952 "src/Graphics/UI/GLFW.hsc" #-}
      (2) -> Joystick2
{-# LINE 953 "src/Graphics/UI/GLFW.hsc" #-}
      (3) -> Joystick3
{-# LINE 954 "src/Graphics/UI/GLFW.hsc" #-}
      (4) -> Joystick4
{-# LINE 955 "src/Graphics/UI/GLFW.hsc" #-}
      (5) -> Joystick5
{-# LINE 956 "src/Graphics/UI/GLFW.hsc" #-}
      (6) -> Joystick6
{-# LINE 957 "src/Graphics/UI/GLFW.hsc" #-}
      (7) -> Joystick7
{-# LINE 958 "src/Graphics/UI/GLFW.hsc" #-}
      (8) -> Joystick8
{-# LINE 959 "src/Graphics/UI/GLFW.hsc" #-}
      (9) -> Joystick9
{-# LINE 960 "src/Graphics/UI/GLFW.hsc" #-}
      (10) -> Joystick10
{-# LINE 961 "src/Graphics/UI/GLFW.hsc" #-}
      (11) -> Joystick11
{-# LINE 962 "src/Graphics/UI/GLFW.hsc" #-}
      (12) -> Joystick12
{-# LINE 963 "src/Graphics/UI/GLFW.hsc" #-}
      (13) -> Joystick13
{-# LINE 964 "src/Graphics/UI/GLFW.hsc" #-}
      (14) -> Joystick14
{-# LINE 965 "src/Graphics/UI/GLFW.hsc" #-}
      (15) -> Joystick15
{-# LINE 966 "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 1016 "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 1033 "src/Graphics/UI/GLFW.hsc" #-}
  toC True  = 1
{-# LINE 1034 "src/Graphics/UI/GLFW.hsc" #-}

  fromC (0) = False
{-# LINE 1036 "src/Graphics/UI/GLFW.hsc" #-}
  fromC (1)  = True
{-# LINE 1037 "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)
{-# NOINLINE charCallback #-}
keyCallback           = unsafePerformIO (newIORef Nothing)
{-# NOINLINE keyCallback #-}
mouseButtonCallback   = unsafePerformIO (newIORef Nothing)
{-# NOINLINE mouseButtonCallback #-}
mousePositionCallback = unsafePerformIO (newIORef Nothing)
{-# NOINLINE mousePositionCallback #-}
mouseWheelCallback    = unsafePerformIO (newIORef Nothing)
{-# NOINLINE mouseWheelCallback #-}
windowCloseCallback   = unsafePerformIO (newIORef Nothing)
{-# NOINLINE windowCloseCallback #-}
windowRefreshCallback = unsafePerformIO (newIORef Nothing)
{-# NOINLINE windowRefreshCallback #-}
windowSizeCallback    = unsafePerformIO (newIORef Nothing)
{-# NOINLINE windowSizeCallback #-}

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