module Graphics.UI.GLFW
  ( 
    Error (..)
    
  , setErrorCallback, ErrorCallback
    
  , Version (..)
    
  , init
  , terminate
  , getVersion
  , getVersionString
    
  , Monitor
  , MonitorState (..)
  , VideoMode    (..)
  , GammaRamp    (gammaRampRed, gammaRampGreen, gammaRampBlue)
  , makeGammaRamp
    
  , getMonitors
  , getPrimaryMonitor
  , getMonitorPos
  , getMonitorPhysicalSize
  , getMonitorName
  , setMonitorCallback, MonitorCallback
  , getVideoModes
  , getVideoMode
  , setGamma
  , getGammaRamp
  , setGammaRamp
    
  , Window
  , WindowHint             (..)
  , ContextRobustness      (..)
  , OpenGLProfile          (..)
  , ClientAPI              (..)
  , ContextCreationAPI     (..)
  , ContextReleaseBehavior (..)
    
  , defaultWindowHints
  , windowHint
  , createWindow
  , destroyWindow
  , windowShouldClose
  , setWindowShouldClose
  , setWindowTitle
  , getWindowPos
  , setWindowPos
  , getWindowSize
  , setWindowSize
  , setWindowSizeLimits
  , setWindowAspectRatio
  , getWindowFrameSize
  , getFramebufferSize
  , setWindowIcon
  , iconifyWindow
  , restoreWindow
  , focusWindow
  , maximizeWindow
  , showWindow
  , hideWindow
  , getWindowMonitor
  , setCursorPos
  , setFullscreen
  , setWindowed
    
  , getWindowFocused                   
  , getWindowMaximized                 
  , getWindowFloating                  
  , getWindowIconified                 
  , getWindowResizable                 
  , getWindowDecorated                 
  , getWindowVisible                   
  , getWindowClientAPI                 
  , getWindowContextCreationAPI        
  , getWindowContextVersionMajor       
  , getWindowContextVersionMinor       
  , getWindowContextVersionRevision    
  , getWindowContextRobustness         
  , getWindowContextReleaseBehavior    
  , getWindowContextNoError            
  , getWindowOpenGLForwardCompat       
  , getWindowOpenGLDebugContext        
  , getWindowOpenGLProfile  
  , setWindowPosCallback,       WindowPosCallback
  , setWindowSizeCallback,      WindowSizeCallback
  , setWindowCloseCallback,     WindowCloseCallback
  , setWindowRefreshCallback,   WindowRefreshCallback
  , setWindowFocusCallback,     WindowFocusCallback
  , setWindowIconifyCallback,   WindowIconifyCallback
  , setFramebufferSizeCallback, FramebufferSizeCallback
  , pollEvents
  , waitEvents
  , waitEventsTimeout
  , postEmptyEvent
    
  , Key                         (..)
  , KeyState                    (..)
  , Joystick                    (..)
  , JoystickState               (..)
  , JoystickButtonState         (..)
  , MouseButton                 (..)
  , MouseButtonState            (..)
  , CursorState                 (..)
  , CursorInputMode             (..)
  , StickyKeysInputMode         (..)
  , StickyMouseButtonsInputMode (..)
  , ModifierKeys                (..)
  , Image
  , mkImage
  , Cursor                      (..)
  , StandardCursorShape         (..)
    
    
  , getCursorInputMode                
  , setCursorInputMode                
  , getStickyKeysInputMode            
  , setStickyKeysInputMode            
  , getStickyMouseButtonsInputMode    
  , setStickyMouseButtonsInputMode  
  , getKey
  , getKeyName
  , getMouseButton
  , getCursorPos
  , setKeyCallback,         KeyCallback
  , setCharCallback,        CharCallback
  , setCharModsCallback,    CharModsCallback
  , setMouseButtonCallback, MouseButtonCallback
  , setCursorPosCallback,   CursorPosCallback
  , setCursorEnterCallback, CursorEnterCallback
  , createCursor
  , createStandardCursor
  , setCursor
  , destroyCursor
  , setScrollCallback,      ScrollCallback
  , setDropCallback,        DropCallback
  , joystickPresent
  , getJoystickAxes
  , getJoystickButtons
  , getJoystickName
  , setJoystickCallback,    JoystickCallback
    
  , getTime
  , setTime
  , getTimerValue
  , getTimerFrequency
    
  , makeContextCurrent
  , getCurrentContext
  , swapBuffers
  , swapInterval
  , extensionSupported
    
  , getClipboardString
  , setClipboardString
    
  , vulkanSupported
  , getRequiredInstanceExtensions
  , getInstanceProcAddress
  , getPhysicalDevicePresentationSupport
  , createWindowSurface
    
    
  , getWin32Adapter
  , getWin32Monitor
  , getWin32Window
  , getWGLContext
  , getCocoaMonitor
  , getCocoaWindow
  , getNSGLContext
  , getX11Display
  , getX11Adapter
  , getX11Monitor
  , getX11Window
  , getGLXContext
  , getGLXWindow
  , getWaylandDisplay
  , getWaylandMonitor
  , getWaylandWindow
  , getMirDisplay
  , getMirMonitor
  , getMirWindow
  , getEGLDisplay
  , getEGLContext
  , getEGLSurface
  ) where
import Prelude hiding (init)
import Control.Monad         (when, liftM)
import Data.IORef            (IORef, atomicModifyIORef, newIORef, readIORef)
import Data.Word             (Word32, Word64)
import Foreign.C.String      (peekCString, withCString, CString)
import Foreign.C.Types       (CUInt, CUShort)
import Foreign.Marshal.Alloc (alloca, allocaBytes)
import Foreign.Marshal.Array (advancePtr, allocaArray, peekArray, withArray)
import Foreign.Ptr           (FunPtr, freeHaskellFunPtr, nullFunPtr, nullPtr
                             ,Ptr)
import Foreign.StablePtr
import Foreign.Storable      (Storable (..))
import System.IO.Unsafe      (unsafePerformIO)
import Graphics.UI.GLFW.C
import Graphics.UI.GLFW.Types
import Bindings.GLFW
storedErrorFun           :: IORef C'GLFWerrorfun
storedMonitorFun         :: IORef C'GLFWmonitorfun
storedJoystickFun        :: IORef C'GLFWjoystickfun
storedErrorFun           = unsafePerformIO $ newIORef nullFunPtr
storedMonitorFun         = unsafePerformIO $ newIORef nullFunPtr
storedJoystickFun        = unsafePerformIO $ newIORef nullFunPtr
{-# NOINLINE storedErrorFun           #-}
{-# NOINLINE storedMonitorFun         #-}
{-# NOINLINE storedJoystickFun         #-}
setWindowCallback
  :: (c -> IO (FunPtr c))                    
  -> (h -> c)                                
  -> (FunPtr c -> IO (FunPtr c))             
  -> (WindowCallbacks -> IORef (FunPtr c))   
  -> Window                                  
  -> Maybe h                                 
  -> IO ()
setWindowCallback wr af gf ior win mcb = do
    pcallbacks <- castPtrToStablePtr `liftM` c'glfwGetWindowUserPointer (unWindow win)
    callbacks <- deRefStablePtr pcallbacks
    setCallback wr af gf (ior callbacks) mcb
setCallback
  :: (c -> IO (FunPtr c))          
  -> (h -> c)                      
  -> (FunPtr c -> IO (FunPtr c))   
  -> IORef (FunPtr c)              
  -> Maybe h                       
  -> IO ()
setCallback wf af gf ior mcb = do
    
    
    ccb <- maybe (return nullFunPtr) (wf . af) mcb
    
    _ <- gf ccb
    
    storeCallback ior ccb
storeCallback :: IORef (FunPtr a) -> FunPtr a -> IO ()
storeCallback ior new = do
    
    prev <- atomicModifyIORef ior (\cur -> (new, cur))
    
    when (prev /= nullFunPtr) $ freeHaskellFunPtr prev
type ErrorCallback           = Error -> String                                           -> IO ()
type WindowPosCallback       = Window -> Int -> Int                                      -> IO ()
type WindowSizeCallback      = Window -> Int -> Int                                      -> IO ()
type WindowCloseCallback     = Window                                                    -> IO ()
type WindowRefreshCallback   = Window                                                    -> IO ()
type WindowFocusCallback     = Window -> Bool                                            -> IO ()
type WindowIconifyCallback   = Window -> Bool                                            -> IO ()
type FramebufferSizeCallback = Window -> Int -> Int                                      -> IO ()
type MouseButtonCallback     = Window -> MouseButton -> MouseButtonState -> ModifierKeys -> IO ()
type CursorPosCallback       = Window -> Double -> Double                                -> IO ()
type CursorEnterCallback     = Window -> CursorState                                     -> IO ()
type ScrollCallback          = Window -> Double -> Double                                -> IO ()
type KeyCallback             = Window -> Key -> Int -> KeyState -> ModifierKeys          -> IO ()
type CharCallback            = Window -> Char                                            -> IO ()
type CharModsCallback        = Window -> Char -> ModifierKeys                            -> IO ()
type MonitorCallback         = Monitor -> MonitorState                                   -> IO ()
type JoystickCallback        = Joystick -> JoystickState                                 -> IO ()
data ScheduledCallbacks = ScheduledCallbacks
  { _forward :: [IO ()] 
  , _backward :: [IO ()] 
  }
storedScheduledCallbacks :: IORef ScheduledCallbacks
storedScheduledCallbacks = unsafePerformIO . newIORef $ ScheduledCallbacks [] []
{-# NOINLINE storedScheduledCallbacks #-}
atomicModifyIORef' :: IORef a -> (a -> (a,b)) -> IO b
atomicModifyIORef' ref f = do
    b <- atomicModifyIORef ref
            (\x -> let (a, b) = f x
                    in (a, a `seq` b))
    b `seq` return b
schedule :: IO () -> IO ()
schedule act =
  atomicModifyIORef' storedScheduledCallbacks $
  \(ScheduledCallbacks oldForward oldBackward) ->
  (ScheduledCallbacks oldForward (act : oldBackward), ())
splitFirst :: [a] -> (Maybe a, [a])
splitFirst [] = (Nothing, [])
splitFirst (x:xs) = (Just x, xs)
getNextScheduled :: IO (Maybe (IO ()))
getNextScheduled =
  atomicModifyIORef storedScheduledCallbacks $
  \(ScheduledCallbacks oldForward oldBackward) ->
  case oldForward of
    [] ->
      let (mCb, newForward) = splitFirst (reverse oldBackward)
      in (ScheduledCallbacks newForward [], mCb)
    (cb:rest) ->                
      (ScheduledCallbacks rest oldBackward, Just cb)
executeScheduled :: IO ()
executeScheduled = do
  mcb <- getNextScheduled
  case mcb of
    Nothing -> return ()
    Just cb -> cb >> executeScheduled
setErrorCallback :: Maybe ErrorCallback -> IO ()
setErrorCallback = setCallback
    mk'GLFWerrorfun
    (\cb a0 a1 -> do
        s <- peekCString a1
        schedule $ cb (fromC a0) s)
    c'glfwSetErrorCallback
    storedErrorFun
withGLFWImage :: Image -> (Ptr C'GLFWimage -> IO a) -> IO a
withGLFWImage (Image w h pxs) f =
  alloca        $ \p'img ->
  withArray pxs $ \p'pxs -> do
    poke p'img $ C'GLFWimage (toC w) (toC h) p'pxs
    f p'img
init :: IO Bool
init =
    fromC `fmap` c'glfwInit
terminate :: IO ()
terminate = do
    c'glfwTerminate
    
    storeCallback storedErrorFun           nullFunPtr
    storeCallback storedMonitorFun         nullFunPtr
    storeCallback storedJoystickFun         nullFunPtr
getVersion :: IO Version
getVersion =
    allocaArray 3 $ \p -> do
        let p0 = p
            p1 = p `advancePtr` 1
            p2 = p `advancePtr` 2
        c'glfwGetVersion p0 p1 p2
        v0 <- fromC `fmap` peek p0
        v1 <- fromC `fmap` peek p1
        v2 <- fromC `fmap` peek p2
        return $ Version v0 v1 v2
getVersionString :: IO (Maybe String)
getVersionString = do
    p'vs <- c'glfwGetVersionString
    if p'vs /= nullPtr
      then Just `fmap` peekCString p'vs
      else return Nothing
getMonitors :: IO (Maybe [Monitor])
getMonitors =
    alloca $ \p'n -> do
        p'mon <- c'glfwGetMonitors p'n
        n <- fromC `fmap` peek p'n
        if p'mon == nullPtr || n <= 0
          then return Nothing
          else (Just . map fromC) `fmap` peekArray n p'mon
getPrimaryMonitor :: IO (Maybe Monitor)
getPrimaryMonitor = do
    p'mon <- c'glfwGetPrimaryMonitor
    return $
      if p'mon == nullPtr
        then Nothing
        else Just $ fromC p'mon
getMonitorPos :: Monitor -> IO (Int, Int)
getMonitorPos mon =
    allocaArray 2 $ \p -> do
        let p'x = p
            p'y = p `advancePtr` 1
        c'glfwGetMonitorPos (toC mon) p'x p'y
        x <- fromC `fmap` peek p'x
        y <- fromC `fmap` peek p'y
        return (x, y)
getMonitorPhysicalSize :: Monitor -> IO (Int, Int)
getMonitorPhysicalSize mon =
    allocaArray 2 $ \p -> do
        let p'w = p
            p'h = p `advancePtr` 1
        c'glfwGetMonitorPhysicalSize (toC mon) p'w p'h
        w <- fromC `fmap` peek p'w
        h <- fromC `fmap` peek p'h
        return (w, h)
getMonitorName :: Monitor -> IO (Maybe String)
getMonitorName mon = do
    p'name <- c'glfwGetMonitorName (toC mon)
    if p'name == nullPtr
      then return Nothing
      else Just `fmap` peekCString p'name
setMonitorCallback :: Maybe MonitorCallback -> IO ()
setMonitorCallback = setCallback
    mk'GLFWmonitorfun
    (\cb a0 a1 -> schedule $ cb (fromC a0) (fromC a1))
    c'glfwSetMonitorCallback
    storedMonitorFun
getVideoModes :: Monitor -> IO (Maybe [VideoMode])
getVideoModes mon =
    alloca $ \p'n -> do
        p'vms <- c'glfwGetVideoModes (toC mon) p'n
        n <- fromC `fmap` peek p'n
        if p'vms == nullPtr || n <= 0
          then return Nothing
          else (Just . map fromC) `fmap` peekArray n p'vms
getVideoMode :: Monitor -> IO (Maybe VideoMode)
getVideoMode mon = do
    p'vm <- c'glfwGetVideoMode (toC mon)
    if p'vm == nullPtr
      then return Nothing
      else (Just . fromC) `fmap` peek p'vm
setGamma :: Monitor -> Double -> IO ()
setGamma mon e =
    c'glfwSetGamma (toC mon) (toC e)
getGammaRamp :: Monitor -> IO (Maybe GammaRamp)
getGammaRamp m = do
    p'ggr <- c'glfwGetGammaRamp (toC m)
    if p'ggr == nullPtr
      then return Nothing
      else do
          ggr <- peek p'ggr
          let p'rs = c'GLFWgammaramp'red   ggr
              p'gs = c'GLFWgammaramp'green ggr
              p'bs = c'GLFWgammaramp'blue  ggr
              cn   = c'GLFWgammaramp'size  ggr
              n    = fromC cn
          if n == 0 || nullPtr `elem` [p'rs, p'gs, p'bs]
            then return Nothing
            else do
                rs <- map fromC `fmap` peekArray n p'rs
                gs <- map fromC `fmap` peekArray n p'gs
                bs <- map fromC `fmap` peekArray n p'bs
                return $ Just GammaRamp
                  { gammaRampRed   = rs
                  , gammaRampGreen = gs
                  , gammaRampBlue  = bs
                  }
setGammaRamp :: Monitor -> GammaRamp -> IO ()
setGammaRamp mon gr =
    let rs = map toC $ gammaRampRed   gr :: [CUShort]
        gs = map toC $ gammaRampGreen gr :: [CUShort]
        bs = map toC $ gammaRampBlue  gr :: [CUShort]
        
        
        cn = toC $ length rs :: CUInt
    in alloca       $ \p'ggr ->
       withArray rs $ \p'rs  ->
       withArray gs $ \p'gs  ->
       withArray bs $ \p'bs  -> do
          let ggr = C'GLFWgammaramp
                      { c'GLFWgammaramp'red   = p'rs
                      , c'GLFWgammaramp'green = p'gs
                      , c'GLFWgammaramp'blue  = p'bs
                      , c'GLFWgammaramp'size  = cn
                      }
          poke p'ggr ggr
          c'glfwSetGammaRamp (toC mon) p'ggr
defaultWindowHints :: IO ()
defaultWindowHints =
    c'glfwDefaultWindowHints
windowHint :: WindowHint -> IO ()
windowHint wh =
    let (t, v) = unpack
    in c'glfwWindowHint t v
  where
    unpack = case wh of
      (WindowHint'Resizable              x) -> (c'GLFW_RESIZABLE,                toC x)
      (WindowHint'Visible                x) -> (c'GLFW_VISIBLE,                  toC x)
      (WindowHint'Decorated              x) -> (c'GLFW_DECORATED,                toC x)
      (WindowHint'RedBits                x) -> (c'GLFW_RED_BITS,                 toC x)
      (WindowHint'GreenBits              x) -> (c'GLFW_GREEN_BITS,               toC x)
      (WindowHint'BlueBits               x) -> (c'GLFW_BLUE_BITS,                toC x)
      (WindowHint'AlphaBits              x) -> (c'GLFW_ALPHA_BITS,               toC x)
      (WindowHint'DepthBits              x) -> (c'GLFW_DEPTH_BITS,               toC x)
      (WindowHint'StencilBits            x) -> (c'GLFW_STENCIL_BITS,             toC x)
      (WindowHint'AccumRedBits           x) -> (c'GLFW_ACCUM_RED_BITS,           toC x)
      (WindowHint'AccumGreenBits         x) -> (c'GLFW_ACCUM_GREEN_BITS,         toC x)
      (WindowHint'AccumBlueBits          x) -> (c'GLFW_ACCUM_BLUE_BITS,          toC x)
      (WindowHint'AccumAlphaBits         x) -> (c'GLFW_ACCUM_ALPHA_BITS,         toC x)
      (WindowHint'AuxBuffers             x) -> (c'GLFW_AUX_BUFFERS,              toC x)
      (WindowHint'Samples                x) -> (c'GLFW_SAMPLES,                  toC x)
      (WindowHint'RefreshRate            x) -> (c'GLFW_REFRESH_RATE,             toC x)
      (WindowHint'DoubleBuffer           x) -> (c'GLFW_DOUBLEBUFFER,             toC x)
      (WindowHint'Stereo                 x) -> (c'GLFW_STEREO,                   toC x)
      (WindowHint'sRGBCapable            x) -> (c'GLFW_SRGB_CAPABLE,             toC x)
      (WindowHint'Floating               x) -> (c'GLFW_FLOATING,                 toC x)
      (WindowHint'Focused                x) -> (c'GLFW_FOCUSED,                  toC x)
      (WindowHint'Maximized              x) -> (c'GLFW_MAXIMIZED,                toC x)
      (WindowHint'AutoIconify            x) -> (c'GLFW_AUTO_ICONIFY,             toC x)
      (WindowHint'ClientAPI              x) -> (c'GLFW_CLIENT_API,               toC x)
      (WindowHint'ContextCreationAPI     x) -> (c'GLFW_CONTEXT_CREATION_API,     toC x)
      (WindowHint'ContextVersionMajor    x) -> (c'GLFW_CONTEXT_VERSION_MAJOR,    toC x)
      (WindowHint'ContextVersionMinor    x) -> (c'GLFW_CONTEXT_VERSION_MINOR,    toC x)
      (WindowHint'ContextRobustness      x) -> (c'GLFW_CONTEXT_ROBUSTNESS,       toC x)
      (WindowHint'ContextReleaseBehavior x) -> (c'GLFW_CONTEXT_RELEASE_BEHAVIOR, toC x)
      (WindowHint'ContextNoError         x) -> (c'GLFW_CONTEXT_NO_ERROR,         toC x)
      (WindowHint'OpenGLForwardCompat    x) -> (c'GLFW_OPENGL_FORWARD_COMPAT,    toC x)
      (WindowHint'OpenGLDebugContext     x) -> (c'GLFW_OPENGL_DEBUG_CONTEXT,     toC x)
      (WindowHint'OpenGLProfile          x) -> (c'GLFW_OPENGL_PROFILE,           toC x)
createWindow :: Int 
             -> Int 
             -> String 
             -> Maybe Monitor 
             -> Maybe Window  
                              
             -> IO (Maybe Window)
createWindow w h title mmon mwin =
    withCString title $ \ptitle -> do
        charFun             <- newIORef nullFunPtr
        charModsFun         <- newIORef nullFunPtr
        cursorEnterFun      <- newIORef nullFunPtr
        cursorPosFun        <- newIORef nullFunPtr
        framebufferSizeFun  <- newIORef nullFunPtr
        keyFun              <- newIORef nullFunPtr
        mouseButtonFun      <- newIORef nullFunPtr
        scrollFun           <- newIORef nullFunPtr
        windowCloseFun      <- newIORef nullFunPtr
        windowFocusFun      <- newIORef nullFunPtr
        windowIconifyFun    <- newIORef nullFunPtr
        windowPosFun        <- newIORef nullFunPtr
        windowRefreshFun    <- newIORef nullFunPtr
        windowSizeFun       <- newIORef nullFunPtr
        dropFun             <- newIORef nullFunPtr
        let callbacks = WindowCallbacks
              { storedCharFun             = charFun
              , storedCharModsFun         = charModsFun
              , storedCursorEnterFun      = cursorEnterFun
              , storedCursorPosFun        = cursorPosFun
              , storedFramebufferSizeFun  = framebufferSizeFun
              , storedKeyFun              = keyFun
              , storedMouseButtonFun      = mouseButtonFun
              , storedScrollFun           = scrollFun
              , storedWindowCloseFun      = windowCloseFun
              , storedWindowFocusFun      = windowFocusFun
              , storedWindowIconifyFun    = windowIconifyFun
              , storedWindowPosFun        = windowPosFun
              , storedWindowRefreshFun    = windowRefreshFun
              , storedWindowSizeFun       = windowSizeFun
              , storedDropFun             = dropFun
              }
        p'win <- c'glfwCreateWindow
          (toC w)
          (toC h)
          ptitle
          (maybe nullPtr toC mmon)
          (maybe nullPtr toC mwin)
        if p'win == nullPtr
          then return Nothing
          else do callbackPtr <- newStablePtr callbacks
                  c'glfwSetWindowUserPointer p'win (castStablePtrToPtr callbackPtr)
                  return $ Just $ fromC p'win
destroyWindow :: Window -> IO ()
destroyWindow win = do
    pcb <- castPtrToStablePtr `liftM` c'glfwGetWindowUserPointer (toC win)
    cbs <- deRefStablePtr pcb
    c'glfwDestroyWindow (toC win)
    let free callback = do funptr <- readIORef (callback cbs)
                           when (funptr /= nullFunPtr) $ freeHaskellFunPtr funptr
    free storedCharFun
    free storedCharModsFun
    free storedCursorEnterFun
    free storedCursorPosFun
    free storedFramebufferSizeFun
    free storedKeyFun
    free storedMouseButtonFun
    free storedScrollFun
    free storedWindowCloseFun
    free storedWindowFocusFun
    free storedWindowIconifyFun
    free storedWindowPosFun
    free storedWindowRefreshFun
    free storedWindowSizeFun
    freeStablePtr pcb
windowShouldClose :: Window -> IO Bool
windowShouldClose win =
    fromC `fmap` c'glfwWindowShouldClose (toC win)
setWindowShouldClose :: Window -> Bool -> IO ()
setWindowShouldClose win b =
    c'glfwSetWindowShouldClose (toC win) (toC b)
setWindowTitle :: Window -> String -> IO ()
setWindowTitle win title =
    withCString title $ c'glfwSetWindowTitle (toC win)
getWindowPos :: Window -> IO (Int, Int)
getWindowPos win =
    allocaArray 2 $ \p -> do
        let p'x = p
            p'y = p `advancePtr` 1
        c'glfwGetWindowPos (toC win) p'x p'y
        x <- fromC `fmap` peek p'x
        y <- fromC `fmap` peek p'y
        return (x, y)
setWindowPos :: Window -> Int -> Int -> IO ()
setWindowPos win x y =
    c'glfwSetWindowPos (toC win) (toC x) (toC y)
getWindowSize :: Window -> IO (Int, Int)
getWindowSize win =
    allocaArray 2 $ \p -> do
        let p'w = p
            p'h = p `advancePtr` 1
        c'glfwGetWindowSize (toC win) p'w p'h
        w <- fromC `fmap` peek p'w
        h <- fromC `fmap` peek p'h
        return (w, h)
getWindowFrameSize :: Window -> IO (Int, Int, Int, Int)
getWindowFrameSize win =
    allocaArray 4 $ \p -> do
        let p'l = p
            p't = p `advancePtr` 1
            p'r = p `advancePtr` 2
            p'b = p `advancePtr` 3
        c'glfwGetWindowFrameSize (toC win) p'l p't p'r p'b
        l <- fromC `fmap` peek p'l
        t <- fromC `fmap` peek p't
        r <- fromC `fmap` peek p'r
        b <- fromC `fmap` peek p'b
        return (l, t, r, b)
setWindowSize :: Window -> Int -> Int -> IO ()
setWindowSize win w h =
    c'glfwSetWindowSize (toC win) (toC w) (toC h)
setWindowSizeLimits :: Window
                    -> Maybe Int
                    
                    
                    -> Maybe Int
                    
                    
                    -> Maybe Int
                    
                    
                    -> Maybe Int
                    
                    
                    -> IO ()
setWindowSizeLimits win min'w min'h max'w max'h =
  c'glfwSetWindowSizeLimits (toC win) (toC min'w) (toC min'h)
                                      (toC max'w) (toC max'h)
setWindowAspectRatio :: Window -> Maybe (Int, Int) -> IO ()
setWindowAspectRatio win Nothing =
  c'glfwSetWindowAspectRatio (toC win) c'GLFW_DONT_CARE c'GLFW_DONT_CARE
setWindowAspectRatio win (Just (w, h)) =
  c'glfwSetWindowAspectRatio (toC win) (toC w) (toC h)
getFramebufferSize :: Window -> IO (Int, Int)
getFramebufferSize win =
    allocaArray 2 $ \p -> do
        let p'w = p
            p'h = p `advancePtr` 1
        c'glfwGetFramebufferSize (toC win) p'w p'h
        w <- fromC `fmap` peek p'w
        h <- fromC `fmap` peek p'h
        return (w, h)
setWindowIcon :: Window -> [Image] -> IO ()
setWindowIcon win [] = c'glfwSetWindowIcon (toC win) 0 nullPtr
setWindowIcon win imgs =
  let arrSizeBytes = length imgs * sizeOf (undefined :: C'GLFWimage)
      addNextImage :: [Image] -> Int -> Ptr C'GLFWimage -> IO ()
      addNextImage [] numImages ptr =
        c'glfwSetWindowIcon (toC win) (toC numImages) ptr
      addNextImage (img:rest) idx ptr =
        withGLFWImage img $ \p'img -> do
          c'img <- peek p'img
          pokeElemOff ptr idx c'img
          addNextImage rest (idx + 1) ptr
  in allocaBytes arrSizeBytes $ addNextImage imgs 0
iconifyWindow :: Window -> IO ()
iconifyWindow =
    c'glfwIconifyWindow . toC
restoreWindow :: Window -> IO ()
restoreWindow =
    c'glfwRestoreWindow . toC
focusWindow :: Window -> IO ()
focusWindow = c'glfwFocusWindow . toC
maximizeWindow :: Window -> IO ()
maximizeWindow = c'glfwMaximizeWindow . toC
showWindow :: Window -> IO ()
showWindow =
    c'glfwShowWindow . toC
hideWindow :: Window -> IO ()
hideWindow =
    c'glfwHideWindow . toC
getWindowMonitor :: Window -> IO (Maybe Monitor)
getWindowMonitor win = do
    p'mon <- c'glfwGetWindowMonitor (toC win)
    return $ if p'mon == nullPtr
      then Nothing
      else Just $ fromC p'mon
setCursorPos :: Window -> Double -> Double -> IO ()
setCursorPos win x y =
    c'glfwSetCursorPos (toC win) (toC x) (toC y)
setFullscreen :: Window -> Monitor -> VideoMode -> IO ()
setFullscreen win mon (VideoMode width height _ _ _ refresh) =
  c'glfwSetWindowMonitor (toC win) (toC mon) 0 0 (toC width) (toC height) (toC refresh)
setWindowed :: Window
            -> Int  
            -> Int  
            -> Int  
            -> Int  
            -> IO ()
setWindowed win width height x y =
  c'glfwSetWindowMonitor (toC win) nullPtr (toC x) (toC y) (toC width) (toC height) 0
getWindowFocused :: Window -> IO Bool
getWindowFocused win =
    fromC `fmap` c'glfwGetWindowAttrib (toC win) c'GLFW_FOCUSED
getWindowMaximized :: Window -> IO Bool
getWindowMaximized win =
    fromC `fmap` c'glfwGetWindowAttrib (toC win) c'GLFW_MAXIMIZED
getWindowFloating :: Window -> IO Bool
getWindowFloating win =
    fromC `fmap` c'glfwGetWindowAttrib (toC win) c'GLFW_FLOATING
getWindowIconified :: Window -> IO Bool
getWindowIconified win =
    fromC `fmap` c'glfwGetWindowAttrib (toC win) c'GLFW_ICONIFIED
getWindowResizable :: Window -> IO Bool
getWindowResizable win =
    fromC `fmap` c'glfwGetWindowAttrib (toC win) c'GLFW_RESIZABLE
getWindowDecorated :: Window -> IO Bool
getWindowDecorated win =
    fromC `fmap` c'glfwGetWindowAttrib (toC win) c'GLFW_DECORATED
getWindowVisible :: Window -> IO Bool
getWindowVisible win =
    fromC `fmap` c'glfwGetWindowAttrib (toC win) c'GLFW_VISIBLE
getWindowClientAPI :: Window -> IO ClientAPI
getWindowClientAPI win =
    fromC `fmap` c'glfwGetWindowAttrib (toC win) c'GLFW_CLIENT_API
getWindowContextCreationAPI :: Window -> IO ContextCreationAPI
getWindowContextCreationAPI win =
    fromC `fmap` c'glfwGetWindowAttrib (toC win) c'GLFW_CONTEXT_CREATION_API
getWindowContextVersionMajor :: Window -> IO Int
getWindowContextVersionMajor win =
    fromC `fmap` c'glfwGetWindowAttrib (toC win) c'GLFW_CONTEXT_VERSION_MAJOR
getWindowContextVersionMinor :: Window -> IO Int
getWindowContextVersionMinor win =
    fromC `fmap` c'glfwGetWindowAttrib (toC win) c'GLFW_CONTEXT_VERSION_MINOR
getWindowContextVersionRevision :: Window -> IO Int
getWindowContextVersionRevision win =
    fromC `fmap` c'glfwGetWindowAttrib (toC win) c'GLFW_CONTEXT_REVISION
getWindowContextRobustness :: Window -> IO ContextRobustness
getWindowContextRobustness win =
    fromC `fmap` c'glfwGetWindowAttrib (toC win) c'GLFW_CONTEXT_ROBUSTNESS
getWindowContextReleaseBehavior :: Window -> IO ContextReleaseBehavior
getWindowContextReleaseBehavior win =
    fromC `fmap` c'glfwGetWindowAttrib (toC win) c'GLFW_CONTEXT_RELEASE_BEHAVIOR
getWindowContextNoError :: Window -> IO Bool
getWindowContextNoError win =
    fromC `fmap` c'glfwGetWindowAttrib (toC win) c'GLFW_CONTEXT_NO_ERROR
getWindowOpenGLForwardCompat :: Window -> IO Bool
getWindowOpenGLForwardCompat win =
    fromC `fmap` c'glfwGetWindowAttrib (toC win) c'GLFW_OPENGL_FORWARD_COMPAT
getWindowOpenGLDebugContext :: Window -> IO Bool
getWindowOpenGLDebugContext win =
    fromC `fmap` c'glfwGetWindowAttrib (toC win) c'GLFW_OPENGL_DEBUG_CONTEXT
getWindowOpenGLProfile :: Window -> IO OpenGLProfile
getWindowOpenGLProfile win =
    fromC `fmap` c'glfwGetWindowAttrib (toC win) c'GLFW_OPENGL_PROFILE
setWindowPosCallback :: Window -> Maybe WindowPosCallback -> IO ()
setWindowPosCallback win = setWindowCallback
    mk'GLFWwindowposfun
    (\cb a0 a1 a2 ->
      schedule $ cb (fromC a0) (fromC a1) (fromC a2))
    (c'glfwSetWindowPosCallback (toC win))
    storedWindowPosFun
    win
setWindowSizeCallback :: Window -> Maybe WindowSizeCallback -> IO ()
setWindowSizeCallback win = setWindowCallback
    mk'GLFWwindowsizefun
    (\cb a0 a1 a2 ->
      schedule $ cb (fromC a0) (fromC a1) (fromC a2))
    (c'glfwSetWindowSizeCallback (toC win))
    storedWindowSizeFun
    win
setWindowCloseCallback :: Window -> Maybe WindowCloseCallback -> IO ()
setWindowCloseCallback win = setWindowCallback
    mk'GLFWwindowclosefun
    (. fromC)
    (c'glfwSetWindowCloseCallback (toC win))
    storedWindowCloseFun
    win
setWindowRefreshCallback :: Window -> Maybe WindowRefreshCallback -> IO ()
setWindowRefreshCallback win = setWindowCallback
    mk'GLFWwindowrefreshfun
    (. fromC)
    (c'glfwSetWindowRefreshCallback (toC win))
    storedWindowRefreshFun
    win
setWindowFocusCallback :: Window -> Maybe WindowFocusCallback -> IO ()
setWindowFocusCallback win = setWindowCallback
    mk'GLFWwindowfocusfun
    (\cb a0 a1 -> schedule $ cb (fromC a0) (fromC a1))
    (c'glfwSetWindowFocusCallback (toC win))
    storedWindowFocusFun
    win
setWindowIconifyCallback :: Window -> Maybe WindowIconifyCallback -> IO ()
setWindowIconifyCallback win = setWindowCallback
    mk'GLFWwindowiconifyfun
    (\cb a0 a1 -> schedule $ cb (fromC a0) (fromC a1))
    (c'glfwSetWindowIconifyCallback (toC win))
    storedWindowIconifyFun
    win
setFramebufferSizeCallback :: Window -> Maybe FramebufferSizeCallback -> IO ()
setFramebufferSizeCallback win = setWindowCallback
    mk'GLFWframebuffersizefun
    (\cb a0 a1 a2 -> schedule $ cb (fromC a0) (fromC a1) (fromC a2))
    (c'glfwSetFramebufferSizeCallback (toC win))
    storedFramebufferSizeFun
    win
pollEvents :: IO ()
pollEvents = c'glfwPollEvents >> executeScheduled
waitEvents :: IO ()
waitEvents = c'glfwWaitEvents >> executeScheduled
waitEventsTimeout :: Double -> IO ()
waitEventsTimeout seconds =
  c'glfwWaitEventsTimeout (toC seconds) >> executeScheduled
postEmptyEvent :: IO ()
postEmptyEvent = c'glfwPostEmptyEvent
getCursorInputMode :: Window -> IO CursorInputMode
getCursorInputMode win =
    fromC `fmap` c'glfwGetInputMode (toC win) c'GLFW_CURSOR
setCursorInputMode :: Window -> CursorInputMode -> IO ()
setCursorInputMode win c =
    c'glfwSetInputMode (toC win) c'GLFW_CURSOR (toC c)
getStickyKeysInputMode :: Window -> IO StickyKeysInputMode
getStickyKeysInputMode win =
    fromC `fmap` c'glfwGetInputMode (toC win) c'GLFW_STICKY_KEYS
setStickyKeysInputMode :: Window -> StickyKeysInputMode -> IO ()
setStickyKeysInputMode win sk =
    c'glfwSetInputMode (toC win) c'GLFW_STICKY_KEYS (toC sk)
getStickyMouseButtonsInputMode :: Window -> IO StickyMouseButtonsInputMode
getStickyMouseButtonsInputMode win =
    fromC `fmap` c'glfwGetInputMode (toC win) c'GLFW_STICKY_MOUSE_BUTTONS
setStickyMouseButtonsInputMode :: Window -> StickyMouseButtonsInputMode -> IO ()
setStickyMouseButtonsInputMode win smb =
    c'glfwSetInputMode (toC win) c'GLFW_STICKY_MOUSE_BUTTONS (toC smb)
getKey :: Window -> Key -> IO KeyState
getKey win k =
    fromC `fmap` c'glfwGetKey (toC win) (toC k)
getKeyName :: Key -> Int -> IO (Maybe String)
getKeyName k scancode = do
  cstr <- c'glfwGetKeyName (toC k) (toC scancode)
  if cstr == nullPtr
    then return Nothing
    else Just `fmap` peekCString cstr
getMouseButton :: Window -> MouseButton -> IO MouseButtonState
getMouseButton win b =
    fromC `fmap` c'glfwGetMouseButton (toC win) (toC b)
getCursorPos :: Window -> IO (Double, Double)
getCursorPos win =
    allocaArray 2 $ \p -> do
        let p'x = p
            p'y = p `advancePtr` 1
        c'glfwGetCursorPos (toC win) p'x p'y
        x <- fromC `fmap` peek p'x
        y <- fromC `fmap` peek p'y
        return (x, y)
setKeyCallback :: Window -> Maybe KeyCallback -> IO ()
setKeyCallback win = setWindowCallback
    mk'GLFWkeyfun
    (\cb a0 a1 a2 a3 a4 ->
      schedule $ cb (fromC a0) (fromC a1) (fromC a2) (fromC a3) (fromC a4))
    (c'glfwSetKeyCallback (toC win))
    storedKeyFun
    win
setCharCallback :: Window -> Maybe CharCallback -> IO ()
setCharCallback win = setWindowCallback
    mk'GLFWcharfun
    (\cb a0 a1 -> schedule $ cb (fromC a0) (fromC a1))
    (c'glfwSetCharCallback (toC win))
    storedCharFun
    win
setCharModsCallback :: Window -> Maybe CharModsCallback -> IO ()
setCharModsCallback win = setWindowCallback
    mk'GLFWcharmodsfun
    (\cb a0 a1 a2 -> schedule $ cb (fromC a0) (fromC a1) (fromC a2))
    (c'glfwSetCharModsCallback (toC win))
    storedCharModsFun
    win
setMouseButtonCallback :: Window -> Maybe MouseButtonCallback -> IO ()
setMouseButtonCallback win = setWindowCallback
    mk'GLFWmousebuttonfun
    (\cb a0 a1 a2 a3 -> schedule $ cb (fromC a0) (fromC a1) (fromC a2) (fromC a3))
    (c'glfwSetMouseButtonCallback (toC win))
    storedMouseButtonFun
    win
setCursorPosCallback :: Window -> Maybe CursorPosCallback -> IO ()
setCursorPosCallback win = setWindowCallback
    mk'GLFWcursorposfun
    (\cb a0 a1 a2 -> schedule $ cb (fromC a0) (fromC a1) (fromC a2))
    (c'glfwSetCursorPosCallback (toC win))
    storedCursorPosFun
    win
setCursorEnterCallback :: Window -> Maybe CursorEnterCallback -> IO ()
setCursorEnterCallback win = setWindowCallback
    mk'GLFWcursorenterfun
    (\cb a0 a1 -> schedule $ cb (fromC a0) (fromC a1))
    (c'glfwSetCursorEnterCallback (toC win))
    storedCursorEnterFun
    win
setScrollCallback :: Window -> Maybe ScrollCallback -> IO ()
setScrollCallback win = setWindowCallback
    mk'GLFWscrollfun
    (\cb a0 a1 a2 -> schedule $ cb (fromC a0) (fromC a1) (fromC a2))
    (c'glfwSetScrollCallback (toC win))
    storedScrollFun
    win
joystickPresent :: Joystick -> IO Bool
joystickPresent js =
    fromC `fmap` c'glfwJoystickPresent (toC js)
getJoystickAxes :: Joystick -> IO (Maybe [Double])
getJoystickAxes js =
    alloca $ \p'n -> do
        p'axes <- c'glfwGetJoystickAxes (toC js) p'n
        n <- fromC `fmap` peek p'n
        if p'axes == nullPtr || n <= 0
          then return Nothing
          else (Just . map fromC) `fmap` peekArray n p'axes
getJoystickButtons :: Joystick -> IO (Maybe [JoystickButtonState])
getJoystickButtons js =
    alloca $ \p'n -> do
        p'buttons <- c'glfwGetJoystickButtons (toC js) p'n
        n <- fromC `fmap` peek p'n
        if p'buttons == nullPtr || n <= 0
          then return Nothing
          else (Just . map fromC) `fmap` peekArray n p'buttons
getJoystickName :: Joystick -> IO (Maybe String)
getJoystickName js = do
    p'name <- c'glfwGetJoystickName (toC js)
    if p'name == nullPtr
      then return Nothing
      else Just `fmap` peekCString p'name
setJoystickCallback :: Maybe JoystickCallback -> IO ()
setJoystickCallback = setCallback
    mk'GLFWjoystickfun
    (\cb a0 a1 -> schedule $ cb (fromC a0) (fromC a1))
    c'glfwSetJoystickCallback
    storedJoystickFun
getTime :: IO (Maybe Double)
getTime = do
    t <- fromC `fmap` c'glfwGetTime
    return $ if t == 0
      then Nothing
      else Just t
setTime :: Double -> IO ()
setTime = c'glfwSetTime . toC
getTimerValue :: IO Word64
getTimerValue = c'glfwGetTimerValue
getTimerFrequency :: IO Word64
getTimerFrequency = c'glfwGetTimerFrequency
makeContextCurrent :: Maybe Window -> IO ()
makeContextCurrent =
    c'glfwMakeContextCurrent . maybe nullPtr toC
getCurrentContext :: IO (Maybe Window)
getCurrentContext = do
    p'win <- c'glfwGetCurrentContext
    return $ if p'win == nullPtr
      then Nothing
      else Just $ fromC p'win
swapBuffers :: Window -> IO ()
swapBuffers =
    c'glfwSwapBuffers . toC
swapInterval :: Int -> IO ()
swapInterval =
    c'glfwSwapInterval . toC
extensionSupported :: String -> IO Bool
extensionSupported ext =
    withCString ext $ \p'ext ->
      fromC `fmap` c'glfwExtensionSupported p'ext
setClipboardString :: Window -> String -> IO ()
setClipboardString win s =
    withCString s (c'glfwSetClipboardString (toC win))
getClipboardString :: Window -> IO (Maybe String)
getClipboardString win = do
    p's <- c'glfwGetClipboardString (toC win)
    if p's == nullPtr
      then return Nothing
      else Just `fmap` peekCString p's
createCursor :: Image 
             -> Int   
                      
             -> Int   
                      
             -> IO Cursor
createCursor img x y =
  withGLFWImage img $ \p'img ->
    Cursor `fmap` c'glfwCreateCursor p'img (toC x) (toC y)
createStandardCursor :: StandardCursorShape -> IO Cursor
createStandardCursor = (fmap Cursor) . c'glfwCreateStandardCursor . toC
setCursor :: Window -> Cursor -> IO ()
setCursor (Window wptr) (Cursor cptr) = c'glfwSetCursor wptr cptr
destroyCursor :: Cursor -> IO ()
destroyCursor = c'glfwDestroyCursor . unCursor
type DropCallback = Window    
                  -> [String] 
                  -> IO ()
setDropCallback :: Window -> Maybe DropCallback -> IO ()
setDropCallback win = setWindowCallback
    mk'GLFWdropfun
    (\cb w c fs -> do
        let count = fromC c
        fps <- flip mapM [0..count-1] $ \i -> do
            let p = advancePtr fs i
            p' <- peek p
            peekCString p'
        schedule $ cb (fromC w) fps)
    (c'glfwSetDropCallback (toC win))
    storedDropFun
    win
vulkanSupported :: IO Bool
vulkanSupported = (c'GLFW_TRUE ==) <$> c'glfwVulkanSupported
getRequiredInstanceExtensions :: IO [CString]
getRequiredInstanceExtensions = alloca $ \countPtr -> do
    extsPtrPtr <- c'glfwGetRequiredInstanceExtensions countPtr
    count <- fromIntegral <$> peek countPtr
    peekArray count extsPtrPtr
getInstanceProcAddress :: Ptr vkInstance
                          
                          
                          
                       -> String
                          
                       -> IO (FunPtr vkProc)
getInstanceProcAddress i procName
  = withCString procName (c'glfwGetInstanceProcAddress i)
getPhysicalDevicePresentationSupport ::
       Ptr vkInstance
       
    -> Ptr vkPhysicalDevice
       
    -> Word32
       
       
       
    -> IO Bool
getPhysicalDevicePresentationSupport inst dev i
  = (c'GLFW_TRUE ==) <$> c'glfwGetPhysicalDevicePresentationSupport inst dev i
createWindowSurface :: Enum vkResult
                    => Ptr vkInstance
                       
                    -> Window
                       
                    -> Ptr vkAllocationCallbacks
                       
                    -> Ptr vkSurfaceKHR
                       
                    -> IO vkResult
createWindowSurface i win acs s
  = toEnum . fromIntegral
  <$> c'glfwCreateWindowSurface i (toC win) acs s
getWin32Adapter :: Window -> IO CString
getWin32Adapter = c'glfwGetWin32Adapter . toC
getWin32Monitor :: Window -> IO CString
getWin32Monitor = c'glfwGetWin32Monitor . toC
getWin32Window  :: Window -> IO (Ptr ())
getWin32Window = c'glfwGetWin32Window . toC
getWGLContext :: Window -> IO (Ptr ())
getWGLContext = c'glfwGetWGLContext . toC
getCocoaMonitor :: Window -> IO (Ptr Word32)
getCocoaMonitor = c'glfwGetCocoaMonitor . toC
getCocoaWindow :: Window -> IO (Ptr ())
getCocoaWindow = c'glfwGetCocoaWindow . toC
getNSGLContext :: Window -> IO (Ptr ())
getNSGLContext = c'glfwGetNSGLContext . toC
getX11Display :: Window -> IO (Ptr display)
getX11Display = c'glfwGetX11Display . toC
getX11Adapter :: Window -> IO Word64
getX11Adapter = c'glfwGetX11Adapter . toC
getX11Monitor :: Window -> IO Word64
getX11Monitor = c'glfwGetX11Monitor . toC
getX11Window  :: Window -> IO Word64
getX11Window = c'glfwGetX11Window . toC
getGLXContext :: Window -> IO (Ptr ())
getGLXContext = c'glfwGetGLXContext . toC
getGLXWindow  :: Window -> IO Word64
getGLXWindow = c'glfwGetGLXWindow . toC
getWaylandDisplay :: IO (Ptr wl_display)
getWaylandDisplay = c'glfwGetWaylandDisplay
getWaylandMonitor :: Window -> IO (Ptr wl_output)
getWaylandMonitor = c'glfwGetWaylandMonitor . toC
getWaylandWindow :: Window -> IO (Ptr wl_surface)
getWaylandWindow = c'glfwGetWaylandWindow . toC
getMirDisplay :: IO (Ptr mir_connection)
getMirDisplay = c'glfwGetMirDisplay
getMirMonitor :: Window -> IO Int
getMirMonitor = (fmap fromC) . c'glfwGetMirMonitor . toC
getMirWindow :: Window -> IO (Ptr mir_surface)
getMirWindow = c'glfwGetMirWindow . toC
getEGLDisplay :: IO (Ptr ())
getEGLDisplay = c'glfwGetEGLDisplay
getEGLContext :: Window -> IO (Ptr ())
getEGLContext = c'glfwGetEGLContext . toC
getEGLSurface :: Window -> IO (Ptr ())
getEGLSurface = c'glfwGetEGLSurface . toC