{-# LANGUAGE ScopedTypeVariables #-}
{-|

Threading restrictions which apply to the C version of GLFW still apply when
writing @GLFW-b@ programs. See
<http://www.glfw.org/docs/3.3/intro.html#thread_safety GLFW thread safety documentation>
(applies here).

Current context restructions which apply to the C version of GLFW still apply.
See <http://www.glfw.org/docs/3.3/context.html#context_current  GLFW current context documentation>
(applies here).

@GLFW-b@ wraps callbacks and schedules them to be run after 'pollEvents' and
'waitEvents' in the normal GHC runtime where they aren't subject to the usual
GLFW reentrancy restrictions. See
<http://www.glfw.org/docs/3.3/intro.html#reentrancy GLFW reentrancy documentation>
(does not apply here).

-}
module Graphics.UI.GLFW
  ( -- * Error handling
    Error (..)
    --
  , setErrorCallback, ErrorCallback

    -- * Initialization and version information
  , Version (..)
    --
  , init
  , InitHint(..)
  , initHint
  , terminate
  , getVersion
  , getVersionString
  , getError
  , clearError
  , rawMouseMotionSupported

    -- * Monitor handling
  , Monitor
  , MonitorState (..)
  , VideoMode    (..)
  , GammaRamp    (gammaRampRed, gammaRampGreen, gammaRampBlue)
  , makeGammaRamp
    --
  , getMonitors
  , getPrimaryMonitor
  , getMonitorPos
  , getMonitorPhysicalSize
  , getMonitorContentScale
  , getMonitorWorkarea
  , getMonitorName
  , setMonitorCallback, MonitorCallback
  , getVideoModes
  , getVideoMode
  , setGamma
  , getGammaRamp
  , setGammaRamp

    -- * Window handling
  , Window
  , WindowHint             (..)
  , WindowAttrib           (..)
  , ContextRobustness      (..)
  , OpenGLProfile          (..)
  , ClientAPI              (..)
  , ContextCreationAPI     (..)
  , ContextReleaseBehavior (..)
    --
  , defaultWindowHints
  , windowHint
  , setWindowAttrib
  , getWindowAttrib
  , createWindow
  , destroyWindow
  , windowShouldClose
  , setWindowShouldClose
  , getWindowOpacity
  , setWindowOpacity
  , setWindowTitle
  , getWindowPos
  , setWindowPos
  , getWindowSize
  , setWindowSize
  , setWindowSizeLimits
  , setWindowAspectRatio
  , getWindowFrameSize
  , getWindowContentScale
  , getFramebufferSize
  , setWindowIcon
  , iconifyWindow
  , restoreWindow
  , focusWindow
  , maximizeWindow
  , showWindow
  , hideWindow
  , requestWindowAttention
  , getWindowMonitor
  , setCursorPos
  , setFullscreen
  , setWindowed
    -- related to c'glfwGetWindowAttrib --.
  , 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
  , setWindowContentScaleCallback, WindowContentScaleCallback
  , setWindowMaximizeCallback,     WindowMaximizeCallback
  , pollEvents
  , waitEvents
  , waitEventsTimeout
  , postEmptyEvent

    -- * Input handling
  , Key                         (..)
  , KeyState                    (..)
  , Joystick                    (..)
  , JoystickState               (..)
  , JoystickButtonState         (..)
  , MouseButton                 (..)
  , MouseButtonState            (..)
  , CursorState                 (..)
  , CursorInputMode             (..)
  , StickyKeysInputMode         (..)
  , StickyMouseButtonsInputMode (..)
  , ModifierKeys                (..)
  , GamepadButton               (..)
  , GamepadAxis                 (..)
  , GamepadButtonState          (..)
  , GamepadState                (..)
  , Image
  , mkImage
  , Cursor                      (..)
  , StandardCursorShape         (..)
    --
    -- related to c'glfwSetInputMode ----.
  , getCursorInputMode                -- |
  , setCursorInputMode                -- |
  , getRawMouseMotion                 -- |
  , setRawMouseMotion                 -- |
  , getStickyKeysInputMode            -- |
  , setStickyKeysInputMode            -- |
  , getStickyMouseButtonsInputMode    -- |
  , setStickyMouseButtonsInputMode  -----'
  , getKey
  , getKeyName
  , getKeyScancode
  , getMouseButton
  , getCursorPos
  , setKeyCallback,         KeyCallback
  , setCharCallback,        CharCallback
  , setCharModsCallback,    CharModsCallback
  , setMouseButtonCallback, MouseButtonCallback
  , setCursorPosCallback,   CursorPosCallback
  , setCursorEnterCallback, CursorEnterCallback
  , createCursor
  , createStandardCursor
  , setCursor
  , destroyCursor
  , setScrollCallback,      ScrollCallback
  , setDropCallback,        DropCallback
  , joystickPresent
  , joystickIsGamepad
  , getJoystickAxes
  , getJoystickButtons
  , getJoystickHats,        JoystickHatState(..)
  , getJoystickName
  , getJoystickGUID
  , setJoystickCallback,    JoystickCallback
  , getGamepadName
  , getGamepadState
  , updateGamepadMappings

    -- * Time
  , getTime
  , setTime
  , getTimerValue
  , getTimerFrequency

    -- * Context
  , makeContextCurrent
  , getCurrentContext
  , swapBuffers
  , swapInterval
  , extensionSupported

    -- * Clipboard
  , getClipboardString
  , setClipboardString

    -- * Vulkan-related functions
  , vulkanSupported
  , getRequiredInstanceExtensions
  , getInstanceProcAddress
  , getPhysicalDevicePresentationSupport
  , createWindowSurface

    -- * Native access functions
    -- $nativeaccess
  , getWin32Adapter
  , getWin32Monitor
  , getWin32Window
  , getWGLContext
  , getCocoaMonitor
  , getCocoaWindow
  , getNSGLContext
  , getX11Display
  , getX11Adapter
  , getX11Monitor
  , getX11Window
  , getX11SelectionString
  , setX11SelectionString
  , getGLXContext
  , getGLXWindow
  , getWaylandDisplay
  , getWaylandMonitor
  , getWaylandWindow
  , getEGLDisplay
  , getEGLContext
  , getEGLSurface
  , getOSMesaContext
  , getOSMesaColorBuffer,   OSMesaColorBuffer, OSMesaRGBA
  , getOSMesaDepthBuffer,   OSMesaDepthBuffer
  ) where

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

import Prelude hiding (init)

import Control.Monad         (when, liftM, forM)
import Data.Array.IArray     (Array, array)
import Data.Bits             (shiftR, shiftL, (.&.), (.|.))
import Data.IORef            (IORef, atomicModifyIORef, newIORef, readIORef)
import Data.List             (foldl')
import Data.Word             (Word8, Word16, Word32, Word64)
import Foreign.C.String      (peekCString, withCString, CString)
import Foreign.C.Types       (CUInt, CInt, CUShort, CFloat(..))
import Foreign.Marshal.Alloc (alloca, allocaBytes)
import Foreign.Marshal.Array (advancePtr, allocaArray, peekArray, withArray)
import Foreign.Ptr           ( FunPtr, freeHaskellFunPtr, nullFunPtr, nullPtr
                             , Ptr, castPtr, plusPtr)
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

--------------------------------------------------------------------------------
-- Helper functions

-- C to haskell float.
hFloat :: CFloat -> Float
hFloat :: CFloat -> Float
hFloat (CFloat Float
f) = Float
f

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

-- We store FunPtrs from mk'GLFW*fun in these stored*Fun IORefs. Initialized
-- with unsafePerformIO, they are basically mutable global variables.

storedErrorFun           :: IORef C'GLFWerrorfun
storedMonitorFun         :: IORef C'GLFWmonitorfun
storedJoystickFun        :: IORef C'GLFWjoystickfun

storedErrorFun :: IORef C'GLFWerrorfun
storedErrorFun           = IO (IORef C'GLFWerrorfun) -> IORef C'GLFWerrorfun
forall a. IO a -> a
unsafePerformIO (IO (IORef C'GLFWerrorfun) -> IORef C'GLFWerrorfun)
-> IO (IORef C'GLFWerrorfun) -> IORef C'GLFWerrorfun
forall a b. (a -> b) -> a -> b
$ C'GLFWerrorfun -> IO (IORef C'GLFWerrorfun)
forall a. a -> IO (IORef a)
newIORef C'GLFWerrorfun
forall a. FunPtr a
nullFunPtr
storedMonitorFun :: IORef C'GLFWmonitorfun
storedMonitorFun         = IO (IORef C'GLFWmonitorfun) -> IORef C'GLFWmonitorfun
forall a. IO a -> a
unsafePerformIO (IO (IORef C'GLFWmonitorfun) -> IORef C'GLFWmonitorfun)
-> IO (IORef C'GLFWmonitorfun) -> IORef C'GLFWmonitorfun
forall a b. (a -> b) -> a -> b
$ C'GLFWmonitorfun -> IO (IORef C'GLFWmonitorfun)
forall a. a -> IO (IORef a)
newIORef C'GLFWmonitorfun
forall a. FunPtr a
nullFunPtr
storedJoystickFun :: IORef C'GLFWjoystickfun
storedJoystickFun        = IO (IORef C'GLFWjoystickfun) -> IORef C'GLFWjoystickfun
forall a. IO a -> a
unsafePerformIO (IO (IORef C'GLFWjoystickfun) -> IORef C'GLFWjoystickfun)
-> IO (IORef C'GLFWjoystickfun) -> IORef C'GLFWjoystickfun
forall a b. (a -> b) -> a -> b
$ C'GLFWjoystickfun -> IO (IORef C'GLFWjoystickfun)
forall a. a -> IO (IORef a)
newIORef C'GLFWjoystickfun
forall a. FunPtr a
nullFunPtr

-- These NOINLINE pragmas are due to use of unsafePerformIO.
-- See http://hackage.haskell.org/packages/archive/base/latest/doc/html/System-IO-Unsafe.html#v:unsafePerformIO .

{-# NOINLINE storedErrorFun           #-}
{-# NOINLINE storedMonitorFun         #-}
{-# NOINLINE storedJoystickFun         #-}

setWindowCallback
  :: (c -> IO (FunPtr c))                    -- wf   wrapper function
  -> (h -> c)                                -- af   adapter function
  -> (FunPtr c -> IO (FunPtr c))             -- gf   c'glfwSet*Callback function
  -> (WindowCallbacks -> IORef (FunPtr c))   -- ior  accessor for storage location
  -> Window                                  -- win  window
  -> Maybe h                                 -- mcb  Haskell callback
  -> IO ()
setWindowCallback :: forall c h.
(c -> IO (FunPtr c))
-> (h -> c)
-> (FunPtr c -> IO (FunPtr c))
-> (WindowCallbacks -> IORef (FunPtr c))
-> Window
-> Maybe h
-> IO ()
setWindowCallback c -> IO (FunPtr c)
wr h -> c
af FunPtr c -> IO (FunPtr c)
gf WindowCallbacks -> IORef (FunPtr c)
ior Window
win Maybe h
mcb = do
    StablePtr WindowCallbacks
pcallbacks <- Ptr () -> StablePtr WindowCallbacks
forall a. Ptr () -> StablePtr a
castPtrToStablePtr (Ptr () -> StablePtr WindowCallbacks)
-> IO (Ptr ()) -> IO (StablePtr WindowCallbacks)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` Ptr C'GLFWwindow -> IO (Ptr ())
c'glfwGetWindowUserPointer (Window -> Ptr C'GLFWwindow
unWindow Window
win)
    WindowCallbacks
callbacks <- StablePtr WindowCallbacks -> IO WindowCallbacks
forall a. StablePtr a -> IO a
deRefStablePtr StablePtr WindowCallbacks
pcallbacks
    (c -> IO (FunPtr c))
-> (h -> c)
-> (FunPtr c -> IO (FunPtr c))
-> IORef (FunPtr c)
-> Maybe h
-> IO ()
forall c h.
(c -> IO (FunPtr c))
-> (h -> c)
-> (FunPtr c -> IO (FunPtr c))
-> IORef (FunPtr c)
-> Maybe h
-> IO ()
setCallback c -> IO (FunPtr c)
wr h -> c
af FunPtr c -> IO (FunPtr c)
gf (WindowCallbacks -> IORef (FunPtr c)
ior WindowCallbacks
callbacks) Maybe h
mcb

setCallback
  :: (c -> IO (FunPtr c))          -- wf   wrapper function
  -> (h -> c)                      -- af   adapter function
  -> (FunPtr c -> IO (FunPtr c))   -- gf   c'glfwSet*Callback function
  -> IORef (FunPtr c)              -- ior  storage location
  -> Maybe h                       -- mcb  Haskell callback
  -> IO ()
setCallback :: forall c h.
(c -> IO (FunPtr c))
-> (h -> c)
-> (FunPtr c -> IO (FunPtr c))
-> IORef (FunPtr c)
-> Maybe h
-> IO ()
setCallback c -> IO (FunPtr c)
wf h -> c
af FunPtr c -> IO (FunPtr c)
gf IORef (FunPtr c)
ior Maybe h
mcb = do
    -- If mcb is Just, make ccb the FunPtr of the adapted callback. Otherwise a
    -- null FunPtr.
    FunPtr c
ccb <- IO (FunPtr c) -> (h -> IO (FunPtr c)) -> Maybe h -> IO (FunPtr c)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (FunPtr c -> IO (FunPtr c)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr c
forall a. FunPtr a
nullFunPtr) (c -> IO (FunPtr c)
wf (c -> IO (FunPtr c)) -> (h -> c) -> h -> IO (FunPtr c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. h -> c
af) Maybe h
mcb
    -- Call the GLFW callback-setting function.
    FunPtr c
_ <- FunPtr c -> IO (FunPtr c)
gf FunPtr c
ccb
    -- Store it.
    IORef (FunPtr c) -> FunPtr c -> IO ()
forall a. IORef (FunPtr a) -> FunPtr a -> IO ()
storeCallback IORef (FunPtr c)
ior FunPtr c
ccb

storeCallback :: IORef (FunPtr a) -> FunPtr a -> IO ()
storeCallback :: forall a. IORef (FunPtr a) -> FunPtr a -> IO ()
storeCallback IORef (FunPtr a)
ior FunPtr a
new = do
    -- Store the new FunPtr, retrieve the previous one.
    FunPtr a
prev <- IORef (FunPtr a)
-> (FunPtr a -> (FunPtr a, FunPtr a)) -> IO (FunPtr a)
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef IORef (FunPtr a)
ior (\FunPtr a
cur -> (FunPtr a
new, FunPtr a
cur))
    -- Free the old FunPtr if necessary.
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (FunPtr a
prev FunPtr a -> FunPtr a -> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr a
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FunPtr a -> IO ()
forall a. FunPtr a -> IO ()
freeHaskellFunPtr FunPtr a
prev

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

-- | The error code and also a human-readable error message.
type ErrorCallback              = Error -> String                                           -> IO ()
-- | Fires when the window position changes.
type WindowPosCallback          = Window -> Int -> Int                                      -> IO ()
-- | Fires when the window is resized (in Screen Coordinates, which might not map 1:1 with pixels).
type WindowSizeCallback         = Window -> Int -> Int                                      -> IO ()
-- | Fires when the user is attempting to close the window
type WindowCloseCallback        = Window                                                    -> IO ()
-- | Fires when the contents of the window are damaged and they must be refreshed.
type WindowRefreshCallback      = Window                                                    -> IO ()
-- | Fires when the window gains or loses input focus.
type WindowFocusCallback        = Window -> Bool                                            -> IO ()
-- | Fires when the window is iconified (minimized) or not.
type WindowIconifyCallback      = Window -> Bool                                            -> IO ()
-- | Fires when the size of the framebuffer for the window changes (in Pixels).
type FramebufferSizeCallback    = Window -> Int -> Int                                      -> IO ()
-- | Fires whenever a mouse button is clicked.
type MouseButtonCallback        = Window -> MouseButton -> MouseButtonState -> ModifierKeys -> IO ()
-- | Fires every time the cursor position changes. Sub-pixel accuracy is used, when available.
type CursorPosCallback          = Window -> Double -> Double                                -> IO ()
-- | Fires when the cursor enters or exits the client area of the window.
type CursorEnterCallback        = Window -> CursorState                                     -> IO ()
-- | Fires when the user scrolls the mouse wheel or via touch gesture.
type ScrollCallback             = Window -> Double -> Double                                -> IO ()
-- | Fires for each press or repeat of keyboard keys (regardless of if it has textual meaning or not, eg Shift)
type KeyCallback                = Window -> Key -> Int -> KeyState -> ModifierKeys          -> IO ()
-- | Fires when a complete character codepoint is typed by the user, Shift then "b" generates "B".
type CharCallback               = Window -> Char                                            -> IO ()
-- | Similar to 'CharCallback', fires when a complete unicode codepoint is typed by the user.
type CharModsCallback           = Window -> Char -> ModifierKeys                            -> IO ()
-- | Fires when a monitor is connected or disconnected.
type MonitorCallback            = Monitor -> MonitorState                                   -> IO ()
-- | Fires when a joystick is connected or disconnected.
type JoystickCallback           = Joystick -> JoystickState                                 -> IO ()
-- | Fires when a window is rescaled
type WindowContentScaleCallback = Window -> Float -> Float                                  -> IO ()
-- | Fires when a window is maximized or restored. Returns True if the window
-- was maximized and False if the window was restored.
type WindowMaximizeCallback = Window -> Bool                                                -> IO ()
--------------------------------------------------------------------------------
-- CB scheduling

data ScheduledCallbacks = ScheduledCallbacks
  { ScheduledCallbacks -> [IO ()]
_forward :: [IO ()] -- Execution iterates this list
  , ScheduledCallbacks -> [IO ()]
_backward :: [IO ()] -- New schedules prepend here
  }

storedScheduledCallbacks :: IORef ScheduledCallbacks
storedScheduledCallbacks :: IORef ScheduledCallbacks
storedScheduledCallbacks = IO (IORef ScheduledCallbacks) -> IORef ScheduledCallbacks
forall a. IO a -> a
unsafePerformIO (IO (IORef ScheduledCallbacks) -> IORef ScheduledCallbacks)
-> (ScheduledCallbacks -> IO (IORef ScheduledCallbacks))
-> ScheduledCallbacks
-> IORef ScheduledCallbacks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScheduledCallbacks -> IO (IORef ScheduledCallbacks)
forall a. a -> IO (IORef a)
newIORef (ScheduledCallbacks -> IORef ScheduledCallbacks)
-> ScheduledCallbacks -> IORef ScheduledCallbacks
forall a b. (a -> b) -> a -> b
$ [IO ()] -> [IO ()] -> ScheduledCallbacks
ScheduledCallbacks [] []

-- This NOINLINE pragma is due to use of unsafePerformIO.
-- See http://hackage.haskell.org/packages/archive/base/latest/doc/html/System-IO-Unsafe.html#v:unsafePerformIO .

{-# NOINLINE storedScheduledCallbacks #-}

-- This is provided in newer "base" versions. To avoid depending on
-- it, it's reimplemented here. Should remove if/when compatibility
-- with older base is not an issue:
atomicModifyIORef' :: IORef a -> (a -> (a,b)) -> IO b
atomicModifyIORef' :: forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef a
ref a -> (a, b)
f = do
    b
b <- IORef a -> (a -> (a, b)) -> IO b
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef IORef a
ref
            (\a
x -> let (a
a, b
b) = a -> (a, b)
f a
x
                    in (a
a, a
a a -> b -> b
forall a b. a -> b -> b
`seq` b
b))
    b
b b -> IO b -> IO b
forall a b. a -> b -> b
`seq` b -> IO b
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return b
b

schedule :: IO () -> IO ()
schedule :: IO () -> IO ()
schedule IO ()
act =
  IORef ScheduledCallbacks
-> (ScheduledCallbacks -> (ScheduledCallbacks, ())) -> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef ScheduledCallbacks
storedScheduledCallbacks ((ScheduledCallbacks -> (ScheduledCallbacks, ())) -> IO ())
-> (ScheduledCallbacks -> (ScheduledCallbacks, ())) -> IO ()
forall a b. (a -> b) -> a -> b
$
  \(ScheduledCallbacks [IO ()]
oldForward [IO ()]
oldBackward) ->
  ([IO ()] -> [IO ()] -> ScheduledCallbacks
ScheduledCallbacks [IO ()]
oldForward (IO ()
act IO () -> [IO ()] -> [IO ()]
forall a. a -> [a] -> [a]
: [IO ()]
oldBackward), ())

splitFirst :: [a] -> (Maybe a, [a])
splitFirst :: forall a. [a] -> (Maybe a, [a])
splitFirst [] = (Maybe a
forall a. Maybe a
Nothing, [])
splitFirst (a
x:[a]
xs) = (a -> Maybe a
forall a. a -> Maybe a
Just a
x, [a]
xs)

getNextScheduled :: IO (Maybe (IO ()))
getNextScheduled :: IO (Maybe (IO ()))
getNextScheduled =
  IORef ScheduledCallbacks
-> (ScheduledCallbacks -> (ScheduledCallbacks, Maybe (IO ())))
-> IO (Maybe (IO ()))
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef IORef ScheduledCallbacks
storedScheduledCallbacks ((ScheduledCallbacks -> (ScheduledCallbacks, Maybe (IO ())))
 -> IO (Maybe (IO ())))
-> (ScheduledCallbacks -> (ScheduledCallbacks, Maybe (IO ())))
-> IO (Maybe (IO ()))
forall a b. (a -> b) -> a -> b
$
  \(ScheduledCallbacks [IO ()]
oldForward [IO ()]
oldBackward) ->
  case [IO ()]
oldForward of
    [] ->
      let (Maybe (IO ())
mCb, [IO ()]
newForward) = [IO ()] -> (Maybe (IO ()), [IO ()])
forall a. [a] -> (Maybe a, [a])
splitFirst ([IO ()] -> [IO ()]
forall a. [a] -> [a]
reverse [IO ()]
oldBackward)
      in ([IO ()] -> [IO ()] -> ScheduledCallbacks
ScheduledCallbacks [IO ()]
newForward [], Maybe (IO ())
mCb)
    (IO ()
cb:[IO ()]
rest) ->                -- Eat forward first
      ([IO ()] -> [IO ()] -> ScheduledCallbacks
ScheduledCallbacks [IO ()]
rest [IO ()]
oldBackward, IO () -> Maybe (IO ())
forall a. a -> Maybe a
Just IO ()
cb)

executeScheduled :: IO ()
executeScheduled :: IO ()
executeScheduled = do
  Maybe (IO ())
mcb <- IO (Maybe (IO ()))
getNextScheduled
  case Maybe (IO ())
mcb of
    Maybe (IO ())
Nothing -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Just IO ()
cb -> IO ()
cb IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
executeScheduled

--------------------------------------------------------------------------------
-- Error handling

-- | Can (and probably should) be used before GLFW initialization.
-- See <http://www.glfw.org/docs/3.3/group__init.html#gaa5d796c3cf7c1a7f02f845486333fb5f glfwSetErrorCallback>
setErrorCallback :: Maybe ErrorCallback -> IO ()
setErrorCallback :: Maybe ErrorCallback -> IO ()
setErrorCallback = ((CInt -> CString -> IO ()) -> IO C'GLFWerrorfun)
-> (ErrorCallback -> CInt -> CString -> IO ())
-> (C'GLFWerrorfun -> IO C'GLFWerrorfun)
-> IORef C'GLFWerrorfun
-> Maybe ErrorCallback
-> IO ()
forall c h.
(c -> IO (FunPtr c))
-> (h -> c)
-> (FunPtr c -> IO (FunPtr c))
-> IORef (FunPtr c)
-> Maybe h
-> IO ()
setCallback
    (CInt -> CString -> IO ()) -> IO C'GLFWerrorfun
mk'GLFWerrorfun
    (\ErrorCallback
cb CInt
a0 CString
a1 -> do
        String
s <- CString -> IO String
peekCString CString
a1
        IO () -> IO ()
schedule (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ ErrorCallback
cb (CInt -> Error
forall c h. C c h => c -> h
fromC CInt
a0) String
s)
    C'GLFWerrorfun -> IO C'GLFWerrorfun
c'glfwSetErrorCallback
    IORef C'GLFWerrorfun
storedErrorFun

--------------------------------------------------------------------------------
-- Image utility functions

withGLFWImage :: Image -> (Ptr C'GLFWimage -> IO a) -> IO a
withGLFWImage :: forall a. Image -> (Ptr C'GLFWimage -> IO a) -> IO a
withGLFWImage (Image Int
w Int
h [CUChar]
pxs) Ptr C'GLFWimage -> IO a
f =
  (Ptr C'GLFWimage -> IO a) -> IO a
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca        ((Ptr C'GLFWimage -> IO a) -> IO a)
-> (Ptr C'GLFWimage -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Ptr C'GLFWimage
p'img ->
  [CUChar] -> (Ptr CUChar -> IO a) -> IO a
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [CUChar]
pxs ((Ptr CUChar -> IO a) -> IO a) -> (Ptr CUChar -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Ptr CUChar
p'pxs -> do
    Ptr C'GLFWimage -> C'GLFWimage -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr C'GLFWimage
p'img (C'GLFWimage -> IO ()) -> C'GLFWimage -> IO ()
forall a b. (a -> b) -> a -> b
$ CInt -> CInt -> Ptr CUChar -> C'GLFWimage
C'GLFWimage (Int -> CInt
forall c h. C c h => h -> c
toC Int
w) (Int -> CInt
forall c h. C c h => h -> c
toC Int
h) Ptr CUChar
p'pxs
    Ptr C'GLFWimage -> IO a
f Ptr C'GLFWimage
p'img

--------------------------------------------------------------------------------
-- Initialization and version information

-- | Attempts to initialize the GLFW library. When the library is not initialized, the only
-- allowed functions to call are 'getVersion', 'getVersionString', 'setErrorCallback',
-- 'init', and 'terminate'. Returns if the initialization was successful or not.
-- See <http://www.glfw.org/docs/3.3/group__init.html#ga317aac130a235ab08c6db0834907d85e glfwInit>
-- and <http://www.glfw.org/docs/3.3/intro.html#intro_init Initialization and Termination>
init :: IO Bool
init :: IO Bool
init = CInt -> Bool
forall c h. C c h => c -> h
fromC (CInt -> Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` IO CInt
c'glfwInit

-- | This function sets hints for the next initialization of GLFW. See
-- <https://www.glfw.org/docs/3.3/group__init.html#ga110fd1d3f0412822b4f1908c026f724a glfwInitHint>
initHint :: InitHint -> Bool -> IO ()
initHint :: InitHint -> Bool -> IO ()
initHint InitHint
hint Bool
val = CInt -> CInt -> IO ()
c'glfwInitHint (InitHint -> CInt
forall c h. C c h => h -> c
toC InitHint
hint) (Bool -> CInt
forall c h. C c h => h -> c
toC Bool
val)

-- | Cleans up GLFW and puts the library into an uninitialized state.
-- Once you call this, you must initilize the library again.
-- Warning: No window's context may be current in another thread when this is called.
-- See <http://www.glfw.org/docs/3.3/group__init.html#gaaae48c0a18607ea4a4ba951d939f0901 glfwTerminate>
-- and <http://www.glfw.org/docs/3.3/intro.html#intro_init Initialization and Termination>. This
-- function is not <https://www.glfw.org/docs/latest/intro.html#reentrancy reentrant>.
terminate :: IO ()
terminate :: IO ()
terminate = do
    IO ()
c'glfwTerminate
    -- Free all stored FunPtrs.
    IORef C'GLFWerrorfun -> C'GLFWerrorfun -> IO ()
forall a. IORef (FunPtr a) -> FunPtr a -> IO ()
storeCallback IORef C'GLFWerrorfun
storedErrorFun           C'GLFWerrorfun
forall a. FunPtr a
nullFunPtr
    IORef C'GLFWmonitorfun -> C'GLFWmonitorfun -> IO ()
forall a. IORef (FunPtr a) -> FunPtr a -> IO ()
storeCallback IORef C'GLFWmonitorfun
storedMonitorFun         C'GLFWmonitorfun
forall a. FunPtr a
nullFunPtr
    IORef C'GLFWjoystickfun -> C'GLFWjoystickfun -> IO ()
forall a. IORef (FunPtr a) -> FunPtr a -> IO ()
storeCallback IORef C'GLFWjoystickfun
storedJoystickFun         C'GLFWjoystickfun
forall a. FunPtr a
nullFunPtr

-- | Gets the version of the GLFW library that's being used with the current program.
-- See <http://www.glfw.org/docs/3.3/group__init.html#ga9f8ffaacf3c269cc48eafbf8b9b71197 glfwGetVersion>
getVersion :: IO Version
getVersion :: IO Version
getVersion =
    Int -> (Ptr CInt -> IO Version) -> IO Version
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
3 ((Ptr CInt -> IO Version) -> IO Version)
-> (Ptr CInt -> IO Version) -> IO Version
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
p -> do
        let p0 :: Ptr CInt
p0 = Ptr CInt
p
            p1 :: Ptr CInt
p1 = Ptr CInt
p Ptr CInt -> Int -> Ptr CInt
forall a. Storable a => Ptr a -> Int -> Ptr a
`advancePtr` Int
1
            p2 :: Ptr CInt
p2 = Ptr CInt
p Ptr CInt -> Int -> Ptr CInt
forall a. Storable a => Ptr a -> Int -> Ptr a
`advancePtr` Int
2
        Ptr CInt -> Ptr CInt -> Ptr CInt -> IO ()
c'glfwGetVersion Ptr CInt
p0 Ptr CInt
p1 Ptr CInt
p2
        Int
v0 <- CInt -> Int
forall c h. C c h => c -> h
fromC (CInt -> Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
p0
        Int
v1 <- CInt -> Int
forall c h. C c h => c -> h
fromC (CInt -> Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
p1
        Int
v2 <- CInt -> Int
forall c h. C c h => c -> h
fromC (CInt -> Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
p2
        Version -> IO Version
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Version -> IO Version) -> Version -> IO Version
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int -> Version
Version Int
v0 Int
v1 Int
v2

-- | Gets the compile-time version string of the GLFW library binary.
-- Gives extra info like platform and compile time options used, but you should not
-- attempt to parse this to get the GLFW version number. Use 'getVersion' instead.
-- See <http://www.glfw.org/docs/3.3/group__init.html#ga23d47dc013fce2bf58036da66079a657 glfwGetVersionString>
getVersionString :: IO (Maybe String)
getVersionString :: IO (Maybe String)
getVersionString = do
    CString
p'vs <- IO CString
c'glfwGetVersionString
    if CString
p'vs CString -> CString -> Bool
forall a. Eq a => a -> a -> Bool
/= CString
forall a. Ptr a
nullPtr
      then String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> IO String -> IO (Maybe String)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` CString -> IO String
peekCString CString
p'vs
      else Maybe String -> IO (Maybe String)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing

-- | Returns and clears the error code of the last error that occurred on the
-- calling thread and a UTF-8 encoded human-readable description of it.  If no
-- error has occurred since the last call, it returns Nothing.
getError :: IO (Maybe (Error, String))
getError :: IO (Maybe (Error, String))
getError = (Ptr CString -> IO (Maybe (Error, String)))
-> IO (Maybe (Error, String))
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CString -> IO (Maybe (Error, String)))
 -> IO (Maybe (Error, String)))
-> (Ptr CString -> IO (Maybe (Error, String)))
-> IO (Maybe (Error, String))
forall a b. (a -> b) -> a -> b
$ \Ptr CString
errStr -> do
  CInt
err <- Ptr CString -> IO CInt
c'glfwGetError Ptr CString
errStr
  if CInt
err CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_NO_ERROR
    then Maybe (Error, String) -> IO (Maybe (Error, String))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Error, String)
forall a. Maybe a
Nothing
    else Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek Ptr CString
errStr
         IO CString -> (CString -> IO String) -> IO String
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CString -> IO String
peekCString
         IO String
-> (String -> IO (Maybe (Error, String)))
-> IO (Maybe (Error, String))
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\String
s -> Maybe (Error, String) -> IO (Maybe (Error, String))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Error, String) -> IO (Maybe (Error, String)))
-> Maybe (Error, String) -> IO (Maybe (Error, String))
forall a b. (a -> b) -> a -> b
$ (Error, String) -> Maybe (Error, String)
forall a. a -> Maybe a
Just (CInt -> Error
forall c h. C c h => c -> h
fromC CInt
err, String
s))

-- | Clears the last error as would be retreived by 'getError'.
clearError :: IO ()
clearError :: IO ()
clearError = Ptr CString -> IO CInt
c'glfwGetError Ptr CString
forall a. Ptr a
nullPtr IO CInt -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | Returns true if raw mouse motion is supported on the current system.
-- See <https://www.glfw.org/docs/3.3/group__input.html#gae4ee0dbd0d256183e1ea4026d897e1c2 glfwRawMouseMotionSupported>
rawMouseMotionSupported :: IO Bool
rawMouseMotionSupported :: IO Bool
rawMouseMotionSupported = CInt -> Bool
forall c h. C c h => c -> h
fromC (CInt -> Bool) -> IO CInt -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO CInt
c'glfwRawMouseMotionSupported

--------------------------------------------------------------------------------
-- Monitor handling

-- | Gets the list of available monitors, if possible.
-- See <http://www.glfw.org/docs/3.3/group__monitor.html#ga3fba51c8bd36491d4712aa5bd074a537 glfwGetMonitors>
getMonitors :: IO (Maybe [Monitor])
getMonitors :: IO (Maybe [Monitor])
getMonitors =
    (Ptr CInt -> IO (Maybe [Monitor])) -> IO (Maybe [Monitor])
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Maybe [Monitor])) -> IO (Maybe [Monitor]))
-> (Ptr CInt -> IO (Maybe [Monitor])) -> IO (Maybe [Monitor])
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
p'n -> do
        Ptr (Ptr C'GLFWmonitor)
p'mon <- Ptr CInt -> IO (Ptr (Ptr C'GLFWmonitor))
c'glfwGetMonitors Ptr CInt
p'n
        Int
n <- CInt -> Int
forall c h. C c h => c -> h
fromC (CInt -> Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
p'n
        if Ptr (Ptr C'GLFWmonitor)
p'mon Ptr (Ptr C'GLFWmonitor) -> Ptr (Ptr C'GLFWmonitor) -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr (Ptr C'GLFWmonitor)
forall a. Ptr a
nullPtr Bool -> Bool -> Bool
|| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0
          then Maybe [Monitor] -> IO (Maybe [Monitor])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [Monitor]
forall a. Maybe a
Nothing
          else ([Monitor] -> Maybe [Monitor]
forall a. a -> Maybe a
Just ([Monitor] -> Maybe [Monitor])
-> ([Ptr C'GLFWmonitor] -> [Monitor])
-> [Ptr C'GLFWmonitor]
-> Maybe [Monitor]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Ptr C'GLFWmonitor -> Monitor) -> [Ptr C'GLFWmonitor] -> [Monitor]
forall a b. (a -> b) -> [a] -> [b]
map Ptr C'GLFWmonitor -> Monitor
forall c h. C c h => c -> h
fromC) ([Ptr C'GLFWmonitor] -> Maybe [Monitor])
-> IO [Ptr C'GLFWmonitor] -> IO (Maybe [Monitor])
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Int -> Ptr (Ptr C'GLFWmonitor) -> IO [Ptr C'GLFWmonitor]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
n Ptr (Ptr C'GLFWmonitor)
p'mon

-- | Gets the primary monitor.
-- See <http://www.glfw.org/docs/3.3/group__monitor.html#ga721867d84c6d18d6790d64d2847ca0b1 glfwGetPrimaryMonitor>
getPrimaryMonitor :: IO (Maybe Monitor)
getPrimaryMonitor :: IO (Maybe Monitor)
getPrimaryMonitor = do
    Ptr C'GLFWmonitor
p'mon <- IO (Ptr C'GLFWmonitor)
c'glfwGetPrimaryMonitor
    Maybe Monitor -> IO (Maybe Monitor)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Monitor -> IO (Maybe Monitor))
-> Maybe Monitor -> IO (Maybe Monitor)
forall a b. (a -> b) -> a -> b
$
      if Ptr C'GLFWmonitor
p'mon Ptr C'GLFWmonitor -> Ptr C'GLFWmonitor -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr C'GLFWmonitor
forall a. Ptr a
nullPtr
        then Maybe Monitor
forall a. Maybe a
Nothing
        else Monitor -> Maybe Monitor
forall a. a -> Maybe a
Just (Monitor -> Maybe Monitor) -> Monitor -> Maybe Monitor
forall a b. (a -> b) -> a -> b
$ Ptr C'GLFWmonitor -> Monitor
forall c h. C c h => c -> h
fromC Ptr C'GLFWmonitor
p'mon

-- | Gets the position of the specified monitor within the coordinate space.
-- See <http://www.glfw.org/docs/3.3/group__monitor.html#ga102f54e7acc9149edbcf0997152df8c9 glfwGetMonitorPos>
getMonitorPos :: Monitor -> IO (Int, Int)
getMonitorPos :: Monitor -> IO (Int, Int)
getMonitorPos Monitor
mon =
    Int -> (Ptr CInt -> IO (Int, Int)) -> IO (Int, Int)
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
2 ((Ptr CInt -> IO (Int, Int)) -> IO (Int, Int))
-> (Ptr CInt -> IO (Int, Int)) -> IO (Int, Int)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
p -> do
        let p'x :: Ptr CInt
p'x = Ptr CInt
p
            p'y :: Ptr CInt
p'y = Ptr CInt
p Ptr CInt -> Int -> Ptr CInt
forall a. Storable a => Ptr a -> Int -> Ptr a
`advancePtr` Int
1
        Ptr C'GLFWmonitor -> Ptr CInt -> Ptr CInt -> IO ()
c'glfwGetMonitorPos (Monitor -> Ptr C'GLFWmonitor
forall c h. C c h => h -> c
toC Monitor
mon) Ptr CInt
p'x Ptr CInt
p'y
        Int
x <- CInt -> Int
forall c h. C c h => c -> h
fromC (CInt -> Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
p'x
        Int
y <- CInt -> Int
forall c h. C c h => c -> h
fromC (CInt -> Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
p'y
        (Int, Int) -> IO (Int, Int)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
x, Int
y)

-- | The physical width and height of the monitor.
-- See <http://www.glfw.org/docs/3.3/group__monitor.html#ga7d8bffc6c55539286a6bd20d32a8d7ea glfwGetMonitorPhysicalSize>
getMonitorPhysicalSize :: Monitor -> IO (Int, Int)
getMonitorPhysicalSize :: Monitor -> IO (Int, Int)
getMonitorPhysicalSize Monitor
mon =
    Int -> (Ptr CInt -> IO (Int, Int)) -> IO (Int, Int)
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
2 ((Ptr CInt -> IO (Int, Int)) -> IO (Int, Int))
-> (Ptr CInt -> IO (Int, Int)) -> IO (Int, Int)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
p -> do
        let p'w :: Ptr CInt
p'w = Ptr CInt
p
            p'h :: Ptr CInt
p'h = Ptr CInt
p Ptr CInt -> Int -> Ptr CInt
forall a. Storable a => Ptr a -> Int -> Ptr a
`advancePtr` Int
1
        Ptr C'GLFWmonitor -> Ptr CInt -> Ptr CInt -> IO ()
c'glfwGetMonitorPhysicalSize (Monitor -> Ptr C'GLFWmonitor
forall c h. C c h => h -> c
toC Monitor
mon) Ptr CInt
p'w Ptr CInt
p'h
        Int
w <- CInt -> Int
forall c h. C c h => c -> h
fromC (CInt -> Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
p'w
        Int
h <- CInt -> Int
forall c h. C c h => c -> h
fromC (CInt -> Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
p'h
        (Int, Int) -> IO (Int, Int)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
w, Int
h)

-- | A human-readable name for the monitor specified.
-- See <http://www.glfw.org/docs/3.3/group__monitor.html#ga79a34ee22ff080ca954a9663e4679daf getMonitorName>
getMonitorName :: Monitor -> IO (Maybe String)
getMonitorName :: Monitor -> IO (Maybe String)
getMonitorName Monitor
mon = do
    CString
p'name <- Ptr C'GLFWmonitor -> IO CString
c'glfwGetMonitorName (Monitor -> Ptr C'GLFWmonitor
forall c h. C c h => h -> c
toC Monitor
mon)
    if CString
p'name CString -> CString -> Bool
forall a. Eq a => a -> a -> Bool
== CString
forall a. Ptr a
nullPtr
      then Maybe String -> IO (Maybe String)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing
      else String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> IO String -> IO (Maybe String)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` CString -> IO String
peekCString CString
p'name

-- | Sets a callback for when a monitor is connected or disconnected.
-- See <http://www.glfw.org/docs/3.3/group__monitor.html#gac3fe0f647f68b731f99756cd81897378 glfwSetMonitorCallback>
setMonitorCallback :: Maybe MonitorCallback -> IO ()
setMonitorCallback :: Maybe MonitorCallback -> IO ()
setMonitorCallback = ((Ptr C'GLFWmonitor -> CInt -> IO ()) -> IO C'GLFWmonitorfun)
-> (MonitorCallback -> Ptr C'GLFWmonitor -> CInt -> IO ())
-> (C'GLFWmonitorfun -> IO C'GLFWmonitorfun)
-> IORef C'GLFWmonitorfun
-> Maybe MonitorCallback
-> IO ()
forall c h.
(c -> IO (FunPtr c))
-> (h -> c)
-> (FunPtr c -> IO (FunPtr c))
-> IORef (FunPtr c)
-> Maybe h
-> IO ()
setCallback
    (Ptr C'GLFWmonitor -> CInt -> IO ()) -> IO C'GLFWmonitorfun
mk'GLFWmonitorfun
    (\MonitorCallback
cb Ptr C'GLFWmonitor
a0 CInt
a1 -> IO () -> IO ()
schedule (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ MonitorCallback
cb (Ptr C'GLFWmonitor -> Monitor
forall c h. C c h => c -> h
fromC Ptr C'GLFWmonitor
a0) (CInt -> MonitorState
forall c h. C c h => c -> h
fromC CInt
a1))
    C'GLFWmonitorfun -> IO C'GLFWmonitorfun
c'glfwSetMonitorCallback
    IORef C'GLFWmonitorfun
storedMonitorFun

-- | Obtains the possible video modes of the monitor.
-- See <http://www.glfw.org/docs/3.3/group__monitor.html#ga820b0ce9a5237d645ea7cbb4bd383458 glfwGetVideoModes>
getVideoModes :: Monitor -> IO (Maybe [VideoMode])
getVideoModes :: Monitor -> IO (Maybe [VideoMode])
getVideoModes Monitor
mon =
    (Ptr CInt -> IO (Maybe [VideoMode])) -> IO (Maybe [VideoMode])
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Maybe [VideoMode])) -> IO (Maybe [VideoMode]))
-> (Ptr CInt -> IO (Maybe [VideoMode])) -> IO (Maybe [VideoMode])
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
p'n -> do
        Ptr C'GLFWvidmode
p'vms <- Ptr C'GLFWmonitor -> Ptr CInt -> IO (Ptr C'GLFWvidmode)
c'glfwGetVideoModes (Monitor -> Ptr C'GLFWmonitor
forall c h. C c h => h -> c
toC Monitor
mon) Ptr CInt
p'n
        Int
n <- CInt -> Int
forall c h. C c h => c -> h
fromC (CInt -> Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
p'n
        if Ptr C'GLFWvidmode
p'vms Ptr C'GLFWvidmode -> Ptr C'GLFWvidmode -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr C'GLFWvidmode
forall a. Ptr a
nullPtr Bool -> Bool -> Bool
|| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0
          then Maybe [VideoMode] -> IO (Maybe [VideoMode])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [VideoMode]
forall a. Maybe a
Nothing
          else ([VideoMode] -> Maybe [VideoMode]
forall a. a -> Maybe a
Just ([VideoMode] -> Maybe [VideoMode])
-> ([C'GLFWvidmode] -> [VideoMode])
-> [C'GLFWvidmode]
-> Maybe [VideoMode]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (C'GLFWvidmode -> VideoMode) -> [C'GLFWvidmode] -> [VideoMode]
forall a b. (a -> b) -> [a] -> [b]
map C'GLFWvidmode -> VideoMode
forall c h. C c h => c -> h
fromC) ([C'GLFWvidmode] -> Maybe [VideoMode])
-> IO [C'GLFWvidmode] -> IO (Maybe [VideoMode])
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Int -> Ptr C'GLFWvidmode -> IO [C'GLFWvidmode]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
n Ptr C'GLFWvidmode
p'vms

-- | Gets the active video mode of the monitor.
-- See <http://www.glfw.org/docs/3.3/group__monitor.html#gafc1bb972a921ad5b3bd5d63a95fc2d52 glfwGetVideoMode>
getVideoMode :: Monitor -> IO (Maybe VideoMode)
getVideoMode :: Monitor -> IO (Maybe VideoMode)
getVideoMode Monitor
mon = do
    Ptr C'GLFWvidmode
p'vm <- Ptr C'GLFWmonitor -> IO (Ptr C'GLFWvidmode)
c'glfwGetVideoMode (Monitor -> Ptr C'GLFWmonitor
forall c h. C c h => h -> c
toC Monitor
mon)
    if Ptr C'GLFWvidmode
p'vm Ptr C'GLFWvidmode -> Ptr C'GLFWvidmode -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr C'GLFWvidmode
forall a. Ptr a
nullPtr
      then Maybe VideoMode -> IO (Maybe VideoMode)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe VideoMode
forall a. Maybe a
Nothing
      else (VideoMode -> Maybe VideoMode
forall a. a -> Maybe a
Just (VideoMode -> Maybe VideoMode)
-> (C'GLFWvidmode -> VideoMode) -> C'GLFWvidmode -> Maybe VideoMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. C'GLFWvidmode -> VideoMode
forall c h. C c h => c -> h
fromC) (C'GLFWvidmode -> Maybe VideoMode)
-> IO C'GLFWvidmode -> IO (Maybe VideoMode)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Ptr C'GLFWvidmode -> IO C'GLFWvidmode
forall a. Storable a => Ptr a -> IO a
peek Ptr C'GLFWvidmode
p'vm

-- | Sets the gamma of a monitor.
-- See <http://www.glfw.org/docs/3.3/group__monitor.html#ga6ac582625c990220785ddd34efa3169a glfwSetGamma>
setGamma :: Monitor -> Double -> IO ()
setGamma :: Monitor -> Double -> IO ()
setGamma Monitor
mon Double
e =
    Ptr C'GLFWmonitor -> CFloat -> IO ()
c'glfwSetGamma (Monitor -> Ptr C'GLFWmonitor
forall c h. C c h => h -> c
toC Monitor
mon) (Double -> CFloat
forall c h. C c h => h -> c
toC Double
e)

-- | Gets the gamma ramp in use with the monitor.
-- See <http://www.glfw.org/docs/3.3/group__monitor.html#gab7c41deb2219bde3e1eb756ddaa9ec80 glfwGetGammaRamp>
getGammaRamp :: Monitor -> IO (Maybe GammaRamp)
getGammaRamp :: Monitor -> IO (Maybe GammaRamp)
getGammaRamp Monitor
m = do
    Ptr C'GLFWgammaramp
p'ggr <- Ptr C'GLFWmonitor -> IO (Ptr C'GLFWgammaramp)
c'glfwGetGammaRamp (Monitor -> Ptr C'GLFWmonitor
forall c h. C c h => h -> c
toC Monitor
m)
    if Ptr C'GLFWgammaramp
p'ggr Ptr C'GLFWgammaramp -> Ptr C'GLFWgammaramp -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr C'GLFWgammaramp
forall a. Ptr a
nullPtr
      then Maybe GammaRamp -> IO (Maybe GammaRamp)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe GammaRamp
forall a. Maybe a
Nothing
      else do
          C'GLFWgammaramp
ggr <- Ptr C'GLFWgammaramp -> IO C'GLFWgammaramp
forall a. Storable a => Ptr a -> IO a
peek Ptr C'GLFWgammaramp
p'ggr
          let p'rs :: Ptr CUShort
p'rs = C'GLFWgammaramp -> Ptr CUShort
c'GLFWgammaramp'red   C'GLFWgammaramp
ggr
              p'gs :: Ptr CUShort
p'gs = C'GLFWgammaramp -> Ptr CUShort
c'GLFWgammaramp'green C'GLFWgammaramp
ggr
              p'bs :: Ptr CUShort
p'bs = C'GLFWgammaramp -> Ptr CUShort
c'GLFWgammaramp'blue  C'GLFWgammaramp
ggr
              cn :: CUInt
cn   = C'GLFWgammaramp -> CUInt
c'GLFWgammaramp'size  C'GLFWgammaramp
ggr
              n :: Int
n    = CUInt -> Int
forall c h. C c h => c -> h
fromC CUInt
cn
          if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
|| Ptr CUShort
forall a. Ptr a
nullPtr Ptr CUShort -> [Ptr CUShort] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Ptr CUShort
p'rs, Ptr CUShort
p'gs, Ptr CUShort
p'bs]
            then Maybe GammaRamp -> IO (Maybe GammaRamp)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe GammaRamp
forall a. Maybe a
Nothing
            else do
                [Int]
rs <- (CUShort -> Int) -> [CUShort] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map CUShort -> Int
forall c h. C c h => c -> h
fromC ([CUShort] -> [Int]) -> IO [CUShort] -> IO [Int]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Int -> Ptr CUShort -> IO [CUShort]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
n Ptr CUShort
p'rs
                [Int]
gs <- (CUShort -> Int) -> [CUShort] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map CUShort -> Int
forall c h. C c h => c -> h
fromC ([CUShort] -> [Int]) -> IO [CUShort] -> IO [Int]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Int -> Ptr CUShort -> IO [CUShort]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
n Ptr CUShort
p'gs
                [Int]
bs <- (CUShort -> Int) -> [CUShort] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map CUShort -> Int
forall c h. C c h => c -> h
fromC ([CUShort] -> [Int]) -> IO [CUShort] -> IO [Int]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Int -> Ptr CUShort -> IO [CUShort]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
n Ptr CUShort
p'bs
                Maybe GammaRamp -> IO (Maybe GammaRamp)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe GammaRamp -> IO (Maybe GammaRamp))
-> Maybe GammaRamp -> IO (Maybe GammaRamp)
forall a b. (a -> b) -> a -> b
$ GammaRamp -> Maybe GammaRamp
forall a. a -> Maybe a
Just GammaRamp
                  { gammaRampRed :: [Int]
gammaRampRed   = [Int]
rs
                  , gammaRampGreen :: [Int]
gammaRampGreen = [Int]
gs
                  , gammaRampBlue :: [Int]
gammaRampBlue  = [Int]
bs
                  }

-- | Assigns a gamma ramp to use with the given monitor.
-- See <http://www.glfw.org/docs/3.3/group__monitor.html#ga583f0ffd0d29613d8cd172b996bbf0dd glfwSetGammaRamp>
setGammaRamp :: Monitor -> GammaRamp -> IO ()
setGammaRamp :: Monitor -> GammaRamp -> IO ()
setGammaRamp Monitor
mon GammaRamp
gr =
    let rs :: [CUShort]
rs = (Int -> CUShort) -> [Int] -> [CUShort]
forall a b. (a -> b) -> [a] -> [b]
map Int -> CUShort
forall c h. C c h => h -> c
toC ([Int] -> [CUShort]) -> [Int] -> [CUShort]
forall a b. (a -> b) -> a -> b
$ GammaRamp -> [Int]
gammaRampRed   GammaRamp
gr :: [CUShort]
        gs :: [CUShort]
gs = (Int -> CUShort) -> [Int] -> [CUShort]
forall a b. (a -> b) -> [a] -> [b]
map Int -> CUShort
forall c h. C c h => h -> c
toC ([Int] -> [CUShort]) -> [Int] -> [CUShort]
forall a b. (a -> b) -> a -> b
$ GammaRamp -> [Int]
gammaRampGreen GammaRamp
gr :: [CUShort]
        bs :: [CUShort]
bs = (Int -> CUShort) -> [Int] -> [CUShort]
forall a b. (a -> b) -> [a] -> [b]
map Int -> CUShort
forall c h. C c h => h -> c
toC ([Int] -> [CUShort]) -> [Int] -> [CUShort]
forall a b. (a -> b) -> a -> b
$ GammaRamp -> [Int]
gammaRampBlue  GammaRamp
gr :: [CUShort]
        -- GammaRamp's smart constructor ensures that the RGB lists all have
        -- equal length, so just use the number of reds.
        cn :: CUInt
cn = Int -> CUInt
forall c h. C c h => h -> c
toC (Int -> CUInt) -> Int -> CUInt
forall a b. (a -> b) -> a -> b
$ [CUShort] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [CUShort]
rs :: CUInt
    in (Ptr C'GLFWgammaramp -> IO ()) -> IO ()
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca       ((Ptr C'GLFWgammaramp -> IO ()) -> IO ())
-> (Ptr C'GLFWgammaramp -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr C'GLFWgammaramp
p'ggr ->
       [CUShort] -> (Ptr CUShort -> IO ()) -> IO ()
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [CUShort]
rs ((Ptr CUShort -> IO ()) -> IO ())
-> (Ptr CUShort -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CUShort
p'rs  ->
       [CUShort] -> (Ptr CUShort -> IO ()) -> IO ()
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [CUShort]
gs ((Ptr CUShort -> IO ()) -> IO ())
-> (Ptr CUShort -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CUShort
p'gs  ->
       [CUShort] -> (Ptr CUShort -> IO ()) -> IO ()
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [CUShort]
bs ((Ptr CUShort -> IO ()) -> IO ())
-> (Ptr CUShort -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CUShort
p'bs  -> do
          let ggr :: C'GLFWgammaramp
ggr = C'GLFWgammaramp
                      { c'GLFWgammaramp'red :: Ptr CUShort
c'GLFWgammaramp'red   = Ptr CUShort
p'rs
                      , c'GLFWgammaramp'green :: Ptr CUShort
c'GLFWgammaramp'green = Ptr CUShort
p'gs
                      , c'GLFWgammaramp'blue :: Ptr CUShort
c'GLFWgammaramp'blue  = Ptr CUShort
p'bs
                      , c'GLFWgammaramp'size :: CUInt
c'GLFWgammaramp'size  = CUInt
cn
                      }
          Ptr C'GLFWgammaramp -> C'GLFWgammaramp -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr C'GLFWgammaramp
p'ggr C'GLFWgammaramp
ggr
          Ptr C'GLFWmonitor -> Ptr C'GLFWgammaramp -> IO ()
c'glfwSetGammaRamp (Monitor -> Ptr C'GLFWmonitor
forall c h. C c h => h -> c
toC Monitor
mon) Ptr C'GLFWgammaramp
p'ggr

-- | This function retrieves the content scale for the specified monitor. The
-- content scale is the ratio between the current DPI and the platform's default
-- DPI.
-- See <https://www.glfw.org/docs/3.3/group__monitor.html#gad3152e84465fa620b601265ebfcdb21b glfwGetMonitorContentScale>
getMonitorContentScale :: Monitor -> IO (Float, Float)
getMonitorContentScale :: Monitor -> IO (Float, Float)
getMonitorContentScale Monitor
mon =
  (Ptr CFloat -> IO (Float, Float)) -> IO (Float, Float)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CFloat -> IO (Float, Float)) -> IO (Float, Float))
-> (Ptr CFloat -> IO (Float, Float)) -> IO (Float, Float)
forall a b. (a -> b) -> a -> b
$ \Ptr CFloat
p'x ->
  (Ptr CFloat -> IO (Float, Float)) -> IO (Float, Float)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CFloat -> IO (Float, Float)) -> IO (Float, Float))
-> (Ptr CFloat -> IO (Float, Float)) -> IO (Float, Float)
forall a b. (a -> b) -> a -> b
$ \Ptr CFloat
p'y -> do
    Ptr C'GLFWmonitor -> Ptr CFloat -> Ptr CFloat -> IO ()
c'glfwGetMonitorContentScale (Monitor -> Ptr C'GLFWmonitor
forall c h. C c h => h -> c
toC Monitor
mon) Ptr CFloat
p'x Ptr CFloat
p'y
    CFloat Float
x <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek Ptr CFloat
p'x
    CFloat Float
y <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek Ptr CFloat
p'y
    (Float, Float) -> IO (Float, Float)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Float
x, Float
y)

-- | This function returns the position, in screen coordinates, of the
-- upper-left corner of the work area of the specified monitor along with the
-- work area size in screen coordinates. Returned tuple is:
-- (xPos, yPos, width, height)
-- See <https://www.glfw.org/docs/3.3/group__monitor.html#ga7387a3bdb64bfe8ebf2b9e54f5b6c9d0 glfwGetMonitorWorkarea>
getMonitorWorkarea :: Monitor -> IO (Int, Int, Int, Int)
getMonitorWorkarea :: Monitor -> IO (Int, Int, Int, Int)
getMonitorWorkarea Monitor
mon =
  (Ptr CInt -> IO (Int, Int, Int, Int)) -> IO (Int, Int, Int, Int)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Int, Int, Int, Int)) -> IO (Int, Int, Int, Int))
-> (Ptr CInt -> IO (Int, Int, Int, Int)) -> IO (Int, Int, Int, Int)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
p'x ->
  (Ptr CInt -> IO (Int, Int, Int, Int)) -> IO (Int, Int, Int, Int)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Int, Int, Int, Int)) -> IO (Int, Int, Int, Int))
-> (Ptr CInt -> IO (Int, Int, Int, Int)) -> IO (Int, Int, Int, Int)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
p'y ->
  (Ptr CInt -> IO (Int, Int, Int, Int)) -> IO (Int, Int, Int, Int)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Int, Int, Int, Int)) -> IO (Int, Int, Int, Int))
-> (Ptr CInt -> IO (Int, Int, Int, Int)) -> IO (Int, Int, Int, Int)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
p'w ->
  (Ptr CInt -> IO (Int, Int, Int, Int)) -> IO (Int, Int, Int, Int)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Int, Int, Int, Int)) -> IO (Int, Int, Int, Int))
-> (Ptr CInt -> IO (Int, Int, Int, Int)) -> IO (Int, Int, Int, Int)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
p'h -> do
    Ptr C'GLFWmonitor
-> Ptr CInt -> Ptr CInt -> Ptr CInt -> Ptr CInt -> IO ()
c'glfwGetMonitorWorkarea (Monitor -> Ptr C'GLFWmonitor
forall c h. C c h => h -> c
toC Monitor
mon) Ptr CInt
p'x Ptr CInt
p'y Ptr CInt
p'w Ptr CInt
p'h
    Int
x <- CInt -> Int
forall c h. C c h => c -> h
fromC (CInt -> Int) -> IO CInt -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
p'x
    Int
y <- CInt -> Int
forall c h. C c h => c -> h
fromC (CInt -> Int) -> IO CInt -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
p'y
    Int
w <- CInt -> Int
forall c h. C c h => c -> h
fromC (CInt -> Int) -> IO CInt -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
p'w
    Int
h <- CInt -> Int
forall c h. C c h => c -> h
fromC (CInt -> Int) -> IO CInt -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
p'h
    (Int, Int, Int, Int) -> IO (Int, Int, Int, Int)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
x, Int
y, Int
w, Int
h)

--------------------------------------------------------------------------------
-- Window handling

-- | Sets all the window hints to default.
-- See <http://www.glfw.org/docs/3.3/group__window.html#gaa77c4898dfb83344a6b4f76aa16b9a4a glfwDefaultWindowHints>
defaultWindowHints :: IO ()
defaultWindowHints :: IO ()
defaultWindowHints =
    IO ()
c'glfwDefaultWindowHints

setStringHint :: CInt -> String -> IO ()
setStringHint :: CInt -> String -> IO ()
setStringHint CInt
hint = (String -> (CString -> IO ()) -> IO ())
-> (CString -> IO ()) -> String -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> (CString -> IO ()) -> IO ()
forall a. String -> (CString -> IO a) -> IO a
withCString (CInt -> CString -> IO ()
c'glfwWindowHintString CInt
hint)

-- | Hints something to the GLFW windowing system.
-- See
-- <http://www.glfw.org/docs/3.3/group__window.html#ga7d9c8c62384b1e2821c4dc48952d2033 glfwWindowHint>
-- and
-- <https://www.glfw.org/docs/3.3/group__window.html#ga8cb2782861c9d997bcf2dea97f363e5f glfwWindowHintString>
windowHint :: WindowHint -> IO ()
windowHint :: WindowHint -> IO ()
windowHint (WindowHint'Resizable              Bool
x) =
  CInt -> CInt -> IO ()
c'glfwWindowHint CInt
forall a. Num a => a
c'GLFW_RESIZABLE                (Bool -> CInt
forall c h. C c h => h -> c
toC Bool
x)
windowHint (WindowHint'Visible                Bool
x) =
  CInt -> CInt -> IO ()
c'glfwWindowHint CInt
forall a. Num a => a
c'GLFW_VISIBLE                  (Bool -> CInt
forall c h. C c h => h -> c
toC Bool
x)
windowHint (WindowHint'Decorated              Bool
x) =
  CInt -> CInt -> IO ()
c'glfwWindowHint CInt
forall a. Num a => a
c'GLFW_DECORATED                (Bool -> CInt
forall c h. C c h => h -> c
toC Bool
x)
windowHint (WindowHint'RedBits                Maybe Int
x) =
  CInt -> CInt -> IO ()
c'glfwWindowHint CInt
forall a. Num a => a
c'GLFW_RED_BITS                 (Maybe Int -> CInt
forall c h. C c h => h -> c
toC Maybe Int
x)
windowHint (WindowHint'GreenBits              Maybe Int
x) =
  CInt -> CInt -> IO ()
c'glfwWindowHint CInt
forall a. Num a => a
c'GLFW_GREEN_BITS               (Maybe Int -> CInt
forall c h. C c h => h -> c
toC Maybe Int
x)
windowHint (WindowHint'BlueBits               Maybe Int
x) =
  CInt -> CInt -> IO ()
c'glfwWindowHint CInt
forall a. Num a => a
c'GLFW_BLUE_BITS                (Maybe Int -> CInt
forall c h. C c h => h -> c
toC Maybe Int
x)
windowHint (WindowHint'AlphaBits              Maybe Int
x) =
  CInt -> CInt -> IO ()
c'glfwWindowHint CInt
forall a. Num a => a
c'GLFW_ALPHA_BITS               (Maybe Int -> CInt
forall c h. C c h => h -> c
toC Maybe Int
x)
windowHint (WindowHint'DepthBits              Maybe Int
x) =
  CInt -> CInt -> IO ()
c'glfwWindowHint CInt
forall a. Num a => a
c'GLFW_DEPTH_BITS               (Maybe Int -> CInt
forall c h. C c h => h -> c
toC Maybe Int
x)
windowHint (WindowHint'StencilBits            Maybe Int
x) =
  CInt -> CInt -> IO ()
c'glfwWindowHint CInt
forall a. Num a => a
c'GLFW_STENCIL_BITS             (Maybe Int -> CInt
forall c h. C c h => h -> c
toC Maybe Int
x)
windowHint (WindowHint'AccumRedBits           Maybe Int
x) =
  CInt -> CInt -> IO ()
c'glfwWindowHint CInt
forall a. Num a => a
c'GLFW_ACCUM_RED_BITS           (Maybe Int -> CInt
forall c h. C c h => h -> c
toC Maybe Int
x)
windowHint (WindowHint'AccumGreenBits         Maybe Int
x) =
  CInt -> CInt -> IO ()
c'glfwWindowHint CInt
forall a. Num a => a
c'GLFW_ACCUM_GREEN_BITS         (Maybe Int -> CInt
forall c h. C c h => h -> c
toC Maybe Int
x)
windowHint (WindowHint'AccumBlueBits          Maybe Int
x) =
  CInt -> CInt -> IO ()
c'glfwWindowHint CInt
forall a. Num a => a
c'GLFW_ACCUM_BLUE_BITS          (Maybe Int -> CInt
forall c h. C c h => h -> c
toC Maybe Int
x)
windowHint (WindowHint'AccumAlphaBits         Maybe Int
x) =
  CInt -> CInt -> IO ()
c'glfwWindowHint CInt
forall a. Num a => a
c'GLFW_ACCUM_ALPHA_BITS         (Maybe Int -> CInt
forall c h. C c h => h -> c
toC Maybe Int
x)
windowHint (WindowHint'AuxBuffers             Maybe Int
x) =
  CInt -> CInt -> IO ()
c'glfwWindowHint CInt
forall a. Num a => a
c'GLFW_AUX_BUFFERS              (Maybe Int -> CInt
forall c h. C c h => h -> c
toC Maybe Int
x)
windowHint (WindowHint'Samples                Maybe Int
x) =
  CInt -> CInt -> IO ()
c'glfwWindowHint CInt
forall a. Num a => a
c'GLFW_SAMPLES                  (Maybe Int -> CInt
forall c h. C c h => h -> c
toC Maybe Int
x)
windowHint (WindowHint'RefreshRate            Maybe Int
x) =
  CInt -> CInt -> IO ()
c'glfwWindowHint CInt
forall a. Num a => a
c'GLFW_REFRESH_RATE             (Maybe Int -> CInt
forall c h. C c h => h -> c
toC Maybe Int
x)
windowHint (WindowHint'DoubleBuffer           Bool
x) =
  CInt -> CInt -> IO ()
c'glfwWindowHint CInt
forall a. Num a => a
c'GLFW_DOUBLEBUFFER             (Bool -> CInt
forall c h. C c h => h -> c
toC Bool
x)
windowHint (WindowHint'Stereo                 Bool
x) =
  CInt -> CInt -> IO ()
c'glfwWindowHint CInt
forall a. Num a => a
c'GLFW_STEREO                   (Bool -> CInt
forall c h. C c h => h -> c
toC Bool
x)
windowHint (WindowHint'sRGBCapable            Bool
x) =
  CInt -> CInt -> IO ()
c'glfwWindowHint CInt
forall a. Num a => a
c'GLFW_SRGB_CAPABLE             (Bool -> CInt
forall c h. C c h => h -> c
toC Bool
x)
windowHint (WindowHint'Floating               Bool
x) =
  CInt -> CInt -> IO ()
c'glfwWindowHint CInt
forall a. Num a => a
c'GLFW_FLOATING                 (Bool -> CInt
forall c h. C c h => h -> c
toC Bool
x)
windowHint (WindowHint'Focused                Bool
x) =
  CInt -> CInt -> IO ()
c'glfwWindowHint CInt
forall a. Num a => a
c'GLFW_FOCUSED                  (Bool -> CInt
forall c h. C c h => h -> c
toC Bool
x)
windowHint (WindowHint'Maximized              Bool
x) =
  CInt -> CInt -> IO ()
c'glfwWindowHint CInt
forall a. Num a => a
c'GLFW_MAXIMIZED                (Bool -> CInt
forall c h. C c h => h -> c
toC Bool
x)
windowHint (WindowHint'AutoIconify            Bool
x) =
  CInt -> CInt -> IO ()
c'glfwWindowHint CInt
forall a. Num a => a
c'GLFW_AUTO_ICONIFY             (Bool -> CInt
forall c h. C c h => h -> c
toC Bool
x)
windowHint (WindowHint'ClientAPI              ClientAPI
x) =
  CInt -> CInt -> IO ()
c'glfwWindowHint CInt
forall a. Num a => a
c'GLFW_CLIENT_API               (ClientAPI -> CInt
forall c h. C c h => h -> c
toC ClientAPI
x)
windowHint (WindowHint'ContextCreationAPI     ContextCreationAPI
x) =
  CInt -> CInt -> IO ()
c'glfwWindowHint CInt
forall a. Num a => a
c'GLFW_CONTEXT_CREATION_API     (ContextCreationAPI -> CInt
forall c h. C c h => h -> c
toC ContextCreationAPI
x)
windowHint (WindowHint'ContextVersionMajor    Int
x) =
  CInt -> CInt -> IO ()
c'glfwWindowHint CInt
forall a. Num a => a
c'GLFW_CONTEXT_VERSION_MAJOR    (Int -> CInt
forall c h. C c h => h -> c
toC Int
x)
windowHint (WindowHint'ContextVersionMinor    Int
x) =
  CInt -> CInt -> IO ()
c'glfwWindowHint CInt
forall a. Num a => a
c'GLFW_CONTEXT_VERSION_MINOR    (Int -> CInt
forall c h. C c h => h -> c
toC Int
x)
windowHint (WindowHint'ContextRobustness      ContextRobustness
x) =
  CInt -> CInt -> IO ()
c'glfwWindowHint CInt
forall a. Num a => a
c'GLFW_CONTEXT_ROBUSTNESS       (ContextRobustness -> CInt
forall c h. C c h => h -> c
toC ContextRobustness
x)
windowHint (WindowHint'ContextReleaseBehavior ContextReleaseBehavior
x) =
  CInt -> CInt -> IO ()
c'glfwWindowHint CInt
forall a. Num a => a
c'GLFW_CONTEXT_RELEASE_BEHAVIOR (ContextReleaseBehavior -> CInt
forall c h. C c h => h -> c
toC ContextReleaseBehavior
x)
windowHint (WindowHint'ContextNoError         Bool
x) =
  CInt -> CInt -> IO ()
c'glfwWindowHint CInt
forall a. Num a => a
c'GLFW_CONTEXT_NO_ERROR         (Bool -> CInt
forall c h. C c h => h -> c
toC Bool
x)
windowHint (WindowHint'OpenGLForwardCompat    Bool
x) =
  CInt -> CInt -> IO ()
c'glfwWindowHint CInt
forall a. Num a => a
c'GLFW_OPENGL_FORWARD_COMPAT    (Bool -> CInt
forall c h. C c h => h -> c
toC Bool
x)
windowHint (WindowHint'OpenGLDebugContext     Bool
x) =
  CInt -> CInt -> IO ()
c'glfwWindowHint CInt
forall a. Num a => a
c'GLFW_OPENGL_DEBUG_CONTEXT     (Bool -> CInt
forall c h. C c h => h -> c
toC Bool
x)
windowHint (WindowHint'OpenGLProfile          OpenGLProfile
x) =
  CInt -> CInt -> IO ()
c'glfwWindowHint CInt
forall a. Num a => a
c'GLFW_OPENGL_PROFILE           (OpenGLProfile -> CInt
forall c h. C c h => h -> c
toC OpenGLProfile
x)
windowHint (WindowHint'TransparentFramebuffer Bool
x) =
  CInt -> CInt -> IO ()
c'glfwWindowHint CInt
forall a. Num a => a
c'GLFW_TRANSPARENT_FRAMEBUFFER  (Bool -> CInt
forall c h. C c h => h -> c
toC Bool
x)
windowHint (WindowHint'CenterCursor           Bool
x) =
  CInt -> CInt -> IO ()
c'glfwWindowHint CInt
forall a. Num a => a
c'GLFW_CENTER_CURSOR            (Bool -> CInt
forall c h. C c h => h -> c
toC Bool
x)
windowHint (WindowHint'FocusOnShow            Bool
x) =
  CInt -> CInt -> IO ()
c'glfwWindowHint CInt
forall a. Num a => a
c'GLFW_FOCUS_ON_SHOW            (Bool -> CInt
forall c h. C c h => h -> c
toC Bool
x)
windowHint (WindowHint'ScaleToMonitor         Bool
x) =
  CInt -> CInt -> IO ()
c'glfwWindowHint CInt
forall a. Num a => a
c'GLFW_SCALE_TO_MONITOR         (Bool -> CInt
forall c h. C c h => h -> c
toC Bool
x)
windowHint (WindowHint'CocoaRetinaFramebuffer Bool
x) =
  CInt -> CInt -> IO ()
c'glfwWindowHint CInt
forall a. Num a => a
c'GLFW_COCOA_RETINA_FRAMEBUFFER (Bool -> CInt
forall c h. C c h => h -> c
toC Bool
x)
windowHint (WindowHint'CocoaGraphicsSwitching Bool
x) =
  CInt -> CInt -> IO ()
c'glfwWindowHint CInt
forall a. Num a => a
c'GLFW_COCOA_GRAPHICS_SWITCHING (Bool -> CInt
forall c h. C c h => h -> c
toC Bool
x)
windowHint (WindowHint'CocoaFrameName  String
x) = CInt -> String -> IO ()
setStringHint CInt
forall a. Num a => a
c'GLFW_COCOA_FRAME_NAME  String
x
windowHint (WindowHint'X11ClassName    String
x) = CInt -> String -> IO ()
setStringHint CInt
forall a. Num a => a
c'GLFW_X11_CLASS_NAME    String
x
windowHint (WindowHint'X11InstanceName String
x) = CInt -> String -> IO ()
setStringHint CInt
forall a. Num a => a
c'GLFW_X11_INSTANCE_NAME String
x

-- | Creates a new window.
-- Note: If running in GHCI don't forget to @:set -fno-ghci-sandbox@ or you
-- may run into an assertion failure, segfault or other nasty crash.
-- See <http://www.glfw.org/docs/3.3/group__window.html#ga5c336fddf2cbb5b92f65f10fb6043344 glfwCreateWindow>
createWindow :: Int -- ^ Desired width for the window.
             -> Int -- ^ Desired height for the window.
             -> String -- ^ Desired title for the window.
             -> Maybe Monitor -- ^ Monitor to use in fullscreen mode.
             -> Maybe Window  -- ^ Window for context object sharing, see
                              -- <http://www.glfw.org/docs/3.3/context.html#context_sharing here>.
             -> IO (Maybe Window)
createWindow :: Int
-> Int
-> String
-> Maybe Monitor
-> Maybe Window
-> IO (Maybe Window)
createWindow Int
w Int
h String
title Maybe Monitor
mmon Maybe Window
mwin =
    String -> (CString -> IO (Maybe Window)) -> IO (Maybe Window)
forall a. String -> (CString -> IO a) -> IO a
withCString String
title ((CString -> IO (Maybe Window)) -> IO (Maybe Window))
-> (CString -> IO (Maybe Window)) -> IO (Maybe Window)
forall a b. (a -> b) -> a -> b
$ \CString
ptitle -> do
        IORef (FunPtr (Ptr C'GLFWwindow -> CUInt -> IO ()))
charFun               <- FunPtr (Ptr C'GLFWwindow -> CUInt -> IO ())
-> IO (IORef (FunPtr (Ptr C'GLFWwindow -> CUInt -> IO ())))
forall a. a -> IO (IORef a)
newIORef FunPtr (Ptr C'GLFWwindow -> CUInt -> IO ())
forall a. FunPtr a
nullFunPtr
        IORef (FunPtr (Ptr C'GLFWwindow -> CUInt -> CInt -> IO ()))
charModsFun           <- FunPtr (Ptr C'GLFWwindow -> CUInt -> CInt -> IO ())
-> IO (IORef (FunPtr (Ptr C'GLFWwindow -> CUInt -> CInt -> IO ())))
forall a. a -> IO (IORef a)
newIORef FunPtr (Ptr C'GLFWwindow -> CUInt -> CInt -> IO ())
forall a. FunPtr a
nullFunPtr
        IORef (FunPtr (Ptr C'GLFWwindow -> CInt -> IO ()))
cursorEnterFun        <- FunPtr (Ptr C'GLFWwindow -> CInt -> IO ())
-> IO (IORef (FunPtr (Ptr C'GLFWwindow -> CInt -> IO ())))
forall a. a -> IO (IORef a)
newIORef FunPtr (Ptr C'GLFWwindow -> CInt -> IO ())
forall a. FunPtr a
nullFunPtr
        IORef (FunPtr (Ptr C'GLFWwindow -> CDouble -> CDouble -> IO ()))
cursorPosFun          <- FunPtr (Ptr C'GLFWwindow -> CDouble -> CDouble -> IO ())
-> IO
     (IORef (FunPtr (Ptr C'GLFWwindow -> CDouble -> CDouble -> IO ())))
forall a. a -> IO (IORef a)
newIORef FunPtr (Ptr C'GLFWwindow -> CDouble -> CDouble -> IO ())
forall a. FunPtr a
nullFunPtr
        IORef (FunPtr (Ptr C'GLFWwindow -> CInt -> CInt -> IO ()))
framebufferSizeFun    <- FunPtr (Ptr C'GLFWwindow -> CInt -> CInt -> IO ())
-> IO (IORef (FunPtr (Ptr C'GLFWwindow -> CInt -> CInt -> IO ())))
forall a. a -> IO (IORef a)
newIORef FunPtr (Ptr C'GLFWwindow -> CInt -> CInt -> IO ())
forall a. FunPtr a
nullFunPtr
        IORef
  (FunPtr
     (Ptr C'GLFWwindow -> CInt -> CInt -> CInt -> CInt -> IO ()))
keyFun                <- FunPtr (Ptr C'GLFWwindow -> CInt -> CInt -> CInt -> CInt -> IO ())
-> IO
     (IORef
        (FunPtr
           (Ptr C'GLFWwindow -> CInt -> CInt -> CInt -> CInt -> IO ())))
forall a. a -> IO (IORef a)
newIORef FunPtr (Ptr C'GLFWwindow -> CInt -> CInt -> CInt -> CInt -> IO ())
forall a. FunPtr a
nullFunPtr
        IORef (FunPtr (Ptr C'GLFWwindow -> CInt -> CInt -> CInt -> IO ()))
mouseButtonFun        <- FunPtr (Ptr C'GLFWwindow -> CInt -> CInt -> CInt -> IO ())
-> IO
     (IORef
        (FunPtr (Ptr C'GLFWwindow -> CInt -> CInt -> CInt -> IO ())))
forall a. a -> IO (IORef a)
newIORef FunPtr (Ptr C'GLFWwindow -> CInt -> CInt -> CInt -> IO ())
forall a. FunPtr a
nullFunPtr
        IORef (FunPtr (Ptr C'GLFWwindow -> CDouble -> CDouble -> IO ()))
scrollFun             <- FunPtr (Ptr C'GLFWwindow -> CDouble -> CDouble -> IO ())
-> IO
     (IORef (FunPtr (Ptr C'GLFWwindow -> CDouble -> CDouble -> IO ())))
forall a. a -> IO (IORef a)
newIORef FunPtr (Ptr C'GLFWwindow -> CDouble -> CDouble -> IO ())
forall a. FunPtr a
nullFunPtr
        IORef (FunPtr (Ptr C'GLFWwindow -> IO ()))
windowCloseFun        <- FunPtr (Ptr C'GLFWwindow -> IO ())
-> IO (IORef (FunPtr (Ptr C'GLFWwindow -> IO ())))
forall a. a -> IO (IORef a)
newIORef FunPtr (Ptr C'GLFWwindow -> IO ())
forall a. FunPtr a
nullFunPtr
        IORef (FunPtr (Ptr C'GLFWwindow -> CInt -> IO ()))
windowFocusFun        <- FunPtr (Ptr C'GLFWwindow -> CInt -> IO ())
-> IO (IORef (FunPtr (Ptr C'GLFWwindow -> CInt -> IO ())))
forall a. a -> IO (IORef a)
newIORef FunPtr (Ptr C'GLFWwindow -> CInt -> IO ())
forall a. FunPtr a
nullFunPtr
        IORef (FunPtr (Ptr C'GLFWwindow -> CInt -> IO ()))
windowIconifyFun      <- FunPtr (Ptr C'GLFWwindow -> CInt -> IO ())
-> IO (IORef (FunPtr (Ptr C'GLFWwindow -> CInt -> IO ())))
forall a. a -> IO (IORef a)
newIORef FunPtr (Ptr C'GLFWwindow -> CInt -> IO ())
forall a. FunPtr a
nullFunPtr
        IORef (FunPtr (Ptr C'GLFWwindow -> CInt -> CInt -> IO ()))
windowPosFun          <- FunPtr (Ptr C'GLFWwindow -> CInt -> CInt -> IO ())
-> IO (IORef (FunPtr (Ptr C'GLFWwindow -> CInt -> CInt -> IO ())))
forall a. a -> IO (IORef a)
newIORef FunPtr (Ptr C'GLFWwindow -> CInt -> CInt -> IO ())
forall a. FunPtr a
nullFunPtr
        IORef (FunPtr (Ptr C'GLFWwindow -> IO ()))
windowRefreshFun      <- FunPtr (Ptr C'GLFWwindow -> IO ())
-> IO (IORef (FunPtr (Ptr C'GLFWwindow -> IO ())))
forall a. a -> IO (IORef a)
newIORef FunPtr (Ptr C'GLFWwindow -> IO ())
forall a. FunPtr a
nullFunPtr
        IORef (FunPtr (Ptr C'GLFWwindow -> CInt -> CInt -> IO ()))
windowSizeFun         <- FunPtr (Ptr C'GLFWwindow -> CInt -> CInt -> IO ())
-> IO (IORef (FunPtr (Ptr C'GLFWwindow -> CInt -> CInt -> IO ())))
forall a. a -> IO (IORef a)
newIORef FunPtr (Ptr C'GLFWwindow -> CInt -> CInt -> IO ())
forall a. FunPtr a
nullFunPtr
        IORef (FunPtr (Ptr C'GLFWwindow -> CFloat -> CFloat -> IO ()))
windowContentScaleFun <- FunPtr (Ptr C'GLFWwindow -> CFloat -> CFloat -> IO ())
-> IO
     (IORef (FunPtr (Ptr C'GLFWwindow -> CFloat -> CFloat -> IO ())))
forall a. a -> IO (IORef a)
newIORef FunPtr (Ptr C'GLFWwindow -> CFloat -> CFloat -> IO ())
forall a. FunPtr a
nullFunPtr
        IORef (FunPtr (Ptr C'GLFWwindow -> CInt -> IO ()))
windowMaximizeFun     <- FunPtr (Ptr C'GLFWwindow -> CInt -> IO ())
-> IO (IORef (FunPtr (Ptr C'GLFWwindow -> CInt -> IO ())))
forall a. a -> IO (IORef a)
newIORef FunPtr (Ptr C'GLFWwindow -> CInt -> IO ())
forall a. FunPtr a
nullFunPtr
        IORef (FunPtr (Ptr C'GLFWwindow -> CInt -> Ptr CString -> IO ()))
dropFun               <- FunPtr (Ptr C'GLFWwindow -> CInt -> Ptr CString -> IO ())
-> IO
     (IORef (FunPtr (Ptr C'GLFWwindow -> CInt -> Ptr CString -> IO ())))
forall a. a -> IO (IORef a)
newIORef FunPtr (Ptr C'GLFWwindow -> CInt -> Ptr CString -> IO ())
forall a. FunPtr a
nullFunPtr
        let callbacks :: WindowCallbacks
callbacks = WindowCallbacks
              { storedCharFun :: IORef (FunPtr (Ptr C'GLFWwindow -> CUInt -> IO ()))
storedCharFun               = IORef (FunPtr (Ptr C'GLFWwindow -> CUInt -> IO ()))
charFun
              , storedCharModsFun :: IORef (FunPtr (Ptr C'GLFWwindow -> CUInt -> CInt -> IO ()))
storedCharModsFun           = IORef (FunPtr (Ptr C'GLFWwindow -> CUInt -> CInt -> IO ()))
charModsFun
              , storedCursorEnterFun :: IORef (FunPtr (Ptr C'GLFWwindow -> CInt -> IO ()))
storedCursorEnterFun        = IORef (FunPtr (Ptr C'GLFWwindow -> CInt -> IO ()))
cursorEnterFun
              , storedCursorPosFun :: IORef (FunPtr (Ptr C'GLFWwindow -> CDouble -> CDouble -> IO ()))
storedCursorPosFun          = IORef (FunPtr (Ptr C'GLFWwindow -> CDouble -> CDouble -> IO ()))
cursorPosFun
              , storedFramebufferSizeFun :: IORef (FunPtr (Ptr C'GLFWwindow -> CInt -> CInt -> IO ()))
storedFramebufferSizeFun    = IORef (FunPtr (Ptr C'GLFWwindow -> CInt -> CInt -> IO ()))
framebufferSizeFun
              , storedKeyFun :: IORef
  (FunPtr
     (Ptr C'GLFWwindow -> CInt -> CInt -> CInt -> CInt -> IO ()))
storedKeyFun                = IORef
  (FunPtr
     (Ptr C'GLFWwindow -> CInt -> CInt -> CInt -> CInt -> IO ()))
keyFun
              , storedMouseButtonFun :: IORef (FunPtr (Ptr C'GLFWwindow -> CInt -> CInt -> CInt -> IO ()))
storedMouseButtonFun        = IORef (FunPtr (Ptr C'GLFWwindow -> CInt -> CInt -> CInt -> IO ()))
mouseButtonFun
              , storedScrollFun :: IORef (FunPtr (Ptr C'GLFWwindow -> CDouble -> CDouble -> IO ()))
storedScrollFun             = IORef (FunPtr (Ptr C'GLFWwindow -> CDouble -> CDouble -> IO ()))
scrollFun
              , storedWindowCloseFun :: IORef (FunPtr (Ptr C'GLFWwindow -> IO ()))
storedWindowCloseFun        = IORef (FunPtr (Ptr C'GLFWwindow -> IO ()))
windowCloseFun
              , storedWindowFocusFun :: IORef (FunPtr (Ptr C'GLFWwindow -> CInt -> IO ()))
storedWindowFocusFun        = IORef (FunPtr (Ptr C'GLFWwindow -> CInt -> IO ()))
windowFocusFun
              , storedWindowIconifyFun :: IORef (FunPtr (Ptr C'GLFWwindow -> CInt -> IO ()))
storedWindowIconifyFun      = IORef (FunPtr (Ptr C'GLFWwindow -> CInt -> IO ()))
windowIconifyFun
              , storedWindowPosFun :: IORef (FunPtr (Ptr C'GLFWwindow -> CInt -> CInt -> IO ()))
storedWindowPosFun          = IORef (FunPtr (Ptr C'GLFWwindow -> CInt -> CInt -> IO ()))
windowPosFun
              , storedWindowRefreshFun :: IORef (FunPtr (Ptr C'GLFWwindow -> IO ()))
storedWindowRefreshFun      = IORef (FunPtr (Ptr C'GLFWwindow -> IO ()))
windowRefreshFun
              , storedWindowSizeFun :: IORef (FunPtr (Ptr C'GLFWwindow -> CInt -> CInt -> IO ()))
storedWindowSizeFun         = IORef (FunPtr (Ptr C'GLFWwindow -> CInt -> CInt -> IO ()))
windowSizeFun
              , storedWindowContentScaleFun :: IORef (FunPtr (Ptr C'GLFWwindow -> CFloat -> CFloat -> IO ()))
storedWindowContentScaleFun = IORef (FunPtr (Ptr C'GLFWwindow -> CFloat -> CFloat -> IO ()))
windowContentScaleFun
              , storedWindowMaximizeFun :: IORef (FunPtr (Ptr C'GLFWwindow -> CInt -> IO ()))
storedWindowMaximizeFun     = IORef (FunPtr (Ptr C'GLFWwindow -> CInt -> IO ()))
windowMaximizeFun
              , storedDropFun :: IORef (FunPtr (Ptr C'GLFWwindow -> CInt -> Ptr CString -> IO ()))
storedDropFun               = IORef (FunPtr (Ptr C'GLFWwindow -> CInt -> Ptr CString -> IO ()))
dropFun
              }
        Ptr C'GLFWwindow
p'win <- CInt
-> CInt
-> CString
-> Ptr C'GLFWmonitor
-> Ptr C'GLFWwindow
-> IO (Ptr C'GLFWwindow)
c'glfwCreateWindow
          (Int -> CInt
forall c h. C c h => h -> c
toC Int
w)
          (Int -> CInt
forall c h. C c h => h -> c
toC Int
h)
          CString
ptitle
          (Ptr C'GLFWmonitor
-> (Monitor -> Ptr C'GLFWmonitor)
-> Maybe Monitor
-> Ptr C'GLFWmonitor
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Ptr C'GLFWmonitor
forall a. Ptr a
nullPtr Monitor -> Ptr C'GLFWmonitor
forall c h. C c h => h -> c
toC Maybe Monitor
mmon)
          (Ptr C'GLFWwindow
-> (Window -> Ptr C'GLFWwindow) -> Maybe Window -> Ptr C'GLFWwindow
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Ptr C'GLFWwindow
forall a. Ptr a
nullPtr Window -> Ptr C'GLFWwindow
forall c h. C c h => h -> c
toC Maybe Window
mwin)
        if Ptr C'GLFWwindow
p'win Ptr C'GLFWwindow -> Ptr C'GLFWwindow -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr C'GLFWwindow
forall a. Ptr a
nullPtr
          then Maybe Window -> IO (Maybe Window)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Window
forall a. Maybe a
Nothing
          else do StablePtr WindowCallbacks
callbackPtr <- WindowCallbacks -> IO (StablePtr WindowCallbacks)
forall a. a -> IO (StablePtr a)
newStablePtr WindowCallbacks
callbacks
                  Ptr C'GLFWwindow -> Ptr () -> IO ()
c'glfwSetWindowUserPointer Ptr C'GLFWwindow
p'win (StablePtr WindowCallbacks -> Ptr ()
forall a. StablePtr a -> Ptr ()
castStablePtrToPtr StablePtr WindowCallbacks
callbackPtr)
                  -- Not sure why this isn't the default...
                  Ptr C'GLFWwindow -> CInt -> CInt -> IO ()
c'glfwSetInputMode Ptr C'GLFWwindow
p'win CInt
forall a. Num a => a
c'GLFW_LOCK_KEY_MODS (Bool -> CInt
forall c h. C c h => h -> c
toC Bool
True)
                  Maybe Window -> IO (Maybe Window)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Window -> IO (Maybe Window))
-> Maybe Window -> IO (Maybe Window)
forall a b. (a -> b) -> a -> b
$ Window -> Maybe Window
forall a. a -> Maybe a
Just (Window -> Maybe Window) -> Window -> Maybe Window
forall a b. (a -> b) -> a -> b
$ Ptr C'GLFWwindow -> Window
forall c h. C c h => c -> h
fromC Ptr C'GLFWwindow
p'win

-- | Cleans up a window and all associated resources
-- See <http://www.glfw.org/docs/3.3/group__window.html#gacdf43e51376051d2c091662e9fe3d7b2 glfwDestroyWindow>.
-- This function is not <https://www.glfw.org/docs/latest/intro.html#reentrancy reentrant>.
destroyWindow :: Window -> IO ()
destroyWindow :: Window -> IO ()
destroyWindow Window
win = do
    StablePtr WindowCallbacks
pcb <- Ptr () -> StablePtr WindowCallbacks
forall a. Ptr () -> StablePtr a
castPtrToStablePtr (Ptr () -> StablePtr WindowCallbacks)
-> IO (Ptr ()) -> IO (StablePtr WindowCallbacks)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` Ptr C'GLFWwindow -> IO (Ptr ())
c'glfwGetWindowUserPointer (Window -> Ptr C'GLFWwindow
forall c h. C c h => h -> c
toC Window
win)
    WindowCallbacks
cbs <- StablePtr WindowCallbacks -> IO WindowCallbacks
forall a. StablePtr a -> IO a
deRefStablePtr StablePtr WindowCallbacks
pcb
    Ptr C'GLFWwindow -> IO ()
c'glfwDestroyWindow (Window -> Ptr C'GLFWwindow
forall c h. C c h => h -> c
toC Window
win)

    let free :: (WindowCallbacks -> IORef (FunPtr a)) -> IO ()
free WindowCallbacks -> IORef (FunPtr a)
callback = do FunPtr a
funptr <- IORef (FunPtr a) -> IO (FunPtr a)
forall a. IORef a -> IO a
readIORef (WindowCallbacks -> IORef (FunPtr a)
callback WindowCallbacks
cbs)
                           Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (FunPtr a
funptr FunPtr a -> FunPtr a -> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr a
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FunPtr a -> IO ()
forall a. FunPtr a -> IO ()
freeHaskellFunPtr FunPtr a
funptr
    (WindowCallbacks
 -> IORef (FunPtr (Ptr C'GLFWwindow -> CUInt -> IO ())))
-> IO ()
forall {a}. (WindowCallbacks -> IORef (FunPtr a)) -> IO ()
free WindowCallbacks
-> IORef (FunPtr (Ptr C'GLFWwindow -> CUInt -> IO ()))
storedCharFun
    (WindowCallbacks
 -> IORef (FunPtr (Ptr C'GLFWwindow -> CUInt -> CInt -> IO ())))
-> IO ()
forall {a}. (WindowCallbacks -> IORef (FunPtr a)) -> IO ()
free WindowCallbacks
-> IORef (FunPtr (Ptr C'GLFWwindow -> CUInt -> CInt -> IO ()))
storedCharModsFun
    (WindowCallbacks
 -> IORef (FunPtr (Ptr C'GLFWwindow -> CInt -> IO ())))
-> IO ()
forall {a}. (WindowCallbacks -> IORef (FunPtr a)) -> IO ()
free WindowCallbacks
-> IORef (FunPtr (Ptr C'GLFWwindow -> CInt -> IO ()))
storedCursorEnterFun
    (WindowCallbacks
 -> IORef
      (FunPtr (Ptr C'GLFWwindow -> CDouble -> CDouble -> IO ())))
-> IO ()
forall {a}. (WindowCallbacks -> IORef (FunPtr a)) -> IO ()
free WindowCallbacks
-> IORef (FunPtr (Ptr C'GLFWwindow -> CDouble -> CDouble -> IO ()))
storedCursorPosFun
    (WindowCallbacks
 -> IORef (FunPtr (Ptr C'GLFWwindow -> CInt -> CInt -> IO ())))
-> IO ()
forall {a}. (WindowCallbacks -> IORef (FunPtr a)) -> IO ()
free WindowCallbacks
-> IORef (FunPtr (Ptr C'GLFWwindow -> CInt -> CInt -> IO ()))
storedFramebufferSizeFun
    (WindowCallbacks
 -> IORef
      (FunPtr
         (Ptr C'GLFWwindow -> CInt -> CInt -> CInt -> CInt -> IO ())))
-> IO ()
forall {a}. (WindowCallbacks -> IORef (FunPtr a)) -> IO ()
free WindowCallbacks
-> IORef
     (FunPtr
        (Ptr C'GLFWwindow -> CInt -> CInt -> CInt -> CInt -> IO ()))
storedKeyFun
    (WindowCallbacks
 -> IORef
      (FunPtr (Ptr C'GLFWwindow -> CInt -> CInt -> CInt -> IO ())))
-> IO ()
forall {a}. (WindowCallbacks -> IORef (FunPtr a)) -> IO ()
free WindowCallbacks
-> IORef
     (FunPtr (Ptr C'GLFWwindow -> CInt -> CInt -> CInt -> IO ()))
storedMouseButtonFun
    (WindowCallbacks
 -> IORef
      (FunPtr (Ptr C'GLFWwindow -> CDouble -> CDouble -> IO ())))
-> IO ()
forall {a}. (WindowCallbacks -> IORef (FunPtr a)) -> IO ()
free WindowCallbacks
-> IORef (FunPtr (Ptr C'GLFWwindow -> CDouble -> CDouble -> IO ()))
storedScrollFun
    (WindowCallbacks -> IORef (FunPtr (Ptr C'GLFWwindow -> IO ())))
-> IO ()
forall {a}. (WindowCallbacks -> IORef (FunPtr a)) -> IO ()
free WindowCallbacks -> IORef (FunPtr (Ptr C'GLFWwindow -> IO ()))
storedWindowCloseFun
    (WindowCallbacks
 -> IORef (FunPtr (Ptr C'GLFWwindow -> CInt -> IO ())))
-> IO ()
forall {a}. (WindowCallbacks -> IORef (FunPtr a)) -> IO ()
free WindowCallbacks
-> IORef (FunPtr (Ptr C'GLFWwindow -> CInt -> IO ()))
storedWindowFocusFun
    (WindowCallbacks
 -> IORef (FunPtr (Ptr C'GLFWwindow -> CInt -> IO ())))
-> IO ()
forall {a}. (WindowCallbacks -> IORef (FunPtr a)) -> IO ()
free WindowCallbacks
-> IORef (FunPtr (Ptr C'GLFWwindow -> CInt -> IO ()))
storedWindowIconifyFun
    (WindowCallbacks
 -> IORef (FunPtr (Ptr C'GLFWwindow -> CInt -> CInt -> IO ())))
-> IO ()
forall {a}. (WindowCallbacks -> IORef (FunPtr a)) -> IO ()
free WindowCallbacks
-> IORef (FunPtr (Ptr C'GLFWwindow -> CInt -> CInt -> IO ()))
storedWindowPosFun
    (WindowCallbacks -> IORef (FunPtr (Ptr C'GLFWwindow -> IO ())))
-> IO ()
forall {a}. (WindowCallbacks -> IORef (FunPtr a)) -> IO ()
free WindowCallbacks -> IORef (FunPtr (Ptr C'GLFWwindow -> IO ()))
storedWindowRefreshFun
    (WindowCallbacks
 -> IORef (FunPtr (Ptr C'GLFWwindow -> CInt -> CInt -> IO ())))
-> IO ()
forall {a}. (WindowCallbacks -> IORef (FunPtr a)) -> IO ()
free WindowCallbacks
-> IORef (FunPtr (Ptr C'GLFWwindow -> CInt -> CInt -> IO ()))
storedWindowSizeFun
    StablePtr WindowCallbacks -> IO ()
forall a. StablePtr a -> IO ()
freeStablePtr StablePtr WindowCallbacks
pcb

-- | Returns the value of an attribute of the specified window or its OpenGL or
-- OpenGL ES context.
-- See <https://www.glfw.org/docs/3.3/group__window.html#gacccb29947ea4b16860ebef42c2cb9337 glfwGetWindowAttrib>
getWindowAttrib :: Window -> WindowAttrib -> IO Bool
getWindowAttrib :: Window -> WindowAttrib -> IO Bool
getWindowAttrib Window
win WindowAttrib
attrib =
  CInt -> Bool
forall c h. C c h => c -> h
fromC (CInt -> Bool) -> IO CInt -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr C'GLFWwindow -> CInt -> IO CInt
c'glfwGetWindowAttrib (Window -> Ptr C'GLFWwindow
forall c h. C c h => h -> c
toC Window
win) (WindowAttrib -> CInt
forall c h. C c h => h -> c
toC WindowAttrib
attrib)

-- | Sets the value of an attribute of the specified window.
-- See <https://www.glfw.org/docs/3.3/group__window.html#gace2afda29b4116ec012e410a6819033e glfwSetWindowAttrib>
setWindowAttrib :: Window -> WindowAttrib -> Bool -> IO ()
setWindowAttrib :: Window -> WindowAttrib -> Bool -> IO ()
setWindowAttrib Window
win WindowAttrib
attrib = Ptr C'GLFWwindow -> CInt -> CInt -> IO ()
c'glfwSetWindowAttrib (Window -> Ptr C'GLFWwindow
forall c h. C c h => h -> c
toC Window
win) (WindowAttrib -> CInt
forall c h. C c h => h -> c
toC WindowAttrib
attrib) (CInt -> IO ()) -> (Bool -> CInt) -> Bool -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> CInt
forall c h. C c h => h -> c
toC

-- | If the window should close or not.
-- See <http://www.glfw.org/docs/3.3/group__window.html#ga24e02fbfefbb81fc45320989f8140ab5 glfwWindowShouldClose>
windowShouldClose :: Window -> IO Bool
windowShouldClose :: Window -> IO Bool
windowShouldClose Window
win =
    CInt -> Bool
forall c h. C c h => c -> h
fromC (CInt -> Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Ptr C'GLFWwindow -> IO CInt
c'glfwWindowShouldClose (Window -> Ptr C'GLFWwindow
forall c h. C c h => h -> c
toC Window
win)

-- | Sets if the window should close or not.
-- See <http://www.glfw.org/docs/3.3/group__window.html#ga49c449dde2a6f87d996f4daaa09d6708 glfwSetWindowShouldClose>
setWindowShouldClose :: Window -> Bool -> IO ()
setWindowShouldClose :: Window -> Bool -> IO ()
setWindowShouldClose Window
win Bool
b =
    Ptr C'GLFWwindow -> CInt -> IO ()
c'glfwSetWindowShouldClose (Window -> Ptr C'GLFWwindow
forall c h. C c h => h -> c
toC Window
win) (Bool -> CInt
forall c h. C c h => h -> c
toC Bool
b)

-- | Returns the opacity of the window, including any decorations.
-- See <https://www.glfw.org/docs/3.3/group__window.html#gad09f0bd7a6307c4533b7061828480a84 glfwGetWindowOpacity
getWindowOpacity :: Window -> IO Float
getWindowOpacity :: Window -> IO Float
getWindowOpacity = (CFloat -> Float) -> IO CFloat -> IO Float
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CFloat -> Float
hFloat (IO CFloat -> IO Float)
-> (Window -> IO CFloat) -> Window -> IO Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr C'GLFWwindow -> IO CFloat
c'glfwGetWindowOpacity (Ptr C'GLFWwindow -> IO CFloat)
-> (Window -> Ptr C'GLFWwindow) -> Window -> IO CFloat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Window -> Ptr C'GLFWwindow
forall c h. C c h => h -> c
toC

-- | Sets the opacity of the window, including any decorations
-- See <https://www.glfw.org/docs/3.3/group__window.html#gac31caeb3d1088831b13d2c8a156802e9 glfwSetWindowOpacity>
setWindowOpacity :: Window -> Float -> IO ()
setWindowOpacity :: Window -> Float -> IO ()
setWindowOpacity Window
win Float
op = Ptr C'GLFWwindow -> CFloat -> IO ()
c'glfwSetWindowOpacity (Window -> Ptr C'GLFWwindow
forall c h. C c h => h -> c
toC Window
win) (Float -> CFloat
CFloat Float
op)

-- | Sets the Title string of the window.
-- See <http://www.glfw.org/docs/3.3/group__window.html#ga5d877f09e968cef7a360b513306f17ff glfwSetWindowTitle>
setWindowTitle :: Window -> String -> IO ()
setWindowTitle :: Window -> String -> IO ()
setWindowTitle Window
win String
title =
    String -> (CString -> IO ()) -> IO ()
forall a. String -> (CString -> IO a) -> IO a
withCString String
title ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr C'GLFWwindow -> CString -> IO ()
c'glfwSetWindowTitle (Window -> Ptr C'GLFWwindow
forall c h. C c h => h -> c
toC Window
win)

-- | Gets the window's position (in screen coordinates).
-- See <http://www.glfw.org/docs/3.3/group__window.html#ga73cb526c000876fd8ddf571570fdb634 glfwGetWindowPos>
getWindowPos :: Window -> IO (Int, Int)
getWindowPos :: Window -> IO (Int, Int)
getWindowPos Window
win =
    Int -> (Ptr CInt -> IO (Int, Int)) -> IO (Int, Int)
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
2 ((Ptr CInt -> IO (Int, Int)) -> IO (Int, Int))
-> (Ptr CInt -> IO (Int, Int)) -> IO (Int, Int)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
p -> do
        let p'x :: Ptr CInt
p'x = Ptr CInt
p
            p'y :: Ptr CInt
p'y = Ptr CInt
p Ptr CInt -> Int -> Ptr CInt
forall a. Storable a => Ptr a -> Int -> Ptr a
`advancePtr` Int
1
        Ptr C'GLFWwindow -> Ptr CInt -> Ptr CInt -> IO ()
c'glfwGetWindowPos (Window -> Ptr C'GLFWwindow
forall c h. C c h => h -> c
toC Window
win) Ptr CInt
p'x Ptr CInt
p'y
        Int
x <- CInt -> Int
forall c h. C c h => c -> h
fromC (CInt -> Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
p'x
        Int
y <- CInt -> Int
forall c h. C c h => c -> h
fromC (CInt -> Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
p'y
        (Int, Int) -> IO (Int, Int)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
x, Int
y)

-- | Sets the window's position (in screen coordinates).
-- See <http://www.glfw.org/docs/3.3/group__window.html#ga1abb6d690e8c88e0c8cd1751356dbca8 glfwSetWindowPos>
setWindowPos :: Window -> Int -> Int -> IO ()
setWindowPos :: Window -> Int -> Int -> IO ()
setWindowPos Window
win Int
x Int
y =
    Ptr C'GLFWwindow -> CInt -> CInt -> IO ()
c'glfwSetWindowPos (Window -> Ptr C'GLFWwindow
forall c h. C c h => h -> c
toC Window
win) (Int -> CInt
forall c h. C c h => h -> c
toC Int
x) (Int -> CInt
forall c h. C c h => h -> c
toC Int
y)

-- | Gets the size of the window (in screen coordinates).
-- See <http://www.glfw.org/docs/3.3/group__window.html#gaeea7cbc03373a41fb51cfbf9f2a5d4c6 glfwGetWindowSize>
getWindowSize :: Window -> IO (Int, Int)
getWindowSize :: Window -> IO (Int, Int)
getWindowSize Window
win =
    Int -> (Ptr CInt -> IO (Int, Int)) -> IO (Int, Int)
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
2 ((Ptr CInt -> IO (Int, Int)) -> IO (Int, Int))
-> (Ptr CInt -> IO (Int, Int)) -> IO (Int, Int)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
p -> do
        let p'w :: Ptr CInt
p'w = Ptr CInt
p
            p'h :: Ptr CInt
p'h = Ptr CInt
p Ptr CInt -> Int -> Ptr CInt
forall a. Storable a => Ptr a -> Int -> Ptr a
`advancePtr` Int
1
        Ptr C'GLFWwindow -> Ptr CInt -> Ptr CInt -> IO ()
c'glfwGetWindowSize (Window -> Ptr C'GLFWwindow
forall c h. C c h => h -> c
toC Window
win) Ptr CInt
p'w Ptr CInt
p'h
        Int
w <- CInt -> Int
forall c h. C c h => c -> h
fromC (CInt -> Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
p'w
        Int
h <- CInt -> Int
forall c h. C c h => c -> h
fromC (CInt -> Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
p'h
        (Int, Int) -> IO (Int, Int)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
w, Int
h)

-- | Gets the size of the frame around the window (in screen coordinates). This
-- size includes the title bar, if the window has one. Not to be confused with
-- 'getFramebufferSize', which gets the size of the rendering area.
-- See <http://www.glfw.org/docs/3.3/group__window.html#ga1a9fd382058c53101b21cf211898f1f1 glfwGetWindowFrameSize>
getWindowFrameSize :: Window -> IO (Int, Int, Int, Int)
getWindowFrameSize :: Window -> IO (Int, Int, Int, Int)
getWindowFrameSize Window
win =
    Int
-> (Ptr CInt -> IO (Int, Int, Int, Int)) -> IO (Int, Int, Int, Int)
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
4 ((Ptr CInt -> IO (Int, Int, Int, Int)) -> IO (Int, Int, Int, Int))
-> (Ptr CInt -> IO (Int, Int, Int, Int)) -> IO (Int, Int, Int, Int)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
p -> do
        let p'l :: Ptr CInt
p'l = Ptr CInt
p
            p't :: Ptr CInt
p't = Ptr CInt
p Ptr CInt -> Int -> Ptr CInt
forall a. Storable a => Ptr a -> Int -> Ptr a
`advancePtr` Int
1
            p'r :: Ptr CInt
p'r = Ptr CInt
p Ptr CInt -> Int -> Ptr CInt
forall a. Storable a => Ptr a -> Int -> Ptr a
`advancePtr` Int
2
            p'b :: Ptr CInt
p'b = Ptr CInt
p Ptr CInt -> Int -> Ptr CInt
forall a. Storable a => Ptr a -> Int -> Ptr a
`advancePtr` Int
3
        Ptr C'GLFWwindow
-> Ptr CInt -> Ptr CInt -> Ptr CInt -> Ptr CInt -> IO ()
c'glfwGetWindowFrameSize (Window -> Ptr C'GLFWwindow
forall c h. C c h => h -> c
toC Window
win) Ptr CInt
p'l Ptr CInt
p't Ptr CInt
p'r Ptr CInt
p'b
        Int
l <- CInt -> Int
forall c h. C c h => c -> h
fromC (CInt -> Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
p'l
        Int
t <- CInt -> Int
forall c h. C c h => c -> h
fromC (CInt -> Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
p't
        Int
r <- CInt -> Int
forall c h. C c h => c -> h
fromC (CInt -> Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
p'r
        Int
b <- CInt -> Int
forall c h. C c h => c -> h
fromC (CInt -> Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
p'b
        (Int, Int, Int, Int) -> IO (Int, Int, Int, Int)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
l, Int
t, Int
r, Int
b)

-- | Sets the size of the client area for the window (in screen coordinates).
-- See <http://www.glfw.org/docs/3.3/group__window.html#ga371911f12c74c504dd8d47d832d095cb glfwSetWindowSize>
setWindowSize :: Window -> Int -> Int -> IO ()
setWindowSize :: Window -> Int -> Int -> IO ()
setWindowSize Window
win Int
w Int
h =
    Ptr C'GLFWwindow -> CInt -> CInt -> IO ()
c'glfwSetWindowSize (Window -> Ptr C'GLFWwindow
forall c h. C c h => h -> c
toC Window
win) (Int -> CInt
forall c h. C c h => h -> c
toC Int
w) (Int -> CInt
forall c h. C c h => h -> c
toC Int
h)

-- | Sets the size limits of the client area of the specified window. If the
-- window is full screen, the size limits only take effect once it is made
-- windowed. If the window is not resizable this function does nothing. Pass
-- 'Nothing' in any argument to disable the limit.
-- See <http://www.glfw.org/docs/3.3/group__window.html#gac314fa6cec7d2d307be9963e2709cc90 glfwSetWindowSizeLimits>
setWindowSizeLimits :: Window
                    -> Maybe Int
                    -- ^ The minimum width, in screen coordinates, of the client
                    --   area.
                    -> Maybe Int
                    -- ^ The minimum height, in screen coordinates, of the
                    --   client area.
                    -> Maybe Int
                    -- ^ The maximum width, in screen coordinates, of the client
                    --   area.
                    -> Maybe Int
                    -- ^ The maximum height, in screen coordinates, of the
                    --   client area.
                    -> IO ()
setWindowSizeLimits :: Window -> Maybe Int -> Maybe Int -> Maybe Int -> Maybe Int -> IO ()
setWindowSizeLimits Window
win Maybe Int
min'w Maybe Int
min'h Maybe Int
max'w Maybe Int
max'h =
  Ptr C'GLFWwindow -> CInt -> CInt -> CInt -> CInt -> IO ()
c'glfwSetWindowSizeLimits (Window -> Ptr C'GLFWwindow
forall c h. C c h => h -> c
toC Window
win) (Maybe Int -> CInt
forall c h. C c h => h -> c
toC Maybe Int
min'w) (Maybe Int -> CInt
forall c h. C c h => h -> c
toC Maybe Int
min'h)
                                      (Maybe Int -> CInt
forall c h. C c h => h -> c
toC Maybe Int
max'w) (Maybe Int -> CInt
forall c h. C c h => h -> c
toC Maybe Int
max'h)

-- | Sets the required aspect ratio of the client area of the specified window.
-- Pass Nothing to disable the limit.
-- See <http://www.glfw.org/docs/3.3/group__window.html#ga72ac8cb1ee2e312a878b55153d81b937 glfwSetWindowAspectRatio>
setWindowAspectRatio :: Window -> Maybe (Int, Int) -> IO ()
setWindowAspectRatio :: Window -> Maybe (Int, Int) -> IO ()
setWindowAspectRatio Window
win Maybe (Int, Int)
Nothing =
  Ptr C'GLFWwindow -> CInt -> CInt -> IO ()
c'glfwSetWindowAspectRatio (Window -> Ptr C'GLFWwindow
forall c h. C c h => h -> c
toC Window
win) CInt
forall a. Num a => a
c'GLFW_DONT_CARE CInt
forall a. Num a => a
c'GLFW_DONT_CARE
setWindowAspectRatio Window
win (Just (Int
w, Int
h)) =
  Ptr C'GLFWwindow -> CInt -> CInt -> IO ()
c'glfwSetWindowAspectRatio (Window -> Ptr C'GLFWwindow
forall c h. C c h => h -> c
toC Window
win) (Int -> CInt
forall c h. C c h => h -> c
toC Int
w) (Int -> CInt
forall c h. C c h => h -> c
toC Int
h)

-- | This function retrieves the content scale for the specified window. The
-- content scale is the ratio between the current DPI and the platform's
-- default DPI.
-- See <https://www.glfw.org/docs/3.3/group__window.html#gaf5d31de9c19c4f994facea64d2b3106c glfwGetWindowContentScale>
getWindowContentScale :: Window -> IO (Float, Float)
getWindowContentScale :: Window -> IO (Float, Float)
getWindowContentScale Window
win =
    (Ptr CFloat -> IO (Float, Float)) -> IO (Float, Float)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CFloat -> IO (Float, Float)) -> IO (Float, Float))
-> (Ptr CFloat -> IO (Float, Float)) -> IO (Float, Float)
forall a b. (a -> b) -> a -> b
$ \Ptr CFloat
p'x ->
    (Ptr CFloat -> IO (Float, Float)) -> IO (Float, Float)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CFloat -> IO (Float, Float)) -> IO (Float, Float))
-> (Ptr CFloat -> IO (Float, Float)) -> IO (Float, Float)
forall a b. (a -> b) -> a -> b
$ \Ptr CFloat
p'y -> do
        Ptr C'GLFWwindow -> Ptr CFloat -> Ptr CFloat -> IO ()
c'glfwGetWindowContentScale (Window -> Ptr C'GLFWwindow
forall c h. C c h => h -> c
toC Window
win) Ptr CFloat
p'x Ptr CFloat
p'y
        CFloat Float
x <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek Ptr CFloat
p'x
        CFloat Float
y <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek Ptr CFloat
p'y
        (Float, Float) -> IO (Float, Float)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Float
x, Float
y)

-- | The size of the framebuffer (in Pixels)
-- See <http://www.glfw.org/docs/3.3/group__window.html#ga0e2637a4161afb283f5300c7f94785c9 glfwGetFramebufferSize>
getFramebufferSize :: Window -> IO (Int, Int)
getFramebufferSize :: Window -> IO (Int, Int)
getFramebufferSize Window
win =
    Int -> (Ptr CInt -> IO (Int, Int)) -> IO (Int, Int)
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
2 ((Ptr CInt -> IO (Int, Int)) -> IO (Int, Int))
-> (Ptr CInt -> IO (Int, Int)) -> IO (Int, Int)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
p -> do
        let p'w :: Ptr CInt
p'w = Ptr CInt
p
            p'h :: Ptr CInt
p'h = Ptr CInt
p Ptr CInt -> Int -> Ptr CInt
forall a. Storable a => Ptr a -> Int -> Ptr a
`advancePtr` Int
1
        Ptr C'GLFWwindow -> Ptr CInt -> Ptr CInt -> IO ()
c'glfwGetFramebufferSize (Window -> Ptr C'GLFWwindow
forall c h. C c h => h -> c
toC Window
win) Ptr CInt
p'w Ptr CInt
p'h
        Int
w <- CInt -> Int
forall c h. C c h => c -> h
fromC (CInt -> Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
p'w
        Int
h <- CInt -> Int
forall c h. C c h => c -> h
fromC (CInt -> Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
p'h
        (Int, Int) -> IO (Int, Int)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
w, Int
h)

-- | Sets the icon of the specified window. The system will try to find the
-- image with the dimensions closest to the ones required by the platform. This
-- image is then scaled and used as the icon for that size. Good sizes are
-- 16x16, 32x32, and 48x48. Pass the empty list to reset to the default icon.
-- Has no effect on OS X (See the <https://developer.apple.com/library/content/documentation/CoreFoundation/Conceptual/CFBundles/Introduction/Introduction.html Bundle Programming Guide>)
setWindowIcon :: Window -> [Image] -> IO ()
setWindowIcon :: Window -> [Image] -> IO ()
setWindowIcon Window
win [] = Ptr C'GLFWwindow -> CInt -> Ptr C'GLFWimage -> IO ()
c'glfwSetWindowIcon (Window -> Ptr C'GLFWwindow
forall c h. C c h => h -> c
toC Window
win) CInt
0 Ptr C'GLFWimage
forall a. Ptr a
nullPtr
setWindowIcon Window
win [Image]
imgs =
  let arrSizeBytes :: Int
arrSizeBytes = [Image] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Image]
imgs Int -> Int -> Int
forall a. Num a => a -> a -> a
* C'GLFWimage -> Int
forall a. Storable a => a -> Int
sizeOf (C'GLFWimage
forall a. HasCallStack => a
undefined :: C'GLFWimage)

      addNextImage :: [Image] -> Int -> Ptr C'GLFWimage -> IO ()
      addNextImage :: [Image] -> Int -> Ptr C'GLFWimage -> IO ()
addNextImage [] Int
numImages Ptr C'GLFWimage
ptr =
        Ptr C'GLFWwindow -> CInt -> Ptr C'GLFWimage -> IO ()
c'glfwSetWindowIcon (Window -> Ptr C'GLFWwindow
forall c h. C c h => h -> c
toC Window
win) (Int -> CInt
forall c h. C c h => h -> c
toC Int
numImages) Ptr C'GLFWimage
ptr

      addNextImage (Image
img:[Image]
rest) Int
idx Ptr C'GLFWimage
ptr =
        Image -> (Ptr C'GLFWimage -> IO ()) -> IO ()
forall a. Image -> (Ptr C'GLFWimage -> IO a) -> IO a
withGLFWImage Image
img ((Ptr C'GLFWimage -> IO ()) -> IO ())
-> (Ptr C'GLFWimage -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr C'GLFWimage
p'img -> do
          C'GLFWimage
c'img <- Ptr C'GLFWimage -> IO C'GLFWimage
forall a. Storable a => Ptr a -> IO a
peek Ptr C'GLFWimage
p'img
          Ptr C'GLFWimage -> Int -> C'GLFWimage -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr C'GLFWimage
ptr Int
idx C'GLFWimage
c'img
          [Image] -> Int -> Ptr C'GLFWimage -> IO ()
addNextImage [Image]
rest (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Ptr C'GLFWimage
ptr
  in Int -> (Ptr C'GLFWimage -> IO ()) -> IO ()
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
arrSizeBytes ((Ptr C'GLFWimage -> IO ()) -> IO ())
-> (Ptr C'GLFWimage -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ [Image] -> Int -> Ptr C'GLFWimage -> IO ()
addNextImage [Image]
imgs Int
0

-- | Iconifies (minimizes) the window.
-- See <http://www.glfw.org/docs/3.3/group__window.html#ga1bb559c0ebaad63c5c05ad2a066779c4 glfwIconifyWindow>
iconifyWindow :: Window -> IO ()
iconifyWindow :: Window -> IO ()
iconifyWindow = Ptr C'GLFWwindow -> IO ()
c'glfwIconifyWindow (Ptr C'GLFWwindow -> IO ())
-> (Window -> Ptr C'GLFWwindow) -> Window -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Window -> Ptr C'GLFWwindow
forall c h. C c h => h -> c
toC

-- | Restores the window from an iconified/minimized state.
-- See <http://www.glfw.org/docs/3.3/group__window.html#ga52527a5904b47d802b6b4bb519cdebc7 glfwRestoreWindow>
restoreWindow :: Window -> IO ()
restoreWindow :: Window -> IO ()
restoreWindow = Ptr C'GLFWwindow -> IO ()
c'glfwRestoreWindow (Ptr C'GLFWwindow -> IO ())
-> (Window -> Ptr C'GLFWwindow) -> Window -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Window -> Ptr C'GLFWwindow
forall c h. C c h => h -> c
toC

-- | Brings the specified window to front and sets input focus. The window
-- should already be visible and not iconified.
-- See <http://www.glfw.org/docs/latest/group__window.html#ga873780357abd3f3a081d71a40aae45a1 glfwFocusWindow>
focusWindow :: Window -> IO ()
focusWindow :: Window -> IO ()
focusWindow = Ptr C'GLFWwindow -> IO ()
c'glfwFocusWindow (Ptr C'GLFWwindow -> IO ())
-> (Window -> Ptr C'GLFWwindow) -> Window -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Window -> Ptr C'GLFWwindow
forall c h. C c h => h -> c
toC

-- | Maximizes the specified window if it was not already maximized.
-- See <http://www.glfw.org/docs/3.3/group__window.html#ga3f541387449d911274324ae7f17ec56b glfwMaximizeWindow>
maximizeWindow :: Window -> IO ()
maximizeWindow :: Window -> IO ()
maximizeWindow = Ptr C'GLFWwindow -> IO ()
c'glfwMaximizeWindow (Ptr C'GLFWwindow -> IO ())
-> (Window -> Ptr C'GLFWwindow) -> Window -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Window -> Ptr C'GLFWwindow
forall c h. C c h => h -> c
toC

-- | Shows the window.
-- See <http://www.glfw.org/docs/3.3/group__window.html#ga61be47917b72536a148300f46494fc66 glfwShowWindow>
showWindow :: Window -> IO ()
showWindow :: Window -> IO ()
showWindow = Ptr C'GLFWwindow -> IO ()
c'glfwShowWindow (Ptr C'GLFWwindow -> IO ())
-> (Window -> Ptr C'GLFWwindow) -> Window -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Window -> Ptr C'GLFWwindow
forall c h. C c h => h -> c
toC

-- | Hides the window.
-- See <http://www.glfw.org/docs/3.3/group__window.html#ga49401f82a1ba5f15db5590728314d47c glfwHideWindow>
hideWindow :: Window -> IO ()
hideWindow :: Window -> IO ()
hideWindow = Ptr C'GLFWwindow -> IO ()
c'glfwHideWindow (Ptr C'GLFWwindow -> IO ())
-> (Window -> Ptr C'GLFWwindow) -> Window -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Window -> Ptr C'GLFWwindow
forall c h. C c h => h -> c
toC

-- | Requests user attention to the specified window.
-- See <https://www.glfw.org/docs/3.3/group__window.html#ga2f8d59323fc4692c1d54ba08c863a703 glfwRequestWindowAttention>
requestWindowAttention :: Window -> IO ()
requestWindowAttention :: Window -> IO ()
requestWindowAttention = Ptr C'GLFWwindow -> IO ()
c'glfwRequestWindowAttention (Ptr C'GLFWwindow -> IO ())
-> (Window -> Ptr C'GLFWwindow) -> Window -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Window -> Ptr C'GLFWwindow
forall c h. C c h => h -> c
toC

-- | Gets the monitor that this window is running on, provided the window is
-- fullscreen.
-- See <http://www.glfw.org/docs/3.3/group__window.html#gaeac25e64789974ccbe0811766bd91a16 glfwGetWindowMonitor>
getWindowMonitor :: Window -> IO (Maybe Monitor)
getWindowMonitor :: Window -> IO (Maybe Monitor)
getWindowMonitor Window
win = do
    Ptr C'GLFWmonitor
p'mon <- Ptr C'GLFWwindow -> IO (Ptr C'GLFWmonitor)
c'glfwGetWindowMonitor (Window -> Ptr C'GLFWwindow
forall c h. C c h => h -> c
toC Window
win)
    Maybe Monitor -> IO (Maybe Monitor)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Monitor -> IO (Maybe Monitor))
-> Maybe Monitor -> IO (Maybe Monitor)
forall a b. (a -> b) -> a -> b
$ if Ptr C'GLFWmonitor
p'mon Ptr C'GLFWmonitor -> Ptr C'GLFWmonitor -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr C'GLFWmonitor
forall a. Ptr a
nullPtr
      then Maybe Monitor
forall a. Maybe a
Nothing
      else Monitor -> Maybe Monitor
forall a. a -> Maybe a
Just (Monitor -> Maybe Monitor) -> Monitor -> Maybe Monitor
forall a b. (a -> b) -> a -> b
$ Ptr C'GLFWmonitor -> Monitor
forall c h. C c h => c -> h
fromC Ptr C'GLFWmonitor
p'mon

-- | Sets the position of the cursor within the window.
-- See <http://www.glfw.org/docs/3.3/group__input.html#ga04b03af936d906ca123c8f4ee08b39e7 glfwSetCursorPos>
setCursorPos :: Window -> Double -> Double -> IO ()
setCursorPos :: Window -> Double -> Double -> IO ()
setCursorPos Window
win Double
x Double
y =
    Ptr C'GLFWwindow -> CDouble -> CDouble -> IO ()
c'glfwSetCursorPos (Window -> Ptr C'GLFWwindow
forall c h. C c h => h -> c
toC Window
win) (Double -> CDouble
forall c h. C c h => h -> c
toC Double
x) (Double -> CDouble
forall c h. C c h => h -> c
toC Double
y)

-- | Makes a window fullscreen on the given monitor. The number of red, green,
-- and blue bits is ignored. Note, this shouldn't be used to update the
-- resolution of a fullscreen window. Use 'setWindowSize' instead.
-- See <http://www.glfw.org/docs/3.3/group__window.html#ga81c76c418af80a1cce7055bccb0ae0a7 glfwSetWindowMonitor>
setFullscreen :: Window -> Monitor -> VideoMode -> IO ()
setFullscreen :: Window -> Monitor -> VideoMode -> IO ()
setFullscreen Window
win Monitor
mon (VideoMode Int
width Int
height Int
_ Int
_ Int
_ Int
refresh) =
  Ptr C'GLFWwindow
-> Ptr C'GLFWmonitor
-> CInt
-> CInt
-> CInt
-> CInt
-> CInt
-> IO ()
c'glfwSetWindowMonitor (Window -> Ptr C'GLFWwindow
forall c h. C c h => h -> c
toC Window
win) (Monitor -> Ptr C'GLFWmonitor
forall c h. C c h => h -> c
toC Monitor
mon) CInt
0 CInt
0 (Int -> CInt
forall c h. C c h => h -> c
toC Int
width) (Int -> CInt
forall c h. C c h => h -> c
toC Int
height) (Int -> CInt
forall c h. C c h => h -> c
toC Int
refresh)

-- | Updates a window to be windowed instead of fullscreen. Note, this shouldn't
-- be used to update the position or size of a window. Use 'setWindowPos' and
-- 'setWindowSize' instead.
-- See <http://www.glfw.org/docs/3.3/group__window.html#ga81c76c418af80a1cce7055bccb0ae0a7 glfwSetWindowMonitor>
setWindowed :: Window
            -> Int  -- ^ The width of the client area
            -> Int  -- ^ The height of the client area
            -> Int  -- ^ The x position of the window
            -> Int  -- ^ The y position of the window
            -> IO ()
setWindowed :: Window -> Int -> Int -> Int -> Int -> IO ()
setWindowed Window
win Int
width Int
height Int
x Int
y =
  Ptr C'GLFWwindow
-> Ptr C'GLFWmonitor
-> CInt
-> CInt
-> CInt
-> CInt
-> CInt
-> IO ()
c'glfwSetWindowMonitor (Window -> Ptr C'GLFWwindow
forall c h. C c h => h -> c
toC Window
win) Ptr C'GLFWmonitor
forall a. Ptr a
nullPtr (Int -> CInt
forall c h. C c h => h -> c
toC Int
x) (Int -> CInt
forall c h. C c h => h -> c
toC Int
y) (Int -> CInt
forall c h. C c h => h -> c
toC Int
width) (Int -> CInt
forall c h. C c h => h -> c
toC Int
height) CInt
0

-- start of functions related to c'glfwGetWindowAttrib

-- | If the window has focus or not.
-- See <http://www.glfw.org/docs/3.3/group__window.html#gacccb29947ea4b16860ebef42c2cb9337 glfwGetWindowAttrib>
getWindowFocused :: Window -> IO Bool
getWindowFocused :: Window -> IO Bool
getWindowFocused Window
win =
    CInt -> Bool
forall c h. C c h => c -> h
fromC (CInt -> Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Ptr C'GLFWwindow -> CInt -> IO CInt
c'glfwGetWindowAttrib (Window -> Ptr C'GLFWwindow
forall c h. C c h => h -> c
toC Window
win) CInt
forall a. Num a => a
c'GLFW_FOCUSED

-- | If the window is maximized or not.
-- See <http://www.glfw.org/docs/3.3/group__window.html#gacccb29947ea4b16860ebef42c2cb9337 glfwGetWindowAttrib>
getWindowMaximized :: Window -> IO Bool
getWindowMaximized :: Window -> IO Bool
getWindowMaximized Window
win =
    CInt -> Bool
forall c h. C c h => c -> h
fromC (CInt -> Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Ptr C'GLFWwindow -> CInt -> IO CInt
c'glfwGetWindowAttrib (Window -> Ptr C'GLFWwindow
forall c h. C c h => h -> c
toC Window
win) CInt
forall a. Num a => a
c'GLFW_MAXIMIZED

-- | If the window has been set to be 'always on top' or not.
-- See <http://www.glfw.org/docs/latest/group__window.html#gacccb29947ea4b16860ebef42c2cb9337 glfwGetWindowAttrib>
getWindowFloating :: Window -> IO Bool
getWindowFloating :: Window -> IO Bool
getWindowFloating Window
win =
    CInt -> Bool
forall c h. C c h => c -> h
fromC (CInt -> Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Ptr C'GLFWwindow -> CInt -> IO CInt
c'glfwGetWindowAttrib (Window -> Ptr C'GLFWwindow
forall c h. C c h => h -> c
toC Window
win) CInt
forall a. Num a => a
c'GLFW_FLOATING

-- | If the window is iconified (minimized) or not.
-- See <http://www.glfw.org/docs/3.3/group__window.html#gacccb29947ea4b16860ebef42c2cb9337 glfwGetWindowAttrib>
getWindowIconified :: Window -> IO Bool
getWindowIconified :: Window -> IO Bool
getWindowIconified Window
win =
    CInt -> Bool
forall c h. C c h => c -> h
fromC (CInt -> Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Ptr C'GLFWwindow -> CInt -> IO CInt
c'glfwGetWindowAttrib (Window -> Ptr C'GLFWwindow
forall c h. C c h => h -> c
toC Window
win) CInt
forall a. Num a => a
c'GLFW_ICONIFIED

-- | If the window is resizable or not.
-- See <http://www.glfw.org/docs/3.3/group__window.html#gacccb29947ea4b16860ebef42c2cb9337 glfwGetWindowAttrib>
getWindowResizable :: Window -> IO Bool
getWindowResizable :: Window -> IO Bool
getWindowResizable Window
win =
    CInt -> Bool
forall c h. C c h => c -> h
fromC (CInt -> Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Ptr C'GLFWwindow -> CInt -> IO CInt
c'glfwGetWindowAttrib (Window -> Ptr C'GLFWwindow
forall c h. C c h => h -> c
toC Window
win) CInt
forall a. Num a => a
c'GLFW_RESIZABLE

-- | If the window is decorated or not.
-- See <http://www.glfw.org/docs/3.3/group__window.html#gacccb29947ea4b16860ebef42c2cb9337 glfwGetWindowAttrib>
getWindowDecorated :: Window -> IO Bool
getWindowDecorated :: Window -> IO Bool
getWindowDecorated Window
win =
    CInt -> Bool
forall c h. C c h => c -> h
fromC (CInt -> Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Ptr C'GLFWwindow -> CInt -> IO CInt
c'glfwGetWindowAttrib (Window -> Ptr C'GLFWwindow
forall c h. C c h => h -> c
toC Window
win) CInt
forall a. Num a => a
c'GLFW_DECORATED

-- | If the window is visible or not.
-- See <http://www.glfw.org/docs/3.3/group__window.html#gacccb29947ea4b16860ebef42c2cb9337 glfwGetWindowAttrib>
getWindowVisible :: Window -> IO Bool
getWindowVisible :: Window -> IO Bool
getWindowVisible Window
win =
    CInt -> Bool
forall c h. C c h => c -> h
fromC (CInt -> Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Ptr C'GLFWwindow -> CInt -> IO CInt
c'glfwGetWindowAttrib (Window -> Ptr C'GLFWwindow
forall c h. C c h => h -> c
toC Window
win) CInt
forall a. Num a => a
c'GLFW_VISIBLE

-- | The client api for this window.
-- See <http://www.glfw.org/docs/3.3/group__window.html#gacccb29947ea4b16860ebef42c2cb9337 glfwGetWindowAttrib>
getWindowClientAPI :: Window -> IO ClientAPI
getWindowClientAPI :: Window -> IO ClientAPI
getWindowClientAPI Window
win =
    CInt -> ClientAPI
forall c h. C c h => c -> h
fromC (CInt -> ClientAPI) -> IO CInt -> IO ClientAPI
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Ptr C'GLFWwindow -> CInt -> IO CInt
c'glfwGetWindowAttrib (Window -> Ptr C'GLFWwindow
forall c h. C c h => h -> c
toC Window
win) CInt
forall a. Num a => a
c'GLFW_CLIENT_API

-- | Returns the context creation API used to create the specified window.
-- See <http://www.glfw.org/docs/3.3/group__window.html#gacccb29947ea4b16860ebef42c2cb9337 glfwGetWindowAttrib>
getWindowContextCreationAPI :: Window -> IO ContextCreationAPI
getWindowContextCreationAPI :: Window -> IO ContextCreationAPI
getWindowContextCreationAPI Window
win =
    CInt -> ContextCreationAPI
forall c h. C c h => c -> h
fromC (CInt -> ContextCreationAPI) -> IO CInt -> IO ContextCreationAPI
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Ptr C'GLFWwindow -> CInt -> IO CInt
c'glfwGetWindowAttrib (Window -> Ptr C'GLFWwindow
forall c h. C c h => h -> c
toC Window
win) CInt
forall a. Num a => a
c'GLFW_CONTEXT_CREATION_API

-- | The context's "major" version, x.0.0
-- See <http://www.glfw.org/docs/3.3/group__window.html#gacccb29947ea4b16860ebef42c2cb9337 glfwGetWindowAttrib>
getWindowContextVersionMajor :: Window -> IO Int
getWindowContextVersionMajor :: Window -> IO Int
getWindowContextVersionMajor Window
win =
    CInt -> Int
forall c h. C c h => c -> h
fromC (CInt -> Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Ptr C'GLFWwindow -> CInt -> IO CInt
c'glfwGetWindowAttrib (Window -> Ptr C'GLFWwindow
forall c h. C c h => h -> c
toC Window
win) CInt
forall a. Num a => a
c'GLFW_CONTEXT_VERSION_MAJOR

-- | The context's "minor" version, 0.y.0
-- See <http://www.glfw.org/docs/3.3/group__window.html#gacccb29947ea4b16860ebef42c2cb9337 glfwGetWindowAttrib>
getWindowContextVersionMinor :: Window -> IO Int
getWindowContextVersionMinor :: Window -> IO Int
getWindowContextVersionMinor Window
win =
    CInt -> Int
forall c h. C c h => c -> h
fromC (CInt -> Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Ptr C'GLFWwindow -> CInt -> IO CInt
c'glfwGetWindowAttrib (Window -> Ptr C'GLFWwindow
forall c h. C c h => h -> c
toC Window
win) CInt
forall a. Num a => a
c'GLFW_CONTEXT_VERSION_MINOR

-- | The context's "revision" version, 0.0.z
-- See <http://www.glfw.org/docs/3.3/group__window.html#gacccb29947ea4b16860ebef42c2cb9337 glfwGetWindowAttrib>
getWindowContextVersionRevision :: Window -> IO Int
getWindowContextVersionRevision :: Window -> IO Int
getWindowContextVersionRevision Window
win =
    CInt -> Int
forall c h. C c h => c -> h
fromC (CInt -> Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Ptr C'GLFWwindow -> CInt -> IO CInt
c'glfwGetWindowAttrib (Window -> Ptr C'GLFWwindow
forall c h. C c h => h -> c
toC Window
win) CInt
forall a. Num a => a
c'GLFW_CONTEXT_REVISION

-- | The context robustness of this window.
-- See <http://www.glfw.org/docs/3.3/group__window.html#gacccb29947ea4b16860ebef42c2cb9337 glfwGetWindowAttrib>
getWindowContextRobustness :: Window -> IO ContextRobustness
getWindowContextRobustness :: Window -> IO ContextRobustness
getWindowContextRobustness Window
win =
    CInt -> ContextRobustness
forall c h. C c h => c -> h
fromC (CInt -> ContextRobustness) -> IO CInt -> IO ContextRobustness
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Ptr C'GLFWwindow -> CInt -> IO CInt
c'glfwGetWindowAttrib (Window -> Ptr C'GLFWwindow
forall c h. C c h => h -> c
toC Window
win) CInt
forall a. Num a => a
c'GLFW_CONTEXT_ROBUSTNESS

-- | Returns the context release behavior.
-- See <http://www.glfw.org/docs/3.3/group__window.html#gacccb29947ea4b16860ebef42c2cb9337 glfwGetWindowAttrib>
getWindowContextReleaseBehavior :: Window -> IO ContextReleaseBehavior
getWindowContextReleaseBehavior :: Window -> IO ContextReleaseBehavior
getWindowContextReleaseBehavior Window
win =
    CInt -> ContextReleaseBehavior
forall c h. C c h => c -> h
fromC (CInt -> ContextReleaseBehavior)
-> IO CInt -> IO ContextReleaseBehavior
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Ptr C'GLFWwindow -> CInt -> IO CInt
c'glfwGetWindowAttrib (Window -> Ptr C'GLFWwindow
forall c h. C c h => h -> c
toC Window
win) CInt
forall a. Num a => a
c'GLFW_CONTEXT_RELEASE_BEHAVIOR

-- | Returns true if the window is set to NO_ERROR (see the
-- <https://www.khronos.org/registry/OpenGL/extensions/KHR/KHR_no_error.txt KHR_no_error>
-- extension.
getWindowContextNoError :: Window -> IO Bool
getWindowContextNoError :: Window -> IO Bool
getWindowContextNoError Window
win =
    CInt -> Bool
forall c h. C c h => c -> h
fromC (CInt -> Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Ptr C'GLFWwindow -> CInt -> IO CInt
c'glfwGetWindowAttrib (Window -> Ptr C'GLFWwindow
forall c h. C c h => h -> c
toC Window
win) CInt
forall a. Num a => a
c'GLFW_CONTEXT_NO_ERROR

-- | If this window is set for opengl to be forward compatible.
-- See <http://www.glfw.org/docs/3.3/group__window.html#gacccb29947ea4b16860ebef42c2cb9337 glfwGetWindowAttrib>
getWindowOpenGLForwardCompat :: Window -> IO Bool
getWindowOpenGLForwardCompat :: Window -> IO Bool
getWindowOpenGLForwardCompat Window
win =
    CInt -> Bool
forall c h. C c h => c -> h
fromC (CInt -> Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Ptr C'GLFWwindow -> CInt -> IO CInt
c'glfwGetWindowAttrib (Window -> Ptr C'GLFWwindow
forall c h. C c h => h -> c
toC Window
win) CInt
forall a. Num a => a
c'GLFW_OPENGL_FORWARD_COMPAT

-- | If the window has an opengl debug context
-- See <http://www.glfw.org/docs/3.3/group__window.html#gacccb29947ea4b16860ebef42c2cb9337 glfwGetWindowAttrib>
getWindowOpenGLDebugContext :: Window -> IO Bool
getWindowOpenGLDebugContext :: Window -> IO Bool
getWindowOpenGLDebugContext Window
win =
    CInt -> Bool
forall c h. C c h => c -> h
fromC (CInt -> Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Ptr C'GLFWwindow -> CInt -> IO CInt
c'glfwGetWindowAttrib (Window -> Ptr C'GLFWwindow
forall c h. C c h => h -> c
toC Window
win) CInt
forall a. Num a => a
c'GLFW_OPENGL_DEBUG_CONTEXT

-- | Obtains the current opengl profile.
-- See <http://www.glfw.org/docs/3.3/group__window.html#gacccb29947ea4b16860ebef42c2cb9337 glfwGetWindowAttrib>
getWindowOpenGLProfile :: Window -> IO OpenGLProfile
getWindowOpenGLProfile :: Window -> IO OpenGLProfile
getWindowOpenGLProfile Window
win =
    CInt -> OpenGLProfile
forall c h. C c h => c -> h
fromC (CInt -> OpenGLProfile) -> IO CInt -> IO OpenGLProfile
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Ptr C'GLFWwindow -> CInt -> IO CInt
c'glfwGetWindowAttrib (Window -> Ptr C'GLFWwindow
forall c h. C c h => h -> c
toC Window
win) CInt
forall a. Num a => a
c'GLFW_OPENGL_PROFILE

-- end of functions related to c'glfwGetWindowAttrib

-- | Sets the callback to use when the window position changes.
-- See <http://www.glfw.org/docs/3.3/group__window.html#ga2837d4d240659feb4268fcb6530a6ba1 glfwSetWindowPosCallback>
setWindowPosCallback :: Window -> Maybe WindowPosCallback -> IO ()
setWindowPosCallback :: Window -> Maybe (Window -> Int -> Int -> IO ()) -> IO ()
setWindowPosCallback Window
win = ((Ptr C'GLFWwindow -> CInt -> CInt -> IO ())
 -> IO (FunPtr (Ptr C'GLFWwindow -> CInt -> CInt -> IO ())))
-> ((Window -> Int -> Int -> IO ())
    -> Ptr C'GLFWwindow -> CInt -> CInt -> IO ())
-> (FunPtr (Ptr C'GLFWwindow -> CInt -> CInt -> IO ())
    -> IO (FunPtr (Ptr C'GLFWwindow -> CInt -> CInt -> IO ())))
-> (WindowCallbacks
    -> IORef (FunPtr (Ptr C'GLFWwindow -> CInt -> CInt -> IO ())))
-> Window
-> Maybe (Window -> Int -> Int -> IO ())
-> IO ()
forall c h.
(c -> IO (FunPtr c))
-> (h -> c)
-> (FunPtr c -> IO (FunPtr c))
-> (WindowCallbacks -> IORef (FunPtr c))
-> Window
-> Maybe h
-> IO ()
setWindowCallback
    (Ptr C'GLFWwindow -> CInt -> CInt -> IO ())
-> IO (FunPtr (Ptr C'GLFWwindow -> CInt -> CInt -> IO ()))
mk'GLFWwindowposfun
    (\Window -> Int -> Int -> IO ()
cb Ptr C'GLFWwindow
a0 CInt
a1 CInt
a2 ->
      IO () -> IO ()
schedule (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Window -> Int -> Int -> IO ()
cb (Ptr C'GLFWwindow -> Window
forall c h. C c h => c -> h
fromC Ptr C'GLFWwindow
a0) (CInt -> Int
forall c h. C c h => c -> h
fromC CInt
a1) (CInt -> Int
forall c h. C c h => c -> h
fromC CInt
a2))
    (Ptr C'GLFWwindow
-> FunPtr (Ptr C'GLFWwindow -> CInt -> CInt -> IO ())
-> IO (FunPtr (Ptr C'GLFWwindow -> CInt -> CInt -> IO ()))
c'glfwSetWindowPosCallback (Window -> Ptr C'GLFWwindow
forall c h. C c h => h -> c
toC Window
win))
    WindowCallbacks
-> IORef (FunPtr (Ptr C'GLFWwindow -> CInt -> CInt -> IO ()))
storedWindowPosFun
    Window
win

-- | Sets the callback to use when the window's size changes.
-- See <http://www.glfw.org/docs/3.3/group__window.html#gaa40cd24840daa8c62f36cafc847c72b6 glfwSetWindowSizeCallback>
setWindowSizeCallback :: Window -> Maybe WindowSizeCallback -> IO ()
setWindowSizeCallback :: Window -> Maybe (Window -> Int -> Int -> IO ()) -> IO ()
setWindowSizeCallback Window
win = ((Ptr C'GLFWwindow -> CInt -> CInt -> IO ())
 -> IO (FunPtr (Ptr C'GLFWwindow -> CInt -> CInt -> IO ())))
-> ((Window -> Int -> Int -> IO ())
    -> Ptr C'GLFWwindow -> CInt -> CInt -> IO ())
-> (FunPtr (Ptr C'GLFWwindow -> CInt -> CInt -> IO ())
    -> IO (FunPtr (Ptr C'GLFWwindow -> CInt -> CInt -> IO ())))
-> (WindowCallbacks
    -> IORef (FunPtr (Ptr C'GLFWwindow -> CInt -> CInt -> IO ())))
-> Window
-> Maybe (Window -> Int -> Int -> IO ())
-> IO ()
forall c h.
(c -> IO (FunPtr c))
-> (h -> c)
-> (FunPtr c -> IO (FunPtr c))
-> (WindowCallbacks -> IORef (FunPtr c))
-> Window
-> Maybe h
-> IO ()
setWindowCallback
    (Ptr C'GLFWwindow -> CInt -> CInt -> IO ())
-> IO (FunPtr (Ptr C'GLFWwindow -> CInt -> CInt -> IO ()))
mk'GLFWwindowsizefun
    (\Window -> Int -> Int -> IO ()
cb Ptr C'GLFWwindow
a0 CInt
a1 CInt
a2 ->
      IO () -> IO ()
schedule (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Window -> Int -> Int -> IO ()
cb (Ptr C'GLFWwindow -> Window
forall c h. C c h => c -> h
fromC Ptr C'GLFWwindow
a0) (CInt -> Int
forall c h. C c h => c -> h
fromC CInt
a1) (CInt -> Int
forall c h. C c h => c -> h
fromC CInt
a2))
    (Ptr C'GLFWwindow
-> FunPtr (Ptr C'GLFWwindow -> CInt -> CInt -> IO ())
-> IO (FunPtr (Ptr C'GLFWwindow -> CInt -> CInt -> IO ()))
c'glfwSetWindowSizeCallback (Window -> Ptr C'GLFWwindow
forall c h. C c h => h -> c
toC Window
win))
    WindowCallbacks
-> IORef (FunPtr (Ptr C'GLFWwindow -> CInt -> CInt -> IO ()))
storedWindowSizeFun
    Window
win

-- | Sets the callback to use when the user attempts to close the window.
-- See <http://www.glfw.org/docs/3.3/group__window.html#gaade9264e79fae52bdb78e2df11ee8d6a glfwSetWindowCloseCallback>
setWindowCloseCallback :: Window -> Maybe WindowCloseCallback -> IO ()
setWindowCloseCallback :: Window -> Maybe (Window -> IO ()) -> IO ()
setWindowCloseCallback Window
win = ((Ptr C'GLFWwindow -> IO ())
 -> IO (FunPtr (Ptr C'GLFWwindow -> IO ())))
-> ((Window -> IO ()) -> Ptr C'GLFWwindow -> IO ())
-> (FunPtr (Ptr C'GLFWwindow -> IO ())
    -> IO (FunPtr (Ptr C'GLFWwindow -> IO ())))
-> (WindowCallbacks -> IORef (FunPtr (Ptr C'GLFWwindow -> IO ())))
-> Window
-> Maybe (Window -> IO ())
-> IO ()
forall c h.
(c -> IO (FunPtr c))
-> (h -> c)
-> (FunPtr c -> IO (FunPtr c))
-> (WindowCallbacks -> IORef (FunPtr c))
-> Window
-> Maybe h
-> IO ()
setWindowCallback
    (Ptr C'GLFWwindow -> IO ())
-> IO (FunPtr (Ptr C'GLFWwindow -> IO ()))
mk'GLFWwindowclosefun
    ((Window -> IO ())
-> (Ptr C'GLFWwindow -> Window) -> Ptr C'GLFWwindow -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr C'GLFWwindow -> Window
forall c h. C c h => c -> h
fromC)
    (Ptr C'GLFWwindow
-> FunPtr (Ptr C'GLFWwindow -> IO ())
-> IO (FunPtr (Ptr C'GLFWwindow -> IO ()))
c'glfwSetWindowCloseCallback (Window -> Ptr C'GLFWwindow
forall c h. C c h => h -> c
toC Window
win))
    WindowCallbacks -> IORef (FunPtr (Ptr C'GLFWwindow -> IO ()))
storedWindowCloseFun
    Window
win

-- | Sets the callback to use when the window's data is partly dead and it should refresh.
-- See <http://www.glfw.org/docs/3.3/group__window.html#ga4569b76e8ac87c55b53199e6becd97eb glfwSetWindowRefreshCallback>
setWindowRefreshCallback :: Window -> Maybe WindowRefreshCallback -> IO ()
setWindowRefreshCallback :: Window -> Maybe (Window -> IO ()) -> IO ()
setWindowRefreshCallback Window
win = ((Ptr C'GLFWwindow -> IO ())
 -> IO (FunPtr (Ptr C'GLFWwindow -> IO ())))
-> ((Window -> IO ()) -> Ptr C'GLFWwindow -> IO ())
-> (FunPtr (Ptr C'GLFWwindow -> IO ())
    -> IO (FunPtr (Ptr C'GLFWwindow -> IO ())))
-> (WindowCallbacks -> IORef (FunPtr (Ptr C'GLFWwindow -> IO ())))
-> Window
-> Maybe (Window -> IO ())
-> IO ()
forall c h.
(c -> IO (FunPtr c))
-> (h -> c)
-> (FunPtr c -> IO (FunPtr c))
-> (WindowCallbacks -> IORef (FunPtr c))
-> Window
-> Maybe h
-> IO ()
setWindowCallback
    (Ptr C'GLFWwindow -> IO ())
-> IO (FunPtr (Ptr C'GLFWwindow -> IO ()))
mk'GLFWwindowrefreshfun
    ((Window -> IO ())
-> (Ptr C'GLFWwindow -> Window) -> Ptr C'GLFWwindow -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr C'GLFWwindow -> Window
forall c h. C c h => c -> h
fromC)
    (Ptr C'GLFWwindow
-> FunPtr (Ptr C'GLFWwindow -> IO ())
-> IO (FunPtr (Ptr C'GLFWwindow -> IO ()))
c'glfwSetWindowRefreshCallback (Window -> Ptr C'GLFWwindow
forall c h. C c h => h -> c
toC Window
win))
    WindowCallbacks -> IORef (FunPtr (Ptr C'GLFWwindow -> IO ()))
storedWindowRefreshFun
    Window
win

-- | Sets the callback to use when the window gains or loses focus.
-- See <http://www.glfw.org/docs/3.3/group__window.html#ga25d1c584edb375d7711c5c3548ba711f glfwSetWindowFocusCallback>
setWindowFocusCallback :: Window -> Maybe WindowFocusCallback -> IO ()
setWindowFocusCallback :: Window -> Maybe (Window -> Bool -> IO ()) -> IO ()
setWindowFocusCallback Window
win = ((Ptr C'GLFWwindow -> CInt -> IO ())
 -> IO (FunPtr (Ptr C'GLFWwindow -> CInt -> IO ())))
-> ((Window -> Bool -> IO ()) -> Ptr C'GLFWwindow -> CInt -> IO ())
-> (FunPtr (Ptr C'GLFWwindow -> CInt -> IO ())
    -> IO (FunPtr (Ptr C'GLFWwindow -> CInt -> IO ())))
-> (WindowCallbacks
    -> IORef (FunPtr (Ptr C'GLFWwindow -> CInt -> IO ())))
-> Window
-> Maybe (Window -> Bool -> IO ())
-> IO ()
forall c h.
(c -> IO (FunPtr c))
-> (h -> c)
-> (FunPtr c -> IO (FunPtr c))
-> (WindowCallbacks -> IORef (FunPtr c))
-> Window
-> Maybe h
-> IO ()
setWindowCallback
    (Ptr C'GLFWwindow -> CInt -> IO ())
-> IO (FunPtr (Ptr C'GLFWwindow -> CInt -> IO ()))
mk'GLFWwindowfocusfun
    (\Window -> Bool -> IO ()
cb Ptr C'GLFWwindow
a0 CInt
a1 -> IO () -> IO ()
schedule (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Window -> Bool -> IO ()
cb (Ptr C'GLFWwindow -> Window
forall c h. C c h => c -> h
fromC Ptr C'GLFWwindow
a0) (CInt -> Bool
forall c h. C c h => c -> h
fromC CInt
a1))
    (Ptr C'GLFWwindow
-> FunPtr (Ptr C'GLFWwindow -> CInt -> IO ())
-> IO (FunPtr (Ptr C'GLFWwindow -> CInt -> IO ()))
c'glfwSetWindowFocusCallback (Window -> Ptr C'GLFWwindow
forall c h. C c h => h -> c
toC Window
win))
    WindowCallbacks
-> IORef (FunPtr (Ptr C'GLFWwindow -> CInt -> IO ()))
storedWindowFocusFun
    Window
win

-- | Sets the callback to use when the window is iconified or not (aka, minimized or not).
-- See <http://www.glfw.org/docs/3.3/group__window.html#gab1ea7263081c0e073b8d5b91d6ffd367 glfwSetWindowIconifyCallback>
setWindowIconifyCallback :: Window -> Maybe WindowIconifyCallback -> IO ()
setWindowIconifyCallback :: Window -> Maybe (Window -> Bool -> IO ()) -> IO ()
setWindowIconifyCallback Window
win = ((Ptr C'GLFWwindow -> CInt -> IO ())
 -> IO (FunPtr (Ptr C'GLFWwindow -> CInt -> IO ())))
-> ((Window -> Bool -> IO ()) -> Ptr C'GLFWwindow -> CInt -> IO ())
-> (FunPtr (Ptr C'GLFWwindow -> CInt -> IO ())
    -> IO (FunPtr (Ptr C'GLFWwindow -> CInt -> IO ())))
-> (WindowCallbacks
    -> IORef (FunPtr (Ptr C'GLFWwindow -> CInt -> IO ())))
-> Window
-> Maybe (Window -> Bool -> IO ())
-> IO ()
forall c h.
(c -> IO (FunPtr c))
-> (h -> c)
-> (FunPtr c -> IO (FunPtr c))
-> (WindowCallbacks -> IORef (FunPtr c))
-> Window
-> Maybe h
-> IO ()
setWindowCallback
    (Ptr C'GLFWwindow -> CInt -> IO ())
-> IO (FunPtr (Ptr C'GLFWwindow -> CInt -> IO ()))
mk'GLFWwindowiconifyfun
    (\Window -> Bool -> IO ()
cb Ptr C'GLFWwindow
a0 CInt
a1 -> IO () -> IO ()
schedule (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Window -> Bool -> IO ()
cb (Ptr C'GLFWwindow -> Window
forall c h. C c h => c -> h
fromC Ptr C'GLFWwindow
a0) (CInt -> Bool
forall c h. C c h => c -> h
fromC CInt
a1))
    (Ptr C'GLFWwindow
-> FunPtr (Ptr C'GLFWwindow -> CInt -> IO ())
-> IO (FunPtr (Ptr C'GLFWwindow -> CInt -> IO ()))
c'glfwSetWindowIconifyCallback (Window -> Ptr C'GLFWwindow
forall c h. C c h => h -> c
toC Window
win))
    WindowCallbacks
-> IORef (FunPtr (Ptr C'GLFWwindow -> CInt -> IO ()))
storedWindowIconifyFun
    Window
win

-- | Sets the callback for when the content scale of the window changes.
-- See <https://www.glfw.org/docs/3.3/window_guide.html#window_scale Window Content Scale>
setWindowContentScaleCallback :: Window -> Maybe WindowContentScaleCallback -> IO ()
setWindowContentScaleCallback :: Window -> Maybe WindowContentScaleCallback -> IO ()
setWindowContentScaleCallback Window
win = ((Ptr C'GLFWwindow -> CFloat -> CFloat -> IO ())
 -> IO (FunPtr (Ptr C'GLFWwindow -> CFloat -> CFloat -> IO ())))
-> (WindowContentScaleCallback
    -> Ptr C'GLFWwindow -> CFloat -> CFloat -> IO ())
-> (FunPtr (Ptr C'GLFWwindow -> CFloat -> CFloat -> IO ())
    -> IO (FunPtr (Ptr C'GLFWwindow -> CFloat -> CFloat -> IO ())))
-> (WindowCallbacks
    -> IORef (FunPtr (Ptr C'GLFWwindow -> CFloat -> CFloat -> IO ())))
-> Window
-> Maybe WindowContentScaleCallback
-> IO ()
forall c h.
(c -> IO (FunPtr c))
-> (h -> c)
-> (FunPtr c -> IO (FunPtr c))
-> (WindowCallbacks -> IORef (FunPtr c))
-> Window
-> Maybe h
-> IO ()
setWindowCallback
    (Ptr C'GLFWwindow -> CFloat -> CFloat -> IO ())
-> IO (FunPtr (Ptr C'GLFWwindow -> CFloat -> CFloat -> IO ()))
mk'GLFWwindowcontentscalefun
    (\WindowContentScaleCallback
cb Ptr C'GLFWwindow
w (CFloat Float
f1) (CFloat Float
f2) -> IO () -> IO ()
schedule (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ WindowContentScaleCallback
cb (Ptr C'GLFWwindow -> Window
forall c h. C c h => c -> h
fromC Ptr C'GLFWwindow
w) Float
f1 Float
f2)
    (Ptr C'GLFWwindow
-> FunPtr (Ptr C'GLFWwindow -> CFloat -> CFloat -> IO ())
-> IO (FunPtr (Ptr C'GLFWwindow -> CFloat -> CFloat -> IO ()))
c'glfwSetWindowContentScaleCallback (Window -> Ptr C'GLFWwindow
forall c h. C c h => h -> c
toC Window
win))
    WindowCallbacks
-> IORef (FunPtr (Ptr C'GLFWwindow -> CFloat -> CFloat -> IO ()))
storedWindowContentScaleFun
    Window
win

-- | Sets the maximization callback of the specified window, which is called
-- when the window is maximized or restored.
-- See <https://www.glfw.org/docs/3.3/window_guide.html#window_maximize Window maximization>
setWindowMaximizeCallback :: Window -> Maybe WindowMaximizeCallback -> IO ()
setWindowMaximizeCallback :: Window -> Maybe (Window -> Bool -> IO ()) -> IO ()
setWindowMaximizeCallback Window
win = ((Ptr C'GLFWwindow -> CInt -> IO ())
 -> IO (FunPtr (Ptr C'GLFWwindow -> CInt -> IO ())))
-> ((Window -> Bool -> IO ()) -> Ptr C'GLFWwindow -> CInt -> IO ())
-> (FunPtr (Ptr C'GLFWwindow -> CInt -> IO ())
    -> IO (FunPtr (Ptr C'GLFWwindow -> CInt -> IO ())))
-> (WindowCallbacks
    -> IORef (FunPtr (Ptr C'GLFWwindow -> CInt -> IO ())))
-> Window
-> Maybe (Window -> Bool -> IO ())
-> IO ()
forall c h.
(c -> IO (FunPtr c))
-> (h -> c)
-> (FunPtr c -> IO (FunPtr c))
-> (WindowCallbacks -> IORef (FunPtr c))
-> Window
-> Maybe h
-> IO ()
setWindowCallback
    (Ptr C'GLFWwindow -> CInt -> IO ())
-> IO (FunPtr (Ptr C'GLFWwindow -> CInt -> IO ()))
mk'GLFWwindowmaximizefun
    (\Window -> Bool -> IO ()
cb Ptr C'GLFWwindow
w CInt
x -> IO () -> IO ()
schedule (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Window -> Bool -> IO ()
cb (Ptr C'GLFWwindow -> Window
forall c h. C c h => c -> h
fromC Ptr C'GLFWwindow
w) (CInt -> Bool
forall c h. C c h => c -> h
fromC CInt
x))
    (Ptr C'GLFWwindow
-> FunPtr (Ptr C'GLFWwindow -> CInt -> IO ())
-> IO (FunPtr (Ptr C'GLFWwindow -> CInt -> IO ()))
c'glfwSetWindowMaximizeCallback (Window -> Ptr C'GLFWwindow
forall c h. C c h => h -> c
toC Window
win))
    WindowCallbacks
-> IORef (FunPtr (Ptr C'GLFWwindow -> CInt -> IO ()))
storedWindowMaximizeFun
    Window
win

-- | Sets the callback to use when the framebuffer's size changes.
-- See <http://www.glfw.org/docs/3.3/group__window.html#ga3203461a5303bf289f2e05f854b2f7cf glfwSetFramebufferSizeCallback>
setFramebufferSizeCallback :: Window -> Maybe FramebufferSizeCallback -> IO ()
setFramebufferSizeCallback :: Window -> Maybe (Window -> Int -> Int -> IO ()) -> IO ()
setFramebufferSizeCallback Window
win = ((Ptr C'GLFWwindow -> CInt -> CInt -> IO ())
 -> IO (FunPtr (Ptr C'GLFWwindow -> CInt -> CInt -> IO ())))
-> ((Window -> Int -> Int -> IO ())
    -> Ptr C'GLFWwindow -> CInt -> CInt -> IO ())
-> (FunPtr (Ptr C'GLFWwindow -> CInt -> CInt -> IO ())
    -> IO (FunPtr (Ptr C'GLFWwindow -> CInt -> CInt -> IO ())))
-> (WindowCallbacks
    -> IORef (FunPtr (Ptr C'GLFWwindow -> CInt -> CInt -> IO ())))
-> Window
-> Maybe (Window -> Int -> Int -> IO ())
-> IO ()
forall c h.
(c -> IO (FunPtr c))
-> (h -> c)
-> (FunPtr c -> IO (FunPtr c))
-> (WindowCallbacks -> IORef (FunPtr c))
-> Window
-> Maybe h
-> IO ()
setWindowCallback
    (Ptr C'GLFWwindow -> CInt -> CInt -> IO ())
-> IO (FunPtr (Ptr C'GLFWwindow -> CInt -> CInt -> IO ()))
mk'GLFWframebuffersizefun
    (\Window -> Int -> Int -> IO ()
cb Ptr C'GLFWwindow
a0 CInt
a1 CInt
a2 -> IO () -> IO ()
schedule (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Window -> Int -> Int -> IO ()
cb (Ptr C'GLFWwindow -> Window
forall c h. C c h => c -> h
fromC Ptr C'GLFWwindow
a0) (CInt -> Int
forall c h. C c h => c -> h
fromC CInt
a1) (CInt -> Int
forall c h. C c h => c -> h
fromC CInt
a2))
    (Ptr C'GLFWwindow
-> FunPtr (Ptr C'GLFWwindow -> CInt -> CInt -> IO ())
-> IO (FunPtr (Ptr C'GLFWwindow -> CInt -> CInt -> IO ()))
c'glfwSetFramebufferSizeCallback (Window -> Ptr C'GLFWwindow
forall c h. C c h => h -> c
toC Window
win))
    WindowCallbacks
-> IORef (FunPtr (Ptr C'GLFWwindow -> CInt -> CInt -> IO ()))
storedFramebufferSizeFun
    Window
win

-- | Checks for any pending events, processes them, and then immediately returns.
-- This is most useful for continual rendering, such as games.
-- See the <http://www.glfw.org/docs/3.3/input.html#events Event Processing Guide>. This
-- function is not <https://www.glfw.org/docs/latest/intro.html#reentrancy reentrant>.
pollEvents :: IO ()
pollEvents :: IO ()
pollEvents = IO ()
c'glfwPollEvents IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
executeScheduled

-- | Waits until at least one event is in the queue then processes the queue and returns.
-- Requires at least one window to be active for it to sleep. This saves a lot of CPU, and
-- is better if you're doing only periodic rendering, such as with an editor program.
-- See the <http://www.glfw.org/docs/3.3/input.html#events Event Processing Guide>. This
-- function is not <https://www.glfw.org/docs/latest/intro.html#reentrancy reentrant>.
waitEvents :: IO ()
waitEvents :: IO ()
waitEvents = IO ()
c'glfwWaitEvents IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
executeScheduled

-- | Same as 'waitEvents', with a timeout after which the function returns.
-- See the <http://www.glfw.org/docs/3.3/input.html#events Event Processing Guide>. This
-- function is not <https://www.glfw.org/docs/latest/intro.html#reentrancy reentrant>.
waitEventsTimeout :: Double -> IO ()
waitEventsTimeout :: Double -> IO ()
waitEventsTimeout Double
seconds =
  CDouble -> IO ()
c'glfwWaitEventsTimeout (Double -> CDouble
forall c h. C c h => h -> c
toC Double
seconds) IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
executeScheduled

-- | Creates an empty event within the event queue. Can be called from any
-- thread, so you can use this to wake up the main thread that's using
-- 'waitEvents' from a secondary thread.
-- See the <http://www.glfw.org/docs/3.3/input.html#events Event Processing Guide>
postEmptyEvent :: IO ()
postEmptyEvent :: IO ()
postEmptyEvent = IO ()
c'glfwPostEmptyEvent

--------------------------------------------------------------------------------
-- Input handling

-- start of glfw{GS}etInputMode-related functions

-- | Gets the current cursor input mode.
-- See <http://www.glfw.org/docs/3.3/group__input.html#gaa92336e173da9c8834558b54ee80563b glfwSetInputMode>
getCursorInputMode :: Window -> IO CursorInputMode
getCursorInputMode :: Window -> IO CursorInputMode
getCursorInputMode Window
win =
    CInt -> CursorInputMode
forall c h. C c h => c -> h
fromC (CInt -> CursorInputMode) -> IO CInt -> IO CursorInputMode
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Ptr C'GLFWwindow -> CInt -> IO CInt
c'glfwGetInputMode (Window -> Ptr C'GLFWwindow
forall c h. C c h => h -> c
toC Window
win) CInt
forall a. Num a => a
c'GLFW_CURSOR

-- | Set the cursor input mode.
-- See <http://www.glfw.org/docs/3.3/group__input.html#gaa92336e173da9c8834558b54ee80563b glfwSetInputMode>
setCursorInputMode :: Window -> CursorInputMode -> IO ()
setCursorInputMode :: Window -> CursorInputMode -> IO ()
setCursorInputMode Window
win CursorInputMode
c =
    Ptr C'GLFWwindow -> CInt -> CInt -> IO ()
c'glfwSetInputMode (Window -> Ptr C'GLFWwindow
forall c h. C c h => h -> c
toC Window
win) CInt
forall a. Num a => a
c'GLFW_CURSOR (CursorInputMode -> CInt
forall c h. C c h => h -> c
toC CursorInputMode
c)

-- | Sets the cursor to receive raw input, if available (See
-- rawMouseMotionSupported and
-- <https://www.glfw.org/docs/3.3/input_guide.html#raw_mouse_motion Raw Mouse Motion>
setRawMouseMotion :: Window -> Bool -> IO ()
setRawMouseMotion :: Window -> Bool -> IO ()
setRawMouseMotion Window
win Bool
toggle = do
    Bool
supported <- IO Bool
rawMouseMotionSupported
    if Bool -> Bool
not Bool
supported
      then String -> IO ()
putStrLn String
"WARNING -- Asked to set raw mouse motion but is unsupported"
      else Ptr C'GLFWwindow -> CInt -> CInt -> IO ()
c'glfwSetInputMode (Window -> Ptr C'GLFWwindow
forall c h. C c h => h -> c
toC Window
win) CInt
forall a. Num a => a
c'GLFW_RAW_MOUSE_MOTION (Bool -> CInt
forall c h. C c h => h -> c
toC Bool
toggle)

-- | Returns whether or not we've currently enabled raw mouse motion.
-- See <https://www.glfw.org/docs/3.3/input_guide.html#raw_mouse_motion Raw Mouse Motion>
getRawMouseMotion :: Window -> IO Bool
getRawMouseMotion :: Window -> IO Bool
getRawMouseMotion Window
win =
    CInt -> Bool
forall c h. C c h => c -> h
fromC (CInt -> Bool) -> IO CInt -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr C'GLFWwindow -> CInt -> IO CInt
c'glfwGetInputMode (Window -> Ptr C'GLFWwindow
forall c h. C c h => h -> c
toC Window
win) CInt
forall a. Num a => a
c'GLFW_RAW_MOUSE_MOTION

-- | Gets the current sticky keys mode.
-- See <http://www.glfw.org/docs/3.3/group__input.html#gaa92336e173da9c8834558b54ee80563b glfwSetInputMode>
getStickyKeysInputMode :: Window -> IO StickyKeysInputMode
getStickyKeysInputMode :: Window -> IO StickyKeysInputMode
getStickyKeysInputMode Window
win =
    CInt -> StickyKeysInputMode
forall c h. C c h => c -> h
fromC (CInt -> StickyKeysInputMode) -> IO CInt -> IO StickyKeysInputMode
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Ptr C'GLFWwindow -> CInt -> IO CInt
c'glfwGetInputMode (Window -> Ptr C'GLFWwindow
forall c h. C c h => h -> c
toC Window
win) CInt
forall a. Num a => a
c'GLFW_STICKY_KEYS

-- | Sets if sticky keys should be used or not.
-- See <http://www.glfw.org/docs/3.3/group__input.html#gaa92336e173da9c8834558b54ee80563b glfwSetInputMode>
setStickyKeysInputMode :: Window -> StickyKeysInputMode -> IO ()
setStickyKeysInputMode :: Window -> StickyKeysInputMode -> IO ()
setStickyKeysInputMode Window
win StickyKeysInputMode
sk =
    Ptr C'GLFWwindow -> CInt -> CInt -> IO ()
c'glfwSetInputMode (Window -> Ptr C'GLFWwindow
forall c h. C c h => h -> c
toC Window
win) CInt
forall a. Num a => a
c'GLFW_STICKY_KEYS (StickyKeysInputMode -> CInt
forall c h. C c h => h -> c
toC StickyKeysInputMode
sk)

-- | Gets if sticky mouse buttons are on or not.
-- See <http://www.glfw.org/docs/3.3/group__input.html#gaa92336e173da9c8834558b54ee80563b glfwSetInputMode>
getStickyMouseButtonsInputMode :: Window -> IO StickyMouseButtonsInputMode
getStickyMouseButtonsInputMode :: Window -> IO StickyMouseButtonsInputMode
getStickyMouseButtonsInputMode Window
win =
    CInt -> StickyMouseButtonsInputMode
forall c h. C c h => c -> h
fromC (CInt -> StickyMouseButtonsInputMode)
-> IO CInt -> IO StickyMouseButtonsInputMode
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Ptr C'GLFWwindow -> CInt -> IO CInt
c'glfwGetInputMode (Window -> Ptr C'GLFWwindow
forall c h. C c h => h -> c
toC Window
win) CInt
forall a. Num a => a
c'GLFW_STICKY_MOUSE_BUTTONS

-- | Sets if sticky mouse buttons should be used or not.
-- See <http://www.glfw.org/docs/3.3/group__input.html#gaa92336e173da9c8834558b54ee80563b glfwSetInputMode>
setStickyMouseButtonsInputMode :: Window -> StickyMouseButtonsInputMode -> IO ()
setStickyMouseButtonsInputMode :: Window -> StickyMouseButtonsInputMode -> IO ()
setStickyMouseButtonsInputMode Window
win StickyMouseButtonsInputMode
smb =
    Ptr C'GLFWwindow -> CInt -> CInt -> IO ()
c'glfwSetInputMode (Window -> Ptr C'GLFWwindow
forall c h. C c h => h -> c
toC Window
win) CInt
forall a. Num a => a
c'GLFW_STICKY_MOUSE_BUTTONS (StickyMouseButtonsInputMode -> CInt
forall c h. C c h => h -> c
toC StickyMouseButtonsInputMode
smb)

-- end of glfw{GS}etInputMode-related functions

-- | Gets the state of the specified key. If Stickey Keys isn't enabled then it's possible for
-- keyboard polling to miss individual key presses. Use the callback to avoid this.
-- See <http://www.glfw.org/docs/3.3/group__input.html#gadd341da06bc8d418b4dc3a3518af9ad2 glfwGetKey>
getKey :: Window -> Key -> IO KeyState
getKey :: Window -> Key -> IO KeyState
getKey Window
win Key
k =
    CInt -> KeyState
forall c h. C c h => c -> h
fromC (CInt -> KeyState) -> IO CInt -> IO KeyState
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Ptr C'GLFWwindow -> CInt -> IO CInt
c'glfwGetKey (Window -> Ptr C'GLFWwindow
forall c h. C c h => h -> c
toC Window
win) (Key -> CInt
forall c h. C c h => h -> c
toC Key
k)

-- | Returns the localized name of the specified printable key. This is intended
-- for displaying key bindings to the user. The scancode is used if the provided
-- 'Key' isn't printable. If the scancode maps to a non-printable key as well,
-- then 'Nothing' is returned.
-- See <http://www.glfw.org/docs/3.3/group__input.html#ga237a182e5ec0b21ce64543f3b5e7e2be glfwGetKeyName>
getKeyName :: Key -> Int -> IO (Maybe String)
getKeyName :: Key -> Int -> IO (Maybe String)
getKeyName Key
k Int
scancode = do
  CString
cstr <- CInt -> CInt -> IO CString
c'glfwGetKeyName (Key -> CInt
forall c h. C c h => h -> c
toC Key
k) (Int -> CInt
forall c h. C c h => h -> c
toC Int
scancode)
  if CString
cstr CString -> CString -> Bool
forall a. Eq a => a -> a -> Bool
== CString
forall a. Ptr a
nullPtr
    then Maybe String -> IO (Maybe String)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing
    else String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> IO String -> IO (Maybe String)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` CString -> IO String
peekCString CString
cstr

-- | This function returns the platform-specific scancode of the specified key.
-- See <https://www.glfw.org/docs/3.3/group__input.html#ga67ddd1b7dcbbaff03e4a76c0ea67103a glfwGetKeyScancode>
getKeyScancode :: Key -> IO Int
getKeyScancode :: Key -> IO Int
getKeyScancode = (CInt -> Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CInt -> Int
forall c h. C c h => c -> h
fromC (IO CInt -> IO Int) -> (Key -> IO CInt) -> Key -> IO Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> IO CInt
c'glfwGetKeyScancode (CInt -> IO CInt) -> (Key -> CInt) -> Key -> IO CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> CInt
forall c h. C c h => h -> c
toC

-- | Gets the state of a single specified mouse button. If sticky mouse button
-- mode isn't enabled it's possible for mouse polling to miss individual mouse events. Use
-- the call back to avoid this.
-- See <http://www.glfw.org/docs/3.3/group__input.html#gac1473feacb5996c01a7a5a33b5066704 glfwGetMouseButton>
getMouseButton :: Window -> MouseButton -> IO MouseButtonState
getMouseButton :: Window -> MouseButton -> IO MouseButtonState
getMouseButton Window
win MouseButton
b =
    CInt -> MouseButtonState
forall c h. C c h => c -> h
fromC (CInt -> MouseButtonState) -> IO CInt -> IO MouseButtonState
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Ptr C'GLFWwindow -> CInt -> IO CInt
c'glfwGetMouseButton (Window -> Ptr C'GLFWwindow
forall c h. C c h => h -> c
toC Window
win) (MouseButton -> CInt
forall c h. C c h => h -> c
toC MouseButton
b)

-- | Returns the position, in screen coodinates, relative to the upper left.
-- If the 'CursorInputMode' is "disabled", then results are unbounded by the window size.
-- See <http://www.glfw.org/docs/3.3/group__input.html#ga01d37b6c40133676b9cea60ca1d7c0cc glfwGetCursorPos>
getCursorPos :: Window -> IO (Double, Double)
getCursorPos :: Window -> IO (Double, Double)
getCursorPos Window
win =
    Int -> (Ptr CDouble -> IO (Double, Double)) -> IO (Double, Double)
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
2 ((Ptr CDouble -> IO (Double, Double)) -> IO (Double, Double))
-> (Ptr CDouble -> IO (Double, Double)) -> IO (Double, Double)
forall a b. (a -> b) -> a -> b
$ \Ptr CDouble
p -> do
        let p'x :: Ptr CDouble
p'x = Ptr CDouble
p
            p'y :: Ptr CDouble
p'y = Ptr CDouble
p Ptr CDouble -> Int -> Ptr CDouble
forall a. Storable a => Ptr a -> Int -> Ptr a
`advancePtr` Int
1
        Ptr C'GLFWwindow -> Ptr CDouble -> Ptr CDouble -> IO ()
c'glfwGetCursorPos (Window -> Ptr C'GLFWwindow
forall c h. C c h => h -> c
toC Window
win) Ptr CDouble
p'x Ptr CDouble
p'y
        Double
x <- CDouble -> Double
forall c h. C c h => c -> h
fromC (CDouble -> Double) -> IO CDouble -> IO Double
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek Ptr CDouble
p'x
        Double
y <- CDouble -> Double
forall c h. C c h => c -> h
fromC (CDouble -> Double) -> IO CDouble -> IO Double
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek Ptr CDouble
p'y
        (Double, Double) -> IO (Double, Double)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Double
x, Double
y)

-- | Assigns the given callback to use for all keyboard presses and repeats.
-- See <http://www.glfw.org/docs/3.3/group__input.html#ga7e496507126f35ea72f01b2e6ef6d155 glfwSetKeyCallback>
setKeyCallback :: Window -> Maybe KeyCallback -> IO ()
setKeyCallback :: Window -> Maybe KeyCallback -> IO ()
setKeyCallback Window
win = ((Ptr C'GLFWwindow -> CInt -> CInt -> CInt -> CInt -> IO ())
 -> IO
      (FunPtr
         (Ptr C'GLFWwindow -> CInt -> CInt -> CInt -> CInt -> IO ())))
-> (KeyCallback
    -> Ptr C'GLFWwindow -> CInt -> CInt -> CInt -> CInt -> IO ())
-> (FunPtr
      (Ptr C'GLFWwindow -> CInt -> CInt -> CInt -> CInt -> IO ())
    -> IO
         (FunPtr
            (Ptr C'GLFWwindow -> CInt -> CInt -> CInt -> CInt -> IO ())))
-> (WindowCallbacks
    -> IORef
         (FunPtr
            (Ptr C'GLFWwindow -> CInt -> CInt -> CInt -> CInt -> IO ())))
-> Window
-> Maybe KeyCallback
-> IO ()
forall c h.
(c -> IO (FunPtr c))
-> (h -> c)
-> (FunPtr c -> IO (FunPtr c))
-> (WindowCallbacks -> IORef (FunPtr c))
-> Window
-> Maybe h
-> IO ()
setWindowCallback
    (Ptr C'GLFWwindow -> CInt -> CInt -> CInt -> CInt -> IO ())
-> IO
     (FunPtr
        (Ptr C'GLFWwindow -> CInt -> CInt -> CInt -> CInt -> IO ()))
mk'GLFWkeyfun
    (\KeyCallback
cb Ptr C'GLFWwindow
a0 CInt
a1 CInt
a2 CInt
a3 CInt
a4 ->
      IO () -> IO ()
schedule (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ KeyCallback
cb (Ptr C'GLFWwindow -> Window
forall c h. C c h => c -> h
fromC Ptr C'GLFWwindow
a0) (CInt -> Key
forall c h. C c h => c -> h
fromC CInt
a1) (CInt -> Int
forall c h. C c h => c -> h
fromC CInt
a2) (CInt -> KeyState
forall c h. C c h => c -> h
fromC CInt
a3) (CInt -> ModifierKeys
forall c h. C c h => c -> h
fromC CInt
a4))
    (Ptr C'GLFWwindow
-> FunPtr
     (Ptr C'GLFWwindow -> CInt -> CInt -> CInt -> CInt -> IO ())
-> IO
     (FunPtr
        (Ptr C'GLFWwindow -> CInt -> CInt -> CInt -> CInt -> IO ()))
c'glfwSetKeyCallback (Window -> Ptr C'GLFWwindow
forall c h. C c h => h -> c
toC Window
win))
    WindowCallbacks
-> IORef
     (FunPtr
        (Ptr C'GLFWwindow -> CInt -> CInt -> CInt -> CInt -> IO ()))
storedKeyFun
    Window
win

-- | Sets the callback to use when the user types a character
-- See <http://www.glfw.org/docs/3.3/group__input.html#ga556239421c6a5a243c66fca28da9f742 glfwSetCharCallback>
setCharCallback :: Window -> Maybe CharCallback -> IO ()
setCharCallback :: Window -> Maybe CharCallback -> IO ()
setCharCallback Window
win = ((Ptr C'GLFWwindow -> CUInt -> IO ())
 -> IO (FunPtr (Ptr C'GLFWwindow -> CUInt -> IO ())))
-> (CharCallback -> Ptr C'GLFWwindow -> CUInt -> IO ())
-> (FunPtr (Ptr C'GLFWwindow -> CUInt -> IO ())
    -> IO (FunPtr (Ptr C'GLFWwindow -> CUInt -> IO ())))
-> (WindowCallbacks
    -> IORef (FunPtr (Ptr C'GLFWwindow -> CUInt -> IO ())))
-> Window
-> Maybe CharCallback
-> IO ()
forall c h.
(c -> IO (FunPtr c))
-> (h -> c)
-> (FunPtr c -> IO (FunPtr c))
-> (WindowCallbacks -> IORef (FunPtr c))
-> Window
-> Maybe h
-> IO ()
setWindowCallback
    (Ptr C'GLFWwindow -> CUInt -> IO ())
-> IO (FunPtr (Ptr C'GLFWwindow -> CUInt -> IO ()))
mk'GLFWcharfun
    (\CharCallback
cb Ptr C'GLFWwindow
a0 CUInt
a1 -> IO () -> IO ()
schedule (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ CharCallback
cb (Ptr C'GLFWwindow -> Window
forall c h. C c h => c -> h
fromC Ptr C'GLFWwindow
a0) (CUInt -> Char
forall c h. C c h => c -> h
fromC CUInt
a1))
    (Ptr C'GLFWwindow
-> FunPtr (Ptr C'GLFWwindow -> CUInt -> IO ())
-> IO (FunPtr (Ptr C'GLFWwindow -> CUInt -> IO ()))
c'glfwSetCharCallback (Window -> Ptr C'GLFWwindow
forall c h. C c h => h -> c
toC Window
win))
    WindowCallbacks
-> IORef (FunPtr (Ptr C'GLFWwindow -> CUInt -> IO ()))
storedCharFun
    Window
win

-- | Sets the callback to use with Unicode characters regardless of what
-- modifier keys are used.
-- See <http://www.glfw.org/docs/3.3/group__input.html#ga3f55ef5dc03a374e567f068b13c94afc glfwSetCharModsCallback>
setCharModsCallback :: Window -> Maybe CharModsCallback -> IO ()
setCharModsCallback :: Window -> Maybe CharModsCallback -> IO ()
setCharModsCallback Window
win = ((Ptr C'GLFWwindow -> CUInt -> CInt -> IO ())
 -> IO (FunPtr (Ptr C'GLFWwindow -> CUInt -> CInt -> IO ())))
-> (CharModsCallback -> Ptr C'GLFWwindow -> CUInt -> CInt -> IO ())
-> (FunPtr (Ptr C'GLFWwindow -> CUInt -> CInt -> IO ())
    -> IO (FunPtr (Ptr C'GLFWwindow -> CUInt -> CInt -> IO ())))
-> (WindowCallbacks
    -> IORef (FunPtr (Ptr C'GLFWwindow -> CUInt -> CInt -> IO ())))
-> Window
-> Maybe CharModsCallback
-> IO ()
forall c h.
(c -> IO (FunPtr c))
-> (h -> c)
-> (FunPtr c -> IO (FunPtr c))
-> (WindowCallbacks -> IORef (FunPtr c))
-> Window
-> Maybe h
-> IO ()
setWindowCallback
    (Ptr C'GLFWwindow -> CUInt -> CInt -> IO ())
-> IO (FunPtr (Ptr C'GLFWwindow -> CUInt -> CInt -> IO ()))
mk'GLFWcharmodsfun
    (\CharModsCallback
cb Ptr C'GLFWwindow
a0 CUInt
a1 CInt
a2 -> IO () -> IO ()
schedule (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ CharModsCallback
cb (Ptr C'GLFWwindow -> Window
forall c h. C c h => c -> h
fromC Ptr C'GLFWwindow
a0) (CUInt -> Char
forall c h. C c h => c -> h
fromC CUInt
a1) (CInt -> ModifierKeys
forall c h. C c h => c -> h
fromC CInt
a2))
    (Ptr C'GLFWwindow
-> FunPtr (Ptr C'GLFWwindow -> CUInt -> CInt -> IO ())
-> IO (FunPtr (Ptr C'GLFWwindow -> CUInt -> CInt -> IO ()))
c'glfwSetCharModsCallback (Window -> Ptr C'GLFWwindow
forall c h. C c h => h -> c
toC Window
win))
    WindowCallbacks
-> IORef (FunPtr (Ptr C'GLFWwindow -> CUInt -> CInt -> IO ()))
storedCharModsFun
    Window
win

-- | Assigns the callback to run whenver a mouse button is clicked.
-- See <http://www.glfw.org/docs/3.3/group__input.html#gaef49b72d84d615bca0a6ed65485e035d glfwSetMouseButtonCallback>
setMouseButtonCallback :: Window -> Maybe MouseButtonCallback -> IO ()
setMouseButtonCallback :: Window -> Maybe MouseButtonCallback -> IO ()
setMouseButtonCallback Window
win = ((Ptr C'GLFWwindow -> CInt -> CInt -> CInt -> IO ())
 -> IO (FunPtr (Ptr C'GLFWwindow -> CInt -> CInt -> CInt -> IO ())))
-> (MouseButtonCallback
    -> Ptr C'GLFWwindow -> CInt -> CInt -> CInt -> IO ())
-> (FunPtr (Ptr C'GLFWwindow -> CInt -> CInt -> CInt -> IO ())
    -> IO (FunPtr (Ptr C'GLFWwindow -> CInt -> CInt -> CInt -> IO ())))
-> (WindowCallbacks
    -> IORef
         (FunPtr (Ptr C'GLFWwindow -> CInt -> CInt -> CInt -> IO ())))
-> Window
-> Maybe MouseButtonCallback
-> IO ()
forall c h.
(c -> IO (FunPtr c))
-> (h -> c)
-> (FunPtr c -> IO (FunPtr c))
-> (WindowCallbacks -> IORef (FunPtr c))
-> Window
-> Maybe h
-> IO ()
setWindowCallback
    (Ptr C'GLFWwindow -> CInt -> CInt -> CInt -> IO ())
-> IO (FunPtr (Ptr C'GLFWwindow -> CInt -> CInt -> CInt -> IO ()))
mk'GLFWmousebuttonfun
    (\MouseButtonCallback
cb Ptr C'GLFWwindow
a0 CInt
a1 CInt
a2 CInt
a3 -> IO () -> IO ()
schedule (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ MouseButtonCallback
cb (Ptr C'GLFWwindow -> Window
forall c h. C c h => c -> h
fromC Ptr C'GLFWwindow
a0) (CInt -> MouseButton
forall c h. C c h => c -> h
fromC CInt
a1) (CInt -> MouseButtonState
forall c h. C c h => c -> h
fromC CInt
a2) (CInt -> ModifierKeys
forall c h. C c h => c -> h
fromC CInt
a3))
    (Ptr C'GLFWwindow
-> FunPtr (Ptr C'GLFWwindow -> CInt -> CInt -> CInt -> IO ())
-> IO (FunPtr (Ptr C'GLFWwindow -> CInt -> CInt -> CInt -> IO ()))
c'glfwSetMouseButtonCallback (Window -> Ptr C'GLFWwindow
forall c h. C c h => h -> c
toC Window
win))
    WindowCallbacks
-> IORef
     (FunPtr (Ptr C'GLFWwindow -> CInt -> CInt -> CInt -> IO ()))
storedMouseButtonFun
    Window
win

-- | Assigns the callback to run whenver the cursor position changes.
-- See <http://www.glfw.org/docs/3.3/group__input.html#ga7dad39486f2c7591af7fb25134a2501d glfwSetCursorPosCallback>
setCursorPosCallback :: Window -> Maybe CursorPosCallback -> IO ()
setCursorPosCallback :: Window -> Maybe (Window -> Double -> Double -> IO ()) -> IO ()
setCursorPosCallback Window
win = ((Ptr C'GLFWwindow -> CDouble -> CDouble -> IO ())
 -> IO (FunPtr (Ptr C'GLFWwindow -> CDouble -> CDouble -> IO ())))
-> ((Window -> Double -> Double -> IO ())
    -> Ptr C'GLFWwindow -> CDouble -> CDouble -> IO ())
-> (FunPtr (Ptr C'GLFWwindow -> CDouble -> CDouble -> IO ())
    -> IO (FunPtr (Ptr C'GLFWwindow -> CDouble -> CDouble -> IO ())))
-> (WindowCallbacks
    -> IORef
         (FunPtr (Ptr C'GLFWwindow -> CDouble -> CDouble -> IO ())))
-> Window
-> Maybe (Window -> Double -> Double -> IO ())
-> IO ()
forall c h.
(c -> IO (FunPtr c))
-> (h -> c)
-> (FunPtr c -> IO (FunPtr c))
-> (WindowCallbacks -> IORef (FunPtr c))
-> Window
-> Maybe h
-> IO ()
setWindowCallback
    (Ptr C'GLFWwindow -> CDouble -> CDouble -> IO ())
-> IO (FunPtr (Ptr C'GLFWwindow -> CDouble -> CDouble -> IO ()))
mk'GLFWcursorposfun
    (\Window -> Double -> Double -> IO ()
cb Ptr C'GLFWwindow
a0 CDouble
a1 CDouble
a2 -> IO () -> IO ()
schedule (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Window -> Double -> Double -> IO ()
cb (Ptr C'GLFWwindow -> Window
forall c h. C c h => c -> h
fromC Ptr C'GLFWwindow
a0) (CDouble -> Double
forall c h. C c h => c -> h
fromC CDouble
a1) (CDouble -> Double
forall c h. C c h => c -> h
fromC CDouble
a2))
    (Ptr C'GLFWwindow
-> FunPtr (Ptr C'GLFWwindow -> CDouble -> CDouble -> IO ())
-> IO (FunPtr (Ptr C'GLFWwindow -> CDouble -> CDouble -> IO ()))
c'glfwSetCursorPosCallback (Window -> Ptr C'GLFWwindow
forall c h. C c h => h -> c
toC Window
win))
    WindowCallbacks
-> IORef (FunPtr (Ptr C'GLFWwindow -> CDouble -> CDouble -> IO ()))
storedCursorPosFun
    Window
win

-- | Sets the callback for when the cursor enters or leaves the client area.
-- See <http://www.glfw.org/docs/3.3/input.html#cursor_enter Cursor Enter/Leave Events>
setCursorEnterCallback :: Window -> Maybe CursorEnterCallback -> IO ()
setCursorEnterCallback :: Window -> Maybe CursorEnterCallback -> IO ()
setCursorEnterCallback Window
win = ((Ptr C'GLFWwindow -> CInt -> IO ())
 -> IO (FunPtr (Ptr C'GLFWwindow -> CInt -> IO ())))
-> (CursorEnterCallback -> Ptr C'GLFWwindow -> CInt -> IO ())
-> (FunPtr (Ptr C'GLFWwindow -> CInt -> IO ())
    -> IO (FunPtr (Ptr C'GLFWwindow -> CInt -> IO ())))
-> (WindowCallbacks
    -> IORef (FunPtr (Ptr C'GLFWwindow -> CInt -> IO ())))
-> Window
-> Maybe CursorEnterCallback
-> IO ()
forall c h.
(c -> IO (FunPtr c))
-> (h -> c)
-> (FunPtr c -> IO (FunPtr c))
-> (WindowCallbacks -> IORef (FunPtr c))
-> Window
-> Maybe h
-> IO ()
setWindowCallback
    (Ptr C'GLFWwindow -> CInt -> IO ())
-> IO (FunPtr (Ptr C'GLFWwindow -> CInt -> IO ()))
mk'GLFWcursorenterfun
    (\CursorEnterCallback
cb Ptr C'GLFWwindow
a0 CInt
a1 -> IO () -> IO ()
schedule (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ CursorEnterCallback
cb (Ptr C'GLFWwindow -> Window
forall c h. C c h => c -> h
fromC Ptr C'GLFWwindow
a0) (CInt -> CursorState
forall c h. C c h => c -> h
fromC CInt
a1))
    (Ptr C'GLFWwindow
-> FunPtr (Ptr C'GLFWwindow -> CInt -> IO ())
-> IO (FunPtr (Ptr C'GLFWwindow -> CInt -> IO ()))
c'glfwSetCursorEnterCallback (Window -> Ptr C'GLFWwindow
forall c h. C c h => h -> c
toC Window
win))
    WindowCallbacks
-> IORef (FunPtr (Ptr C'GLFWwindow -> CInt -> IO ()))
storedCursorEnterFun
    Window
win

-- | Sets the callback to run when the user scrolls with the mouse wheel or a touch gesture.
-- See <http://www.glfw.org/docs/3.3/input.html#scrolling Scroll Input>
setScrollCallback :: Window -> Maybe ScrollCallback -> IO ()
setScrollCallback :: Window -> Maybe (Window -> Double -> Double -> IO ()) -> IO ()
setScrollCallback Window
win = ((Ptr C'GLFWwindow -> CDouble -> CDouble -> IO ())
 -> IO (FunPtr (Ptr C'GLFWwindow -> CDouble -> CDouble -> IO ())))
-> ((Window -> Double -> Double -> IO ())
    -> Ptr C'GLFWwindow -> CDouble -> CDouble -> IO ())
-> (FunPtr (Ptr C'GLFWwindow -> CDouble -> CDouble -> IO ())
    -> IO (FunPtr (Ptr C'GLFWwindow -> CDouble -> CDouble -> IO ())))
-> (WindowCallbacks
    -> IORef
         (FunPtr (Ptr C'GLFWwindow -> CDouble -> CDouble -> IO ())))
-> Window
-> Maybe (Window -> Double -> Double -> IO ())
-> IO ()
forall c h.
(c -> IO (FunPtr c))
-> (h -> c)
-> (FunPtr c -> IO (FunPtr c))
-> (WindowCallbacks -> IORef (FunPtr c))
-> Window
-> Maybe h
-> IO ()
setWindowCallback
    (Ptr C'GLFWwindow -> CDouble -> CDouble -> IO ())
-> IO (FunPtr (Ptr C'GLFWwindow -> CDouble -> CDouble -> IO ()))
mk'GLFWscrollfun
    (\Window -> Double -> Double -> IO ()
cb Ptr C'GLFWwindow
a0 CDouble
a1 CDouble
a2 -> IO () -> IO ()
schedule (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Window -> Double -> Double -> IO ()
cb (Ptr C'GLFWwindow -> Window
forall c h. C c h => c -> h
fromC Ptr C'GLFWwindow
a0) (CDouble -> Double
forall c h. C c h => c -> h
fromC CDouble
a1) (CDouble -> Double
forall c h. C c h => c -> h
fromC CDouble
a2))
    (Ptr C'GLFWwindow
-> FunPtr (Ptr C'GLFWwindow -> CDouble -> CDouble -> IO ())
-> IO (FunPtr (Ptr C'GLFWwindow -> CDouble -> CDouble -> IO ()))
c'glfwSetScrollCallback (Window -> Ptr C'GLFWwindow
forall c h. C c h => h -> c
toC Window
win))
    WindowCallbacks
-> IORef (FunPtr (Ptr C'GLFWwindow -> CDouble -> CDouble -> IO ()))
storedScrollFun
    Window
win

-- | Tests if the joystick is present at all
-- See <http://www.glfw.org/docs/3.3/group__input.html#gaffcbd9ac8ee737fcdd25475123a3c790 glfwJoystickPresent>
joystickPresent :: Joystick -> IO Bool
joystickPresent :: Joystick -> IO Bool
joystickPresent = (CInt -> Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CInt -> Bool
forall c h. C c h => c -> h
fromC (IO CInt -> IO Bool)
-> (Joystick -> IO CInt) -> Joystick -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> IO CInt
c'glfwJoystickPresent (CInt -> IO CInt) -> (Joystick -> CInt) -> Joystick -> IO CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Joystick -> CInt
forall c h. C c h => h -> c
toC

-- | Returns the values of all axes of the specified joystick, normalized to between -1.0 and 1.0
-- See <http://www.glfw.org/docs/3.3/group__input.html#ga6271d46a5901ec2c99601ccf4dd14731 glfwGetJoystickAxes>
getJoystickAxes :: Joystick -> IO (Maybe [Double])
getJoystickAxes :: Joystick -> IO (Maybe [Double])
getJoystickAxes Joystick
js = (Ptr CInt -> IO (Maybe [Double])) -> IO (Maybe [Double])
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Maybe [Double])) -> IO (Maybe [Double]))
-> (Ptr CInt -> IO (Maybe [Double])) -> IO (Maybe [Double])
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
p'n -> do
    Ptr CFloat
p'axes <- CInt -> Ptr CInt -> IO (Ptr CFloat)
c'glfwGetJoystickAxes (Joystick -> CInt
forall c h. C c h => h -> c
toC Joystick
js) Ptr CInt
p'n
    Int
n <- CInt -> Int
forall c h. C c h => c -> h
fromC (CInt -> Int) -> IO CInt -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
p'n
    if Ptr CFloat
p'axes Ptr CFloat -> Ptr CFloat -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr CFloat
forall a. Ptr a
nullPtr Bool -> Bool -> Bool
|| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0
      then Maybe [Double] -> IO (Maybe [Double])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [Double]
forall a. Maybe a
Nothing
      else ([Double] -> Maybe [Double]
forall a. a -> Maybe a
Just ([Double] -> Maybe [Double])
-> ([CFloat] -> [Double]) -> [CFloat] -> Maybe [Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CFloat -> Double) -> [CFloat] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map CFloat -> Double
forall c h. C c h => c -> h
fromC) ([CFloat] -> Maybe [Double]) -> IO [CFloat] -> IO (Maybe [Double])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Ptr CFloat -> IO [CFloat]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
n Ptr CFloat
p'axes

-- | Returns a list of all joystick button states for the specified joystick.
-- See <http://www.glfw.org/docs/3.3/group__input.html#gace54cd930dcd502e118fe4021384ce1b glfwGetJoystickButtons>
getJoystickButtons :: Joystick -> IO (Maybe [JoystickButtonState])
getJoystickButtons :: Joystick -> IO (Maybe [JoystickButtonState])
getJoystickButtons Joystick
js = (Ptr CInt -> IO (Maybe [JoystickButtonState]))
-> IO (Maybe [JoystickButtonState])
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Maybe [JoystickButtonState]))
 -> IO (Maybe [JoystickButtonState]))
-> (Ptr CInt -> IO (Maybe [JoystickButtonState]))
-> IO (Maybe [JoystickButtonState])
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
p'n -> do
    Ptr CUChar
p'buttons <- CInt -> Ptr CInt -> IO (Ptr CUChar)
c'glfwGetJoystickButtons (Joystick -> CInt
forall c h. C c h => h -> c
toC Joystick
js) Ptr CInt
p'n
    Int
n <- CInt -> Int
forall c h. C c h => c -> h
fromC (CInt -> Int) -> IO CInt -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
p'n
    if Ptr CUChar
p'buttons Ptr CUChar -> Ptr CUChar -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr CUChar
forall a. Ptr a
nullPtr Bool -> Bool -> Bool
|| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0
      then Maybe [JoystickButtonState] -> IO (Maybe [JoystickButtonState])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [JoystickButtonState]
forall a. Maybe a
Nothing
      else ([JoystickButtonState] -> Maybe [JoystickButtonState]
forall a. a -> Maybe a
Just ([JoystickButtonState] -> Maybe [JoystickButtonState])
-> ([CUChar] -> [JoystickButtonState])
-> [CUChar]
-> Maybe [JoystickButtonState]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CUChar -> JoystickButtonState)
-> [CUChar] -> [JoystickButtonState]
forall a b. (a -> b) -> [a] -> [b]
map CUChar -> JoystickButtonState
forall c h. C c h => c -> h
fromC) ([CUChar] -> Maybe [JoystickButtonState])
-> IO [CUChar] -> IO (Maybe [JoystickButtonState])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Ptr CUChar -> IO [CUChar]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
n Ptr CUChar
p'buttons

-- | Returns a list of all hats of the specified joystick.
-- See <https://www.glfw.org/docs/3.3/group__input.html#ga2d8d0634bb81c180899aeb07477a67ea glfwGetJoystickHats>
getJoystickHats :: Joystick -> IO (Maybe [JoystickHatState])
getJoystickHats :: Joystick -> IO (Maybe [JoystickHatState])
getJoystickHats Joystick
js = (Ptr CInt -> IO (Maybe [JoystickHatState]))
-> IO (Maybe [JoystickHatState])
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Maybe [JoystickHatState]))
 -> IO (Maybe [JoystickHatState]))
-> (Ptr CInt -> IO (Maybe [JoystickHatState]))
-> IO (Maybe [JoystickHatState])
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
p'n -> do
    Ptr CUChar
p'hats <- CInt -> Ptr CInt -> IO (Ptr CUChar)
c'glfwGetJoystickHats (Joystick -> CInt
forall c h. C c h => h -> c
toC Joystick
js) Ptr CInt
p'n
    Int
n <- CInt -> Int
forall c h. C c h => c -> h
fromC (CInt -> Int) -> IO CInt -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
p'n
    if Ptr CUChar
p'hats Ptr CUChar -> Ptr CUChar -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr CUChar
forall a. Ptr a
nullPtr Bool -> Bool -> Bool
|| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0
      then Maybe [JoystickHatState] -> IO (Maybe [JoystickHatState])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [JoystickHatState]
forall a. Maybe a
Nothing
      else ([JoystickHatState] -> Maybe [JoystickHatState]
forall a. a -> Maybe a
Just ([JoystickHatState] -> Maybe [JoystickHatState])
-> ([CUChar] -> [JoystickHatState])
-> [CUChar]
-> Maybe [JoystickHatState]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CUChar -> JoystickHatState) -> [CUChar] -> [JoystickHatState]
forall a b. (a -> b) -> [a] -> [b]
map CUChar -> JoystickHatState
forall c h. C c h => c -> h
fromC) ([CUChar] -> Maybe [JoystickHatState])
-> IO [CUChar] -> IO (Maybe [JoystickHatState])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Ptr CUChar -> IO [CUChar]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
n Ptr CUChar
p'hats

-- | A human-readable name for a Joystick. Not guranteed to be unique.
-- See <http://www.glfw.org/docs/3.3/group__input.html#gac8d7f6107e05cfd106cfba973ab51e19 glfwGetJoystickName>
getJoystickName :: Joystick -> IO (Maybe String)
getJoystickName :: Joystick -> IO (Maybe String)
getJoystickName Joystick
js = do
    CString
p'name <- CInt -> IO CString
c'glfwGetJoystickName (Joystick -> CInt
forall c h. C c h => h -> c
toC Joystick
js)
    if CString
p'name CString -> CString -> Bool
forall a. Eq a => a -> a -> Bool
== CString
forall a. Ptr a
nullPtr
      then Maybe String -> IO (Maybe String)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing
      else String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> IO String -> IO (Maybe String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CString -> IO String
peekCString CString
p'name

-- | Sets a callback for when a joystick is connected or disconnected.
-- See <http://www.glfw.org/docs/3.3/group__input.html#gab1dc8379f1b82bb660a6b9c9fa06ca07 glfwSetJoystickCallback>
setJoystickCallback :: Maybe JoystickCallback -> IO ()
setJoystickCallback :: Maybe JoystickCallback -> IO ()
setJoystickCallback = ((CInt -> CInt -> IO ()) -> IO C'GLFWjoystickfun)
-> (JoystickCallback -> CInt -> CInt -> IO ())
-> (C'GLFWjoystickfun -> IO C'GLFWjoystickfun)
-> IORef C'GLFWjoystickfun
-> Maybe JoystickCallback
-> IO ()
forall c h.
(c -> IO (FunPtr c))
-> (h -> c)
-> (FunPtr c -> IO (FunPtr c))
-> IORef (FunPtr c)
-> Maybe h
-> IO ()
setCallback
    (CInt -> CInt -> IO ()) -> IO C'GLFWjoystickfun
mk'GLFWjoystickfun
    (\JoystickCallback
cb CInt
a0 CInt
a1 -> IO () -> IO ()
schedule (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ JoystickCallback
cb (CInt -> Joystick
forall c h. C c h => c -> h
fromC CInt
a0) (CInt -> JoystickState
forall c h. C c h => c -> h
fromC CInt
a1))
    C'GLFWjoystickfun -> IO C'GLFWjoystickfun
c'glfwSetJoystickCallback
    IORef C'GLFWjoystickfun
storedJoystickFun

-- | Adds the specified SDL_GameControllerDB gamepad mappings.
-- See <https://www.glfw.org/docs/3.3/group__input.html#gaed5104612f2fa8e66aa6e846652ad00f glfwUpdateGamepadMappings>
updateGamepadMappings :: String -> IO Bool
updateGamepadMappings :: String -> IO Bool
updateGamepadMappings =
    (String -> (CString -> IO Bool) -> IO Bool)
-> (CString -> IO Bool) -> String -> IO Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> (CString -> IO Bool) -> IO Bool
forall a. String -> (CString -> IO a) -> IO a
withCString ((CString -> IO Bool) -> String -> IO Bool)
-> (CString -> IO Bool) -> String -> IO Bool
forall a b. (a -> b) -> a -> b
$ \CString
s -> CInt -> Bool
forall c h. C c h => c -> h
fromC (CInt -> Bool) -> IO CInt -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CString -> IO CInt
c'glfwUpdateGamepadMappings CString
s

-- | This function returns whether the specified joystick is both present and
-- has a gamepad mapping.
-- See <https://www.glfw.org/docs/3.3/group__input.html#gad0f676860f329d80f7e47e9f06a96f00 glfwJoystickIsGamepad>
joystickIsGamepad :: Joystick -> IO Bool
joystickIsGamepad :: Joystick -> IO Bool
joystickIsGamepad = (CInt -> Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'GLFW_TRUE) (IO CInt -> IO Bool)
-> (Joystick -> IO CInt) -> Joystick -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> IO CInt
c'glfwJoystickIsGamepad (CInt -> IO CInt) -> (Joystick -> CInt) -> Joystick -> IO CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Joystick -> CInt
forall c h. C c h => h -> c
toC

-- | This function returns the SDL compatible GUID of the specified joystick.
-- See <https://www.glfw.org/docs/3.3/group__input.html#gae168c2c0b8cf2a1cb67c6b3c00bdd543 glfwGetJoystickGUID>
getJoystickGUID :: Joystick -> IO (Maybe String)
getJoystickGUID :: Joystick -> IO (Maybe String)
getJoystickGUID Joystick
js = do
  CString
p'guid <- CInt -> IO CString
c'glfwGetJoystickGUID (Joystick -> CInt
forall c h. C c h => h -> c
toC Joystick
js)
  if CString
p'guid CString -> CString -> Bool
forall a. Eq a => a -> a -> Bool
== CString
forall a. Ptr a
nullPtr
    then Maybe String -> IO (Maybe String)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing
    else String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> IO String -> IO (Maybe String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CString -> IO String
peekCString CString
p'guid

-- | This function returns the human-readable name of the gamepad from the
-- gamepad mapping assigned to the specified joystick.
-- See <https://www.glfw.org/docs/3.3/group__input.html#ga5c71e3533b2d384db9317fcd7661b210 glfwGetGamepadName>
getGamepadName :: Joystick -> IO (Maybe String)
getGamepadName :: Joystick -> IO (Maybe String)
getGamepadName Joystick
js = do
  CString
p'name <- CInt -> IO CString
c'glfwGetGamepadName (Joystick -> CInt
forall c h. C c h => h -> c
toC Joystick
js)
  if CString
p'name CString -> CString -> Bool
forall a. Eq a => a -> a -> Bool
== CString
forall a. Ptr a
nullPtr
    then Maybe String -> IO (Maybe String)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing
    else String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> IO String -> IO (Maybe String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CString -> IO String
peekCString CString
p'name

-- | This function retrives the state of the specified joystick remapped to an
-- Xbox-like gamepad.
-- See <https://www.glfw.org/docs/3.3/group__input.html#gadccddea8bce6113fa459de379ddaf051 glfwGetGamepadState>
getGamepadState :: Joystick -> IO (Maybe GamepadState)
getGamepadState :: Joystick -> IO (Maybe GamepadState)
getGamepadState Joystick
js = (Ptr C'GLFWgamepadstate -> IO (Maybe GamepadState))
-> IO (Maybe GamepadState)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr C'GLFWgamepadstate -> IO (Maybe GamepadState))
 -> IO (Maybe GamepadState))
-> (Ptr C'GLFWgamepadstate -> IO (Maybe GamepadState))
-> IO (Maybe GamepadState)
forall a b. (a -> b) -> a -> b
$ \Ptr C'GLFWgamepadstate
p'gps -> do
  Bool
hasGamepad <- CInt -> Bool
forall c h. C c h => c -> h
fromC (CInt -> Bool) -> IO CInt -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CInt -> Ptr C'GLFWgamepadstate -> IO CInt
c'glfwGetGamepadState (Joystick -> CInt
forall c h. C c h => h -> c
toC Joystick
js) Ptr C'GLFWgamepadstate
p'gps
  if Bool
hasGamepad
    then do
      C'GLFWgamepadstate
gps <- Ptr C'GLFWgamepadstate -> IO C'GLFWgamepadstate
forall a. Storable a => Ptr a -> IO a
peek Ptr C'GLFWgamepadstate
p'gps
      Maybe GamepadState -> IO (Maybe GamepadState)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe GamepadState -> IO (Maybe GamepadState))
-> Maybe GamepadState -> IO (Maybe GamepadState)
forall a b. (a -> b) -> a -> b
$ GamepadState -> Maybe GamepadState
forall a. a -> Maybe a
Just GamepadState
        { getButtonState :: GamepadButton -> GamepadButtonState
getButtonState = CUChar -> GamepadButtonState
forall c h. C c h => c -> h
fromC (CUChar -> GamepadButtonState)
-> (GamepadButton -> CUChar) -> GamepadButton -> GamepadButtonState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (C'GLFWgamepadstate -> [CUChar]
c'GLFWgamepadstate'buttons C'GLFWgamepadstate
gps [CUChar] -> Int -> CUChar
forall a. HasCallStack => [a] -> Int -> a
!!)
                         (Int -> CUChar)
-> (GamepadButton -> Int) -> GamepadButton -> CUChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: CInt -> Int)
                         (CInt -> Int) -> (GamepadButton -> CInt) -> GamepadButton -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GamepadButton -> CInt
forall c h. C c h => h -> c
toC
        , getAxisState :: GamepadAxis -> Float
getAxisState = CFloat -> Float
hFloat
                       (CFloat -> Float)
-> (GamepadAxis -> CFloat) -> GamepadAxis -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (C'GLFWgamepadstate -> [CFloat]
c'GLFWgamepadstate'axes C'GLFWgamepadstate
gps [CFloat] -> Int -> CFloat
forall a. HasCallStack => [a] -> Int -> a
!!)
                       (Int -> CFloat) -> (GamepadAxis -> Int) -> GamepadAxis -> CFloat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: CInt -> Int)
                       (CInt -> Int) -> (GamepadAxis -> CInt) -> GamepadAxis -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GamepadAxis -> CInt
forall c h. C c h => h -> c
toC
        }
    else Maybe GamepadState -> IO (Maybe GamepadState)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe GamepadState
forall a. Maybe a
Nothing

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

-- | Returns the time (in seconds) of the GLFW timer.
-- This is the amount of time since GLFW was initialized, unless 'setTime' was used.
-- The exact resolution is system dependent.
-- See <http://www.glfw.org/docs/3.3/group__input.html#gaa6cf4e7a77158a3b8fd00328b1720a4a glfwGetTime>
getTime :: IO (Maybe Double)
getTime :: IO (Maybe Double)
getTime = do
    Double
t <- CDouble -> Double
forall c h. C c h => c -> h
fromC (CDouble -> Double) -> IO CDouble -> IO Double
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` IO CDouble
c'glfwGetTime
    Maybe Double -> IO (Maybe Double)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Double -> IO (Maybe Double))
-> Maybe Double -> IO (Maybe Double)
forall a b. (a -> b) -> a -> b
$ if Double
t Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
0
      then Maybe Double
forall a. Maybe a
Nothing
      else Double -> Maybe Double
forall a. a -> Maybe a
Just Double
t

-- | Sets the GLFW timer to the specified value, which is measured in seconds, and must be positive.
-- The value must also be less than ~584 years in seconds (18446744073.0).
-- After this the timer begins to count upward at the normal rate.
-- See <http://www.glfw.org/docs/3.3/group__input.html#gaf59589ef6e8b8c8b5ad184b25afd4dc0 glfwSetTime>
setTime :: Double -> IO ()
setTime :: Double -> IO ()
setTime = CDouble -> IO ()
c'glfwSetTime (CDouble -> IO ()) -> (Double -> CDouble) -> Double -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> CDouble
forall c h. C c h => h -> c
toC

-- | Returns the current value of the raw timer, measured in 1 / frequency
-- seconds. The frequency can be queried using getTimerFrequency.
-- See <http://www.glfw.org/docs/3.3/input_guide.html#time Timer input>
getTimerValue :: IO Word64
getTimerValue :: IO Word64
getTimerValue = IO Word64
c'glfwGetTimerValue

-- | Returns the frequency, in Hz, of the raw timer.
-- See <http://www.glfw.org/docs/3.3/input_guide.html#time Timer input>
getTimerFrequency :: IO Word64
getTimerFrequency :: IO Word64
getTimerFrequency = IO Word64
c'glfwGetTimerFrequency

--------------------------------------------------------------------------------
-- Context

-- | Makes the context of the specified window the current one for the calling thread.
-- A context can only be made current on a single thread at a time,
-- and each thread can have only a single current context at a time.
-- See <http://www.glfw.org/docs/3.3/group__context.html#ga1c04dc242268f827290fe40aa1c91157 glfwMakeContextCurrent>
makeContextCurrent :: Maybe Window -> IO ()
makeContextCurrent :: Maybe Window -> IO ()
makeContextCurrent =
    Ptr C'GLFWwindow -> IO ()
c'glfwMakeContextCurrent (Ptr C'GLFWwindow -> IO ())
-> (Maybe Window -> Ptr C'GLFWwindow) -> Maybe Window -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr C'GLFWwindow
-> (Window -> Ptr C'GLFWwindow) -> Maybe Window -> Ptr C'GLFWwindow
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Ptr C'GLFWwindow
forall a. Ptr a
nullPtr Window -> Ptr C'GLFWwindow
forall c h. C c h => h -> c
toC

-- | Obtains which window owns the current context of the calling thread.
-- See <http://www.glfw.org/docs/3.3/group__context.html#gac84759b1f6c2d271a4fea8ae89ec980d glfwGetCurrentContext>
getCurrentContext :: IO (Maybe Window)
getCurrentContext :: IO (Maybe Window)
getCurrentContext = do
    Ptr C'GLFWwindow
p'win <- IO (Ptr C'GLFWwindow)
c'glfwGetCurrentContext
    Maybe Window -> IO (Maybe Window)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Window -> IO (Maybe Window))
-> Maybe Window -> IO (Maybe Window)
forall a b. (a -> b) -> a -> b
$ if Ptr C'GLFWwindow
p'win Ptr C'GLFWwindow -> Ptr C'GLFWwindow -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr C'GLFWwindow
forall a. Ptr a
nullPtr
      then Maybe Window
forall a. Maybe a
Nothing
      else Window -> Maybe Window
forall a. a -> Maybe a
Just (Window -> Maybe Window) -> Window -> Maybe Window
forall a b. (a -> b) -> a -> b
$ Ptr C'GLFWwindow -> Window
forall c h. C c h => c -> h
fromC Ptr C'GLFWwindow
p'win

-- | Swaps the front and back buffers of the window.
-- See <http://www.glfw.org/docs/3.3/group__window.html#ga15a5a1ee5b3c2ca6b15ca209a12efd14 glfwSwapBuffers>
swapBuffers :: Window -> IO ()
swapBuffers :: Window -> IO ()
swapBuffers =
    Ptr C'GLFWwindow -> IO ()
c'glfwSwapBuffers (Ptr C'GLFWwindow -> IO ())
-> (Window -> Ptr C'GLFWwindow) -> Window -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Window -> Ptr C'GLFWwindow
forall c h. C c h => h -> c
toC

-- | Sets the number of screen updates that the GPU should wait after 'swapBuffers' before actually swapping the buffers.
-- Generates 'Error'NoCurrentContext' if no context is current.
-- See <http://www.glfw.org/docs/3.3/group__context.html#ga6d4e0cdf151b5e579bd67f13202994ed glfwSwapInterval>
swapInterval :: Int -> IO ()
swapInterval :: Int -> IO ()
swapInterval =
    CInt -> IO ()
c'glfwSwapInterval (CInt -> IO ()) -> (Int -> CInt) -> Int -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> CInt
forall c h. C c h => h -> c
toC

-- | If the current OpenGL or OpenGL ES context supports the extension specified.
-- Generates 'Error'NoCurrentContext' if no context is current.
-- See <http://www.glfw.org/docs/3.3/group__context.html#ga87425065c011cef1ebd6aac75e059dfa glfwExtensionSupported>
extensionSupported :: String -> IO Bool
extensionSupported :: String -> IO Bool
extensionSupported String
ext =
    String -> (CString -> IO Bool) -> IO Bool
forall a. String -> (CString -> IO a) -> IO a
withCString String
ext ((CString -> IO Bool) -> IO Bool)
-> (CString -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \CString
p'ext ->
      CInt -> Bool
forall c h. C c h => c -> h
fromC (CInt -> Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` CString -> IO CInt
c'glfwExtensionSupported CString
p'ext

--------------------------------------------------------------------------------
-- Clipboard
-- http://www.glfw.org/docs/3.3/input.html#clipboard

-- | The window that will own the clipboard contents, and also the clipboard string.
-- See <http://www.glfw.org/docs/3.3/group__input.html#gaba1f022c5eb07dfac421df34cdcd31dd glfwSetClipboardString>
setClipboardString :: Window -> String -> IO ()
setClipboardString :: Window -> String -> IO ()
setClipboardString Window
win String
s =
    String -> (CString -> IO ()) -> IO ()
forall a. String -> (CString -> IO a) -> IO a
withCString String
s (Ptr C'GLFWwindow -> CString -> IO ()
c'glfwSetClipboardString (Window -> Ptr C'GLFWwindow
forall c h. C c h => h -> c
toC Window
win))

-- | Obtains the contents of the system keyboard, if possible.
-- Generates 'Error'FormatUnavailable' if the system clipboard is empty or if it's not a UTF-8 string.
-- See <http://www.glfw.org/docs/3.3/group__input.html#ga5aba1d704d9ab539282b1fbe9f18bb94 glfwGetClipboardString>
getClipboardString :: Window -> IO (Maybe String)
getClipboardString :: Window -> IO (Maybe String)
getClipboardString Window
win = do
    CString
p's <- Ptr C'GLFWwindow -> IO CString
c'glfwGetClipboardString (Window -> Ptr C'GLFWwindow
forall c h. C c h => h -> c
toC Window
win)
    if CString
p's CString -> CString -> Bool
forall a. Eq a => a -> a -> Bool
== CString
forall a. Ptr a
nullPtr
      then Maybe String -> IO (Maybe String)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing
      else String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> IO String -> IO (Maybe String)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` CString -> IO String
peekCString CString
p's

--------------------------------------------------------------------------------
-- 3.1 additions (http://www.glfw.org/docs/3.1/news.html#news_31)
--------------------------------------------------------------------------------

-- Cursor Objects
-- http://www.glfw.org/docs/3.3/input.html#cursor_object

-- | Creates a new cursor.
createCursor :: Image -- ^ The desired cursor image.
             -> Int   -- ^ The desired x-coordinate, in pixels, of the cursor
                      --   hotspot.
             -> Int   -- ^ The desired y-coordinate, in pixels, of the cursor
                      --   hotspot.
             -> IO Cursor
createCursor :: Image -> Int -> Int -> IO Cursor
createCursor Image
img Int
x Int
y =
  Image -> (Ptr C'GLFWimage -> IO Cursor) -> IO Cursor
forall a. Image -> (Ptr C'GLFWimage -> IO a) -> IO a
withGLFWImage Image
img ((Ptr C'GLFWimage -> IO Cursor) -> IO Cursor)
-> (Ptr C'GLFWimage -> IO Cursor) -> IO Cursor
forall a b. (a -> b) -> a -> b
$ \Ptr C'GLFWimage
p'img ->
    Ptr C'GLFWcursor -> Cursor
Cursor (Ptr C'GLFWcursor -> Cursor) -> IO (Ptr C'GLFWcursor) -> IO Cursor
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Ptr C'GLFWimage -> CInt -> CInt -> IO (Ptr C'GLFWcursor)
c'glfwCreateCursor Ptr C'GLFWimage
p'img (Int -> CInt
forall c h. C c h => h -> c
toC Int
x) (Int -> CInt
forall c h. C c h => h -> c
toC Int
y)

-- | Creates a cursor with a standard shape that can be set for a window with
-- setCursor.
createStandardCursor :: StandardCursorShape -> IO Cursor
createStandardCursor :: StandardCursorShape -> IO Cursor
createStandardCursor = ((Ptr C'GLFWcursor -> Cursor) -> IO (Ptr C'GLFWcursor) -> IO Cursor
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ptr C'GLFWcursor -> Cursor
Cursor) (IO (Ptr C'GLFWcursor) -> IO Cursor)
-> (StandardCursorShape -> IO (Ptr C'GLFWcursor))
-> StandardCursorShape
-> IO Cursor
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> IO (Ptr C'GLFWcursor)
c'glfwCreateStandardCursor (CInt -> IO (Ptr C'GLFWcursor))
-> (StandardCursorShape -> CInt)
-> StandardCursorShape
-> IO (Ptr C'GLFWcursor)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StandardCursorShape -> CInt
forall c h. C c h => h -> c
toC

-- | Sets the cursor image to be used when the cursor is over the client area
-- of the specified window. The set cursor will only be visible when the cursor
-- mode of the window is @GLFW_CURSOR_NORMAL@.

-- On some platforms, the set cursor may not be visible unless the window also
-- has input focus.
setCursor :: Window -> Cursor -> IO ()
setCursor :: Window -> Cursor -> IO ()
setCursor (Window Ptr C'GLFWwindow
wptr) (Cursor Ptr C'GLFWcursor
cptr) = Ptr C'GLFWwindow -> Ptr C'GLFWcursor -> IO ()
c'glfwSetCursor Ptr C'GLFWwindow
wptr Ptr C'GLFWcursor
cptr

-- | Destroys a cursor previously created with `createCursor`. Any remaining
-- cursors will be destroyed by `terminate`. This function is not
-- <https://www.glfw.org/docs/latest/intro.html#reentrancy reentrant>.
destroyCursor :: Cursor -> IO ()
destroyCursor :: Cursor -> IO ()
destroyCursor = Ptr C'GLFWcursor -> IO ()
c'glfwDestroyCursor (Ptr C'GLFWcursor -> IO ())
-> (Cursor -> Ptr C'GLFWcursor) -> Cursor -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cursor -> Ptr C'GLFWcursor
unCursor

-- | A callback that allows for drag and drop support.
type DropCallback = Window    -- ^ The window that received the event.
                  -> [String] -- ^ The file and/or directory path names
                  -> IO ()

-- | Sets the file drop callback of the specified window, which is called when
-- one or more dragged files are dropped on the window.
setDropCallback :: Window -> Maybe DropCallback -> IO ()
setDropCallback :: Window -> Maybe DropCallback -> IO ()
setDropCallback Window
win = ((Ptr C'GLFWwindow -> CInt -> Ptr CString -> IO ())
 -> IO (FunPtr (Ptr C'GLFWwindow -> CInt -> Ptr CString -> IO ())))
-> (DropCallback
    -> Ptr C'GLFWwindow -> CInt -> Ptr CString -> IO ())
-> (FunPtr (Ptr C'GLFWwindow -> CInt -> Ptr CString -> IO ())
    -> IO (FunPtr (Ptr C'GLFWwindow -> CInt -> Ptr CString -> IO ())))
-> (WindowCallbacks
    -> IORef
         (FunPtr (Ptr C'GLFWwindow -> CInt -> Ptr CString -> IO ())))
-> Window
-> Maybe DropCallback
-> IO ()
forall c h.
(c -> IO (FunPtr c))
-> (h -> c)
-> (FunPtr c -> IO (FunPtr c))
-> (WindowCallbacks -> IORef (FunPtr c))
-> Window
-> Maybe h
-> IO ()
setWindowCallback
    (Ptr C'GLFWwindow -> CInt -> Ptr CString -> IO ())
-> IO (FunPtr (Ptr C'GLFWwindow -> CInt -> Ptr CString -> IO ()))
mk'GLFWdropfun
    (\DropCallback
cb Ptr C'GLFWwindow
w CInt
c Ptr CString
fs -> do
        let count :: Int
count = CInt -> Int
forall c h. C c h => c -> h
fromC CInt
c
        [String]
fps <- ((Int -> IO String) -> [Int] -> IO [String])
-> [Int] -> (Int -> IO String) -> IO [String]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Int -> IO String) -> [Int] -> IO [String]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM [Int
0..Int
countInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1] ((Int -> IO String) -> IO [String])
-> (Int -> IO String) -> IO [String]
forall a b. (a -> b) -> a -> b
$ \Int
i -> do
            let p :: Ptr CString
p = Ptr CString -> Int -> Ptr CString
forall a. Storable a => Ptr a -> Int -> Ptr a
advancePtr Ptr CString
fs Int
i
            CString
p' <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek Ptr CString
p
            CString -> IO String
peekCString CString
p'
        IO () -> IO ()
schedule (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ DropCallback
cb (Ptr C'GLFWwindow -> Window
forall c h. C c h => c -> h
fromC Ptr C'GLFWwindow
w) [String]
fps)
    (Ptr C'GLFWwindow
-> FunPtr (Ptr C'GLFWwindow -> CInt -> Ptr CString -> IO ())
-> IO (FunPtr (Ptr C'GLFWwindow -> CInt -> Ptr CString -> IO ()))
c'glfwSetDropCallback (Window -> Ptr C'GLFWwindow
forall c h. C c h => h -> c
toC Window
win))
    WindowCallbacks
-> IORef
     (FunPtr (Ptr C'GLFWwindow -> CInt -> Ptr CString -> IO ()))
storedDropFun
    Window
win

--------------------------------------------------------------------------------
-- Vulkan-related functions
--------------------------------------------------------------------------------

-- | This function returns whether the Vulkan loader has been found.
--   This check is performed by `init`.
vulkanSupported :: IO Bool
vulkanSupported :: IO Bool
vulkanSupported = (CInt
forall a. Num a => a
c'GLFW_TRUE CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
==) (CInt -> Bool) -> IO CInt -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO CInt
c'glfwVulkanSupported

-- | Get required vulkan extensions;
--   Pointer memory is managed by GLFW, destroyed by `terminate` call.
--
--   The returned extension names are kept in `CString` type, because
--   they are expected to be consumed by vulkan device initialization functions.
getRequiredInstanceExtensions :: IO [CString]
getRequiredInstanceExtensions :: IO [CString]
getRequiredInstanceExtensions = (Ptr Word32 -> IO [CString]) -> IO [CString]
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Word32 -> IO [CString]) -> IO [CString])
-> (Ptr Word32 -> IO [CString]) -> IO [CString]
forall a b. (a -> b) -> a -> b
$ \Ptr Word32
countPtr -> do
    Ptr CString
extsPtrPtr <- Ptr Word32 -> IO (Ptr CString)
c'glfwGetRequiredInstanceExtensions Ptr Word32
countPtr
    Int
count <- Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> IO Word32 -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
countPtr
    Int -> Ptr CString -> IO [CString]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
count Ptr CString
extsPtrPtr

-- | Returns the address of the specified Vulkan instance function.
getInstanceProcAddress :: Ptr vkInstance
                          -- ^ VkInstance.
                          --   Note, the returned function must be used
                          --   with the same instance or its child.
                       -> String
                          -- ^ Function name
                       -> IO (FunPtr vkProc)
getInstanceProcAddress :: forall vkInstance vkProc.
Ptr vkInstance -> String -> IO (FunPtr vkProc)
getInstanceProcAddress Ptr vkInstance
i String
procName
  = String -> (CString -> IO (FunPtr vkProc)) -> IO (FunPtr vkProc)
forall a. String -> (CString -> IO a) -> IO a
withCString String
procName (Ptr vkInstance -> CString -> IO (FunPtr vkProc)
forall vkInstance vkProc.
Ptr vkInstance -> CString -> IO (FunPtr vkProc)
c'glfwGetInstanceProcAddress Ptr vkInstance
i)

-- | Returns whether the specified queue family can present images.
getPhysicalDevicePresentationSupport ::
       Ptr vkInstance
       -- ^ VkInstance
    -> Ptr vkPhysicalDevice
       -- ^ VkPhysicalDevice
    -> Word32
       -- ^ Index of a queue family to query.
       --   This is an index in the array returned by
       --   @vkGetPhysicalDeviceQueueFamilyProperties@ function.
    -> IO Bool
getPhysicalDevicePresentationSupport :: forall vkInstance vkPhysicalDevice.
Ptr vkInstance -> Ptr vkPhysicalDevice -> Word32 -> IO Bool
getPhysicalDevicePresentationSupport Ptr vkInstance
inst Ptr vkPhysicalDevice
dev Word32
i
  = (CInt
forall a. Num a => a
c'GLFW_TRUE CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
==) (CInt -> Bool) -> IO CInt -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr vkInstance -> Ptr vkPhysicalDevice -> Word32 -> IO CInt
forall vkInstance vkPhysicalDevice.
Ptr vkInstance -> Ptr vkPhysicalDevice -> Word32 -> IO CInt
c'glfwGetPhysicalDevicePresentationSupport Ptr vkInstance
inst Ptr vkPhysicalDevice
dev Word32
i

-- | Creates a Vulkan surface for the specified window
createWindowSurface :: Enum vkResult
                    => Ptr vkInstance
                       -- ^ VkInstance
                    -> Window
                       -- ^ GLFWwindow *window
                    -> Ptr vkAllocationCallbacks
                       -- ^ const VkAllocationCallbacks *allocator
                    -> Ptr vkSurfaceKHR
                       -- ^ VkSurfaceKHR *surface
                    -> IO vkResult
createWindowSurface :: forall vkResult vkInstance vkAllocationCallbacks vkSurfaceKHR.
Enum vkResult =>
Ptr vkInstance
-> Window
-> Ptr vkAllocationCallbacks
-> Ptr vkSurfaceKHR
-> IO vkResult
createWindowSurface Ptr vkInstance
i Window
win Ptr vkAllocationCallbacks
acs Ptr vkSurfaceKHR
s
  = Int -> vkResult
forall a. Enum a => Int -> a
toEnum (Int -> vkResult) -> (Int32 -> Int) -> Int32 -> vkResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral
  (Int32 -> vkResult) -> IO Int32 -> IO vkResult
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr vkInstance
-> Ptr C'GLFWwindow
-> Ptr vkAllocationCallbacks
-> Ptr vkSurfaceKHR
-> IO Int32
forall vkInstance vkAllocationCallbacks vkSurfaceKHR.
Ptr vkInstance
-> Ptr C'GLFWwindow
-> Ptr vkAllocationCallbacks
-> Ptr vkSurfaceKHR
-> IO Int32
c'glfwCreateWindowSurface Ptr vkInstance
i (Window -> Ptr C'GLFWwindow
forall c h. C c h => h -> c
toC Window
win) Ptr vkAllocationCallbacks
acs Ptr vkSurfaceKHR
s

--------------------------------------------------------------------------------
-- Native APIs
--------------------------------------------------------------------------------

-- $nativeaccess
-- The low level native-access bindings are exposed here via bindings-GLFW.
-- These must be enabled with the @ExposeNative@ flag passed to bindings-GLFW.
-- The return values of these functions are used as a best-guess and are not
-- coupled with any other implementation. They should be used with caution
-- and at your own risk.

-- | See <http://www.glfw.org/docs/3.3/group__native.html#gac84f63a3f9db145b9435e5e0dbc4183d glfwGetWin32Adapter>
getWin32Adapter :: Window -> IO CString
getWin32Adapter :: Window -> IO CString
getWin32Adapter = Ptr C'GLFWwindow -> IO CString
c'glfwGetWin32Adapter (Ptr C'GLFWwindow -> IO CString)
-> (Window -> Ptr C'GLFWwindow) -> Window -> IO CString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Window -> Ptr C'GLFWwindow
forall c h. C c h => h -> c
toC

-- | See <http://www.glfw.org/docs/3.3/group__native.html#gac408b09a330749402d5d1fa1f5894dd9 glfwGetWin32Monitor>
getWin32Monitor :: Window -> IO CString
getWin32Monitor :: Window -> IO CString
getWin32Monitor = Ptr C'GLFWwindow -> IO CString
c'glfwGetWin32Monitor (Ptr C'GLFWwindow -> IO CString)
-> (Window -> Ptr C'GLFWwindow) -> Window -> IO CString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Window -> Ptr C'GLFWwindow
forall c h. C c h => h -> c
toC

-- | See <http://www.glfw.org/docs/3.3/group__native.html#gafe5079aa79038b0079fc09d5f0a8e667 glfwGetWin32Window>
getWin32Window  :: Window -> IO (Ptr ())
getWin32Window :: Window -> IO (Ptr ())
getWin32Window = Ptr C'GLFWwindow -> IO (Ptr ())
c'glfwGetWin32Window (Ptr C'GLFWwindow -> IO (Ptr ()))
-> (Window -> Ptr C'GLFWwindow) -> Window -> IO (Ptr ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Window -> Ptr C'GLFWwindow
forall c h. C c h => h -> c
toC

-- | See <http://www.glfw.org/docs/3.3/group__native.html#gadc4010d91d9cc1134d040eeb1202a143 glfwGetWGLContext>
getWGLContext :: Window -> IO (Ptr ())
getWGLContext :: Window -> IO (Ptr ())
getWGLContext = Ptr C'GLFWwindow -> IO (Ptr ())
c'glfwGetWGLContext (Ptr C'GLFWwindow -> IO (Ptr ()))
-> (Window -> Ptr C'GLFWwindow) -> Window -> IO (Ptr ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Window -> Ptr C'GLFWwindow
forall c h. C c h => h -> c
toC

-- | See <http://www.glfw.org/docs/3.3/group__native.html#gaf22f429aec4b1aab316142d66d9be3e6 glfwGetCocoaMonitor>
getCocoaMonitor :: Window -> IO (Ptr Word32)
getCocoaMonitor :: Window -> IO (Ptr Word32)
getCocoaMonitor = Ptr C'GLFWwindow -> IO (Ptr Word32)
c'glfwGetCocoaMonitor (Ptr C'GLFWwindow -> IO (Ptr Word32))
-> (Window -> Ptr C'GLFWwindow) -> Window -> IO (Ptr Word32)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Window -> Ptr C'GLFWwindow
forall c h. C c h => h -> c
toC

-- | See <http://www.glfw.org/docs/3.3/group__native.html#gac3ed9d495d0c2bb9652de5a50c648715 glfwGetCocoaWindow>
getCocoaWindow :: Window -> IO (Ptr ())
getCocoaWindow :: Window -> IO (Ptr ())
getCocoaWindow = Ptr C'GLFWwindow -> IO (Ptr ())
c'glfwGetCocoaWindow (Ptr C'GLFWwindow -> IO (Ptr ()))
-> (Window -> Ptr C'GLFWwindow) -> Window -> IO (Ptr ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Window -> Ptr C'GLFWwindow
forall c h. C c h => h -> c
toC

-- | See <http://www.glfw.org/docs/3.3/group__native.html#ga559e002e3cd63c979881770cd4dc63bc glfwGetNSGLContext>
getNSGLContext :: Window -> IO (Ptr ())
getNSGLContext :: Window -> IO (Ptr ())
getNSGLContext = Ptr C'GLFWwindow -> IO (Ptr ())
c'glfwGetNSGLContext (Ptr C'GLFWwindow -> IO (Ptr ()))
-> (Window -> Ptr C'GLFWwindow) -> Window -> IO (Ptr ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Window -> Ptr C'GLFWwindow
forall c h. C c h => h -> c
toC

-- | See <http://www.glfw.org/docs/3.3/group__native.html#ga8519b66594ea3ef6eeafaa2e3ee37406 glfwGetX11Display>
getX11Display :: Window -> IO (Ptr display)
getX11Display :: forall display. Window -> IO (Ptr display)
getX11Display = Ptr C'GLFWwindow -> IO (Ptr display)
forall display. Ptr C'GLFWwindow -> IO (Ptr display)
c'glfwGetX11Display (Ptr C'GLFWwindow -> IO (Ptr display))
-> (Window -> Ptr C'GLFWwindow) -> Window -> IO (Ptr display)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Window -> Ptr C'GLFWwindow
forall c h. C c h => h -> c
toC

-- | See <http://www.glfw.org/docs/3.3/group__native.html#ga088fbfa80f50569402b41be71ad66e40 glfwGetX11Adapter>
getX11Adapter :: Window -> IO Word64
getX11Adapter :: Window -> IO Word64
getX11Adapter = Ptr C'GLFWwindow -> IO Word64
c'glfwGetX11Adapter (Ptr C'GLFWwindow -> IO Word64)
-> (Window -> Ptr C'GLFWwindow) -> Window -> IO Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Window -> Ptr C'GLFWwindow
forall c h. C c h => h -> c
toC

-- | See <http://www.glfw.org/docs/3.3/group__native.html#gab2f8cc043905e9fa9b12bfdbbcfe874c glfwGetX11Monitor>
getX11Monitor :: Window -> IO Word64
getX11Monitor :: Window -> IO Word64
getX11Monitor = Ptr C'GLFWwindow -> IO Word64
c'glfwGetX11Monitor (Ptr C'GLFWwindow -> IO Word64)
-> (Window -> Ptr C'GLFWwindow) -> Window -> IO Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Window -> Ptr C'GLFWwindow
forall c h. C c h => h -> c
toC

-- | See <http://www.glfw.org/docs/3.3/group__native.html#ga90ca676322740842db446999a1b1f21d glfwGetX11Window>
getX11Window  :: Window -> IO Word64
getX11Window :: Window -> IO Word64
getX11Window = Ptr C'GLFWwindow -> IO Word64
c'glfwGetX11Window (Ptr C'GLFWwindow -> IO Word64)
-> (Window -> Ptr C'GLFWwindow) -> Window -> IO Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Window -> Ptr C'GLFWwindow
forall c h. C c h => h -> c
toC

-- | See <https://www.glfw.org/docs/3.3/group__native.html#ga72f23e3980b83788c70aa854eca31430 glfwGetX11SelectionString>
getX11SelectionString :: IO String
getX11SelectionString :: IO String
getX11SelectionString = IO CString
c'glfwGetX11SelectionString IO CString -> (CString -> IO String) -> IO String
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CString -> IO String
peekCString

-- | See <https://www.glfw.org/docs/3.3/group__native.html#ga55f879ab02d93367f966186b6f0133f7 glfwSetX11SelectionString>
setX11SelectionString :: String -> IO ()
setX11SelectionString :: String -> IO ()
setX11SelectionString = (String -> (CString -> IO ()) -> IO ())
-> (CString -> IO ()) -> String -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> (CString -> IO ()) -> IO ()
forall a. String -> (CString -> IO a) -> IO a
withCString CString -> IO ()
c'glfwSetX11SelectionString

-- | See <http://www.glfw.org/docs/3.3/group__native.html#ga62d884114b0abfcdc2930e89f20867e2 glfwGetGLXContext>
getGLXContext :: Window -> IO (Ptr ())
getGLXContext :: Window -> IO (Ptr ())
getGLXContext = Ptr C'GLFWwindow -> IO (Ptr ())
c'glfwGetGLXContext (Ptr C'GLFWwindow -> IO (Ptr ()))
-> (Window -> Ptr C'GLFWwindow) -> Window -> IO (Ptr ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Window -> Ptr C'GLFWwindow
forall c h. C c h => h -> c
toC

-- | See <http://www.glfw.org/docs/3.3/group__native.html#ga1ed27b8766e859a21381e8f8ce18d049 glfwGetGLXWindow>
getGLXWindow  :: Window -> IO Word64
getGLXWindow :: Window -> IO Word64
getGLXWindow = Ptr C'GLFWwindow -> IO Word64
c'glfwGetGLXWindow (Ptr C'GLFWwindow -> IO Word64)
-> (Window -> Ptr C'GLFWwindow) -> Window -> IO Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Window -> Ptr C'GLFWwindow
forall c h. C c h => h -> c
toC

-- | See <http://www.glfw.org/docs/3.3/group__native.html#gaaf8118a3c877f3a6bc8e7a649519de5e glfwGetWaylandDisplay>
getWaylandDisplay :: IO (Ptr wl_display)
getWaylandDisplay :: forall wl_display. IO (Ptr wl_display)
getWaylandDisplay = IO (Ptr wl_display)
forall wl_display. IO (Ptr wl_display)
c'glfwGetWaylandDisplay

-- | See <http://www.glfw.org/docs/3.3/group__native.html#gab10427a667b6cd91eec7709f7a906bd3 glfwGetWaylandMonitor>
getWaylandMonitor :: Window -> IO (Ptr wl_output)
getWaylandMonitor :: forall display. Window -> IO (Ptr display)
getWaylandMonitor = Ptr C'GLFWwindow -> IO (Ptr wl_output)
forall display. Ptr C'GLFWwindow -> IO (Ptr display)
c'glfwGetWaylandMonitor (Ptr C'GLFWwindow -> IO (Ptr wl_output))
-> (Window -> Ptr C'GLFWwindow) -> Window -> IO (Ptr wl_output)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Window -> Ptr C'GLFWwindow
forall c h. C c h => h -> c
toC

-- | See <http://www.glfw.org/docs/3.3/group__native.html#ga4738d7aca4191363519a9a641c3ab64c glfwGetWaylandWindow>
getWaylandWindow :: Window -> IO (Ptr wl_surface)
getWaylandWindow :: forall display. Window -> IO (Ptr display)
getWaylandWindow = Ptr C'GLFWwindow -> IO (Ptr wl_surface)
forall display. Ptr C'GLFWwindow -> IO (Ptr display)
c'glfwGetWaylandWindow (Ptr C'GLFWwindow -> IO (Ptr wl_surface))
-> (Window -> Ptr C'GLFWwindow) -> Window -> IO (Ptr wl_surface)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Window -> Ptr C'GLFWwindow
forall c h. C c h => h -> c
toC

-- | See <http://www.glfw.org/docs/3.3/group__native.html#ga1cd8d973f47aacb5532d368147cc3138 glfwGetEGLDisplay>
getEGLDisplay :: IO (Ptr ())
getEGLDisplay :: IO (Ptr ())
getEGLDisplay = IO (Ptr ())
c'glfwGetEGLDisplay

-- | See <http://www.glfw.org/docs/3.3/group__native.html#ga671c5072becd085f4ab5771a9c8efcf1 glfwGetEGLContext>
getEGLContext :: Window -> IO (Ptr ())
getEGLContext :: Window -> IO (Ptr ())
getEGLContext = Ptr C'GLFWwindow -> IO (Ptr ())
c'glfwGetEGLContext (Ptr C'GLFWwindow -> IO (Ptr ()))
-> (Window -> Ptr C'GLFWwindow) -> Window -> IO (Ptr ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Window -> Ptr C'GLFWwindow
forall c h. C c h => h -> c
toC

-- | See <http://www.glfw.org/docs/3.3/group__native.html#ga2199b36117a6a695fec8441d8052eee6 glfwGetEGLSurface>
getEGLSurface :: Window -> IO (Ptr ())
getEGLSurface :: Window -> IO (Ptr ())
getEGLSurface = Ptr C'GLFWwindow -> IO (Ptr ())
c'glfwGetEGLSurface (Ptr C'GLFWwindow -> IO (Ptr ()))
-> (Window -> Ptr C'GLFWwindow) -> Window -> IO (Ptr ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Window -> Ptr C'GLFWwindow
forall c h. C c h => h -> c
toC

-- | See <https://www.glfw.org/docs/3.3/group__native.html#ga9e47700080094eb569cb053afaa88773 glfwGetOSMesaContext>
getOSMesaContext :: Window -> IO (Ptr ())
getOSMesaContext :: Window -> IO (Ptr ())
getOSMesaContext = Ptr C'GLFWwindow -> IO (Ptr ())
c'glfwGetOSMesaContext (Ptr C'GLFWwindow -> IO (Ptr ()))
-> (Window -> Ptr C'GLFWwindow) -> Window -> IO (Ptr ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Window -> Ptr C'GLFWwindow
forall c h. C c h => h -> c
toC

-- | An RGBA type is a low-dynamic range representation of a color, represented
-- by a 32-bit value. The channels here are in order: R, G, B, A
type OSMesaRGBA = (Word8, Word8, Word8, Word8)

-- | A color buffer is a two dimensional array of RGBA values. The first
-- dimension is width, and the second is height.
--
-- TODO: It's a shame this is an Array and not a UArray.
type OSMesaColorBuffer = Array (Int, Int) OSMesaRGBA

-- | A depth buffer is a two dimensional array of depth values. The range is
-- usually determined by a parameter returned from the query function.
type OSMesaDepthBuffer = Array (Int, Int) Word32

-- | Returns the color buffer of the offscreen context provided by OSMesa. The
-- color buffer is returned as an array whose integers are unsigned and
-- represent the (R, G, B, A) values. For formats that do not have alpha, A
-- will always be 255.
getOSMesaColorBuffer :: Window -> IO (Maybe OSMesaColorBuffer)
getOSMesaColorBuffer :: Window -> IO (Maybe OSMesaColorBuffer)
getOSMesaColorBuffer Window
win =
    (Ptr CInt -> IO (Maybe OSMesaColorBuffer))
-> IO (Maybe OSMesaColorBuffer)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Maybe OSMesaColorBuffer))
 -> IO (Maybe OSMesaColorBuffer))
-> (Ptr CInt -> IO (Maybe OSMesaColorBuffer))
-> IO (Maybe OSMesaColorBuffer)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
p'width ->
    (Ptr CInt -> IO (Maybe OSMesaColorBuffer))
-> IO (Maybe OSMesaColorBuffer)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Maybe OSMesaColorBuffer))
 -> IO (Maybe OSMesaColorBuffer))
-> (Ptr CInt -> IO (Maybe OSMesaColorBuffer))
-> IO (Maybe OSMesaColorBuffer)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
p'height ->
    (Ptr CInt -> IO (Maybe OSMesaColorBuffer))
-> IO (Maybe OSMesaColorBuffer)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Maybe OSMesaColorBuffer))
 -> IO (Maybe OSMesaColorBuffer))
-> (Ptr CInt -> IO (Maybe OSMesaColorBuffer))
-> IO (Maybe OSMesaColorBuffer)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
p'format ->
    (Ptr (Ptr ()) -> IO (Maybe OSMesaColorBuffer))
-> IO (Maybe OSMesaColorBuffer)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr (Ptr ()) -> IO (Maybe OSMesaColorBuffer))
 -> IO (Maybe OSMesaColorBuffer))
-> (Ptr (Ptr ()) -> IO (Maybe OSMesaColorBuffer))
-> IO (Maybe OSMesaColorBuffer)
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr ())
p'buf -> do
        Bool
result <- CInt -> Bool
forall c h. C c h => c -> h
fromC (CInt -> Bool) -> IO CInt -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr C'GLFWwindow
-> Ptr CInt -> Ptr CInt -> Ptr CInt -> Ptr (Ptr ()) -> IO CInt
c'glfwGetOSMesaColorBuffer (Window -> Ptr C'GLFWwindow
forall c h. C c h => h -> c
toC Window
win)
                                Ptr CInt
p'width Ptr CInt
p'height Ptr CInt
p'format Ptr (Ptr ())
p'buf
        if Bool -> Bool
not Bool
result then Maybe OSMesaColorBuffer -> IO (Maybe OSMesaColorBuffer)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe OSMesaColorBuffer
forall a. Maybe a
Nothing else do
            Int
w <- CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Int) -> IO CInt -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
p'width
            Int
h <- CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Int) -> IO CInt -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
p'height
            CInt
format <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
p'format
            Ptr ()
buf <- Ptr (Ptr ()) -> IO (Ptr ())
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr ())
p'buf
            OSMesaColorBuffer -> Maybe OSMesaColorBuffer
forall a. a -> Maybe a
Just (OSMesaColorBuffer -> Maybe OSMesaColorBuffer)
-> ([((Int, Int), OSMesaRGBA)] -> OSMesaColorBuffer)
-> [((Int, Int), OSMesaRGBA)]
-> Maybe OSMesaColorBuffer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Int), (Int, Int))
-> [((Int, Int), OSMesaRGBA)] -> OSMesaColorBuffer
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [(i, e)] -> a i e
array ((Int
0, Int
0), (Int
w, Int
h)) ([((Int, Int), OSMesaRGBA)] -> Maybe OSMesaColorBuffer)
-> IO [((Int, Int), OSMesaRGBA)] -> IO (Maybe OSMesaColorBuffer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [IO ((Int, Int), OSMesaRGBA)] -> IO [((Int, Int), OSMesaRGBA)]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence
              [ (OSMesaRGBA -> ((Int, Int), OSMesaRGBA))
-> IO OSMesaRGBA -> IO ((Int, Int), OSMesaRGBA)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\OSMesaRGBA
rgba -> ((Int
x, Int
y), OSMesaRGBA
rgba)) (IO OSMesaRGBA -> IO ((Int, Int), OSMesaRGBA))
-> IO OSMesaRGBA -> IO ((Int, Int), OSMesaRGBA)
forall a b. (a -> b) -> a -> b
$
                  CInt -> Ptr Word8 -> Int -> IO OSMesaRGBA
mkRGBA CInt
format (Ptr () -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr ()
buf) (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x)
              | Int
x <- [Int
0..Int
w]
              , Int
y <- [Int
0..Int
h]
              ]
  where
    getByte :: Int -> Word32 -> Word8
    getByte :: Int -> Word32 -> Word8
getByte Int
i Word32
x = Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Word8) -> Word32 -> Word8
forall a b. (a -> b) -> a -> b
$ (Word32
x Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8)) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0xFF

    mkRGBA :: CInt -> Ptr Word8 -> Int -> IO OSMesaRGBA
    mkRGBA :: CInt -> Ptr Word8 -> Int -> IO OSMesaRGBA
mkRGBA CInt
0x1908 Ptr Word8
buf Int
offset = do
        -- OSMESA_RGBA
        (Word32
rgba :: Word32) <- Ptr Word32 -> Int -> IO Word32
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff (Ptr Word8 -> Ptr Word32
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
buf) Int
offset
        OSMesaRGBA -> IO OSMesaRGBA
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Word32 -> Word8
getByte Int
0 Word32
rgba, Int -> Word32 -> Word8
getByte Int
1 Word32
rgba, Int -> Word32 -> Word8
getByte Int
2 Word32
rgba, Int -> Word32 -> Word8
getByte Int
3 Word32
rgba)
    mkRGBA CInt
0x1 Ptr Word8
buf Int
offset = do
        -- OSMESA_BGRA
        (Word32
bgra :: Word32) <- Ptr Word32 -> Int -> IO Word32
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff (Ptr Word8 -> Ptr Word32
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
buf) Int
offset
        OSMesaRGBA -> IO OSMesaRGBA
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Word32 -> Word8
getByte Int
2 Word32
bgra, Int -> Word32 -> Word8
getByte Int
1 Word32
bgra, Int -> Word32 -> Word8
getByte Int
0 Word32
bgra, Int -> Word32 -> Word8
getByte Int
3 Word32
bgra)
    mkRGBA CInt
0x2 Ptr Word8
buf Int
offset = do
        -- OSMESA_ARGB
        (Word32
argb :: Word32) <- Ptr Word32 -> Int -> IO Word32
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff (Ptr Word8 -> Ptr Word32
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
buf) Int
offset
        OSMesaRGBA -> IO OSMesaRGBA
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Word32 -> Word8
getByte Int
1 Word32
argb, Int -> Word32 -> Word8
getByte Int
2 Word32
argb, Int -> Word32 -> Word8
getByte Int
3 Word32
argb, Int -> Word32 -> Word8
getByte Int
0 Word32
argb)
    mkRGBA CInt
0x1907 Ptr Word8
buf Int
offset = do
        -- OSMESA_RGB
        Word8
r <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek (Ptr Word8
buf Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0))
        Word8
g <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek (Ptr Word8
buf Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
        Word8
b <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek (Ptr Word8
buf Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2))
        OSMesaRGBA -> IO OSMesaRGBA
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word8
r, Word8
g, Word8
b, Word8
255)
    mkRGBA CInt
0x4 Ptr Word8
buf Int
offset = do
        -- OSMESA_BGR
        Word8
b <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek (Ptr Word8
buf Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0))
        Word8
g <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek (Ptr Word8
buf Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
        Word8
r <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek (Ptr Word8
buf Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2))
        OSMesaRGBA -> IO OSMesaRGBA
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word8
r, Word8
g, Word8
b, Word8
255)
    mkRGBA CInt
0x5 Ptr Word8
buf Int
offset = do
        -- OSMESA_RGB_565
        (Word16
rgb :: Word16) <- Ptr Word16 -> Int -> IO Word16
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff (Ptr Word8 -> Ptr Word16
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
buf) Int
offset
        OSMesaRGBA -> IO OSMesaRGBA
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (
          Word16 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Word8) -> Word16 -> Word8
forall a b. (a -> b) -> a -> b
$ Word16
rgb Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.&. Word16
0x1F,
          Word16 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Word8) -> Word16 -> Word8
forall a b. (a -> b) -> a -> b
$ (Word16
rgb Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
`shiftR` Int
5) Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.&. Word16
0x3F,
          Word16 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Word8) -> Word16 -> Word8
forall a b. (a -> b) -> a -> b
$ (Word16
rgb Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
`shiftR` Int
11) Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.&. Word16
0x1F,
          Word8
255)
    mkRGBA CInt
fmt Ptr Word8
_ Int
_ = String -> IO OSMesaRGBA
forall a. HasCallStack => String -> a
error (String -> IO OSMesaRGBA) -> String -> IO OSMesaRGBA
forall a b. (a -> b) -> a -> b
$ String
"Unrecognized OSMESA_FORMAT: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ CInt -> String
forall a. Show a => a -> String
show CInt
fmt

-- | Returns the depth buffer and maximum depth value of the offscreen render
-- target that's provided by OSMesa.
getOSMesaDepthBuffer :: Window -> IO (Maybe (OSMesaDepthBuffer, Word32))
getOSMesaDepthBuffer :: Window -> IO (Maybe (OSMesaDepthBuffer, Word32))
getOSMesaDepthBuffer Window
win =
    (Ptr CInt -> IO (Maybe (OSMesaDepthBuffer, Word32)))
-> IO (Maybe (OSMesaDepthBuffer, Word32))
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Maybe (OSMesaDepthBuffer, Word32)))
 -> IO (Maybe (OSMesaDepthBuffer, Word32)))
-> (Ptr CInt -> IO (Maybe (OSMesaDepthBuffer, Word32)))
-> IO (Maybe (OSMesaDepthBuffer, Word32))
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
p'width ->
    (Ptr CInt -> IO (Maybe (OSMesaDepthBuffer, Word32)))
-> IO (Maybe (OSMesaDepthBuffer, Word32))
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Maybe (OSMesaDepthBuffer, Word32)))
 -> IO (Maybe (OSMesaDepthBuffer, Word32)))
-> (Ptr CInt -> IO (Maybe (OSMesaDepthBuffer, Word32)))
-> IO (Maybe (OSMesaDepthBuffer, Word32))
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
p'height ->
    (Ptr CInt -> IO (Maybe (OSMesaDepthBuffer, Word32)))
-> IO (Maybe (OSMesaDepthBuffer, Word32))
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Maybe (OSMesaDepthBuffer, Word32)))
 -> IO (Maybe (OSMesaDepthBuffer, Word32)))
-> (Ptr CInt -> IO (Maybe (OSMesaDepthBuffer, Word32)))
-> IO (Maybe (OSMesaDepthBuffer, Word32))
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
p'bytesPerVal ->
    (Ptr (Ptr ()) -> IO (Maybe (OSMesaDepthBuffer, Word32)))
-> IO (Maybe (OSMesaDepthBuffer, Word32))
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr (Ptr ()) -> IO (Maybe (OSMesaDepthBuffer, Word32)))
 -> IO (Maybe (OSMesaDepthBuffer, Word32)))
-> (Ptr (Ptr ()) -> IO (Maybe (OSMesaDepthBuffer, Word32)))
-> IO (Maybe (OSMesaDepthBuffer, Word32))
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr ())
p'buf -> do
        Bool
result <- CInt -> Bool
forall c h. C c h => c -> h
fromC (CInt -> Bool) -> IO CInt -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr C'GLFWwindow
-> Ptr CInt -> Ptr CInt -> Ptr CInt -> Ptr (Ptr ()) -> IO CInt
c'glfwGetOSMesaDepthBuffer (Window -> Ptr C'GLFWwindow
forall c h. C c h => h -> c
toC Window
win)
                                Ptr CInt
p'width Ptr CInt
p'height Ptr CInt
p'bytesPerVal Ptr (Ptr ())
p'buf
        if Bool -> Bool
not Bool
result then Maybe (OSMesaDepthBuffer, Word32)
-> IO (Maybe (OSMesaDepthBuffer, Word32))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (OSMesaDepthBuffer, Word32)
forall a. Maybe a
Nothing else do
            Int
w <- CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Int) -> IO CInt -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
p'width
            Int
h <- CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Int) -> IO CInt -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
p'height
            Int
bytesPerVal <- CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Int) -> IO CInt -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
p'bytesPerVal
            Ptr ()
buf <- Ptr (Ptr ()) -> IO (Ptr ())
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr ())
p'buf
            OSMesaDepthBuffer
depthBuffer <- ((Int, Int), (Int, Int))
-> [((Int, Int), Word32)] -> OSMesaDepthBuffer
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [(i, e)] -> a i e
array ((Int
0, Int
0), (Int
w, Int
h)) ([((Int, Int), Word32)] -> OSMesaDepthBuffer)
-> IO [((Int, Int), Word32)] -> IO OSMesaDepthBuffer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [IO ((Int, Int), Word32)] -> IO [((Int, Int), Word32)]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence
              [ (Word32 -> ((Int, Int), Word32))
-> IO Word32 -> IO ((Int, Int), Word32)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Word32
d -> ((Int
x, Int
y), Word32
d)) (IO Word32 -> IO ((Int, Int), Word32))
-> IO Word32 -> IO ((Int, Int), Word32)
forall a b. (a -> b) -> a -> b
$
                  Int -> Ptr Word8 -> Int -> IO Word32
mkDepth Int
bytesPerVal (Ptr () -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr ()
buf) (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x)
              | Int
x <- [Int
0..Int
w]
              , Int
y <- [Int
0..Int
h]
              ]
            Maybe (OSMesaDepthBuffer, Word32)
-> IO (Maybe (OSMesaDepthBuffer, Word32))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((OSMesaDepthBuffer, Word32) -> Maybe (OSMesaDepthBuffer, Word32)
forall a. a -> Maybe a
Just (OSMesaDepthBuffer
depthBuffer, (Word32
1 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
bytesPerVal)) Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
- Word32
1))
  where
    mkDepth :: Int -> Ptr Word8 -> Int -> IO Word32
    mkDepth :: Int -> Ptr Word8 -> Int -> IO Word32
mkDepth Int
bpv Ptr Word8
ptr Int
offset = do
        -- Assumes little-endian?
        [Word8]
bytes <- [Int] -> (Int -> IO Word8) -> IO [Word8]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Int
0..(Int
bpv Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)] ((Int -> IO Word8) -> IO [Word8])
-> (Int -> IO Word8) -> IO [Word8]
forall a b. (a -> b) -> a -> b
$ \Int
i -> Ptr Word8 -> Int -> IO Word8
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Word8
ptr (Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
bpv Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i)
        Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word32 -> IO Word32) -> Word32 -> IO Word32
forall a b. (a -> b) -> a -> b
$ (Word32 -> Word8 -> Word32) -> Word32 -> [Word8] -> Word32
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Word32
d -> ((Word32
d Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
8) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|.) (Word32 -> Word32) -> (Word8 -> Word32) -> Word8 -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral) Word32
0 [Word8]
bytes