{-# LANGUAGE ScopedTypeVariables #-}
module Graphics.UI.GLFW
(
Error (..)
, setErrorCallback, ErrorCallback
, Version (..)
, init
, InitHint(..)
, initHint
, terminate
, getVersion
, getVersionString
, getError
, clearError
, rawMouseMotionSupported
, Monitor
, MonitorState (..)
, VideoMode (..)
, GammaRamp (gammaRampRed, gammaRampGreen, gammaRampBlue)
, makeGammaRamp
, getMonitors
, getPrimaryMonitor
, getMonitorPos
, getMonitorPhysicalSize
, getMonitorContentScale
, getMonitorWorkarea
, getMonitorName
, setMonitorCallback, MonitorCallback
, getVideoModes
, getVideoMode
, setGamma
, getGammaRamp
, setGammaRamp
, 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
, 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
, Key (..)
, KeyState (..)
, Joystick (..)
, JoystickState (..)
, JoystickButtonState (..)
, MouseButton (..)
, MouseButtonState (..)
, CursorState (..)
, CursorInputMode (..)
, StickyKeysInputMode (..)
, StickyMouseButtonsInputMode (..)
, ModifierKeys (..)
, GamepadButton (..)
, GamepadAxis (..)
, GamepadButtonState (..)
, GamepadState (..)
, Image
, mkImage
, Cursor (..)
, StandardCursorShape (..)
, 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
, getTime
, setTime
, getTimerValue
, getTimerFrequency
, makeContextCurrent
, getCurrentContext
, swapBuffers
, swapInterval
, extensionSupported
, getClipboardString
, setClipboardString
, vulkanSupported
, getRequiredInstanceExtensions
, getInstanceProcAddress
, getPhysicalDevicePresentationSupport
, createWindowSurface
, getWin32Adapter
, getWin32Monitor
, getWin32Window
, getWGLContext
, getCocoaMonitor
, getCocoaWindow
, getNSGLContext
, getX11Display
, getX11Adapter
, getX11Monitor
, getX11Window
, 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
hFloat :: CFloat -> Float
hFloat :: CFloat -> Float
hFloat (CFloat Float
f) = Float
f
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
{-# NOINLINE storedErrorFun #-}
{-# NOINLINE storedMonitorFun #-}
{-# NOINLINE storedJoystickFun #-}
setWindowCallback
:: (c -> IO (FunPtr c))
-> (h -> c)
-> (FunPtr c -> IO (FunPtr c))
-> (WindowCallbacks -> IORef (FunPtr c))
-> Window
-> Maybe h
-> IO ()
setWindowCallback :: 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))
-> (h -> c)
-> (FunPtr c -> IO (FunPtr c))
-> IORef (FunPtr c)
-> Maybe h
-> 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
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
FunPtr c
_ <- FunPtr c -> IO (FunPtr c)
gf FunPtr c
ccb
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
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))
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
type ErrorCallback = Error -> String -> IO ()
type WindowPosCallback = Window -> Int -> Int -> IO ()
type WindowSizeCallback = Window -> Int -> Int -> IO ()
type WindowCloseCallback = Window -> IO ()
type WindowRefreshCallback = Window -> IO ()
type WindowFocusCallback = Window -> Bool -> IO ()
type WindowIconifyCallback = Window -> Bool -> IO ()
type FramebufferSizeCallback = Window -> Int -> Int -> IO ()
type MouseButtonCallback = Window -> MouseButton -> MouseButtonState -> ModifierKeys -> IO ()
type CursorPosCallback = Window -> Double -> Double -> IO ()
type CursorEnterCallback = Window -> CursorState -> IO ()
type ScrollCallback = Window -> Double -> Double -> IO ()
type KeyCallback = Window -> Key -> Int -> KeyState -> ModifierKeys -> IO ()
type CharCallback = Window -> Char -> IO ()
type CharModsCallback = Window -> Char -> ModifierKeys -> IO ()
type MonitorCallback = Monitor -> MonitorState -> IO ()
type JoystickCallback = Joystick -> JoystickState -> IO ()
type WindowContentScaleCallback = Window -> Float -> Float -> IO ()
type WindowMaximizeCallback = Window -> Bool -> IO ()
data ScheduledCallbacks = ScheduledCallbacks
{ ScheduledCallbacks -> [IO ()]
_forward :: [IO ()]
, ScheduledCallbacks -> [IO ()]
_backward :: [IO ()]
}
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 [] []
{-# NOINLINE storedScheduledCallbacks #-}
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) ->
([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
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
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
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
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)
terminate :: IO ()
terminate :: IO ()
terminate = do
IO ()
c'glfwTerminate
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
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
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
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))
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 ()
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
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
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
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)
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)
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
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
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
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
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)
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
}
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]
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
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)
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)
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)
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
createWindow :: Int
-> Int
-> String
-> Maybe Monitor
-> Maybe Window
-> 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)
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
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
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)
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
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)
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)
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
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)
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)
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)
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)
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)
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)
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)
setWindowSizeLimits :: Window
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> 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)
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)
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)
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)
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
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
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
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
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
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
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
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
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
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)
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)
setWindowed :: Window
-> Int
-> Int
-> Int
-> Int
-> 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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
postEmptyEvent :: IO ()
postEmptyEvent :: IO ()
postEmptyEvent = IO ()
c'glfwPostEmptyEvent
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
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)
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)
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
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
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)
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
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)
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)
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
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
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)
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)
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
getTimerValue :: IO Word64
getTimerValue :: IO Word64
getTimerValue = IO Word64
c'glfwGetTimerValue
getTimerFrequency :: IO Word64
getTimerFrequency :: IO Word64
getTimerFrequency = IO Word64
c'glfwGetTimerFrequency
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
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
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
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
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
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))
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
createCursor :: Image
-> Int
-> Int
-> 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)
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
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
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
type DropCallback = Window
-> [String]
-> IO ()
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
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
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
getInstanceProcAddress :: Ptr vkInstance
-> String
-> 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)
getPhysicalDevicePresentationSupport ::
Ptr vkInstance
-> Ptr vkPhysicalDevice
-> Word32
-> 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
createWindowSurface :: Enum vkResult
=> Ptr vkInstance
-> Window
-> Ptr vkAllocationCallbacks
-> Ptr vkSurfaceKHR
-> 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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
getEGLDisplay :: IO (Ptr ())
getEGLDisplay :: IO (Ptr ())
getEGLDisplay = IO (Ptr ())
c'glfwGetEGLDisplay
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
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
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
type OSMesaRGBA = (Word8, Word8, Word8, Word8)
type OSMesaColorBuffer = Array (Int, Int) OSMesaRGBA
type OSMesaDepthBuffer = Array (Int, Int) Word32
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
(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
(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
(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
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
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
(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
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
[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