1{-# LANGUAGE CPP #-} 2-- -*-haskell-*- 3-- GIMP Toolkit (GTK) Cursor 4-- 5-- Author : Bit Connor <bit@mutantlemon.com> 6-- Andy Stewart <lazycat.manatee@gmail.com> 7-- 8-- Created: 18 November 2007 9-- 10-- Copyright (C) 2007 Bit Connor 11-- Copyright (C) 2009 Andy Stewart 12-- 13-- This library is free software; you can redistribute it and/or 14-- modify it under the terms of the GNU Lesser General Public 15-- License as published by the Free Software Foundation; either 16-- version 2.1 of the License, or (at your option) any later version. 17-- 18-- This library is distributed in the hope that it will be useful, 19-- but WITHOUT ANY WARRANTY; without even the implied warranty of 20-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 21-- Lesser General Public License for more details. 22-- 23-- | 24-- Maintainer : gtk2hs-users@lists.sourceforge.net 25-- Stability : provisional 26-- Portability : portable (depends on GHC) 27-- 28-- Cursors | Standard and pixmap cursors. 29-- 30module Graphics.UI.Gtk.Gdk.Cursor ( 31-- * Types 32 Cursor(..), 33 34-- * Enums 35 CursorType(..), 36 37-- * Constructors 38 cursorNew, 39 40-- * Methods 41#if GTK_MAJOR_VERSION < 3 42 cursorNewFromPixmap, 43#endif 44 cursorNewFromPixbuf, 45 cursorNewFromName, 46 cursorNewForDisplay, 47 cursorGetDisplay, 48 cursorGetImage 49 ) where 50 51import Control.Monad (liftM) 52 53import System.Glib.FFI 54import System.Glib.UTFString 55#if GTK_MAJOR_VERSION < 3 56import Graphics.UI.Gtk.General.Structs (Color) 57#endif 58 59{#import Graphics.UI.Gtk.Types#} hiding (Arrow) 60 61{#context lib="gdk" prefix ="gdk"#} 62 63-------------------- 64-- Types 65{#pointer *GdkCursor as Cursor foreign newtype #} 66 67-------------------- 68-- Enums 69-- | Cursor types. 70{#enum GdkCursorType as CursorType {underscoreToCase} deriving (Bounded,Eq,Show)#} 71 72-------------------- 73-- Utils 74makeNewCursor :: Ptr Cursor -> IO Cursor 75makeNewCursor rPtr = do 76 cursor <- newForeignPtr rPtr cursor_unref 77 return (Cursor cursor) 78 79foreign import ccall unsafe "&gdk_cursor_unref" 80 cursor_unref :: FinalizerPtr Cursor 81 82-------------------- 83-- Constructors 84-- | Creates a new cursor from the set of builtin cursors for the default display. 85-- See 'cursorNewForDisplay'. 86-- To make the cursor invisible, use 'BlankCursor'. 87cursorNew :: 88 CursorType -- ^ @cursorType@ cursor to create 89 -> IO Cursor -- ^ return a new 'Cursor' 90cursorNew cursorType = do 91 cursorPtr <- {#call cursor_new#} $fromIntegral (fromEnum cursorType) 92 makeNewCursor cursorPtr 93 94-------------------- 95-- Methods 96#if GTK_MAJOR_VERSION < 3 97-- | Creates a new cursor from a given pixmap and mask. Both the pixmap and 98-- mask must have a depth of 1 (i.e. each pixel has only 2 values - on or off). 99-- The standard cursor size is 16 by 16 pixels. 100-- 101-- Removed in Gtk3. 102cursorNewFromPixmap :: 103 Pixmap -- ^ @source@ - the pixmap specifying the cursor. 104 -> Pixmap -- ^ @mask@ - the pixmap specifying the mask, which must be the 105 -- same size as source. 106 -> Color -- ^ @fg@ - the foreground color, used for the bits in the source 107 -- which are 1. The color does not have to be allocated first. 108 -> Color -- ^ @bg@ - the background color, used for the bits in the source 109 -- which are 0. The color does not have to be allocated first. 110 -> Int -- ^ @x@ - the horizontal offset of the \'hotspot\' of the cursor. 111 -> Int -- ^ @y@ - the vertical offset of the \'hotspot\' of the cursor. 112 -> IO Cursor 113cursorNewFromPixmap source mask fg bg x y = 114 with fg $ \fgPtr -> 115 with bg $ \bgPtr -> do 116 rPtr <- {# call unsafe cursor_new_from_pixmap #} source mask (castPtr fgPtr) (castPtr bgPtr) (fromIntegral x) (fromIntegral y) 117 makeNewCursor rPtr 118#endif 119 120-- | Creates a new cursor from a pixbuf. 121-- Not all GDK backends support RGBA cursors. If they are not supported, a monochrome approximation will be displayed. 122-- The functions 'displaySupportsCursorAlpha' and 'displaySupportsCursorColor' can be used to determine whether RGBA cursors are supported; 123-- 'displayGetDefaultCursorSize' and 'displayGetMaximalCursorSize' give information about cursor sizes. 124-- 125-- On the X backend, support for RGBA cursors requires a sufficently new version of the X Render extension. 126-- 127cursorNewFromPixbuf :: 128 Display -- ^ @display@ the 'Display' for which the cursor will be created 129 -> Pixbuf -- ^ @pixbuf@ the 'Pixbuf' containing the cursor image 130 -> Int -- ^ @x@ the horizontal offset of the 'hotspot' of the cursor. 131 -> Int -- ^ @y@ the vertical offset of the 'hotspot' of the cursor. 132 -> IO Cursor -- ^ return a new 'Cursor'. 133cursorNewFromPixbuf display pixbuf x y = do 134 cursorPtr <- {#call cursor_new_from_pixbuf#} display pixbuf (fromIntegral x) (fromIntegral y) 135 makeNewCursor cursorPtr 136 137-- | Creates a new cursor by looking up name in the current cursor theme. 138cursorNewFromName :: GlibString string 139 => Display -- ^ @display@ the 'Display' for which the cursor will be created 140 -> string -- ^ @name@ the name of the cursor 141 -> IO (Maybe Cursor) -- ^ return a new 'Cursor', or @Nothing@ if there is no cursor with the given name 142cursorNewFromName display name = 143 withUTFString name $ \namePtr -> do 144 cursorPtr <- {#call cursor_new_from_name#} display namePtr 145 if cursorPtr == nullPtr then return Nothing else liftM Just $ makeNewCursor cursorPtr 146 147-- | Creates a new cursor from the set of builtin cursors. 148cursorNewForDisplay :: 149 Display -- ^ @display@ the 'Display' for which the cursor will be created 150 -> CursorType -- ^ @cursorType@ cursor to create 151 -> IO Cursor -- ^ return a new 'Cursor' 152cursorNewForDisplay display cursorType = do 153 cursorPtr <- {#call cursor_new_for_display#} display $fromIntegral (fromEnum cursorType) 154 makeNewCursor cursorPtr 155 156-- | Returns the display on which the GdkCursor is defined. 157cursorGetDisplay :: 158 Cursor -- ^ @cursor@ 'Cursor' 159 -> IO Display -- ^ return the 'Display' associated to cursor 160cursorGetDisplay cursor = 161 makeNewGObject mkDisplay $ {#call cursor_get_display#} cursor 162 163-- | Returns a 'Pixbuf' with the image used to display the cursor. 164-- Note that depending on the capabilities of the windowing system and on the cursor, GDK may not be able to obtain the image data. 165-- In this case, @Nothing@ is returned. 166cursorGetImage :: 167 Cursor -- ^ @cursor@ 'Cursor' 168 -> IO (Maybe Pixbuf) -- ^ a 'Pixbuf' representing cursor, or @Nothing@ 169cursorGetImage cursor = 170 maybeNull (makeNewGObject mkPixbuf) $ {#call cursor_get_image#} cursor 171