GtkForeign.hs

{-# 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 <chris@cm...> - 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)