GLFW-b 1.4.7.3 → 1.4.8.0
raw patch · 4 files changed
+139/−8 lines, 4 filesdep ~basedep ~bindings-GLFW
Dependency ranges changed: base, bindings-GLFW
Files
- GLFW-b.cabal +3/−3
- Graphics/UI/GLFW.hs +78/−0
- Graphics/UI/GLFW/C.hs +25/−1
- Graphics/UI/GLFW/Types.hs +33/−4
GLFW-b.cabal view
@@ -1,5 +1,5 @@ name: GLFW-b-version: 1.4.7.3+version: 1.4.8.0 category: Graphics author: Brian Lewis <brian@lorf.org>@@ -50,7 +50,7 @@ build-depends: base < 5,- bindings-GLFW >= 3.1.1.4+ bindings-GLFW >= 3.1.2.0 -------------------------------------------------------------------------------- @@ -68,7 +68,7 @@ GLFW-b, HUnit == 1.2.*, base < 5,- bindings-GLFW >= 3.1.1.4,+ bindings-GLFW >= 3.1.2.0, test-framework == 0.8.*, test-framework-hunit == 0.3.*
Graphics/UI/GLFW.hs view
@@ -95,6 +95,9 @@ , StickyKeysInputMode (..) , StickyMouseButtonsInputMode (..) , ModifierKeys (..)+ , Image (..)+ , Cursor (..)+ , StandardCursorShape (..) -- -- related to c'glfwSetInputMode ----. , getCursorInputMode -- |@@ -111,7 +114,12 @@ , setMouseButtonCallback, MouseButtonCallback , setCursorPosCallback, CursorPosCallback , setCursorEnterCallback, CursorEnterCallback+ , createCursor+ , createStandardCursor+ , setCursor+ , destroyCursor , setScrollCallback, ScrollCallback+ , setDropCallback, DropCallback , joystickPresent , getJoystickAxes , getJoystickButtons@@ -224,6 +232,8 @@ type CharCallback = Window -> Char -> IO () type MonitorCallback = Monitor -> MonitorState -> IO () +-- 3.1 additions+ -------------------------------------------------------------------------------- -- CB scheduling @@ -500,6 +510,7 @@ windowPosFun <- newIORef nullFunPtr windowRefreshFun <- newIORef nullFunPtr windowSizeFun <- newIORef nullFunPtr+ dropFun <- newIORef nullFunPtr let callbacks = WindowCallbacks { storedCharFun = charFun , storedCursorEnterFun = cursorEnterFun@@ -514,6 +525,7 @@ , storedWindowPosFun = windowPosFun , storedWindowRefreshFun = windowRefreshFun , storedWindowSizeFun = windowSizeFun+ , storedDropFun = dropFun } p'win <- c'glfwCreateWindow (toC w)@@ -809,6 +821,7 @@ storedKeyFun win + setCharCallback :: Window -> Maybe CharCallback -> IO () setCharCallback win = setWindowCallback mk'GLFWcharfun@@ -932,3 +945,68 @@ if p's == nullPtr then return Nothing else Just `fmap` peekCString p's++--------------------------------------------------------------------------------+-- 3.1 additions (http://www.glfw.org/docs/latest/news.html#news_31)+--------------------------------------------------------------------------------++-- Cursor Objects+-- http://www.glfw.org/docs/latest/input.html#cursor_object++-- | Creates a new cursor.+createCursor :: Image -- ^ The desired cursor image.+ -> Int -- ^ The desired x-coordinate, in pixels, of the cursor+ -- hotspot.+ -> Int -- ^ The desired y-coordinate, in pixels, of the cursor+ -- hotspot.+ -> IO Cursor+createCursor (Image 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 <$> c'glfwCreateCursor p'img (toC x) (toC y)++-- | Creates a cursor with a standard shape that can be set for a window with+-- setCursor.+createStandardCursor :: StandardCursorShape -> IO Cursor+createStandardCursor = (Cursor <$>) . c'glfwCreateStandardCursor . toC++-- | Sets the cursor image to be used when the cursor is over the client area+-- of the specified window. The set cursor will only be visible when the cursor+-- mode of the window is GLFW_CURSOR_NORMAL.++-- On some platforms, the set cursor may not be visible unless the window also+-- has input focus.+setCursor :: Window -> Cursor -> IO ()+setCursor (Window wptr) (Cursor cptr) = c'glfwSetCursor wptr cptr++-- | Destroys a cursor previously created with `createCursor`. Any remaining+-- cursors will be destroyed by `terminate`.+destroyCursor :: Cursor -> IO ()+destroyCursor = c'glfwDestroyCursor . unCursor++-- Path Drop Input+-- http://www.glfw.org/docs/latest/input.html#path_drop++type DropCallback = Window -- ^ The window that received the event.+ -> [String] -- ^ The file and/or directory path names+ -> IO ()++-- | Sets the file drop callback of the specified window, which is called when+-- one or more dragged files are dropped on the window.+setDropCallback :: Window -> Maybe DropCallback -> IO ()+setDropCallback 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
Graphics/UI/GLFW/C.hs view
@@ -12,7 +12,7 @@ import Data.Bits ((.&.)) import Data.Char (chr, ord)-import Foreign.C.Types (CDouble, CFloat, CInt, CUChar, CUInt, CUShort)+import Foreign.C.Types (CDouble, CFloat, CInt, CChar, CUChar, CUInt, CUShort) import Foreign.Ptr (Ptr) import Bindings.GLFW@@ -26,6 +26,10 @@ -------------------------------------------------------------------------------- +instance C CChar Char where+ fromC = chr . fromIntegral+ toC = fromIntegral . ord+ instance C CInt Char where fromC = chr . fromIntegral toC = fromIntegral . ord@@ -527,6 +531,26 @@ | otherwise = error $ "C CInt StickyMouseButtonsInputMode fromC: " ++ show v toC StickyMouseButtonsInputMode'Enabled = c'GL_TRUE toC StickyMouseButtonsInputMode'Disabled = c'GL_FALSE++--------------------------------------------------------------------------------+-- 3.1 Additions+--------------------------------------------------------------------------------++instance C CInt StandardCursorShape where+ fromC v+ | v == c'GLFW_ARROW_CURSOR = StandardCursorShape'Arrow+ | v == c'GLFW_IBEAM_CURSOR = StandardCursorShape'IBeam+ | v == c'GLFW_CROSSHAIR_CURSOR = StandardCursorShape'Crosshair+ | v == c'GLFW_HAND_CURSOR = StandardCursorShape'Hand+ | v == c'GLFW_HRESIZE_CURSOR = StandardCursorShape'HResize+ | v == c'GLFW_VRESIZE_CURSOR = StandardCursorShape'VResize+ | otherwise = error $ "C CInt StandardCursorShape fromC: " ++ show v+ toC StandardCursorShape'Arrow = c'GLFW_ARROW_CURSOR+ toC StandardCursorShape'IBeam = c'GLFW_IBEAM_CURSOR+ toC StandardCursorShape'Crosshair = c'GLFW_CROSSHAIR_CURSOR+ toC StandardCursorShape'Hand = c'GLFW_HAND_CURSOR+ toC StandardCursorShape'HResize = c'GLFW_HRESIZE_CURSOR+ toC StandardCursorShape'VResize = c'GLFW_VRESIZE_CURSOR --------------------------------------------------------------------------------
Graphics/UI/GLFW/Types.hs view
@@ -1,14 +1,17 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# OPTIONS_GHC -fno-warn-orphans #-} module Graphics.UI.GLFW.Types where -------------------------------------------------------------------------------- -import Data.Data (Data)-import Data.IORef (IORef)-import Data.Typeable (Typeable)-import Foreign.Ptr (Ptr)+import Data.Data (Data)+import Data.IORef (IORef)+import Data.Typeable (Typeable)+import Foreign.Ptr (Ptr)+import Foreign.C.Types (CUChar(..)) import GHC.Generics import Bindings.GLFW@@ -95,6 +98,7 @@ , storedWindowPosFun :: IORef C'GLFWwindowposfun , storedWindowRefreshFun :: IORef C'GLFWwindowrefreshfun , storedWindowSizeFun :: IORef C'GLFWwindowsizefun+ , storedDropFun :: IORef C'GLFWdropfun } newtype Window = Window@@ -356,6 +360,31 @@ , modifierKeysAlt :: Bool , modifierKeysSuper :: Bool } deriving (Data, Eq, Ord, Read, Show, Typeable, Generic)++--------------------------------------------------------------------------------+-- 3.1 Additions+--------------------------------------------------------------------------------++deriving instance Data CUChar++data Image = Image+ { imageWidth :: Int+ , imageHeight :: Int+ , imagePixels :: [CUChar]+ } deriving (Data, Eq, Ord, Read, Show, Typeable, Generic)++newtype Cursor = Cursor+ { unCursor :: Ptr C'GLFWcursor+ } deriving (Data, Eq, Ord, Show, Typeable, Generic)++data StandardCursorShape =+ StandardCursorShape'Arrow+ | StandardCursorShape'IBeam+ | StandardCursorShape'Crosshair+ | StandardCursorShape'Hand+ | StandardCursorShape'HResize+ | StandardCursorShape'VResize+ deriving (Data, Enum, Eq, Ord, Read, Show, Typeable, Generic) --------------------------------------------------------------------------------