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