{-# LANGUAGE ForeignFunctionInterface, CPP #-} -- | Provides a function to set the cursor to a specified shape. -- Generalized from an example in email -- Re: [Gtk2hs-users] Changing the mouse cursor shape -- From: Chris Mears - 2007-05-22 07:48 -- found on -- https://sourceforge.net/mailarchive/forum.php?thread_name=87ps50ie9o.fsf%40loki.cmears.id.au&forum_name=gtk2hs-users -- and modified by removing the definition of data Cursor -- since that is now part of gtk2hs/gtk -- although the enum values are not :-( -- The CursorType type itself is now exported from -- Graphics.UI.Gtk.Gdk.Cursor, as also cursorNew -- and cursorNewFromPixmap. module Graphics.UI.Sifflet.GtkForeign (setCursor) where import System.Glib import System.Glib.FFI import Foreign.ForeignPtr () import Graphics.UI.Gtk foreign import ccall "gdk_window_set_cursor" gdkWindowSetCursor :: Ptr DrawWindow -> Ptr Cursor -> IO () foreign import ccall "gdk_cursor_new" gdkCursorNew :: Int -> IO (Ptr Cursor) -- | Set the X Window cursor for a window to a specified type setCursor :: Window -> CursorType -> IO () setCursor window cursorType = do c <- gdkCursorNew (cursorTypeNumber cursorType) d <- widgetGetDrawWindow window let GObject fp = toGObject d withForeignPtr (castForeignPtr fp) $ \ptr -> gdkWindowSetCursor ptr c -- These numbers are from /usr/include/gtk-2.0/gdk/gdkcursor.h cursorTypeNumber :: CursorType -> Int cursorTypeNumber cursorType = case cursorType of XCursor -> 0 Arrow -> 2 BasedArrowDown -> 4 BasedArrowUp -> 6 Boat -> 8 Bogosity -> 10 BottomLeftCorner -> 12 BottomRightCorner -> 14 BottomSide -> 16 BottomTee -> 18 BoxSpiral -> 20 CenterPtr -> 22 Circle -> 24 Clock -> 26 CoffeeMug -> 28 Cross -> 30 CrossReverse -> 32 Crosshair -> 34 DiamondCross -> 36 Dot -> 38 Dotbox -> 40 DoubleArrow -> 42 DraftLarge -> 44 DraftSmall -> 46 DrapedBox -> 48 Exchange -> 50 Fleur -> 52 Gobbler -> 54 Gumby -> 56 Hand1 -> 58 Hand2 -> 60 Heart -> 62 Icon -> 64 IronCross -> 66 LeftPtr -> 68 LeftSide -> 70 LeftTee -> 72 Leftbutton -> 74 LlAngle -> 76 LrAngle -> 78 Man -> 80 Middlebutton -> 82 Mouse -> 84 Pencil -> 86 Pirate -> 88 Plus -> 90 QuestionArrow -> 92 RightPtr -> 94 RightSide -> 96 RightTee -> 98 Rightbutton -> 100 RtlLogo -> 102 Sailboat -> 104 SbDownArrow -> 106 SbHDoubleArrow -> 108 SbLeftArrow -> 110 SbRightArrow -> 112 SbUpArrow -> 114 SbVDoubleArrow -> 116 Shuttle -> 118 Sizing -> 120 Spider -> 122 Spraycan -> 124 Star -> 126 Target -> 128 Tcross -> 130 TopLeftArrow -> 132 TopLeftCorner -> 134 TopRightCorner -> 136 TopSide -> 138 TopTee -> 140 Trek -> 142 UlAngle -> 144 Umbrella -> 146 UrAngle -> 148 Watch -> 150 Xterm -> 152 LastCursor -> 153 BlankCursor -> (-2) CursorIsPixmap -> (-1)