1{-# LANGUAGE CPP #-}
2-- -*-haskell-*-
3--  GIMP Toolkit (GTK) Widget DrawingArea
4--
5--  Author : Axel Simon
6--
7--  Created: 22 September 2002
8--
9--  Copyright (C) 1999-2005 Axel Simon
10--
11--  This library is free software; you can redistribute it and/or
12--  modify it under the terms of the GNU Lesser General Public
13--  License as published by the Free Software Foundation; either
14--  version 2.1 of the License, or (at your option) any later version.
15--
16--  This library is distributed in the hope that it will be useful,
17--  but WITHOUT ANY WARRANTY; without even the implied warranty of
18--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
19--  Lesser General Public License for more details.
20--
21-- |
22-- Maintainer  : gtk2hs-users@lists.sourceforge.net
23-- Stability   : provisional
24-- Portability : portable (depends on GHC)
25--
26-- A widget for custom user interface elements
27--
28module Graphics.UI.Gtk.Misc.DrawingArea (
29-- * Detail
30--
31-- | The 'DrawingArea' widget is used for creating custom user interface
32-- elements. It's essentially a blank widget; you can draw on
33-- the 'Drawable' returned by 'drawingAreaGetDrawWindow'.
34--
35-- After creating a drawing area, the application may want to connect to:
36--
37-- * Mouse and button press signals to respond to input from the user.
38--
39-- * The 'realize' signal to take any necessary actions when the widget is
40-- instantiated on a particular display. (Create GDK resources in response to
41-- this signal.)
42--
43-- * The 'configureEvent' signal to take any necessary actions when the
44-- widget changes size.
45--
46-- * The 'exposeEvent' signal to handle redrawing the contents of the
47-- widget.
48--
49-- Expose events are normally delivered when a drawing area first comes
50-- onscreen, or when it's covered by another window and then uncovered
51-- (exposed). You can also force an expose event by adding to the \"damage
52-- region\" of the drawing area's window; 'widgetQueueDrawArea' and
53-- 'windowInvalidateRect' are equally good ways to do this. You\'ll then get an
54-- expose event for the invalid region.
55--
56-- The available routines for drawing are documented on the GDK Drawing
57-- Primitives page.
58--
59-- To receive mouse events on a drawing area, you will need to enable them
60-- with 'widgetAddEvents'. To receive keyboard events, you will need to set the
61-- 'widgetCanFocus' attribute on the drawing area, and should probably draw some
62-- user-visible indication that the drawing area is focused.
63
64-- * Class Hierarchy
65-- |
66-- @
67-- |  'GObject'
68-- |   +----'Object'
69-- |         +----'Widget'
70-- |               +----DrawingArea
71-- @
72
73-- * Types
74  DrawingArea,
75  DrawingAreaClass,
76  castToDrawingArea, gTypeDrawingArea,
77  toDrawingArea,
78
79-- * Constructors
80  drawingAreaNew,
81
82-- * Methods
83#if GTK_MAJOR_VERSION < 3
84  drawingAreaGetDrawWindow,
85  drawingAreaGetSize
86#endif
87  ) where
88
89import Control.Monad    (liftM)
90
91import System.Glib.FFI
92import Graphics.UI.Gtk.Abstract.Object  (makeNewObject)
93{#import Graphics.UI.Gtk.Types#}
94#if GTK_MAJOR_VERSION < 3
95import Graphics.UI.Gtk.General.Structs  (widgetGetDrawWindow, widgetGetSize)
96#endif
97
98{# context lib="gtk" prefix="gtk" #}
99
100--------------------
101-- Constructors
102
103-- | Creates a new drawing area.
104--
105drawingAreaNew :: IO DrawingArea
106drawingAreaNew =
107  makeNewObject mkDrawingArea $
108  liftM (castPtr :: Ptr Widget -> Ptr DrawingArea) $
109  {# call unsafe drawing_area_new #}
110
111#if GTK_MAJOR_VERSION < 3
112-- | See 'widgetGetDrawWindow'
113--
114-- Removed in Gtk3.
115drawingAreaGetDrawWindow :: DrawingArea -> IO DrawWindow
116drawingAreaGetDrawWindow = widgetGetDrawWindow
117{-# DEPRECATED drawingAreaGetDrawWindow "use widgetGetDrawWindow instead" #-}
118
119-- | See 'widgetGetSize'
120--
121-- Removed in Gtk3.
122drawingAreaGetSize :: DrawingArea -> IO (Int, Int)
123drawingAreaGetSize = widgetGetSize
124{-# DEPRECATED drawingAreaGetSize "use widgetGetSize instead" #-}
125#endif
126