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