1{-# LANGUAGE CPP #-}
2-- -*-haskell-*-
3--  GIMP Toolkit (GTK) Widget Range
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-- |
22-- Maintainer  : gtk2hs-users@lists.sourceforge.net
23-- Stability   : provisional
24-- Portability : portable (depends on GHC)
25--
26-- Base class for widgets which visualize an adjustment
27--
28module Graphics.UI.Gtk.Abstract.Range (
29-- * Description
30--
31-- | For signals regarding a change in the range or increments, refer to
32-- 'Adjustment' which is contained in the 'Range' object.
33
34-- * Class Hierarchy
35-- |
36-- @
37-- |  'GObject'
38-- |   +----'Object'
39-- |         +----'Widget'
40-- |               +----Range
41-- |                     +----'Scale'
42-- |                     +----'Scrollbar'
43-- @
44
45-- * Types
46  Range,
47  RangeClass,
48  castToRange, gTypeRange,
49  toRange,
50
51-- * Methods
52  rangeGetAdjustment,
53  rangeSetAdjustment,
54#if GTK_MAJOR_VERSION < 3
55  rangeGetUpdatePolicy,
56  rangeSetUpdatePolicy,
57#endif
58  rangeGetInverted,
59  rangeSetInverted,
60  rangeGetValue,
61  rangeSetValue,
62  rangeSetIncrements,
63  rangeSetRange,
64  ScrollType(..),
65#if GTK_CHECK_VERSION(2,10,0)
66  SensitivityType(..),
67  rangeSetLowerStepperSensitivity,
68  rangeGetLowerStepperSensitivity,
69  rangeSetUpperStepperSensitivity,
70  rangeGetUpperStepperSensitivity,
71#endif
72#if GTK_CHECK_VERSION(2,20,0)
73  rangeGetMinSliderSize,
74  rangeGetRangeRect,
75  rangeGetSliderRange,
76  rangeGetSliderSizeFixed,
77  rangeSetMinSliderSize,
78  rangeSetSliderSizeFixed,
79#endif
80
81-- * Attributes
82#if GTK_MAJOR_VERSION < 3
83  rangeUpdatePolicy,
84#endif
85  rangeAdjustment,
86  rangeInverted,
87#if GTK_CHECK_VERSION(2,10,0)
88  rangeLowerStepperSensitivity,
89  rangeUpperStepperSensitivity,
90#endif
91  rangeValue,
92#if GTK_CHECK_VERSION(2,20,0)
93  rangeSliderSizeFixed,
94  rangeMinSliderSize,
95#endif
96
97-- * Signals
98  adjustBounds,
99  valueChanged,
100#if GTK_CHECK_VERSION(2,6,0)
101  changeValue,
102#endif
103
104-- * Deprecated
105#ifndef DISABLE_DEPRECATED
106  onMoveSlider,
107  afterMoveSlider,
108  onAdjustBounds,
109  afterAdjustBounds,
110#if GTK_CHECK_VERSION(2,6,0)
111  onRangeChangeValue,
112  afterRangeChangeValue,
113#endif
114  onRangeValueChanged,
115  afterRangeValueChanged
116#endif
117  ) where
118
119import Control.Monad    (liftM)
120
121import System.Glib.FFI
122import System.Glib.Attributes
123import System.Glib.Properties
124import Graphics.UI.Gtk.Abstract.Object  (makeNewObject)
125{#import Graphics.UI.Gtk.Types#}
126{#import Graphics.UI.Gtk.Signals#}
127import Graphics.UI.Gtk.General.Enums    (ScrollType(..))
128#if GTK_MAJOR_VERSION < 3
129import Graphics.UI.Gtk.General.Enums    (UpdateType(..))
130#endif
131import Graphics.UI.Gtk.General.Structs  (Rectangle(..))
132
133{# context lib="gtk" prefix="gtk" #}
134
135--------------------
136-- Methods
137
138-- | Get the 'Adjustment' which is the \"model\" object for 'Range'. See
139-- 'rangeSetAdjustment' for details.
140--
141rangeGetAdjustment :: RangeClass self => self
142 -> IO Adjustment -- ^ returns a 'Adjustment'
143rangeGetAdjustment self =
144  makeNewObject mkAdjustment $
145  {# call unsafe range_get_adjustment #}
146    (toRange self)
147
148-- | Sets the adjustment to be used as the \"model\" object for this range
149-- widget. The adjustment indicates the current range value, the minimum and
150-- maximum range values, the step\/page increments used for keybindings and
151-- scrolling, and the page size. The page size is normally 0 for 'Scale' and
152-- nonzero for 'Scrollbar', and indicates the size of the visible area of the
153-- widget being scrolled. The page size affects the size of the scrollbar
154-- slider.
155--
156rangeSetAdjustment :: RangeClass self => self
157 -> Adjustment -- ^ @adjustment@ - a 'Adjustment'
158 -> IO ()
159rangeSetAdjustment self adjustment =
160  {# call range_set_adjustment #}
161    (toRange self)
162    adjustment
163
164#if GTK_MAJOR_VERSION < 3
165-- | Gets the update policy of @range@. See 'rangeSetUpdatePolicy'.
166--
167-- Removed in Gtk3.
168rangeGetUpdatePolicy :: RangeClass self => self
169 -> IO UpdateType -- ^ returns the current update policy
170rangeGetUpdatePolicy self =
171  liftM (toEnum . fromIntegral) $
172  {# call unsafe range_get_update_policy #}
173    (toRange self)
174
175
176-- | Sets the update policy for the range. 'UpdateContinuous' means that
177-- anytime the range slider is moved, the range value will change and the
178-- value_changed signal will be emitted. 'UpdateDelayed' means that the value
179-- will be updated after a brief timeout where no slider motion occurs, so
180-- updates are spaced by a short time rather than continuous.
181-- 'UpdateDiscontinuous' means that the value will only be updated when the
182-- user releases the button and ends the slider drag operation.
183--
184-- Removed in Gtk3.
185rangeSetUpdatePolicy :: RangeClass self => self
186 -> UpdateType -- ^ @policy@ - update policy
187 -> IO ()
188rangeSetUpdatePolicy self policy =
189  {# call range_set_update_policy #}
190    (toRange self)
191    ((fromIntegral . fromEnum) policy)
192#endif
193
194-- | Gets the value set by 'rangeSetInverted'.
195--
196rangeGetInverted :: RangeClass self => self
197 -> IO Bool -- ^ returns @True@ if the range is inverted
198rangeGetInverted self =
199  liftM toBool $
200  {# call unsafe range_get_inverted #}
201    (toRange self)
202
203-- | Ranges normally move from lower to higher values as the slider moves from
204-- top to bottom or left to right. Inverted ranges have higher values at the
205-- top or on the right rather than on the bottom or left.
206--
207rangeSetInverted :: RangeClass self => self
208 -> Bool  -- ^ @setting@ - @True@ to invert the range
209 -> IO ()
210rangeSetInverted self setting =
211  {# call range_set_inverted #}
212    (toRange self)
213    (fromBool setting)
214
215-- | Gets the current value of the range.
216--
217rangeGetValue :: RangeClass self => self
218 -> IO Double -- ^ returns current value of the range.
219rangeGetValue self =
220  liftM realToFrac $
221  {# call unsafe range_get_value #}
222    (toRange self)
223
224-- | Sets the current value of the range; if the value is outside the minimum
225-- or maximum range values, it will be clamped to fit inside them. The range
226-- emits the 'valueChanged' signal if the value changes.
227--
228rangeSetValue :: RangeClass self => self
229 -> Double -- ^ @value@ - new value of the range
230 -> IO ()
231rangeSetValue self value =
232  {# call range_set_value #}
233    (toRange self)
234    (realToFrac value)
235
236-- | Sets the step and page sizes for the range. The step size is used when
237-- the user clicks the 'Scrollbar' arrows or moves 'Scale' via arrow keys. The
238-- page size is used for example when moving via Page Up or Page Down keys.
239--
240rangeSetIncrements :: RangeClass self => self
241 -> Double -- ^ @step@ - step size
242 -> Double -- ^ @page@ - page size
243 -> IO ()
244rangeSetIncrements self step page =
245  {# call range_set_increments #}
246    (toRange self)
247    (realToFrac step)
248    (realToFrac page)
249
250-- | Sets the allowable values in the 'Range', and clamps the range value to
251-- be between @min@ and @max@. (If the range has a non-zero page size, it is
252-- clamped between @min@ and @max@ - page-size.)
253--
254rangeSetRange :: RangeClass self => self
255 -> Double -- ^ @min@ - minimum range value
256 -> Double -- ^ @max@ - maximum range value
257 -> IO ()
258rangeSetRange self min max =
259  {# call range_set_range #}
260    (toRange self)
261    (realToFrac min)
262    (realToFrac max)
263
264#if GTK_CHECK_VERSION(2,10,0)
265
266-- | Determines how Gtk+ handles the sensitivity of stepper arrows at the end of range widgets.
267--
268-- * 'SensitivityAuto': the arrow is made insensitive if the thumb is at the end
269--
270-- * 'SensitivityOn': the arrow is alwasy sensitive
271--
272-- * 'SensitivityOff': the arrow is always insensitive
273--
274{#enum SensitivityType {underscoreToCase} deriving (Bounded,Eq,Show)#}
275
276-- %hash c:3a8d d:d336
277-- | Sets the sensitivity policy for the stepper that points to the \'lower\'
278-- end of the 'Range''s adjustment.
279--
280-- * Available since Gtk+ version 2.10
281--
282rangeSetLowerStepperSensitivity :: RangeClass self => self
283 -> SensitivityType -- ^ @sensitivity@ - the lower stepper's sensitivity
284                    -- policy.
285 -> IO ()
286rangeSetLowerStepperSensitivity self sensitivity =
287  {# call gtk_range_set_lower_stepper_sensitivity #}
288    (toRange self)
289    ((fromIntegral . fromEnum) sensitivity)
290
291-- %hash c:12a2 d:2f2a
292-- | Gets the sensitivity policy for the stepper that points to the \'lower\'
293-- end of the 'Range''s adjustment.
294--
295-- * Available since Gtk+ version 2.10
296--
297rangeGetLowerStepperSensitivity :: RangeClass self => self
298 -> IO SensitivityType -- ^ returns The lower stepper's sensitivity policy.
299rangeGetLowerStepperSensitivity self =
300  liftM (toEnum . fromIntegral) $
301  {# call gtk_range_get_lower_stepper_sensitivity #}
302    (toRange self)
303
304-- %hash c:a939 d:2d79
305-- | Sets the sensitivity policy for the stepper that points to the \'upper\'
306-- end of the 'Range''s adjustment.
307--
308-- * Available since Gtk+ version 2.10
309--
310rangeSetUpperStepperSensitivity :: RangeClass self => self
311 -> SensitivityType -- ^ @sensitivity@ - the upper stepper's sensitivity
312                    -- policy.
313 -> IO ()
314rangeSetUpperStepperSensitivity self sensitivity =
315  {# call gtk_range_set_upper_stepper_sensitivity #}
316    (toRange self)
317    ((fromIntegral . fromEnum) sensitivity)
318
319-- %hash c:456e d:896d
320-- | Gets the sensitivity policy for the stepper that points to the \'upper\'
321-- end of the 'Range''s adjustment.
322--
323-- * Available since Gtk+ version 2.10
324--
325rangeGetUpperStepperSensitivity :: RangeClass self => self
326 -> IO SensitivityType -- ^ returns The upper stepper's sensitivity policy.
327rangeGetUpperStepperSensitivity self =
328  liftM (toEnum . fromIntegral) $
329  {# call gtk_range_get_upper_stepper_sensitivity #}
330    (toRange self)
331#endif
332#if GTK_CHECK_VERSION(2,20,0)
333-- | This function is useful mainly for 'Range' subclasses.
334--
335-- See 'rangeSetMinSliderSize'.
336rangeGetMinSliderSize :: RangeClass self => self
337                      -> IO Int  -- ^ returns The minimum size of the range's slider.
338rangeGetMinSliderSize range =
339  liftM fromIntegral $
340  {#call gtk_range_get_min_slider_size #}
341    (toRange range)
342
343-- | This function returns the area that contains the range's trough and its steppers, in 'DrawWindow'
344-- coordinates.
345--
346-- This function is useful mainly for 'Range' subclasses.
347rangeGetRangeRect :: RangeClass self => self
348                  -> IO Rectangle
349rangeGetRangeRect self =
350  alloca $ \rPtr -> do
351  {# call gtk_range_get_range_rect #}
352    (toRange self)
353    (castPtr rPtr)
354  peek rPtr
355
356-- | This function returns sliders range along the long dimension, in 'DrawWindow' coordinates.
357--
358-- This function is useful mainly for 'Range' subclasses.
359rangeGetSliderRange :: RangeClass self => self
360                    -> IO (Maybe (Int, Int))
361rangeGetSliderRange range =
362    alloca $ \ startPtr ->
363    alloca $ \ endPtr -> do
364      {#call gtk_range_get_slider_range #}
365        (toRange range)
366        startPtr
367        endPtr
368      if (startPtr /= nullPtr && endPtr /= nullPtr)
369         then do
370           start <- peek startPtr
371           end <- peek endPtr
372           return (Just (fromIntegral start, fromIntegral end))
373         else return Nothing
374
375-- | This function is useful mainly for 'Range' subclasses.
376--
377-- See 'rangeSetSliderSizeFixed'.
378rangeGetSliderSizeFixed :: RangeClass self => self
379                        -> IO Bool  -- ^ returns whether the range's slider has a fixed size.
380rangeGetSliderSizeFixed self =
381  liftM toBool $
382  {#call gtk_range_get_slider_size_fixed #}
383    (toRange self)
384
385-- | Sets the minimum size of the range's slider.
386--
387-- This function is useful mainly for 'Range' subclasses.
388rangeSetMinSliderSize :: RangeClass self => self
389                      -> Bool
390                      -> IO ()
391rangeSetMinSliderSize self minSize =
392  {#call gtk_range_set_min_slider_size #}
393    (toRange self)
394    (fromBool minSize)
395
396-- | Sets whether the range's slider has a fixed size, or a size that depends on it's adjustment's page
397-- size.
398--
399-- This function is useful mainly for 'Range' subclasses.
400rangeSetSliderSizeFixed :: RangeClass self => self
401                        -> Bool -- ^ @sizeFixed@ 'True' to make the slider size constant
402                        -> IO ()
403rangeSetSliderSizeFixed self sizeFixed =
404  {#call gtk_range_set_slider_size_fixed #}
405    (toRange self)
406    (fromBool sizeFixed)
407#endif
408
409--------------------
410-- Attributes
411
412#if GTK_MAJOR_VERSION < 3
413-- | How the range should be updated on the screen.
414--
415-- Default value: 'UpdateContinuous'
416--
417-- Removed in Gtk3.
418rangeUpdatePolicy :: RangeClass self => Attr self UpdateType
419rangeUpdatePolicy = newAttr
420  rangeGetUpdatePolicy
421  rangeSetUpdatePolicy
422#endif
423
424-- | The 'Adjustment' that contains the current value of this range object.
425--
426rangeAdjustment :: RangeClass self => Attr self Adjustment
427rangeAdjustment = newAttr
428  rangeGetAdjustment
429  rangeSetAdjustment
430
431-- | Invert direction slider moves to increase range value.
432--
433-- Default value: @False@
434--
435rangeInverted :: RangeClass self => Attr self Bool
436rangeInverted = newAttr
437  rangeGetInverted
438  rangeSetInverted
439
440#if GTK_CHECK_VERSION(2,10,0)
441-- %hash c:b6dd d:1607
442-- | The sensitivity policy for the stepper that points to the adjustment's
443-- lower side.
444--
445-- Default value: 'SensitivityAuto'
446--
447rangeLowerStepperSensitivity :: RangeClass self => Attr self SensitivityType
448rangeLowerStepperSensitivity = newAttrFromEnumProperty "lower-stepper-sensitivity"
449                                 {# call pure unsafe gtk_sensitivity_type_get_type #}
450
451-- %hash c:2fc6 d:132a
452-- | The sensitivity policy for the stepper that points to the adjustment's
453-- upper side.
454--
455-- Default value: 'SensitivityAuto'
456--
457rangeUpperStepperSensitivity :: RangeClass self => Attr self SensitivityType
458rangeUpperStepperSensitivity = newAttrFromEnumProperty "upper-stepper-sensitivity"
459                                 {# call pure unsafe gtk_sensitivity_type_get_type #}
460#endif
461
462-- %hash c:f615 d:2481
463-- | \'value\' property. See 'rangeGetValue' and 'rangeSetValue'
464--
465rangeValue :: RangeClass self => Attr self Double
466rangeValue = newAttr
467  rangeGetValue
468  rangeSetValue
469
470#if GTK_CHECK_VERSION(2,20,0)
471-- | Wheter range's slikder has a fixed size, or a size that depends on it's adjustment's page size.
472rangeSliderSizeFixed :: RangeClass self => Attr self Bool
473rangeSliderSizeFixed = newAttr
474  rangeGetSliderSizeFixed
475  rangeSetSliderSizeFixed
476
477-- | Get\/Set sliders range along the long dimension, in 'DrawWindow' coordinates.
478rangeMinSliderSize :: RangeClass self => ReadWriteAttr self Int Bool
479rangeMinSliderSize = newAttr
480  rangeGetMinSliderSize
481  rangeSetMinSliderSize
482#endif
483
484--------------------
485-- Signals
486
487-- %hash c:9758 d:680f
488-- | Emitted when the range value changes.
489--
490valueChanged :: RangeClass self => Signal self (IO ())
491valueChanged = Signal (connect_NONE__NONE "value-changed")
492
493-- %hash c:9576 d:af3f
494-- |
495--
496adjustBounds :: RangeClass self => Signal self (Double -> IO ())
497adjustBounds = Signal (connect_DOUBLE__NONE "adjust-bounds")
498
499#if GTK_CHECK_VERSION(2,6,0)
500-- %hash c:a84 d:a60c
501-- | The 'changeValue' signal is emitted when a scroll action is performed on
502-- a range. It allows an application to determine the type of scroll event that
503-- occurred and the resultant new value. The application can handle the event
504-- itself and return @True@ to prevent further processing. Or, by returning
505-- @False@, it can pass the event to other handlers until the default Gtk+
506-- handler is reached.
507--
508-- The value parameter is unrounded. An application that overrides the
509-- 'changeValue' signal is responsible for clamping the value to the desired
510-- number of decimal digits.
511--
512-- It is not possible to use delayed update policies in an overridden
513-- 'changeValue' handler.
514--
515-- * Available since Gtk+ version 2.6
516--
517changeValue :: RangeClass self => Signal self (ScrollType -> Double -> IO Bool)
518changeValue = Signal (connect_ENUM_DOUBLE__BOOL "change-value")
519#endif
520
521--------------------
522-- Deprecated Signals
523
524#ifndef DISABLE_DEPRECATED
525
526#if GTK_CHECK_VERSION(2,6,0)
527-- | Emitted when a scroll action is performed on a range. It allows
528--   an application to determine the type of scroll event that
529--   occurred and the resultant new value. The application can handle
530--   the event itself and return 'True' to prevent further
531--   processing. Or, by returning 'False', it can pass the event to
532--   other handlers until the default GTK+ handler is reached.
533--
534--   * Since Gtk 2.6
535--
536onRangeChangeValue, afterRangeChangeValue :: RangeClass self => self
537 -> (ScrollType -> Double -> IO Bool)
538 -> IO (ConnectId self)
539onRangeChangeValue = connect_ENUM_DOUBLE__BOOL "change_value" False
540afterRangeChangeValue = connect_ENUM_DOUBLE__BOOL "change_value" True
541#endif
542
543-- | Emitted when the range value is changed either programmatically or by
544-- user action.
545--
546onRangeValueChanged, afterRangeValueChanged :: RangeClass self => self
547 -> IO ()
548 -> IO (ConnectId self)
549onRangeValueChanged = connect_NONE__NONE "value_changed" False
550afterRangeValueChanged = connect_NONE__NONE "value_changed" True
551
552-- | Emitted when the range is adjusted by user action. Note the value can be
553-- outside the bounds of the range since it depends on the mouse position.
554--
555-- Usually you should use 'onRangeValueChanged' \/ 'afterRangeValueChanged'
556-- instead.
557--
558onAdjustBounds, afterAdjustBounds :: RangeClass self => self
559 -> (Double -> IO ())
560 -> IO (ConnectId self)
561onAdjustBounds = connect_DOUBLE__NONE "adjust_bounds" False
562afterAdjustBounds = connect_DOUBLE__NONE "adjust_bounds" True
563
564-- | Emitted when the user presses a key (e.g. Page Up, Home, Right Arrow) to
565-- move the slider. The 'ScrollType' parameter gives the key that was pressed.
566--
567-- Usually you should use 'onRangeValueChanged' \/
568-- 'afterRangeValueChanged' instead.
569--
570onMoveSlider, afterMoveSlider :: RangeClass self => self
571 -> (ScrollType -> IO ())
572 -> IO (ConnectId self)
573onMoveSlider = connect_ENUM__NONE "move_slider" False
574afterMoveSlider = connect_ENUM__NONE "move_slider" True
575#endif
576