1{-# LANGUAGE CPP #-}
2-- -*-haskell-*-
3--  GIMP Toolkit (GTK) Widget Viewport
4--
5--  Author : Axel Simon
6--
7--  Created: 23 May 2001
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-- Issues:
22--
23-- The binding of this widget is superfluous as far as I can tell.
24--
25-- The only signal this widget registers is \"set-scroll-adjustments\". It is
26--   not bound because it is meant to be received by the 'Viewport'
27--   and sent by 'ScrolledWindow'.
28--
29-- |
30-- Maintainer  : gtk2hs-users@lists.sourceforge.net
31-- Stability   : provisional
32-- Portability : portable (depends on GHC)
33--
34-- An adapter which makes widgets scrollable
35--
36module Graphics.UI.Gtk.Misc.Viewport (
37-- * Detail
38--
39-- | A 'Viewport' is a helper widget that adds Adjustment slots to a
40-- widget, i.e. the widget becomes scrollable. It can then be put into
41-- 'ScrolledWindow' and will behave as expected.
42
43-- * Class Hierarchy
44-- |
45-- @
46-- |  'GObject'
47-- |   +----'Object'
48-- |         +----'Widget'
49-- |               +----'Container'
50-- |                     +----'Bin'
51-- |                           +----Viewport
52-- @
53
54-- * Types
55  Viewport,
56  ViewportClass,
57  ShadowType(..),
58  castToViewport, gTypeViewport,
59  toViewport,
60
61-- * Constructors
62  viewportNew,
63
64-- * Methods
65  viewportGetHAdjustment,
66  viewportGetVAdjustment,
67  viewportSetHAdjustment,
68  viewportSetVAdjustment,
69  viewportSetShadowType,
70  viewportGetShadowType,
71#if GTK_CHECK_VERSION(2,20,0)
72  viewportGetBinWindow,
73#endif
74#if GTK_CHECK_VERSION(2,22,0)
75  viewportGetViewWindow,
76#endif
77
78-- * Attributes
79  viewportHAdjustment,
80  viewportVAdjustment,
81  viewportShadowType,
82  ) where
83
84import Control.Monad    (liftM)
85
86import System.Glib.FFI
87import System.Glib.Attributes
88import Graphics.UI.Gtk.Abstract.Object  (makeNewObject)
89{#import Graphics.UI.Gtk.Types#}
90import Graphics.UI.Gtk.General.Enums    (ShadowType(..))
91
92{# context lib="gtk" prefix="gtk" #}
93
94--------------------
95-- Constructors
96
97-- | Creates a new 'Viewport' with the given adjustments.
98--
99viewportNew ::
100    Adjustment  -- ^ @hadjustment@ - horizontal adjustment.
101 -> Adjustment  -- ^ @vadjustment@ - vertical adjustment.
102 -> IO Viewport
103viewportNew hadjustment vadjustment =
104  makeNewObject mkViewport $
105  liftM (castPtr :: Ptr Widget -> Ptr Viewport) $
106  {# call unsafe viewport_new #}
107    hadjustment
108    vadjustment
109
110--------------------
111-- Methods
112
113-- | Returns the horizontal adjustment of the viewport.
114--
115viewportGetHAdjustment :: ViewportClass self => self -> IO Adjustment
116viewportGetHAdjustment self =
117  makeNewObject mkAdjustment $
118  {# call unsafe viewport_get_hadjustment #}
119    (toViewport self)
120
121-- | Returns the vertical adjustment of the viewport.
122--
123viewportGetVAdjustment :: ViewportClass self => self -> IO Adjustment
124viewportGetVAdjustment self =
125  makeNewObject mkAdjustment $
126  {# call unsafe viewport_get_vadjustment #}
127    (toViewport self)
128
129-- | Sets the horizontal adjustment of the viewport.
130--
131viewportSetHAdjustment :: ViewportClass self => self -> Adjustment -> IO ()
132viewportSetHAdjustment self adjustment =
133  {# call viewport_set_hadjustment #}
134    (toViewport self)
135    adjustment
136
137-- | Sets the vertical adjustment of the viewport.
138--
139viewportSetVAdjustment :: ViewportClass self => self -> Adjustment -> IO ()
140viewportSetVAdjustment self adjustment =
141  {# call viewport_set_vadjustment #}
142    (toViewport self)
143    adjustment
144
145-- | Sets the shadow type of the viewport.
146--
147viewportSetShadowType :: ViewportClass self => self
148 -> ShadowType -- ^ @type@ - the new shadow type.
149 -> IO ()
150viewportSetShadowType self type_ =
151  {# call viewport_set_shadow_type #}
152    (toViewport self)
153    ((fromIntegral . fromEnum) type_)
154
155-- | Gets the shadow type of the 'Viewport'. See 'viewportSetShadowType'.
156--
157viewportGetShadowType :: ViewportClass self => self
158 -> IO ShadowType -- ^ returns the shadow type
159viewportGetShadowType self =
160  liftM (toEnum . fromIntegral) $
161  {# call unsafe viewport_get_shadow_type #}
162    (toViewport self)
163
164#if GTK_CHECK_VERSION(2,20,0)
165-- | Gets the bin window of the 'Viewport'.
166--
167-- * Available since Gtk version 2.20
168--
169viewportGetBinWindow :: ViewportClass self => self -> IO DrawWindow
170viewportGetBinWindow self =
171    makeNewGObject mkDrawWindow $
172    {#call gtk_viewport_get_bin_window #}
173      (toViewport self)
174#endif
175
176#if GTK_CHECK_VERSION(2,22,0)
177-- | Gets the view window of the 'Viewport'.
178--
179-- * Available since Gtk+ version 2.22
180--
181viewportGetViewWindow :: ViewportClass self => self -> IO DrawWindow
182viewportGetViewWindow self =
183    makeNewGObject mkDrawWindow $
184    {#call gtk_viewport_get_view_window #}
185      (toViewport self)
186#endif
187
188--------------------
189-- Attributes
190
191-- | The 'Adjustment' that determines the values of the horizontal position
192-- for this viewport.
193--
194viewportHAdjustment :: ViewportClass self => Attr self Adjustment
195viewportHAdjustment = newAttr
196  viewportGetHAdjustment
197  viewportSetHAdjustment
198
199-- | The 'Adjustment' that determines the values of the vertical position for
200-- this viewport.
201--
202viewportVAdjustment :: ViewportClass self => Attr self Adjustment
203viewportVAdjustment = newAttr
204  viewportGetVAdjustment
205  viewportSetVAdjustment
206
207-- | Determines how the shadowed box around the viewport is drawn.
208--
209-- Default value: 'ShadowIn'
210--
211viewportShadowType :: ViewportClass self => Attr self ShadowType
212viewportShadowType = newAttr
213  viewportGetShadowType
214  viewportSetShadowType
215
216--------------------
217-- Signals
218
219