diff --git a/GLFW-b.cabal b/GLFW-b.cabal --- a/GLFW-b.cabal +++ b/GLFW-b.cabal @@ -1,9 +1,11 @@ name: GLFW-b -version: 1.4.8.4 +version: 3.2.1.0 category: Graphics author: Brian Lewis -maintainer: Brian Lewis , Schell Scivally +maintainer: Brian Lewis + , Schell Scivally + , Pavel Krajcevski license: BSD3 license-file: LICENSE @@ -18,8 +20,7 @@ (), which, as of the time of this writing, binds to GLFW 3.2.1, released 2016-08-18 ( - ). However, these high-level bindings only - point to some of the new features in 3.1 and 3.2. + ). . If you've used GLFW < 3 before, you should read the transition guide (). @@ -52,7 +53,7 @@ build-depends: base < 5 , deepseq >= 1.1.0.0 - , bindings-GLFW >= 3.2.1.0 + , bindings-GLFW >= 3.2.1.1 -------------------------------------------------------------------------------- diff --git a/Graphics/UI/GLFW.hs b/Graphics/UI/GLFW.hs --- a/Graphics/UI/GLFW.hs +++ b/Graphics/UI/GLFW.hs @@ -2,17 +2,17 @@ Threading restrictions which apply to the C version of GLFW still apply when writing @GLFW-b@ programs. See - + (applies here). Current context restructions which apply to the C version of GLFW still apply. -See +See (applies here). @GLFW-b@ wraps callbacks and schedules them to be run after 'pollEvents' and 'waitEvents' in the normal GHC runtime where they aren't subject to the usual GLFW reentrancy restrictions. See - + (does not apply here). -} @@ -51,12 +51,12 @@ -- * Window handling , Window - , WindowHint (..) - , FocusState (..) - , IconifyState (..) - , ContextRobustness (..) - , OpenGLProfile (..) - , ClientAPI (..) + , WindowHint (..) + , ContextRobustness (..) + , OpenGLProfile (..) + , ClientAPI (..) + , ContextCreationAPI (..) + , ContextReleaseBehavior (..) -- , defaultWindowHints , windowHint @@ -69,24 +69,37 @@ , setWindowPos , getWindowSize , setWindowSize + , setWindowSizeLimits + , setWindowAspectRatio + , getWindowFrameSize , getFramebufferSize + , setWindowIcon , iconifyWindow , restoreWindow + , focusWindow + , maximizeWindow , showWindow , hideWindow , getWindowMonitor , setCursorPos + , setFullscreen + , setWindowed -- related to c'glfwGetWindowAttrib --. , getWindowFocused -- | + , getWindowMaximized -- | + , getWindowFloating -- | , getWindowIconified -- | , getWindowResizable -- | , getWindowDecorated -- | , getWindowVisible -- | , getWindowClientAPI -- | + , getWindowContextCreationAPI -- | , getWindowContextVersionMajor -- | , getWindowContextVersionMinor -- | , getWindowContextVersionRevision -- | , getWindowContextRobustness -- | + , getWindowContextReleaseBehavior -- | + , getWindowContextNoError -- | , getWindowOpenGLForwardCompat -- | , getWindowOpenGLDebugContext -- | , getWindowOpenGLProfile --------------' @@ -99,12 +112,14 @@ , setFramebufferSizeCallback, FramebufferSizeCallback , pollEvents , waitEvents + , waitEventsTimeout , postEmptyEvent -- * Input handling , Key (..) , KeyState (..) , Joystick (..) + , JoystickState (..) , JoystickButtonState (..) , MouseButton (..) , MouseButtonState (..) @@ -113,7 +128,8 @@ , StickyKeysInputMode (..) , StickyMouseButtonsInputMode (..) , ModifierKeys (..) - , Image (..) + , Image + , mkImage , Cursor (..) , StandardCursorShape (..) -- @@ -125,10 +141,12 @@ , getStickyMouseButtonsInputMode -- | , setStickyMouseButtonsInputMode -----' , getKey + , getKeyName , getMouseButton , getCursorPos , setKeyCallback, KeyCallback , setCharCallback, CharCallback + , setCharModsCallback, CharModsCallback , setMouseButtonCallback, MouseButtonCallback , setCursorPosCallback, CursorPosCallback , setCursorEnterCallback, CursorEnterCallback @@ -142,10 +160,13 @@ , getJoystickAxes , getJoystickButtons , getJoystickName + , setJoystickCallback, JoystickCallback -- * Time , getTime , setTime + , getTimerValue + , getTimerFrequency -- * Context , makeContextCurrent @@ -157,6 +178,39 @@ -- * Clipboard , getClipboardString , setClipboardString + + -- * Vulkan-related functions + , vulkanSupported + , getRequiredInstanceExtensions + , getInstanceProcAddress + , getPhysicalDevicePresentationSupport + , createWindowSurface + + -- * Native access functions + -- $nativeaccess + , getWin32Adapter + , getWin32Monitor + , getWin32Window + , getWGLContext + , getCocoaMonitor + , getCocoaWindow + , getNSGLContext + , getX11Display + , getX11Adapter + , getX11Monitor + , getX11Window + , getGLXContext + , getGLXWindow + , getWaylandDisplay + , getWaylandMonitor + , getWaylandWindow + , getMirDisplay + , getMirMonitor + , getMirWindow + , getEGLDisplay + , getEGLContext + , getEGLSurface + ) where -------------------------------------------------------------------------------- @@ -165,11 +219,13 @@ import Control.Monad (when, liftM) import Data.IORef (IORef, atomicModifyIORef, newIORef, readIORef) -import Foreign.C.String (peekCString, withCString) +import Data.Word (Word32, Word64) +import Foreign.C.String (peekCString, withCString, CString) import Foreign.C.Types (CUInt, CUShort) -import Foreign.Marshal.Alloc (alloca) +import Foreign.Marshal.Alloc (alloca, allocaBytes) import Foreign.Marshal.Array (advancePtr, allocaArray, peekArray, withArray) -import Foreign.Ptr (FunPtr, freeHaskellFunPtr, nullFunPtr, nullPtr) +import Foreign.Ptr (FunPtr, freeHaskellFunPtr, nullFunPtr, nullPtr + ,Ptr) import Foreign.StablePtr import Foreign.Storable (Storable (..)) import System.IO.Unsafe (unsafePerformIO) @@ -186,15 +242,18 @@ storedErrorFun :: IORef C'GLFWerrorfun storedMonitorFun :: IORef C'GLFWmonitorfun +storedJoystickFun :: IORef C'GLFWjoystickfun storedErrorFun = unsafePerformIO $ newIORef nullFunPtr storedMonitorFun = unsafePerformIO $ newIORef nullFunPtr +storedJoystickFun = unsafePerformIO $ newIORef nullFunPtr -- These NOINLINE pragmas are due to use of unsafePerformIO. -- See http://hackage.haskell.org/packages/archive/base/latest/doc/html/System-IO-Unsafe.html#v:unsafePerformIO . {-# NOINLINE storedErrorFun #-} {-# NOINLINE storedMonitorFun #-} +{-# NOINLINE storedJoystickFun #-} setWindowCallback :: (c -> IO (FunPtr c)) -- wf wrapper function @@ -245,9 +304,9 @@ -- | Fires when the contents of the window are damaged and they must be refreshed. type WindowRefreshCallback = Window -> IO () -- | Fires when the window gains or loses input focus. -type WindowFocusCallback = Window -> FocusState -> IO () +type WindowFocusCallback = Window -> Bool -> IO () -- | Fires when the window is iconified (minimized) or not. -type WindowIconifyCallback = Window -> IconifyState -> IO () +type WindowIconifyCallback = Window -> Bool -> IO () -- | Fires when the size of the framebuffer for the window changes (in Pixels). type FramebufferSizeCallback = Window -> Int -> Int -> IO () -- | Fires whenever a mouse button is clicked. @@ -262,8 +321,12 @@ type KeyCallback = Window -> Key -> Int -> KeyState -> ModifierKeys -> IO () -- | Fires when a complete character codepoint is typed by the user, Shift then 'b' generates "B". type CharCallback = Window -> Char -> IO () +-- | Similar to 'CharCallback', fires when a complete unicode codepoint is typed by the user. +type CharModsCallback = Window -> Char -> ModifierKeys -> IO () -- | Fires when a monitor is connected or disconnected. type MonitorCallback = Monitor -> MonitorState -> IO () +-- | Fires when a joystick is connected or disconnected. +type JoystickCallback = Joystick -> JoystickState -> IO () -- 3.1 additions @@ -325,7 +388,7 @@ -- Error handling -- | Can (and probably should) be used before GLFW initialization. --- See +-- See setErrorCallback :: Maybe ErrorCallback -> IO () setErrorCallback = setCallback mk'GLFWerrorfun @@ -336,13 +399,23 @@ storedErrorFun -------------------------------------------------------------------------------- +-- Image utility functions + +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 + +-------------------------------------------------------------------------------- -- Initialization and version information -- | Attempts to initialize the GLFW library. When the library is not initialized, the only -- allowed functions to call are 'getVersion', 'getVersionString', 'setErrorCallback', -- 'init', and 'terminate'. Returns if the initialization was successful or not. --- See --- and +-- See +-- and init :: IO Bool init = fromC `fmap` c'glfwInit @@ -350,17 +423,18 @@ -- | Cleans up GLFW and puts the library into an uninitialized state. -- Once you call this, you must initilize the library again. -- Warning: No window's context may be current in another thread when this is called. --- See --- and +-- See +-- and terminate :: IO () terminate = do c'glfwTerminate -- Free all stored FunPtrs. storeCallback storedErrorFun nullFunPtr storeCallback storedMonitorFun nullFunPtr + storeCallback storedJoystickFun nullFunPtr -- | Gets the version of the GLFW library that's being used with the current program. --- See +-- See getVersion :: IO Version getVersion = allocaArray 3 $ \p -> do @@ -376,7 +450,7 @@ -- | Gets the compile-time version string of the GLFW library binary. -- Gives extra info like platform and compile time options used, but you should not -- attempt to parse this to get the GLFW version number. Use 'getVersion' instead. --- See +-- See getVersionString :: IO (Maybe String) getVersionString = do p'vs <- c'glfwGetVersionString @@ -388,7 +462,7 @@ -- Monitor handling -- | Gets the list of available monitors, if possible. --- See +-- See getMonitors :: IO (Maybe [Monitor]) getMonitors = alloca $ \p'n -> do @@ -399,7 +473,7 @@ else (Just . map fromC) `fmap` peekArray n p'mon -- | Gets the primary monitor. --- See +-- See getPrimaryMonitor :: IO (Maybe Monitor) getPrimaryMonitor = do p'mon <- c'glfwGetPrimaryMonitor @@ -409,7 +483,7 @@ else Just $ fromC p'mon -- | Gets the position of the specified monitor within the coordinate space. --- See +-- See getMonitorPos :: Monitor -> IO (Int, Int) getMonitorPos mon = allocaArray 2 $ \p -> do @@ -421,7 +495,7 @@ return (x, y) -- | The physical width and height of the monitor. --- See +-- See getMonitorPhysicalSize :: Monitor -> IO (Int, Int) getMonitorPhysicalSize mon = allocaArray 2 $ \p -> do @@ -433,7 +507,7 @@ return (w, h) -- | A human-readable name for the monitor specified. --- See +-- See getMonitorName :: Monitor -> IO (Maybe String) getMonitorName mon = do p'name <- c'glfwGetMonitorName (toC mon) @@ -442,7 +516,7 @@ else Just `fmap` peekCString p'name -- | Sets a callback for when a monitor is connected or disconnected. --- See +-- See setMonitorCallback :: Maybe MonitorCallback -> IO () setMonitorCallback = setCallback mk'GLFWmonitorfun @@ -451,7 +525,7 @@ storedMonitorFun -- | Obtains the possible video modes of the monitor. --- See +-- See getVideoModes :: Monitor -> IO (Maybe [VideoMode]) getVideoModes mon = alloca $ \p'n -> do @@ -462,7 +536,7 @@ else (Just . map fromC) `fmap` peekArray n p'vms -- | Gets the active video mode of the monitor. --- See +-- See getVideoMode :: Monitor -> IO (Maybe VideoMode) getVideoMode mon = do p'vm <- c'glfwGetVideoMode (toC mon) @@ -471,13 +545,13 @@ else (Just . fromC) `fmap` peek p'vm -- | Sets the gamma of a monitor. --- See +-- See setGamma :: Monitor -> Double -> IO () setGamma mon e = c'glfwSetGamma (toC mon) (toC e) -- | Gets the gamma ramp in use with the monitor. --- See +-- See getGammaRamp :: Monitor -> IO (Maybe GammaRamp) getGammaRamp m = do p'ggr <- c'glfwGetGammaRamp (toC m) @@ -503,7 +577,7 @@ } -- | Assigns a gamma ramp to use with the given monitor. --- See +-- See setGammaRamp :: Monitor -> GammaRamp -> IO () setGammaRamp mon gr = let rs = map toC $ gammaRampRed gr :: [CUShort] @@ -529,59 +603,68 @@ -- Window handling -- | Sets all the window hints to default. --- See +-- See defaultWindowHints :: IO () defaultWindowHints = c'glfwDefaultWindowHints -- | Hints something to the GLFW windowing system. --- See +-- See 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'Stereo x) -> (c'GLFW_STEREO, toC x) - (WindowHint'sRGBCapable x) -> (c'GLFW_SRGB_CAPABLE, toC x) - (WindowHint'ClientAPI x) -> (c'GLFW_CLIENT_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'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) + (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) -- | Creates a new window. -- Note: If running in GHCI don't forget to `:set -fno-ghci-sandbox` or you -- may run into an assertion failure, segfault or other nasty crash. --- See +-- See createWindow :: Int -- ^ Desired width for the window. -> Int -- ^ Desired height for the window. -> String -- ^ Desired title for the window. -> Maybe Monitor -- ^ Monitor to use in fullscreen mode. -> Maybe Window -- ^ Window for context object sharing, see - -- . + -- . -> 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 @@ -597,6 +680,7 @@ dropFun <- newIORef nullFunPtr let callbacks = WindowCallbacks { storedCharFun = charFun + , storedCharModsFun = charModsFun , storedCursorEnterFun = cursorEnterFun , storedCursorPosFun = cursorPosFun , storedFramebufferSizeFun = framebufferSizeFun @@ -624,7 +708,7 @@ return $ Just $ fromC p'win -- | Cleans up a window and all associated resources --- See +-- See destroyWindow :: Window -> IO () destroyWindow win = do pcb <- castPtrToStablePtr `liftM` c'glfwGetWindowUserPointer (toC win) @@ -634,6 +718,7 @@ let free callback = do funptr <- readIORef (callback cbs) when (funptr /= nullFunPtr) $ freeHaskellFunPtr funptr free storedCharFun + free storedCharModsFun free storedCursorEnterFun free storedCursorPosFun free storedFramebufferSizeFun @@ -649,25 +734,25 @@ freeStablePtr pcb -- | If the window should close or not. --- See +-- See windowShouldClose :: Window -> IO Bool windowShouldClose win = fromC `fmap` c'glfwWindowShouldClose (toC win) -- | Sets if the window should close or not. --- See +-- See setWindowShouldClose :: Window -> Bool -> IO () setWindowShouldClose win b = c'glfwSetWindowShouldClose (toC win) (toC b) -- | Sets the Title string of the window. --- See +-- See setWindowTitle :: Window -> String -> IO () setWindowTitle win title = withCString title $ c'glfwSetWindowTitle (toC win) -- | Gets the window's position (in Screen Coordinates). --- See +-- See getWindowPos :: Window -> IO (Int, Int) getWindowPos win = allocaArray 2 $ \p -> do @@ -679,13 +764,13 @@ return (x, y) -- | Sets the window's position (in Screen Coordinates). --- See +-- See setWindowPos :: Window -> Int -> Int -> IO () setWindowPos win x y = c'glfwSetWindowPos (toC win) (toC x) (toC y) -- | Gets the size of the window (in Screen Coordinates). --- See +-- See getWindowSize :: Window -> IO (Int, Int) getWindowSize win = allocaArray 2 $ \p -> do @@ -696,14 +781,64 @@ h <- fromC `fmap` peek p'h return (w, h) +-- | Gets the size of the frame around the window (in Screen Coordinates). This +-- size includes the title bar, if the window has one. Not to be confused with +-- 'getFramebufferSize', which gets the size of the rendering area. +-- See +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) + -- | Sets the size of the client area for the window (in Screen Coordinates). --- See +-- See setWindowSize :: Window -> Int -> Int -> IO () setWindowSize win w h = c'glfwSetWindowSize (toC win) (toC w) (toC h) +-- | Sets the size limits of the client area of the specified window. If the +-- window is full screen, the size limits only take effect once it is made +-- windowed. If the window is not resizable this function does nothing. Pass +-- 'Nothing' in any argument to disable the limit. +-- See +setWindowSizeLimits :: Window + -> Maybe Int + -- ^ The minimum width, in screen coordinates, of the client + -- area. + -> Maybe Int + -- ^ The minimum height, in screen coordinates, of the + -- client area. + -> Maybe Int + -- ^ The maximum width, in screen coordinates, of the client + -- area. + -> Maybe Int + -- ^ The maximum height, in screen coordinates, of the + -- client area. + -> IO () +setWindowSizeLimits 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) + +-- | Sets the required aspect ratio of the client area of the specified window. +-- Pass Nothing to disable the limit. +-- See +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) + -- | The size of the framebuffer (in Pixels) --- See +-- See getFramebufferSize :: Window -> IO (Int, Int) getFramebufferSize win = allocaArray 2 $ \p -> do @@ -714,32 +849,65 @@ h <- fromC `fmap` peek p'h return (w, h) +-- | Sets the icon of the specified window. The system will try to find the +-- image with the dimensions closest to the ones required by the platform. This +-- image is then scaled and used as the icon for that size. Good sizes are +-- 16x16, 32x32, and 48x48. Pass the empty list to reset to the default icon. +-- Has no effect on OS X (See the ) +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 + -- | Iconifies (minimizes) the window. --- See +-- See iconifyWindow :: Window -> IO () iconifyWindow = c'glfwIconifyWindow . toC -- | Restores the window from an iconified/minimized state. --- See +-- See restoreWindow :: Window -> IO () restoreWindow = c'glfwRestoreWindow . toC +-- | Brings the specified window to front and sets input focus. The window +-- should already be visible and not iconified. +-- See +focusWindow :: Window -> IO () +focusWindow = c'glfwFocusWindow . toC + +-- | Maximizes the specified window if it was not already maximized. +-- See +maximizeWindow :: Window -> IO () +maximizeWindow = c'glfwMaximizeWindow . toC + -- | Shows the window. --- See +-- See showWindow :: Window -> IO () showWindow = c'glfwShowWindow . toC -- | Hides the window. --- See +-- See hideWindow :: Window -> IO () hideWindow = c'glfwHideWindow . toC --- | Gets the monitor that this window is running on. --- See +-- | Gets the monitor that this window is running on, provided the window is +-- fullscreen. +-- See getWindowMonitor :: Window -> IO (Maybe Monitor) getWindowMonitor win = do p'mon <- c'glfwGetWindowMonitor (toC win) @@ -748,87 +916,139 @@ else Just $ fromC p'mon -- | Sets the position of the cursor within the window. --- See +-- See setCursorPos :: Window -> Double -> Double -> IO () setCursorPos win x y = c'glfwSetCursorPos (toC win) (toC x) (toC y) +-- | Makes a window fullscreen on the given monitor. The number of red, green, +-- and blue bits is ignored. Note, this shouldn't be used to update the +-- resolution of a fullscreen window. Use 'setWindowSize' instead. +-- See +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) + +-- | Updates a window to be windowed instead of fullscreen. Note, this shouldn't +-- be used to update the position or size of a window. Use 'setWindowPos' and +-- 'setWindowSize' instead. +-- See +setWindowed :: Window + -> Int -- ^ The width of the client area + -> Int -- ^ The height of the client area + -> Int -- ^ The x position of the window + -> Int -- ^ The y position of the window + -> IO () +setWindowed win width height x y = + c'glfwSetWindowMonitor (toC win) nullPtr (toC x) (toC y) (toC width) (toC height) 0 + -- start of functions related to c'glfwGetWindowAttrib -- | If the window has focus or not. --- See -getWindowFocused :: Window -> IO FocusState +-- See +getWindowFocused :: Window -> IO Bool getWindowFocused win = fromC `fmap` c'glfwGetWindowAttrib (toC win) c'GLFW_FOCUSED --- | If the window is iconified (minimized) or not. +-- | If the window is maximized or not. +-- See +getWindowMaximized :: Window -> IO Bool +getWindowMaximized win = + fromC `fmap` c'glfwGetWindowAttrib (toC win) c'GLFW_MAXIMIZED + +-- | If the window has been set to be 'always on top' or not. -- See -getWindowIconified :: Window -> IO IconifyState +getWindowFloating :: Window -> IO Bool +getWindowFloating win = + fromC `fmap` c'glfwGetWindowAttrib (toC win) c'GLFW_FLOATING + +-- | If the window is iconified (minimized) or not. +-- See +getWindowIconified :: Window -> IO Bool getWindowIconified win = fromC `fmap` c'glfwGetWindowAttrib (toC win) c'GLFW_ICONIFIED -- | If the window is resizable or not. --- See +-- See getWindowResizable :: Window -> IO Bool getWindowResizable win = fromC `fmap` c'glfwGetWindowAttrib (toC win) c'GLFW_RESIZABLE -- | If the window is decorated or not. --- See +-- See getWindowDecorated :: Window -> IO Bool getWindowDecorated win = fromC `fmap` c'glfwGetWindowAttrib (toC win) c'GLFW_DECORATED -- | If the window is visible or not. --- See +-- See getWindowVisible :: Window -> IO Bool getWindowVisible win = fromC `fmap` c'glfwGetWindowAttrib (toC win) c'GLFW_VISIBLE -- | The client api for this window. --- See +-- See getWindowClientAPI :: Window -> IO ClientAPI getWindowClientAPI win = fromC `fmap` c'glfwGetWindowAttrib (toC win) c'GLFW_CLIENT_API +-- | Returns the context creation API used to create the specified window. +-- See +getWindowContextCreationAPI :: Window -> IO ContextCreationAPI +getWindowContextCreationAPI win = + fromC `fmap` c'glfwGetWindowAttrib (toC win) c'GLFW_CONTEXT_CREATION_API + -- | The context's "major" version, x.0.0 --- See +-- See getWindowContextVersionMajor :: Window -> IO Int getWindowContextVersionMajor win = fromC `fmap` c'glfwGetWindowAttrib (toC win) c'GLFW_CONTEXT_VERSION_MAJOR -- | The context's "minor" version, 0.y.0 --- See +-- See getWindowContextVersionMinor :: Window -> IO Int getWindowContextVersionMinor win = fromC `fmap` c'glfwGetWindowAttrib (toC win) c'GLFW_CONTEXT_VERSION_MINOR -- | The context's "revision" version, 0.0.z --- See +-- See getWindowContextVersionRevision :: Window -> IO Int getWindowContextVersionRevision win = fromC `fmap` c'glfwGetWindowAttrib (toC win) c'GLFW_CONTEXT_REVISION -- | The context robustness of this window. --- See +-- See getWindowContextRobustness :: Window -> IO ContextRobustness getWindowContextRobustness win = fromC `fmap` c'glfwGetWindowAttrib (toC win) c'GLFW_CONTEXT_ROBUSTNESS +-- | Returns the context release behavior. +-- See +getWindowContextReleaseBehavior :: Window -> IO ContextReleaseBehavior +getWindowContextReleaseBehavior win = + fromC `fmap` c'glfwGetWindowAttrib (toC win) c'GLFW_CONTEXT_RELEASE_BEHAVIOR + +-- | Returns true if the window is set to NO_ERROR (see the +-- +-- extension. +getWindowContextNoError :: Window -> IO Bool +getWindowContextNoError win = + fromC `fmap` c'glfwGetWindowAttrib (toC win) c'GLFW_CONTEXT_NO_ERROR + -- | If this window is set for opengl to be forward compatible. --- See +-- See getWindowOpenGLForwardCompat :: Window -> IO Bool getWindowOpenGLForwardCompat win = fromC `fmap` c'glfwGetWindowAttrib (toC win) c'GLFW_OPENGL_FORWARD_COMPAT -- | If the window has an opengl debug context --- See +-- See getWindowOpenGLDebugContext :: Window -> IO Bool getWindowOpenGLDebugContext win = fromC `fmap` c'glfwGetWindowAttrib (toC win) c'GLFW_OPENGL_DEBUG_CONTEXT -- | Obtains the current opengl profile. --- See +-- See getWindowOpenGLProfile :: Window -> IO OpenGLProfile getWindowOpenGLProfile win = fromC `fmap` c'glfwGetWindowAttrib (toC win) c'GLFW_OPENGL_PROFILE @@ -836,7 +1056,7 @@ -- end of functions related to c'glfwGetWindowAttrib -- | Sets the callback to use when the window position changes. --- See +-- See setWindowPosCallback :: Window -> Maybe WindowPosCallback -> IO () setWindowPosCallback win = setWindowCallback mk'GLFWwindowposfun @@ -847,7 +1067,7 @@ win -- | Sets the callback to use when the window's size changes. --- See +-- See setWindowSizeCallback :: Window -> Maybe WindowSizeCallback -> IO () setWindowSizeCallback win = setWindowCallback mk'GLFWwindowsizefun @@ -858,7 +1078,7 @@ win -- | Sets the callback to use when the user attempts to close the window. --- See +-- See setWindowCloseCallback :: Window -> Maybe WindowCloseCallback -> IO () setWindowCloseCallback win = setWindowCallback mk'GLFWwindowclosefun @@ -868,7 +1088,7 @@ win -- | Sets the callback to use when the window's data is partly dead and it should refresh. --- See +-- See setWindowRefreshCallback :: Window -> Maybe WindowRefreshCallback -> IO () setWindowRefreshCallback win = setWindowCallback mk'GLFWwindowrefreshfun @@ -878,7 +1098,7 @@ win -- | Sets the callback to use when the window gains or loses focus. --- See +-- See setWindowFocusCallback :: Window -> Maybe WindowFocusCallback -> IO () setWindowFocusCallback win = setWindowCallback mk'GLFWwindowfocusfun @@ -888,7 +1108,7 @@ win -- | Sets the callback to use when the window is iconified or not (aka, minimized or not). --- See +-- See setWindowIconifyCallback :: Window -> Maybe WindowIconifyCallback -> IO () setWindowIconifyCallback win = setWindowCallback mk'GLFWwindowiconifyfun @@ -898,7 +1118,7 @@ win -- | Sets the callback to use when the framebuffer's size changes. --- See +-- See setFramebufferSizeCallback :: Window -> Maybe FramebufferSizeCallback -> IO () setFramebufferSizeCallback win = setWindowCallback mk'GLFWframebuffersizefun @@ -909,21 +1129,27 @@ -- | Checks for any pending events, processes them, and then immediately returns. -- This is most useful for continual rendering, such as games. --- See the +-- See the pollEvents :: IO () pollEvents = c'glfwPollEvents >> executeScheduled -- | Waits until at least one event is in the queue then processes the queue and returns. -- Requires at least one window to be active for it to sleep. This saves a lot of CPU, and -- is better if you're doing only periodic rendering, such as with an editor program. --- See the +-- See the waitEvents :: IO () waitEvents = c'glfwWaitEvents >> executeScheduled +-- | Same as 'waitEvents', with a timeout after which the function returns. +-- See the +waitEventsTimeout :: Double -> IO () +waitEventsTimeout seconds = + c'glfwWaitEventsTimeout (toC seconds) >> executeScheduled + -- | Creates an empty event within the event queue. Can be called from any -- thread, so you can use this to wake up the main thread that's using -- 'waitEvents' from a secondary thread. --- See the +-- See the postEmptyEvent :: IO () postEmptyEvent = c'glfwPostEmptyEvent @@ -933,37 +1159,37 @@ -- start of glfw{GS}etInputMode-related functions -- | Gets the current cursor input mode. --- See +-- See getCursorInputMode :: Window -> IO CursorInputMode getCursorInputMode win = fromC `fmap` c'glfwGetInputMode (toC win) c'GLFW_CURSOR -- | Set the cursor input mode. --- See +-- See setCursorInputMode :: Window -> CursorInputMode -> IO () setCursorInputMode win c = c'glfwSetInputMode (toC win) c'GLFW_CURSOR (toC c) -- | Gets the current sticky keys mode. --- See +-- See getStickyKeysInputMode :: Window -> IO StickyKeysInputMode getStickyKeysInputMode win = fromC `fmap` c'glfwGetInputMode (toC win) c'GLFW_STICKY_KEYS -- | Sets if sticky keys should be used or not. --- See +-- See setStickyKeysInputMode :: Window -> StickyKeysInputMode -> IO () setStickyKeysInputMode win sk = c'glfwSetInputMode (toC win) c'GLFW_STICKY_KEYS (toC sk) -- | Gets if sticky mouse buttons are on or not. --- See +-- See getStickyMouseButtonsInputMode :: Window -> IO StickyMouseButtonsInputMode getStickyMouseButtonsInputMode win = fromC `fmap` c'glfwGetInputMode (toC win) c'GLFW_STICKY_MOUSE_BUTTONS -- | Sets if sticky mouse buttons should be used or not. --- See +-- See setStickyMouseButtonsInputMode :: Window -> StickyMouseButtonsInputMode -> IO () setStickyMouseButtonsInputMode win smb = c'glfwSetInputMode (toC win) c'GLFW_STICKY_MOUSE_BUTTONS (toC smb) @@ -972,22 +1198,34 @@ -- | Gets the state of the specified key. If Stickey Keys isn't enabled then it's possible for -- keyboard polling to miss individual key presses. Use the callback to avoid this. --- See +-- See getKey :: Window -> Key -> IO KeyState getKey win k = fromC `fmap` c'glfwGetKey (toC win) (toC k) +-- | Returns the localized name of the specified printable key. This is intended +-- for displaying key bindings to the user. The scancode is used if the provided +-- 'Key' isn't printable. If the scancode maps to a non-printable key as well, +-- then 'Nothing' is returned. +-- See +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 + -- | Gets the state of a single specified mouse button. If sticky mouse button -- mode isn't enabled it's possible for mouse polling to miss individual mouse events. Use -- the call back to avoid this. --- See +-- See getMouseButton :: Window -> MouseButton -> IO MouseButtonState getMouseButton win b = fromC `fmap` c'glfwGetMouseButton (toC win) (toC b) -- | Returns the position, in screen coodinates, relative to the upper left. -- If the 'CursorInputMode' is "disabled", then results are unbounded by the window size. --- See +-- See getCursorPos :: Window -> IO (Double, Double) getCursorPos win = allocaArray 2 $ \p -> do @@ -999,7 +1237,7 @@ return (x, y) -- | Assigns the given callback to use for all keyboard presses and repeats. --- See +-- See setKeyCallback :: Window -> Maybe KeyCallback -> IO () setKeyCallback win = setWindowCallback mk'GLFWkeyfun @@ -1010,7 +1248,7 @@ win -- | Sets the callback to use when the user types a character --- See +-- See setCharCallback :: Window -> Maybe CharCallback -> IO () setCharCallback win = setWindowCallback mk'GLFWcharfun @@ -1019,8 +1257,19 @@ storedCharFun win +-- | Sets the callback to use with Unicode characters regardless of what +-- modifier keys are used. +-- See +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 + -- | Assigns the callback to run whenver a mouse button is clicked. --- See +-- See setMouseButtonCallback :: Window -> Maybe MouseButtonCallback -> IO () setMouseButtonCallback win = setWindowCallback mk'GLFWmousebuttonfun @@ -1030,7 +1279,7 @@ win -- | Assigns the callback to run whenver the cursor position changes. --- See +-- See setCursorPosCallback :: Window -> Maybe CursorPosCallback -> IO () setCursorPosCallback win = setWindowCallback mk'GLFWcursorposfun @@ -1040,7 +1289,7 @@ win -- | Sets the callback for when the cursor enters or leaves the client area. --- See +-- See setCursorEnterCallback :: Window -> Maybe CursorEnterCallback -> IO () setCursorEnterCallback win = setWindowCallback mk'GLFWcursorenterfun @@ -1050,7 +1299,7 @@ win -- | Sets the callback to run when the user scrolls with the mouse wheel or a touch gesture. --- See +-- See setScrollCallback :: Window -> Maybe ScrollCallback -> IO () setScrollCallback win = setWindowCallback mk'GLFWscrollfun @@ -1060,13 +1309,13 @@ win -- | Tests if the joystick is present at all --- See +-- See joystickPresent :: Joystick -> IO Bool joystickPresent js = fromC `fmap` c'glfwJoystickPresent (toC js) -- | Returns the values of all axes of the specified joystick, normalized to between -1.0 and 1.0 --- See +-- See getJoystickAxes :: Joystick -> IO (Maybe [Double]) getJoystickAxes js = alloca $ \p'n -> do @@ -1077,7 +1326,7 @@ else (Just . map fromC) `fmap` peekArray n p'axes -- | Returns a list of all joystick button states for the specified joystick. --- See +-- See getJoystickButtons :: Joystick -> IO (Maybe [JoystickButtonState]) getJoystickButtons js = alloca $ \p'n -> do @@ -1088,7 +1337,7 @@ else (Just . map fromC) `fmap` peekArray n p'buttons -- | A human-readable name for a Joystick. Not guranteed to be unique. --- See +-- See getJoystickName :: Joystick -> IO (Maybe String) getJoystickName js = do p'name <- c'glfwGetJoystickName (toC js) @@ -1096,13 +1345,22 @@ then return Nothing else Just `fmap` peekCString p'name +-- | Sets a callback for when a joystick is connected or disconnected. +-- See +setJoystickCallback :: Maybe JoystickCallback -> IO () +setJoystickCallback = setCallback + mk'GLFWjoystickfun + (\cb a0 a1 -> schedule $ cb (fromC a0) (fromC a1)) + c'glfwSetJoystickCallback + storedJoystickFun + -------------------------------------------------------------------------------- -- Time -- | Returns the time (in seconds) of the GLFW timer. -- This is the amount of time since GLFW was initialized, unless 'setTime' was used. -- The exact resolution is system dependent. --- See +-- See getTime :: IO (Maybe Double) getTime = do t <- fromC `fmap` c'glfwGetTime @@ -1113,24 +1371,34 @@ -- | Sets the GLFW timer to the specified value, which is measured in seconds, and must be positive. -- The value must also be less than ~584 years in seconds (18446744073.0). -- After this the timer begins to count upward at the normal rate. --- See +-- See setTime :: Double -> IO () -setTime = - c'glfwSetTime . toC +setTime = c'glfwSetTime . toC +-- | Returns the current value of the raw timer, measured in 1 / frequency +-- seconds. The frequency can be queried using getTimerFrequency. +-- See +getTimerValue :: IO Word64 +getTimerValue = c'glfwGetTimerValue + +-- | Returns the frequency, in Hz, of the raw timer. +-- See +getTimerFrequency :: IO Word64 +getTimerFrequency = c'glfwGetTimerFrequency + -------------------------------------------------------------------------------- -- Context -- | Makes the context of the specified window the current one for the calling thread. -- A context can only be made current on a single thread at a time, -- and each thread can have only a single current context at a time. --- See +-- See makeContextCurrent :: Maybe Window -> IO () makeContextCurrent = c'glfwMakeContextCurrent . maybe nullPtr toC -- | Obtains which window owns the current context of the calling thread. --- See +-- See getCurrentContext :: IO (Maybe Window) getCurrentContext = do p'win <- c'glfwGetCurrentContext @@ -1139,21 +1407,21 @@ else Just $ fromC p'win -- | Swaps the front and back buffers of the window. --- See +-- See swapBuffers :: Window -> IO () swapBuffers = c'glfwSwapBuffers . toC -- | Sets the number of screen updates that the GPU should wait after 'swapBuffers' before actually swapping the buffers. -- Generates 'Error'NoCurrentContext' if no context is current. --- See +-- See swapInterval :: Int -> IO () swapInterval = c'glfwSwapInterval . toC -- | If the current OpenGL or OpenGL ES context supports the extension specified. -- Generates 'Error'NoCurrentContext' if no context is current. --- See +-- See extensionSupported :: String -> IO Bool extensionSupported ext = withCString ext $ \p'ext -> @@ -1161,17 +1429,17 @@ -------------------------------------------------------------------------------- -- Clipboard --- http://www.glfw.org/docs/3.1/input.html#clipboard +-- http://www.glfw.org/docs/3.2/input.html#clipboard -- | The window that will own the clipboard contents, and also the clipboard string. --- See +-- See setClipboardString :: Window -> String -> IO () setClipboardString win s = withCString s (c'glfwSetClipboardString (toC win)) -- | Obtains the contents of the system keyboard, if possible. -- Generates 'Error'FormatUnavailable' if the system clipboard is empty or if it's not a UTF-8 string. --- See +-- See getClipboardString :: Window -> IO (Maybe String) getClipboardString win = do p's <- c'glfwGetClipboardString (toC win) @@ -1180,11 +1448,11 @@ else Just `fmap` peekCString p's -------------------------------------------------------------------------------- --- 3.1 additions (http://www.glfw.org/docs/latest/news.html#news_31) +-- 3.1 additions (http://www.glfw.org/docs/3.1/news.html#news_31) -------------------------------------------------------------------------------- -- Cursor Objects --- http://www.glfw.org/docs/3.1/input.html#cursor_object +-- http://www.glfw.org/docs/3.2/input.html#cursor_object -- | Creates a new cursor. createCursor :: Image -- ^ The desired cursor image. @@ -1193,14 +1461,9 @@ -> Int -- ^ The desired y-coordinate, in pixels, of the cursor -- hotspot. -> IO Cursor -createCursor (Image w h pxs) x y = - alloca $ \p'img -> - withArray pxs $ \p'pxs -> do - let img = C'GLFWimage (toC w) - (toC h) - p'pxs - poke p'img img - Cursor `fmap` c'glfwCreateCursor p'img (toC x) (toC y) +createCursor img x y = + withGLFWImage img $ \p'img -> + Cursor `fmap` c'glfwCreateCursor p'img (toC x) (toC y) -- | Creates a cursor with a standard shape that can be set for a window with -- setCursor. @@ -1241,3 +1504,162 @@ (c'glfwSetDropCallback (toC win)) storedDropFun win + +-------------------------------------------------------------------------------- +-- Vulkan-related functions +-------------------------------------------------------------------------------- + +-- | This function returns whether the Vulkan loader has been found. +-- This check is performed by `init`. +vulkanSupported :: IO Bool +vulkanSupported = (c'GLFW_TRUE ==) <$> c'glfwVulkanSupported + +-- | Get required vulkan extensions; +-- Pointer memory is managed by GLFW, destroyed by `terminate` call. +-- +-- The returned extension names are kept in `CString` type, because +-- they are expected to be consumed by vulkan device initialization functions. +getRequiredInstanceExtensions :: IO [CString] +getRequiredInstanceExtensions = alloca $ \countPtr -> do + extsPtrPtr <- c'glfwGetRequiredInstanceExtensions countPtr + count <- fromIntegral <$> peek countPtr + peekArray count extsPtrPtr + +-- | Returns the address of the specified Vulkan instance function. +getInstanceProcAddress :: Ptr vkInstance + -- ^ VkInstance. + -- Note, the returned function must be used + -- with the same instance or its child. + -> String + -- ^ Function name + -> IO (FunPtr vkProc) +getInstanceProcAddress i procName + = withCString procName (c'glfwGetInstanceProcAddress i) + +-- | Returns whether the specified queue family can present images. +getPhysicalDevicePresentationSupport :: + Ptr vkInstance + -- ^ VkInstance + -> Ptr vkPhysicalDevice + -- ^ VkPhysicalDevice + -> Word32 + -- ^ Index of a queue family to query. + -- This is an index in the array returned by + -- @vkGetPhysicalDeviceQueueFamilyProperties@ function. + -> IO Bool +getPhysicalDevicePresentationSupport inst dev i + = (c'GLFW_TRUE ==) <$> c'glfwGetPhysicalDevicePresentationSupport inst dev i + +-- | Creates a Vulkan surface for the specified window +createWindowSurface :: Enum vkResult + => Ptr vkInstance + -- ^ VkInstance + -> Window + -- ^ GLFWwindow *window + -> Ptr vkAllocationCallbacks + -- ^ const VkAllocationCallbacks *allocator + -> Ptr vkSurfaceKHR + -- ^ VkSurfaceKHR *surface + -> IO vkResult +createWindowSurface i win acs s + = toEnum . fromIntegral + <$> c'glfwCreateWindowSurface i (toC win) acs s + +-------------------------------------------------------------------------------- +-- Native APIs +-------------------------------------------------------------------------------- + +-- $nativeaccess +-- The low level native-access bindings are exposed here via bindings-GLFW. +-- These must be enabled with the 'ExposeNative' flag passed to bindings-GLFW. +-- The return values of these functions are used as a best-guess and are not +-- coupled with any other implementation. They should be used with caution +-- and at your own risk. + +-- | See +getWin32Adapter :: Window -> IO CString +getWin32Adapter = c'glfwGetWin32Adapter . toC + +-- | See +getWin32Monitor :: Window -> IO CString +getWin32Monitor = c'glfwGetWin32Monitor . toC + +-- | See +getWin32Window :: Window -> IO (Ptr ()) +getWin32Window = c'glfwGetWin32Window . toC + +-- | See +getWGLContext :: Window -> IO (Ptr ()) +getWGLContext = c'glfwGetWGLContext . toC + +-- | See +getCocoaMonitor :: Window -> IO (Ptr Word32) +getCocoaMonitor = c'glfwGetCocoaMonitor . toC + +-- | See +getCocoaWindow :: Window -> IO (Ptr ()) +getCocoaWindow = c'glfwGetCocoaWindow . toC + +-- | See +getNSGLContext :: Window -> IO (Ptr ()) +getNSGLContext = c'glfwGetNSGLContext . toC + +-- | See +getX11Display :: Window -> IO (Ptr display) +getX11Display = c'glfwGetX11Display . toC + +-- | See +getX11Adapter :: Window -> IO Word64 +getX11Adapter = c'glfwGetX11Adapter . toC + +-- | See +getX11Monitor :: Window -> IO Word64 +getX11Monitor = c'glfwGetX11Monitor . toC + +-- | See +getX11Window :: Window -> IO Word64 +getX11Window = c'glfwGetX11Window . toC + +-- | See +getGLXContext :: Window -> IO (Ptr ()) +getGLXContext = c'glfwGetGLXContext . toC + +-- | See +getGLXWindow :: Window -> IO Word64 +getGLXWindow = c'glfwGetGLXWindow . toC + +-- | See +getWaylandDisplay :: IO (Ptr wl_display) +getWaylandDisplay = c'glfwGetWaylandDisplay + +-- | See +getWaylandMonitor :: Window -> IO (Ptr wl_output) +getWaylandMonitor = c'glfwGetWaylandMonitor . toC + +-- | See +getWaylandWindow :: Window -> IO (Ptr wl_surface) +getWaylandWindow = c'glfwGetWaylandWindow . toC + +-- | See +getMirDisplay :: IO (Ptr mir_connection) +getMirDisplay = c'glfwGetMirDisplay + +-- | See +getMirMonitor :: Window -> IO Int +getMirMonitor = (fmap fromC) . c'glfwGetMirMonitor . toC + +-- | See +getMirWindow :: Window -> IO (Ptr mir_surface) +getMirWindow = c'glfwGetMirWindow . toC + +-- | See +getEGLDisplay :: IO (Ptr ()) +getEGLDisplay = c'glfwGetEGLDisplay + +-- | See +getEGLContext :: Window -> IO (Ptr ()) +getEGLContext = c'glfwGetEGLContext . toC + +-- | See +getEGLSurface :: Window -> IO (Ptr ()) +getEGLSurface = c'glfwGetEGLSurface . toC diff --git a/Graphics/UI/GLFW/C.hs b/Graphics/UI/GLFW/C.hs --- a/Graphics/UI/GLFW/C.hs +++ b/Graphics/UI/GLFW/C.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, FlexibleContexts #-} -------------------------------------------------------------------------------- @@ -26,6 +26,13 @@ -------------------------------------------------------------------------------- +instance (C CInt b) => C CInt (Maybe b) where + fromC i | i == c'GLFW_DONT_CARE = Nothing + | otherwise = Just $ fromC i + toC = maybe c'GLFW_DONT_CARE toC + +-------------------------------------------------------------------------------- + instance C CInt Char where fromC = chr . fromIntegral toC = fromIntegral . ord @@ -132,27 +139,11 @@ instance C CInt MonitorState where fromC v - | v == c'GLFW_TRUE = MonitorState'Connected - | v == c'GLFW_FALSE = MonitorState'Disconnected + | v == c'GLFW_CONNECTED = MonitorState'Connected + | v == c'GLFW_DISCONNECTED = MonitorState'Disconnected | otherwise = error $ "C CInt MonitorState fromC: " ++ show v - toC MonitorState'Connected = c'GLFW_TRUE - toC MonitorState'Disconnected = c'GLFW_FALSE - -instance C CInt FocusState where - fromC v - | v == c'GLFW_TRUE = FocusState'Focused - | v == c'GLFW_FALSE = FocusState'Defocused - | otherwise = error $ "C CInt FocusState fromC: " ++ show v - toC FocusState'Focused = c'GLFW_TRUE - toC FocusState'Defocused = c'GLFW_FALSE - -instance C CInt IconifyState where - fromC v - | v == c'GLFW_TRUE = IconifyState'Iconified - | v == c'GLFW_FALSE = IconifyState'NotIconified - | otherwise = error $ "C CInt IconifyState fromC: " ++ show v - toC IconifyState'Iconified = c'GLFW_TRUE - toC IconifyState'NotIconified = c'GLFW_FALSE + toC MonitorState'Connected = c'GLFW_CONNECTED + toC MonitorState'Disconnected = c'GLFW_DISCONNECTED instance C CInt ContextRobustness where fromC v @@ -164,6 +155,16 @@ toC ContextRobustness'NoResetNotification = c'GLFW_NO_RESET_NOTIFICATION toC ContextRobustness'LoseContextOnReset = c'GLFW_LOSE_CONTEXT_ON_RESET +instance C CInt ContextReleaseBehavior where + fromC v + | v == c'GLFW_ANY_RELEASE_BEHAVIOR = ContextReleaseBehavior'Any + | v == c'GLFW_RELEASE_BEHAVIOR_NONE = ContextReleaseBehavior'None + | v == c'GLFW_RELEASE_BEHAVIOR_FLUSH = ContextReleaseBehavior'Flush + | otherwise = error $ "C CInt ContextReleaseBehavior fromC: " ++ show v + toC ContextReleaseBehavior'Any = c'GLFW_ANY_RELEASE_BEHAVIOR + toC ContextReleaseBehavior'None = c'GLFW_RELEASE_BEHAVIOR_NONE + toC ContextReleaseBehavior'Flush = c'GLFW_RELEASE_BEHAVIOR_FLUSH + instance C CInt OpenGLProfile where fromC v | v == c'GLFW_OPENGL_ANY_PROFILE = OpenGLProfile'Any @@ -176,12 +177,22 @@ instance C CInt ClientAPI where fromC v + | v == c'GLFW_NO_API = ClientAPI'NoAPI | v == c'GLFW_OPENGL_API = ClientAPI'OpenGL | v == c'GLFW_OPENGL_ES_API = ClientAPI'OpenGLES | otherwise = error $ "C CInt ClientAPI fromC: " ++ show v + toC ClientAPI'NoAPI = c'GLFW_NO_API toC ClientAPI'OpenGL = c'GLFW_OPENGL_API toC ClientAPI'OpenGLES = c'GLFW_OPENGL_ES_API +instance C CInt ContextCreationAPI where + fromC v + | v == c'GLFW_NATIVE_CONTEXT_API = ContextCreationAPI'Native + | v == c'GLFW_EGL_CONTEXT_API = ContextCreationAPI'EGL + | otherwise = error $ "C CInt ContextCreationAPI fromC: " ++ show v + toC ContextCreationAPI'Native = c'GLFW_NATIVE_CONTEXT_API + toC ContextCreationAPI'EGL = c'GLFW_EGL_CONTEXT_API + instance C CInt Key where fromC v | v == c'GLFW_KEY_UNKNOWN = Key'Unknown @@ -481,6 +492,14 @@ | otherwise = error $ "C CUChar JoystickButtonState fromC: " ++ show v toC JoystickButtonState'Pressed = c'GLFW_PRESS toC JoystickButtonState'Released = c'GLFW_RELEASE + +instance C CInt JoystickState where + fromC v + | v == c'GLFW_CONNECTED = JoystickState'Connected + | v == c'GLFW_DISCONNECTED = JoystickState'Disconnected + | otherwise = error $ "C CInt JoystickState fromC: " ++ show v + toC JoystickState'Connected = c'GLFW_CONNECTED + toC JoystickState'Disconnected = c'GLFW_DISCONNECTED instance C CInt MouseButton where fromC v diff --git a/Graphics/UI/GLFW/Types.hs b/Graphics/UI/GLFW/Types.hs --- a/Graphics/UI/GLFW/Types.hs +++ b/Graphics/UI/GLFW/Types.hs @@ -13,6 +13,7 @@ import Data.Data (Data) import Data.IORef (IORef) import Data.Typeable (Typeable) +import Data.Word (Word8) import Foreign.Ptr (Ptr) import Foreign.C.Types (CUChar(..)) import GHC.Generics @@ -22,17 +23,17 @@ -------------------------------------------------------------------------------- -- Error handling --- | An enum for one of the . +-- | An enum for one of the . data Error = - Error'NotInitialized -- ^ - | Error'NoCurrentContext -- ^ - | Error'InvalidEnum -- ^ - | Error'InvalidValue -- ^ - | Error'OutOfMemory -- ^ - | Error'ApiUnavailable -- ^ - | Error'VersionUnavailable -- ^ - | Error'PlatformError -- ^ - | Error'FormatUnavailable -- ^ + Error'NotInitialized -- ^ + | Error'NoCurrentContext -- ^ + | Error'InvalidEnum -- ^ + | Error'InvalidValue -- ^ + | Error'OutOfMemory -- ^ + | Error'ApiUnavailable -- ^ + | Error'VersionUnavailable -- ^ + | Error'PlatformError -- ^ + | Error'FormatUnavailable -- ^ deriving (Bounded, Data, Enum, Eq, Ord, Read, Show, Typeable, Generic) instance NFData Error @@ -41,7 +42,7 @@ -- Initialization and version information -- | The library version of the GLFW implementation in use. --- See +-- See data Version = Version { versionMajor :: Int , versionMinor :: Int @@ -54,7 +55,7 @@ -- Monitor handling -- | Represents a physical monitor that's currently connected. --- See the +-- See the newtype Monitor = Monitor { unMonitor :: Ptr C'GLFWmonitor } deriving (Data, Eq, Ord, Show, Typeable, Generic) @@ -67,7 +68,7 @@ instance NFData MonitorState --- | See +-- | See data VideoMode = VideoMode { videoModeWidth :: Int , videoModeHeight :: Int @@ -80,7 +81,7 @@ instance NFData VideoMode -- | Lets you adjust the gamma of a monitor. To ensure that only valid values are created, use 'makeGammaRamp'. --- See . +-- See . data GammaRamp = GammaRamp -- NOTE: It would be bad to give clients a way to construct invalid gamma ramps -- with lists of unequal length, so this constructor should not be exported. @@ -109,6 +110,7 @@ -- | Collects all the callbacks that can be associated with a Window into a single place. data WindowCallbacks = WindowCallbacks { storedCharFun :: IORef C'GLFWcharfun + , storedCharModsFun :: IORef C'GLFWcharmodsfun , storedCursorEnterFun :: IORef C'GLFWcursorenterfun , storedCursorPosFun :: IORef C'GLFWcursorposfun , storedFramebufferSizeFun :: IORef C'GLFWframebuffersizefun @@ -125,60 +127,52 @@ } -- | Reprisents a GLFW window value. --- See the +-- See the newtype Window = Window { unWindow :: Ptr C'GLFWwindow } deriving (Data, Eq, Ord, Show, Typeable, Generic) -- | Lets you set various window hints before creating a 'Window'. --- See , --- particularly . +-- See , +-- particularly . data WindowHint = - WindowHint'Resizable Bool - | WindowHint'Visible Bool - | WindowHint'Decorated Bool - | WindowHint'RedBits Int - | WindowHint'GreenBits Int - | WindowHint'BlueBits Int - | WindowHint'AlphaBits Int - | WindowHint'DepthBits Int - | WindowHint'StencilBits Int - | WindowHint'AccumRedBits Int - | WindowHint'AccumGreenBits Int - | WindowHint'AccumBlueBits Int - | WindowHint'AccumAlphaBits Int - | WindowHint'AuxBuffers Int - | WindowHint'Samples Int - | WindowHint'RefreshRate Int - | WindowHint'Stereo Bool - | WindowHint'sRGBCapable Bool - | WindowHint'ClientAPI ClientAPI - | WindowHint'ContextVersionMajor Int - | WindowHint'ContextVersionMinor Int - | WindowHint'ContextRobustness ContextRobustness - | WindowHint'OpenGLForwardCompat Bool - | WindowHint'OpenGLDebugContext Bool - | WindowHint'OpenGLProfile OpenGLProfile + WindowHint'Resizable Bool + | WindowHint'Visible Bool + | WindowHint'Decorated Bool + | WindowHint'RedBits (Maybe Int) + | WindowHint'GreenBits (Maybe Int) + | WindowHint'BlueBits (Maybe Int) + | WindowHint'AlphaBits (Maybe Int) + | WindowHint'DepthBits (Maybe Int) + | WindowHint'StencilBits (Maybe Int) + | WindowHint'AccumRedBits (Maybe Int) + | WindowHint'AccumGreenBits (Maybe Int) + | WindowHint'AccumBlueBits (Maybe Int) + | WindowHint'AccumAlphaBits (Maybe Int) + | WindowHint'AuxBuffers (Maybe Int) + | WindowHint'Samples (Maybe Int) + | WindowHint'RefreshRate (Maybe Int) + | WindowHint'DoubleBuffer Bool + | WindowHint'Stereo Bool + | WindowHint'sRGBCapable Bool + | WindowHint'Floating Bool + | WindowHint'Focused Bool + | WindowHint'Maximized Bool + | WindowHint'AutoIconify Bool + | WindowHint'ClientAPI ClientAPI + | WindowHint'ContextCreationAPI ContextCreationAPI + | WindowHint'ContextVersionMajor Int + | WindowHint'ContextVersionMinor Int + | WindowHint'ContextRobustness ContextRobustness + | WindowHint'ContextReleaseBehavior ContextReleaseBehavior + | WindowHint'ContextNoError Bool + | WindowHint'OpenGLForwardCompat Bool + | WindowHint'OpenGLDebugContext Bool + | WindowHint'OpenGLProfile OpenGLProfile deriving (Data, Eq, Ord, Read, Show, Typeable, Generic) instance NFData WindowHint --- | For use with the focus callback. -data FocusState = - FocusState'Focused - | FocusState'Defocused - deriving (Bounded, Data, Enum, Eq, Ord, Read, Show, Typeable, Generic) - -instance NFData FocusState - --- | For use with the iconify callback. (note: iconified means minimized) -data IconifyState = - IconifyState'Iconified - | IconifyState'NotIconified - deriving (Bounded, Data, Enum, Eq, Ord, Read, Show, Typeable, Generic) - -instance NFData IconifyState - -- | The OpenGL robustness strategy. data ContextRobustness = ContextRobustness'NoRobustness @@ -199,16 +193,47 @@ -- | The type of OpenGL to create a context for. data ClientAPI = - ClientAPI'OpenGL + ClientAPI'NoAPI + | ClientAPI'OpenGL | ClientAPI'OpenGLES deriving (Bounded, Data, Enum, Eq, Ord, Read, Show, Typeable, Generic) instance NFData ClientAPI +-- | The type of API to use for context creation. +-- See the for +-- more information. +-- +-- This is a hard constraint. If no client API is requested, this hint is +-- ignored. Best practice is to stick to one API or the other, otherwise may +-- segfault on Linux. OS X does not support the EGL API and will fail if this +-- hint is used. +data ContextCreationAPI + = ContextCreationAPI'Native + | ContextCreationAPI'EGL + deriving (Bounded, Data, Enum, Eq, Ord, Read, Show, Typeable, Generic) + +instance NFData ContextCreationAPI + +-- | The context release behavior. +-- See the for +-- more information. +-- +-- Context release behaviors are described in detail by the +-- +-- extension. +data ContextReleaseBehavior + = ContextReleaseBehavior'Any + | ContextReleaseBehavior'None + | ContextReleaseBehavior'Flush + deriving (Bounded, Data, Enum, Eq, Ord, Read, Show, Typeable, Generic) + +instance NFData ContextReleaseBehavior + -------------------------------------------------------------------------------- -- Input handling --- | Part of the system. +-- | Part of the system. data Key = Key'Unknown | Key'Space @@ -344,7 +369,7 @@ instance NFData KeyState --- | For use with the system. +-- | For use with the system. data Joystick = Joystick'1 | Joystick'2 @@ -374,7 +399,15 @@ instance NFData JoystickButtonState --- | Part of the system. +-- | Part of the 'JoystickCallback', for when a monitor gets connected or disconnected. +data JoystickState + = JoystickState'Connected + | JoystickState'Disconnected + deriving (Bounded, Data, Enum, Eq, Ord, Read, Show, Typeable, Generic) + +instance NFData JoystickState + +-- | Part of the system. data MouseButton = MouseButton'1 | MouseButton'2 @@ -405,7 +438,7 @@ instance NFData CursorState -- | Allows for special forms of mouse input. --- See +-- See data CursorInputMode = CursorInputMode'Normal | CursorInputMode'Hidden @@ -458,6 +491,19 @@ , imagePixels :: [CUChar] } deriving (Data, Eq, Ord, Read, Show, Typeable, Generic) +-- | Create an image given the function to generate 8-bit RGBA values based on +-- the pixel location. +mkImage :: Int -> Int -> (Int -> Int -> (Word8, Word8, Word8, Word8)) -> Image +mkImage width height gen = Image + { imageWidth = width + , imageHeight = height + , imagePixels = [ CUChar channel | y <- [0..(height - 1)] + , x <- [0..(width - 1)] + , (r, g, b, a) <- [gen x y] + , channel <- [r, g, b, a] + ] + } + instance NFData Image -- | Reprisents a GLFW cursor. @@ -467,7 +513,7 @@ -- | Lets you use one of the standard cursor appearnaces that the local -- system theme provides for. --- See . +-- See . data StandardCursorShape = StandardCursorShape'Arrow | StandardCursorShape'IBeam diff --git a/TODO b/TODO --- a/TODO +++ b/TODO @@ -14,6 +14,3 @@ getPressedKeys? getJoystickAxesN? - -Coordinate with GLFW C-library maintainer about new functionality. -1.) waitEvents with timeout? diff --git a/Test.hs b/Test.hs --- a/Test.hs +++ b/Test.hs @@ -1,6 +1,8 @@ -- base import Control.Concurrent (threadDelay) +import Control.Monad (forM_) import Data.Char (isAscii) +import Data.Bits (xor) import Data.List (intercalate, isPrefixOf) -- HUnit @@ -30,6 +32,10 @@ mwin@(Just win) <- GLFW.createWindow 100 100 "GLFW-b test" Nothing Nothing GLFW.makeContextCurrent mwin + -- Mostly check for compiling + GLFW.setJoystickCallback $ Just $ \j c -> putStrLn $ concat + [ show j, " changed state: ", show c ] + defaultMain $ tests mon win -- TODO because of how defaultMain works, this code is not reached @@ -38,12 +44,13 @@ -------------------------------------------------------------------------------- -versionMajor, versionMinor :: Int +versionMajor, versionMinor, versionRevision :: Int versionMajor = 3 -versionMinor = 1 +versionMinor = 2 +versionRevision = 1 giveItTime :: IO () -giveItTime = threadDelay 250000 +giveItTime = threadDelay 500000 joysticks :: [GLFW.Joystick] joysticks = @@ -95,20 +102,11 @@ , testCase "getVideoModes" $ test_getVideoModes mon , testCase "getVideoMode" $ test_getVideoMode mon , testCase "getGamma" $ test_getGammaRamp mon - -- , testCase "setGamma" $ test_setGamma mon - -- , testCase "gamma ramp" $ test_gamma_ramp mon ] , testGroup "Window handling" [ testCase "defaultWindowHints" test_defaultWindowHints - , testCase "window close flag" $ test_window_close_flag win - , testCase "setWindowTitle" $ test_setWindowTitle win - , testCase "window pos" $ test_window_pos win - , testCase "window size" $ test_window_size win - , testCase "getFramebufferSize" $ test_getFramebufferSize win - , testCase "iconification" $ test_iconification win - -- , testCase "show/hide" $ test_show_hide win - , testCase "getWindowMonitor" $ test_getWindowMonitor win mon - , testCase "cursor pos" $ test_cursor_pos win + + -- Test window attributes , testCase "getWindowFocused" $ test_getWindowFocused win , testCase "getWindowResizable" $ test_getWindowResizable win , testCase "getWindowDecorated" $ test_getWindowDecorated win @@ -118,8 +116,25 @@ , testCase "getWindowOpenGLForwardCompat" $ test_getWindowOpenGLForwardCompat win , testCase "getWindowOpenGLDebugContext" $ test_getWindowOpenGLDebugContext win , testCase "getWindowOpenGLProfile" $ test_getWindowOpenGLProfile win + , testCase "window close flag" $ test_window_close_flag win + , testCase "setWindowTitle" $ test_setWindowTitle win + , testCase "window pos" $ test_window_pos win + , testCase "window size" $ test_window_size win + , testCase "getWindowFrameSize" $ test_getWindowFrameSize win + , testCase "getFramebufferSize" $ test_getFramebufferSize win + , testCase "iconification" $ test_iconification win + -- , testCase "show/hide" $ test_show_hide win + , testCase "getWindowMonitor" $ test_getWindowMonitor win mon + , testCase "setWindowed" $ test_setWindowed win + , testCase "setWindowIcon" $ test_setWindowIcon win + , testCase "maximizeWindow" $ test_maximizeWindow win + , testCase "setWindowSizeLimits" $ test_setWindowSizeLimits win + , testCase "setWindowAspectRatio" $ test_setWindowAspectRatio win + , testCase "focusWindow" $ test_focusWindow win + , testCase "cursor pos" $ test_cursor_pos win , testCase "pollEvents" test_pollEvents , testCase "waitEvents" test_waitEvents + , testCase "waitEventsTimeout" test_waitEventsTimeout ] , testGroup "Input handling" [ testCase "cursor input mode" $ test_cursor_input_mode win @@ -129,10 +144,13 @@ , testCase "getJoystickAxes" test_getJoystickAxes , testCase "getJoystickButtons" test_getJoystickButtons , testCase "getJoystickName" test_getJoystickName + , testCase "getKeyName" test_getKeyName ] , testGroup "Time" - [ testCase "getTime" test_getTime - , testCase "setTime" test_setTime + [ testCase "getTime" test_getTime + , testCase "setTime" test_setTime + , testCase "getTimerValue" test_getTimerValue + , testCase "getTimerFrequency" test_getTimerFrequency ] , testGroup "Context" [ testCase "getCurrentContext" $ test_getCurrentContext win @@ -152,6 +170,7 @@ v <- GLFW.getVersion GLFW.versionMajor v @?= versionMajor GLFW.versionMinor v @?= versionMinor + GLFW.versionRevision v @?= versionRevision test_getVersionString :: IO () test_getVersionString = do @@ -270,14 +289,22 @@ test_window_size :: GLFW.Window -> IO () test_window_size win = do - let w = 17 - h = 37 + let w = 170 + h = 370 GLFW.setWindowSize win w h giveItTime (w', h') <- GLFW.getWindowSize win w' @?= w h' @?= h +test_getWindowFrameSize :: GLFW.Window -> IO () +test_getWindowFrameSize win = do + -- The frame size is pretty dependent on the window manager. We can only + -- really expect that the window has a title bar, so the top frame won't be + -- zero... + (_, t, _, _) <- GLFW.getWindowFrameSize win + assertBool "Window has no frame width up top!" $ t > 0 + test_getFramebufferSize :: GLFW.Window -> IO () test_getFramebufferSize win = do (w, h) <- GLFW.getWindowSize win @@ -293,15 +320,17 @@ test_iconification :: GLFW.Window -> IO () test_iconification win = do + GLFW.showWindow win is0 <- GLFW.getWindowIconified win - is0 @?= GLFW.IconifyState'NotIconified + is0 @?= False GLFW.iconifyWindow win giveItTime is1 <- GLFW.getWindowIconified win - is1 @?= GLFW.IconifyState'Iconified + is1 @?= True GLFW.restoreWindow win + GLFW.hideWindow win -- test_show_hide :: GLFW.Window -> IO () -- test_show_hide win = do @@ -323,23 +352,77 @@ m <- GLFW.getWindowMonitor win m @?= Nothing +test_setWindowed :: GLFW.Window -> IO () +test_setWindowed win = GLFW.setWindowed win 100 100 0 0 + +test_setWindowIcon :: GLFW.Window -> IO () +test_setWindowIcon win = let + icon1 = GLFW.mkImage 32 32 $ \x y -> + case even ((x `div` 8) `xor` (y `div` 8)) of + True -> (255, 0, 0, 255) + False -> (0, 255, 0, 255) + + icon2 = GLFW.mkImage 16 16 $ \x y -> + case even ((x `div` 8) `xor` (y `div` 8)) of + True -> (255, 255, 255, 255) + False -> (0, 0, 0, 255) + + in GLFW.setWindowIcon win [icon1, icon2] + +test_maximizeWindow :: GLFW.Window -> IO () +test_maximizeWindow win = do + GLFW.showWindow win + startsMaximized <- GLFW.getWindowMaximized win + startsMaximized @?= False + + GLFW.maximizeWindow win + giveItTime + + isMaximized <- GLFW.getWindowMaximized win + isMaximized @?= True + GLFW.hideWindow win + +test_setWindowSizeLimits :: GLFW.Window -> IO () +test_setWindowSizeLimits win = do + GLFW.setWindowSizeLimits win (Just 640) (Just 480) (Just 1024) (Just 768) + +test_setWindowAspectRatio :: GLFW.Window -> IO () +test_setWindowAspectRatio win = do + GLFW.setWindowAspectRatio win Nothing + +test_focusWindow :: GLFW.Window -> IO () +test_focusWindow = GLFW.focusWindow + test_cursor_pos :: GLFW.Window -> IO () test_cursor_pos win = do - (w, h) <- GLFW.getWindowSize win - let cx = fromIntegral w / 2 - cy = fromIntegral h / 2 - -- Can you set the cursor pos as of glfw 3.1? I don't see it in the - -- docs. - GLFW.setCursorPos win cx cy - --giveItTime - --(cx', cy') <- GLFW.getCursorPos win - --cx' @?= cx - --cy' @?= cy + GLFW.showWindow win + (w, h) <- GLFW.getWindowSize win + -- Make sure we use integral coordinates here so that we don't run into + -- platform-dependent differences. + let cx :: Double + cy :: Double + (cx, cy) = (fromIntegral $ w `div` 2, fromIntegral $ h `div` 2) + + -- !HACK! Poll events seems to be necessary on OS X, + -- before /and/ after glfwSetCursorPos, otherwise, the + -- windowing system likely never receives the cursor update. This is + -- reflected in the C version of GLFW as well, we just call it here in + -- order to have a more robust test. + + GLFW.pollEvents + GLFW.setCursorPos win cx cy + GLFW.pollEvents -- !HACK! see comment above + + (cx', cy') <- GLFW.getCursorPos win + cx' @?= cx + cy' @?= cy + GLFW.hideWindow win + test_getWindowFocused :: GLFW.Window -> IO () test_getWindowFocused win = do fs <- GLFW.getWindowFocused win - fs @?= GLFW.FocusState'Defocused + fs @?= False test_getWindowResizable :: GLFW.Window -> IO () test_getWindowResizable win = do @@ -360,8 +443,7 @@ test_window_context_version win = do v0 <- GLFW.getWindowContextVersionMajor win v1 <- GLFW.getWindowContextVersionMinor win - v2 <- GLFW.getWindowContextVersionRevision win - assertBool "" $ all (`between` (0, 20)) [v0, v1, v2] + assertBool "" $ all (`between` (0, 20)) [v0, v1] test_getWindowContextRobustness :: GLFW.Window -> IO () test_getWindowContextRobustness win = do @@ -388,9 +470,13 @@ GLFW.pollEvents test_waitEvents :: IO () -test_waitEvents = - GLFW.waitEvents +test_waitEvents = GLFW.postEmptyEvent >> GLFW.waitEvents +test_waitEventsTimeout :: IO () +test_waitEventsTimeout = + -- to not slow down the test too much we set the timeout to 0.001 second : + GLFW.waitEventsTimeout 0.001 + -------------------------------------------------------------------------------- test_cursor_input_mode :: GLFW.Window -> IO () @@ -451,6 +537,14 @@ test_getJoystickName = mapM_ GLFW.getJoystickName joysticks +test_getKeyName :: IO () +test_getKeyName = + forM_ (zip [GLFW.Key'Slash, GLFW.Key'Period] ["/", "."]) $ \(k, n) -> do + name <- GLFW.getKeyName k 0 + case name of + Nothing -> return () + Just s -> s @?= n + -------------------------------------------------------------------------------- test_getTime :: IO () @@ -469,6 +563,12 @@ Just t' -> assertBool "" $ t' `between` (t, t+10) Nothing -> assertFailure "" +test_getTimerValue :: IO () +test_getTimerValue = GLFW.getTimerValue >>= assertBool "" . (> 0) + +test_getTimerFrequency :: IO () +test_getTimerFrequency = GLFW.getTimerFrequency >>= assertBool "" . (> 0) + -------------------------------------------------------------------------------- test_getCurrentContext :: GLFW.Window -> IO () @@ -506,6 +606,7 @@ ] setGet s = do GLFW.setClipboardString win s + giveItTime GLFW.getClipboardString win --------------------------------------------------------------------------------