{-# LINE 2 "./Graphics/UI/Gtk/Abstract/Range.chs" #-}
-- -*-haskell-*-
-- GIMP Toolkit (GTK) Widget Range
--
-- Author : Axel Simon
--
-- Created: 23 May 2001
--
-- Copyright (C) 1999-2005 Axel Simon
--
-- This library is free software; you can redistribute it and/or
-- modify it under the terms of the GNU Lesser General Public
-- License as published by the Free Software Foundation; either
-- version 2.1 of the License, or (at your option) any later version.
--
-- This library is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-- Lesser General Public License for more details.
--
-- |
-- Maintainer : gtk2hs-users@lists.sourceforge.net
-- Stability : provisional
-- Portability : portable (depends on GHC)
--
-- Base class for widgets which visualize an adjustment
--
module Graphics.UI.Gtk.Abstract.Range (
-- * Description
--
-- | For signals regarding a change in the range or increments, refer to
-- 'Adjustment' which is contained in the 'Range' object.

-- * Class Hierarchy
-- |
-- @
-- | 'GObject'
-- | +----'Object'
-- | +----'Widget'
-- | +----Range
-- | +----'Scale'
-- | +----'Scrollbar'
-- @

-- * Types
  Range,
  RangeClass,
  castToRange, gTypeRange,
  toRange,

-- * Methods
  rangeGetAdjustment,
  rangeSetAdjustment,

  rangeGetUpdatePolicy,
  rangeSetUpdatePolicy,

  rangeGetInverted,
  rangeSetInverted,
  rangeGetValue,
  rangeSetValue,
  rangeSetIncrements,
  rangeSetRange,
  ScrollType(..),

  SensitivityType(..),
  rangeSetLowerStepperSensitivity,
  rangeGetLowerStepperSensitivity,
  rangeSetUpperStepperSensitivity,
  rangeGetUpperStepperSensitivity,


  rangeGetMinSliderSize,
  rangeGetRangeRect,
  rangeGetSliderRange,
  rangeGetSliderSizeFixed,
  rangeSetMinSliderSize,
  rangeSetSliderSizeFixed,


-- * Attributes

  rangeUpdatePolicy,

  rangeAdjustment,
  rangeInverted,

  rangeLowerStepperSensitivity,
  rangeUpperStepperSensitivity,

  rangeValue,

  rangeSliderSizeFixed,
  rangeMinSliderSize,


-- * Signals
  adjustBounds,
  valueChanged,

  changeValue,


-- * Deprecated

  onMoveSlider,
  afterMoveSlider,
  onAdjustBounds,
  afterAdjustBounds,

  onRangeChangeValue,
  afterRangeChangeValue,

  onRangeValueChanged,
  afterRangeValueChanged

  ) where

import Control.Monad (liftM)

import System.Glib.FFI
import System.Glib.Attributes
import System.Glib.Properties
import Graphics.UI.Gtk.Abstract.Object (makeNewObject)
import Graphics.UI.Gtk.Types
{-# LINE 126 "./Graphics/UI/Gtk/Abstract/Range.chs" #-}
import Graphics.UI.Gtk.Signals
{-# LINE 127 "./Graphics/UI/Gtk/Abstract/Range.chs" #-}
import Graphics.UI.Gtk.General.Enums (ScrollType(..))

import Graphics.UI.Gtk.General.Enums (UpdateType(..))

import Graphics.UI.Gtk.General.Structs (Rectangle(..))


{-# LINE 134 "./Graphics/UI/Gtk/Abstract/Range.chs" #-}

--------------------
-- Methods

-- | Get the 'Adjustment' which is the \"model\" object for 'Range'. See
-- 'rangeSetAdjustment' for details.
--
rangeGetAdjustment :: RangeClass self => self
 -> IO Adjustment -- ^ returns a 'Adjustment'
rangeGetAdjustment :: forall self. RangeClass self => self -> IO Adjustment
rangeGetAdjustment self
self =
  (ForeignPtr Adjustment -> Adjustment, FinalizerPtr Adjustment)
-> IO (Ptr Adjustment) -> IO Adjustment
forall obj.
ObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
makeNewObject (ForeignPtr Adjustment -> Adjustment, FinalizerPtr Adjustment)
forall {a}. (ForeignPtr Adjustment -> Adjustment, FinalizerPtr a)
mkAdjustment (IO (Ptr Adjustment) -> IO Adjustment)
-> IO (Ptr Adjustment) -> IO Adjustment
forall a b. (a -> b) -> a -> b
$
  (\(Range ForeignPtr Range
arg1) -> ForeignPtr Range
-> (Ptr Range -> IO (Ptr Adjustment)) -> IO (Ptr Adjustment)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Range
arg1 ((Ptr Range -> IO (Ptr Adjustment)) -> IO (Ptr Adjustment))
-> (Ptr Range -> IO (Ptr Adjustment)) -> IO (Ptr Adjustment)
forall a b. (a -> b) -> a -> b
$ \Ptr Range
argPtr1 ->Ptr Range -> IO (Ptr Adjustment)
gtk_range_get_adjustment Ptr Range
argPtr1)
{-# LINE 146 "./Graphics/UI/Gtk/Abstract/Range.chs" #-}
    (toRange self)

-- | Sets the adjustment to be used as the \"model\" object for this range
-- widget. The adjustment indicates the current range value, the minimum and
-- maximum range values, the step\/page increments used for keybindings and
-- scrolling, and the page size. The page size is normally 0 for 'Scale' and
-- nonzero for 'Scrollbar', and indicates the size of the visible area of the
-- widget being scrolled. The page size affects the size of the scrollbar
-- slider.
--
rangeSetAdjustment :: RangeClass self => self
 -> Adjustment -- ^ @adjustment@ - a 'Adjustment'
 -> IO ()
rangeSetAdjustment :: forall self. RangeClass self => self -> Adjustment -> IO ()
rangeSetAdjustment self
self Adjustment
adjustment =
  (\(Range ForeignPtr Range
arg1) (Adjustment ForeignPtr Adjustment
arg2) -> ForeignPtr Range -> (Ptr Range -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Range
arg1 ((Ptr Range -> IO ()) -> IO ()) -> (Ptr Range -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Range
argPtr1 ->ForeignPtr Adjustment -> (Ptr Adjustment -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Adjustment
arg2 ((Ptr Adjustment -> IO ()) -> IO ())
-> (Ptr Adjustment -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Adjustment
argPtr2 ->Ptr Range -> Ptr Adjustment -> IO ()
gtk_range_set_adjustment Ptr Range
argPtr1 Ptr Adjustment
argPtr2)
{-# LINE 161 "./Graphics/UI/Gtk/Abstract/Range.chs" #-}
    (toRange self)
    Adjustment
adjustment


-- | Gets the update policy of @range@. See 'rangeSetUpdatePolicy'.
--
-- Removed in Gtk3.
rangeGetUpdatePolicy :: RangeClass self => self
 -> IO UpdateType -- ^ returns the current update policy
rangeGetUpdatePolicy :: forall self. RangeClass self => self -> IO UpdateType
rangeGetUpdatePolicy self
self =
  (CInt -> UpdateType) -> IO CInt -> IO UpdateType
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Int -> UpdateType
forall a. Enum a => Int -> a
toEnum (Int -> UpdateType) -> (CInt -> Int) -> CInt -> UpdateType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) (IO CInt -> IO UpdateType) -> IO CInt -> IO UpdateType
forall a b. (a -> b) -> a -> b
$
  (\(Range ForeignPtr Range
arg1) -> ForeignPtr Range -> (Ptr Range -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Range
arg1 ((Ptr Range -> IO CInt) -> IO CInt)
-> (Ptr Range -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Range
argPtr1 ->Ptr Range -> IO CInt
gtk_range_get_update_policy Ptr Range
argPtr1)
{-# LINE 173 "./Graphics/UI/Gtk/Abstract/Range.chs" #-}
    (toRange self)


-- | Sets the update policy for the range. 'UpdateContinuous' means that
-- anytime the range slider is moved, the range value will change and the
-- value_changed signal will be emitted. 'UpdateDelayed' means that the value
-- will be updated after a brief timeout where no slider motion occurs, so
-- updates are spaced by a short time rather than continuous.
-- 'UpdateDiscontinuous' means that the value will only be updated when the
-- user releases the button and ends the slider drag operation.
--
-- Removed in Gtk3.
rangeSetUpdatePolicy :: RangeClass self => self
 -> UpdateType -- ^ @policy@ - update policy
 -> IO ()
rangeSetUpdatePolicy :: forall self. RangeClass self => self -> UpdateType -> IO ()
rangeSetUpdatePolicy self
self UpdateType
policy =
  (\(Range ForeignPtr Range
arg1) CInt
arg2 -> ForeignPtr Range -> (Ptr Range -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Range
arg1 ((Ptr Range -> IO ()) -> IO ()) -> (Ptr Range -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Range
argPtr1 ->Ptr Range -> CInt -> IO ()
gtk_range_set_update_policy Ptr Range
argPtr1 CInt
arg2)
{-# LINE 190 "./Graphics/UI/Gtk/Abstract/Range.chs" #-}
    (toRange self)
    ((Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (UpdateType -> Int) -> UpdateType -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UpdateType -> Int
forall a. Enum a => a -> Int
fromEnum) UpdateType
policy)


-- | Gets the value set by 'rangeSetInverted'.
--
rangeGetInverted :: RangeClass self => self
 -> IO Bool -- ^ returns @True@ if the range is inverted
rangeGetInverted :: forall self. RangeClass self => self -> IO Bool
rangeGetInverted self
self =
  (CInt -> Bool) -> IO CInt -> IO Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (IO CInt -> IO Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> a -> b
$
  (\(Range ForeignPtr Range
arg1) -> ForeignPtr Range -> (Ptr Range -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Range
arg1 ((Ptr Range -> IO CInt) -> IO CInt)
-> (Ptr Range -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Range
argPtr1 ->Ptr Range -> IO CInt
gtk_range_get_inverted Ptr Range
argPtr1)
{-# LINE 201 "./Graphics/UI/Gtk/Abstract/Range.chs" #-}
    (toRange self)

-- | Ranges normally move from lower to higher values as the slider moves from
-- top to bottom or left to right. Inverted ranges have higher values at the
-- top or on the right rather than on the bottom or left.
--
rangeSetInverted :: RangeClass self => self
 -> Bool -- ^ @setting@ - @True@ to invert the range
 -> IO ()
rangeSetInverted :: forall self. RangeClass self => self -> Bool -> IO ()
rangeSetInverted self
self Bool
setting =
  (\(Range ForeignPtr Range
arg1) CInt
arg2 -> ForeignPtr Range -> (Ptr Range -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Range
arg1 ((Ptr Range -> IO ()) -> IO ()) -> (Ptr Range -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Range
argPtr1 ->Ptr Range -> CInt -> IO ()
gtk_range_set_inverted Ptr Range
argPtr1 CInt
arg2)
{-# LINE 212 "./Graphics/UI/Gtk/Abstract/Range.chs" #-}
    (toRange self)
    (Bool -> CInt
forall a. Num a => Bool -> a
fromBool Bool
setting)

-- | Gets the current value of the range.
--
rangeGetValue :: RangeClass self => self
 -> IO Double -- ^ returns current value of the range.
rangeGetValue :: forall self. RangeClass self => self -> IO Double
rangeGetValue self
self =
  (CDouble -> Double) -> IO CDouble -> IO Double
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (IO CDouble -> IO Double) -> IO CDouble -> IO Double
forall a b. (a -> b) -> a -> b
$
  (\(Range ForeignPtr Range
arg1) -> ForeignPtr Range -> (Ptr Range -> IO CDouble) -> IO CDouble
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Range
arg1 ((Ptr Range -> IO CDouble) -> IO CDouble)
-> (Ptr Range -> IO CDouble) -> IO CDouble
forall a b. (a -> b) -> a -> b
$ \Ptr Range
argPtr1 ->Ptr Range -> IO CDouble
gtk_range_get_value Ptr Range
argPtr1)
{-# LINE 222 "./Graphics/UI/Gtk/Abstract/Range.chs" #-}
    (toRange self)

-- | Sets the current value of the range; if the value is outside the minimum
-- or maximum range values, it will be clamped to fit inside them. The range
-- emits the 'valueChanged' signal if the value changes.
--
rangeSetValue :: RangeClass self => self
 -> Double -- ^ @value@ - new value of the range
 -> IO ()
rangeSetValue :: forall self. RangeClass self => self -> Double -> IO ()
rangeSetValue self
self Double
value =
  (\(Range ForeignPtr Range
arg1) CDouble
arg2 -> ForeignPtr Range -> (Ptr Range -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Range
arg1 ((Ptr Range -> IO ()) -> IO ()) -> (Ptr Range -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Range
argPtr1 ->Ptr Range -> CDouble -> IO ()
gtk_range_set_value Ptr Range
argPtr1 CDouble
arg2)
{-# LINE 233 "./Graphics/UI/Gtk/Abstract/Range.chs" #-}
    (toRange self)
    (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
value)

-- | Sets the step and page sizes for the range. The step size is used when
-- the user clicks the 'Scrollbar' arrows or moves 'Scale' via arrow keys. The
-- page size is used for example when moving via Page Up or Page Down keys.
--
rangeSetIncrements :: RangeClass self => self
 -> Double -- ^ @step@ - step size
 -> Double -- ^ @page@ - page size
 -> IO ()
rangeSetIncrements :: forall self. RangeClass self => self -> Double -> Double -> IO ()
rangeSetIncrements self
self Double
step Double
page =
  (\(Range ForeignPtr Range
arg1) CDouble
arg2 CDouble
arg3 -> ForeignPtr Range -> (Ptr Range -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Range
arg1 ((Ptr Range -> IO ()) -> IO ()) -> (Ptr Range -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Range
argPtr1 ->Ptr Range -> CDouble -> CDouble -> IO ()
gtk_range_set_increments Ptr Range
argPtr1 CDouble
arg2 CDouble
arg3)
{-# LINE 246 "./Graphics/UI/Gtk/Abstract/Range.chs" #-}
    (toRange self)
    (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
step)
    (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
page)

-- | Sets the allowable values in the 'Range', and clamps the range value to
-- be between @min@ and @max@. (If the range has a non-zero page size, it is
-- clamped between @min@ and @max@ - page-size.)
--
rangeSetRange :: RangeClass self => self
 -> Double -- ^ @min@ - minimum range value
 -> Double -- ^ @max@ - maximum range value
 -> IO ()
rangeSetRange :: forall self. RangeClass self => self -> Double -> Double -> IO ()
rangeSetRange self
self Double
min Double
max =
  (\(Range ForeignPtr Range
arg1) CDouble
arg2 CDouble
arg3 -> ForeignPtr Range -> (Ptr Range -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Range
arg1 ((Ptr Range -> IO ()) -> IO ()) -> (Ptr Range -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Range
argPtr1 ->Ptr Range -> CDouble -> CDouble -> IO ()
gtk_range_set_range Ptr Range
argPtr1 CDouble
arg2 CDouble
arg3)
{-# LINE 260 "./Graphics/UI/Gtk/Abstract/Range.chs" #-}
    (toRange self)
    (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
min)
    (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
max)



-- | Determines how Gtk+ handles the sensitivity of stepper arrows at the end of range widgets.
--
-- * 'SensitivityAuto': the arrow is made insensitive if the thumb is at the end
--
-- * 'SensitivityOn': the arrow is always sensitive
--
-- * 'SensitivityOff': the arrow is always insensitive
--
data SensitivityType = SensitivityAuto
                     | SensitivityOn
                     | SensitivityOff
                     deriving (Int -> SensitivityType
SensitivityType -> Int
SensitivityType -> [SensitivityType]
SensitivityType -> SensitivityType
SensitivityType -> SensitivityType -> [SensitivityType]
SensitivityType
-> SensitivityType -> SensitivityType -> [SensitivityType]
(SensitivityType -> SensitivityType)
-> (SensitivityType -> SensitivityType)
-> (Int -> SensitivityType)
-> (SensitivityType -> Int)
-> (SensitivityType -> [SensitivityType])
-> (SensitivityType -> SensitivityType -> [SensitivityType])
-> (SensitivityType -> SensitivityType -> [SensitivityType])
-> (SensitivityType
    -> SensitivityType -> SensitivityType -> [SensitivityType])
-> Enum SensitivityType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: SensitivityType -> SensitivityType
succ :: SensitivityType -> SensitivityType
$cpred :: SensitivityType -> SensitivityType
pred :: SensitivityType -> SensitivityType
$ctoEnum :: Int -> SensitivityType
toEnum :: Int -> SensitivityType
$cfromEnum :: SensitivityType -> Int
fromEnum :: SensitivityType -> Int
$cenumFrom :: SensitivityType -> [SensitivityType]
enumFrom :: SensitivityType -> [SensitivityType]
$cenumFromThen :: SensitivityType -> SensitivityType -> [SensitivityType]
enumFromThen :: SensitivityType -> SensitivityType -> [SensitivityType]
$cenumFromTo :: SensitivityType -> SensitivityType -> [SensitivityType]
enumFromTo :: SensitivityType -> SensitivityType -> [SensitivityType]
$cenumFromThenTo :: SensitivityType
-> SensitivityType -> SensitivityType -> [SensitivityType]
enumFromThenTo :: SensitivityType
-> SensitivityType -> SensitivityType -> [SensitivityType]
Enum,SensitivityType
SensitivityType -> SensitivityType -> Bounded SensitivityType
forall a. a -> a -> Bounded a
$cminBound :: SensitivityType
minBound :: SensitivityType
$cmaxBound :: SensitivityType
maxBound :: SensitivityType
Bounded,SensitivityType -> SensitivityType -> Bool
(SensitivityType -> SensitivityType -> Bool)
-> (SensitivityType -> SensitivityType -> Bool)
-> Eq SensitivityType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SensitivityType -> SensitivityType -> Bool
== :: SensitivityType -> SensitivityType -> Bool
$c/= :: SensitivityType -> SensitivityType -> Bool
/= :: SensitivityType -> SensitivityType -> Bool
Eq,Int -> SensitivityType -> ShowS
[SensitivityType] -> ShowS
SensitivityType -> String
(Int -> SensitivityType -> ShowS)
-> (SensitivityType -> String)
-> ([SensitivityType] -> ShowS)
-> Show SensitivityType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SensitivityType -> ShowS
showsPrec :: Int -> SensitivityType -> ShowS
$cshow :: SensitivityType -> String
show :: SensitivityType -> String
$cshowList :: [SensitivityType] -> ShowS
showList :: [SensitivityType] -> ShowS
Show)

{-# LINE 275 "./Graphics/UI/Gtk/Abstract/Range.chs" #-}

-- %hash c:3a8d d:d336
-- | Sets the sensitivity policy for the stepper that points to the \'lower\'
-- end of the 'Range''s adjustment.
--
-- * Available since Gtk+ version 2.10
--
rangeSetLowerStepperSensitivity :: RangeClass self => self
 -> SensitivityType -- ^ @sensitivity@ - the lower stepper's sensitivity
                    -- policy.
 -> IO ()
rangeSetLowerStepperSensitivity :: forall self. RangeClass self => self -> SensitivityType -> IO ()
rangeSetLowerStepperSensitivity self
self SensitivityType
sensitivity =
  (\(Range ForeignPtr Range
arg1) CInt
arg2 -> ForeignPtr Range -> (Ptr Range -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Range
arg1 ((Ptr Range -> IO ()) -> IO ()) -> (Ptr Range -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Range
argPtr1 ->Ptr Range -> CInt -> IO ()
gtk_range_set_lower_stepper_sensitivity Ptr Range
argPtr1 CInt
arg2)
{-# LINE 288 "./Graphics/UI/Gtk/Abstract/Range.chs" #-}
    (toRange self)
    ((Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt)
-> (SensitivityType -> Int) -> SensitivityType -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SensitivityType -> Int
forall a. Enum a => a -> Int
fromEnum) SensitivityType
sensitivity)

-- %hash c:12a2 d:2f2a
-- | Gets the sensitivity policy for the stepper that points to the \'lower\'
-- end of the 'Range''s adjustment.
--
-- * Available since Gtk+ version 2.10
--
rangeGetLowerStepperSensitivity :: RangeClass self => self
 -> IO SensitivityType -- ^ returns The lower stepper's sensitivity policy.
rangeGetLowerStepperSensitivity :: forall self. RangeClass self => self -> IO SensitivityType
rangeGetLowerStepperSensitivity self
self =
  (CInt -> SensitivityType) -> IO CInt -> IO SensitivityType
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Int -> SensitivityType
forall a. Enum a => Int -> a
toEnum (Int -> SensitivityType)
-> (CInt -> Int) -> CInt -> SensitivityType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) (IO CInt -> IO SensitivityType) -> IO CInt -> IO SensitivityType
forall a b. (a -> b) -> a -> b
$
  (\(Range ForeignPtr Range
arg1) -> ForeignPtr Range -> (Ptr Range -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Range
arg1 ((Ptr Range -> IO CInt) -> IO CInt)
-> (Ptr Range -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Range
argPtr1 ->Ptr Range -> IO CInt
gtk_range_get_lower_stepper_sensitivity Ptr Range
argPtr1)
{-# LINE 302 "./Graphics/UI/Gtk/Abstract/Range.chs" #-}
    (toRange self)

-- %hash c:a939 d:2d79
-- | Sets the sensitivity policy for the stepper that points to the \'upper\'
-- end of the 'Range''s adjustment.
--
-- * Available since Gtk+ version 2.10
--
rangeSetUpperStepperSensitivity :: RangeClass self => self
 -> SensitivityType -- ^ @sensitivity@ - the upper stepper's sensitivity
                    -- policy.
 -> IO ()
rangeSetUpperStepperSensitivity :: forall self. RangeClass self => self -> SensitivityType -> IO ()
rangeSetUpperStepperSensitivity self
self SensitivityType
sensitivity =
  (\(Range ForeignPtr Range
arg1) CInt
arg2 -> ForeignPtr Range -> (Ptr Range -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Range
arg1 ((Ptr Range -> IO ()) -> IO ()) -> (Ptr Range -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Range
argPtr1 ->Ptr Range -> CInt -> IO ()
gtk_range_set_upper_stepper_sensitivity Ptr Range
argPtr1 CInt
arg2)
{-# LINE 316 "./Graphics/UI/Gtk/Abstract/Range.chs" #-}
    (toRange self)
    ((Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt)
-> (SensitivityType -> Int) -> SensitivityType -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SensitivityType -> Int
forall a. Enum a => a -> Int
fromEnum) SensitivityType
sensitivity)

-- %hash c:456e d:896d
-- | Gets the sensitivity policy for the stepper that points to the \'upper\'
-- end of the 'Range''s adjustment.
--
-- * Available since Gtk+ version 2.10
--
rangeGetUpperStepperSensitivity :: RangeClass self => self
 -> IO SensitivityType -- ^ returns The upper stepper's sensitivity policy.
rangeGetUpperStepperSensitivity :: forall self. RangeClass self => self -> IO SensitivityType
rangeGetUpperStepperSensitivity self
self =
  (CInt -> SensitivityType) -> IO CInt -> IO SensitivityType
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Int -> SensitivityType
forall a. Enum a => Int -> a
toEnum (Int -> SensitivityType)
-> (CInt -> Int) -> CInt -> SensitivityType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) (IO CInt -> IO SensitivityType) -> IO CInt -> IO SensitivityType
forall a b. (a -> b) -> a -> b
$
  (\(Range ForeignPtr Range
arg1) -> ForeignPtr Range -> (Ptr Range -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Range
arg1 ((Ptr Range -> IO CInt) -> IO CInt)
-> (Ptr Range -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Range
argPtr1 ->Ptr Range -> IO CInt
gtk_range_get_upper_stepper_sensitivity Ptr Range
argPtr1)
{-# LINE 330 "./Graphics/UI/Gtk/Abstract/Range.chs" #-}
    (toRange self)


-- | This function is useful mainly for 'Range' subclasses.
--
-- See 'rangeSetMinSliderSize'.
rangeGetMinSliderSize :: RangeClass self => self
                      -> IO Int -- ^ returns The minimum size of the range's slider.
rangeGetMinSliderSize :: forall self. RangeClass self => self -> IO Int
rangeGetMinSliderSize self
range =
  (CInt -> Int) -> IO CInt -> IO Int
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO CInt -> IO Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> a -> b
$
  (\(Range ForeignPtr Range
arg1) -> ForeignPtr Range -> (Ptr Range -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Range
arg1 ((Ptr Range -> IO CInt) -> IO CInt)
-> (Ptr Range -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Range
argPtr1 ->Ptr Range -> IO CInt
gtk_range_get_min_slider_size Ptr Range
argPtr1)
{-# LINE 341 "./Graphics/UI/Gtk/Abstract/Range.chs" #-}
    (toRange range)

-- | This function returns the area that contains the range's through and its steppers, in 'DrawWindow'
-- coordinates.
--
-- This function is useful mainly for 'Range' subclasses.
rangeGetRangeRect :: RangeClass self => self
                  -> IO Rectangle
rangeGetRangeRect :: forall self. RangeClass self => self -> IO Rectangle
rangeGetRangeRect self
self =
  (Ptr Rectangle -> IO Rectangle) -> IO Rectangle
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Rectangle -> IO Rectangle) -> IO Rectangle)
-> (Ptr Rectangle -> IO Rectangle) -> IO Rectangle
forall a b. (a -> b) -> a -> b
$ \Ptr Rectangle
rPtr -> do
  (\(Range ForeignPtr Range
arg1) Ptr ()
arg2 -> ForeignPtr Range -> (Ptr Range -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Range
arg1 ((Ptr Range -> IO ()) -> IO ()) -> (Ptr Range -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Range
argPtr1 ->Ptr Range -> Ptr () -> IO ()
gtk_range_get_range_rect Ptr Range
argPtr1 Ptr ()
arg2)
{-# LINE 352 "./Graphics/UI/Gtk/Abstract/Range.chs" #-}
    (toRange self)
    (Ptr Rectangle -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr Rectangle
rPtr)
  Ptr Rectangle -> IO Rectangle
forall a. Storable a => Ptr a -> IO a
peek Ptr Rectangle
rPtr

-- | This function returns sliders range along the long dimension, in 'DrawWindow' coordinates.
--
-- This function is useful mainly for 'Range' subclasses.
rangeGetSliderRange :: RangeClass self => self
                    -> IO (Maybe (Int, Int))
rangeGetSliderRange :: forall self. RangeClass self => self -> IO (Maybe (Int, Int))
rangeGetSliderRange self
range =
    (Ptr CInt -> IO (Maybe (Int, Int))) -> IO (Maybe (Int, Int))
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Maybe (Int, Int))) -> IO (Maybe (Int, Int)))
-> (Ptr CInt -> IO (Maybe (Int, Int))) -> IO (Maybe (Int, Int))
forall a b. (a -> b) -> a -> b
$ \ Ptr CInt
startPtr ->
    (Ptr CInt -> IO (Maybe (Int, Int))) -> IO (Maybe (Int, Int))
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Maybe (Int, Int))) -> IO (Maybe (Int, Int)))
-> (Ptr CInt -> IO (Maybe (Int, Int))) -> IO (Maybe (Int, Int))
forall a b. (a -> b) -> a -> b
$ \ Ptr CInt
endPtr -> do
      (\(Range ForeignPtr Range
arg1) Ptr CInt
arg2 Ptr CInt
arg3 -> ForeignPtr Range -> (Ptr Range -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Range
arg1 ((Ptr Range -> IO ()) -> IO ()) -> (Ptr Range -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Range
argPtr1 ->Ptr Range -> Ptr CInt -> Ptr CInt -> IO ()
gtk_range_get_slider_range Ptr Range
argPtr1 Ptr CInt
arg2 Ptr CInt
arg3)
{-# LINE 365 "./Graphics/UI/Gtk/Abstract/Range.chs" #-}
        (self -> Range
forall o. RangeClass o => o -> Range
toRange self
range)
        Ptr CInt
startPtr
        Ptr CInt
endPtr
      if (Ptr CInt
startPtr Ptr CInt -> Ptr CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr CInt
forall a. Ptr a
nullPtr Bool -> Bool -> Bool
&& Ptr CInt
endPtr Ptr CInt -> Ptr CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr CInt
forall a. Ptr a
nullPtr)
         then do
           CInt
start <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
startPtr
           CInt
end <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
endPtr
           Maybe (Int, Int) -> IO (Maybe (Int, Int))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Int, Int) -> Maybe (Int, Int)
forall a. a -> Maybe a
Just (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
start, CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
end))
         else Maybe (Int, Int) -> IO (Maybe (Int, Int))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Int, Int)
forall a. Maybe a
Nothing

-- | This function is useful mainly for 'Range' subclasses.
--
-- See 'rangeSetSliderSizeFixed'.
rangeGetSliderSizeFixed :: RangeClass self => self
                        -> IO Bool -- ^ returns whether the range's slider has a fixed size.
rangeGetSliderSizeFixed :: forall self. RangeClass self => self -> IO Bool
rangeGetSliderSizeFixed self
self =
  (CInt -> Bool) -> IO CInt -> IO Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (IO CInt -> IO Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> a -> b
$
  (\(Range ForeignPtr Range
arg1) -> ForeignPtr Range -> (Ptr Range -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Range
arg1 ((Ptr Range -> IO CInt) -> IO CInt)
-> (Ptr Range -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Range
argPtr1 ->Ptr Range -> IO CInt
gtk_range_get_slider_size_fixed Ptr Range
argPtr1)
{-# LINE 383 "./Graphics/UI/Gtk/Abstract/Range.chs" #-}
    (toRange self)

-- | Sets the minimum size of the range's slider.
--
-- This function is useful mainly for 'Range' subclasses.
rangeSetMinSliderSize :: RangeClass self => self
                      -> Bool
                      -> IO ()
rangeSetMinSliderSize :: forall self. RangeClass self => self -> Bool -> IO ()
rangeSetMinSliderSize self
self Bool
minSize =
  (\(Range ForeignPtr Range
arg1) CInt
arg2 -> ForeignPtr Range -> (Ptr Range -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Range
arg1 ((Ptr Range -> IO ()) -> IO ()) -> (Ptr Range -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Range
argPtr1 ->Ptr Range -> CInt -> IO ()
gtk_range_set_min_slider_size Ptr Range
argPtr1 CInt
arg2)
{-# LINE 393 "./Graphics/UI/Gtk/Abstract/Range.chs" #-}
    (toRange self)
    (Bool -> CInt
forall a. Num a => Bool -> a
fromBool Bool
minSize)

-- | Sets whether the range's slider has a fixed size, or a size that depends on it's adjustment's page
-- size.
--
-- This function is useful mainly for 'Range' subclasses.
rangeSetSliderSizeFixed :: RangeClass self => self
                        -> Bool -- ^ @sizeFixed@ 'True' to make the slider size constant
                        -> IO ()
rangeSetSliderSizeFixed :: forall self. RangeClass self => self -> Bool -> IO ()
rangeSetSliderSizeFixed self
self Bool
sizeFixed =
  (\(Range ForeignPtr Range
arg1) CInt
arg2 -> ForeignPtr Range -> (Ptr Range -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Range
arg1 ((Ptr Range -> IO ()) -> IO ()) -> (Ptr Range -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Range
argPtr1 ->Ptr Range -> CInt -> IO ()
gtk_range_set_slider_size_fixed Ptr Range
argPtr1 CInt
arg2)
{-# LINE 405 "./Graphics/UI/Gtk/Abstract/Range.chs" #-}
    (toRange self)
    (Bool -> CInt
forall a. Num a => Bool -> a
fromBool Bool
sizeFixed)


--------------------
-- Attributes


-- | How the range should be updated on the screen.
--
-- Default value: 'UpdateContinuous'
--
-- Removed in Gtk3.
rangeUpdatePolicy :: RangeClass self => Attr self UpdateType
rangeUpdatePolicy :: forall self. RangeClass self => Attr self UpdateType
rangeUpdatePolicy = (self -> IO UpdateType)
-> (self -> UpdateType -> IO ())
-> ReadWriteAttr self UpdateType UpdateType
forall o a b.
(o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newAttr
  self -> IO UpdateType
forall self. RangeClass self => self -> IO UpdateType
rangeGetUpdatePolicy
  self -> UpdateType -> IO ()
forall self. RangeClass self => self -> UpdateType -> IO ()
rangeSetUpdatePolicy


-- | The 'Adjustment' that contains the current value of this range object.
--
rangeAdjustment :: RangeClass self => Attr self Adjustment
rangeAdjustment :: forall self. RangeClass self => Attr self Adjustment
rangeAdjustment = (self -> IO Adjustment)
-> (self -> Adjustment -> IO ())
-> ReadWriteAttr self Adjustment Adjustment
forall o a b.
(o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newAttr
  self -> IO Adjustment
forall self. RangeClass self => self -> IO Adjustment
rangeGetAdjustment
  self -> Adjustment -> IO ()
forall self. RangeClass self => self -> Adjustment -> IO ()
rangeSetAdjustment

-- | Invert direction slider moves to increase range value.
--
-- Default value: @False@
--
rangeInverted :: RangeClass self => Attr self Bool
rangeInverted :: forall self. RangeClass self => Attr self Bool
rangeInverted = (self -> IO Bool)
-> (self -> Bool -> IO ()) -> ReadWriteAttr self Bool Bool
forall o a b.
(o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newAttr
  self -> IO Bool
forall self. RangeClass self => self -> IO Bool
rangeGetInverted
  self -> Bool -> IO ()
forall self. RangeClass self => self -> Bool -> IO ()
rangeSetInverted


-- %hash c:b6dd d:1607
-- | The sensitivity policy for the stepper that points to the adjustment's
-- lower side.
--
-- Default value: 'SensitivityAuto'
--
rangeLowerStepperSensitivity :: RangeClass self => Attr self SensitivityType
rangeLowerStepperSensitivity :: forall self. RangeClass self => Attr self SensitivityType
rangeLowerStepperSensitivity = String -> GType -> Attr self SensitivityType
forall gobj enum.
(GObjectClass gobj, Enum enum) =>
String -> GType -> Attr gobj enum
newAttrFromEnumProperty String
"lower-stepper-sensitivity"
                                 GType
gtk_sensitivity_type_get_type
{-# LINE 450 "./Graphics/UI/Gtk/Abstract/Range.chs" #-}

-- %hash c:2fc6 d:132a
-- | The sensitivity policy for the stepper that points to the adjustment's
-- upper side.
--
-- Default value: 'SensitivityAuto'
--
rangeUpperStepperSensitivity :: RangeClass self => Attr self SensitivityType
rangeUpperStepperSensitivity :: forall self. RangeClass self => Attr self SensitivityType
rangeUpperStepperSensitivity = String -> GType -> Attr self SensitivityType
forall gobj enum.
(GObjectClass gobj, Enum enum) =>
String -> GType -> Attr gobj enum
newAttrFromEnumProperty String
"upper-stepper-sensitivity"
                                 GType
gtk_sensitivity_type_get_type
{-# LINE 460 "./Graphics/UI/Gtk/Abstract/Range.chs" #-}


-- %hash c:f615 d:2481
-- | \'value\' property. See 'rangeGetValue' and 'rangeSetValue'
--
rangeValue :: RangeClass self => Attr self Double
rangeValue :: forall self. RangeClass self => Attr self Double
rangeValue = (self -> IO Double)
-> (self -> Double -> IO ()) -> ReadWriteAttr self Double Double
forall o a b.
(o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newAttr
  self -> IO Double
forall self. RangeClass self => self -> IO Double
rangeGetValue
  self -> Double -> IO ()
forall self. RangeClass self => self -> Double -> IO ()
rangeSetValue


-- | Whether range's slikder has a fixed size, or a size that depends on it's adjustment's page size.
rangeSliderSizeFixed :: RangeClass self => Attr self Bool
rangeSliderSizeFixed :: forall self. RangeClass self => Attr self Bool
rangeSliderSizeFixed = (self -> IO Bool)
-> (self -> Bool -> IO ()) -> ReadWriteAttr self Bool Bool
forall o a b.
(o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newAttr
  self -> IO Bool
forall self. RangeClass self => self -> IO Bool
rangeGetSliderSizeFixed
  self -> Bool -> IO ()
forall self. RangeClass self => self -> Bool -> IO ()
rangeSetSliderSizeFixed

-- | Get\/Set sliders range along the long dimension, in 'DrawWindow' coordinates.
rangeMinSliderSize :: RangeClass self => ReadWriteAttr self Int Bool
rangeMinSliderSize :: forall self. RangeClass self => ReadWriteAttr self Int Bool
rangeMinSliderSize = (self -> IO Int)
-> (self -> Bool -> IO ()) -> ReadWriteAttr self Int Bool
forall o a b.
(o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newAttr
  self -> IO Int
forall self. RangeClass self => self -> IO Int
rangeGetMinSliderSize
  self -> Bool -> IO ()
forall self. RangeClass self => self -> Bool -> IO ()
rangeSetMinSliderSize


--------------------
-- Signals

-- %hash c:9758 d:680f
-- | Emitted when the range value changes.
--
valueChanged :: RangeClass self => Signal self (IO ())
valueChanged :: forall self. RangeClass self => Signal self (IO ())
valueChanged = (Bool -> self -> IO () -> IO (ConnectId self))
-> Signal self (IO ())
forall object handler.
(Bool -> object -> handler -> IO (ConnectId object))
-> Signal object handler
Signal (String -> Bool -> self -> IO () -> IO (ConnectId self)
forall obj.
GObjectClass obj =>
String -> Bool -> obj -> IO () -> IO (ConnectId obj)
connect_NONE__NONE String
"value-changed")

-- %hash c:9576 d:af3f
-- |
--
adjustBounds :: RangeClass self => Signal self (Double -> IO ())
adjustBounds :: forall self. RangeClass self => Signal self (Double -> IO ())
adjustBounds = (Bool -> self -> (Double -> IO ()) -> IO (ConnectId self))
-> Signal self (Double -> IO ())
forall object handler.
(Bool -> object -> handler -> IO (ConnectId object))
-> Signal object handler
Signal (String -> Bool -> self -> (Double -> IO ()) -> IO (ConnectId self)
forall obj.
GObjectClass obj =>
String -> Bool -> obj -> (Double -> IO ()) -> IO (ConnectId obj)
connect_DOUBLE__NONE String
"adjust-bounds")


-- %hash c:a84 d:a60c
-- | The 'changeValue' signal is emitted when a scroll action is performed on
-- a range. It allows an application to determine the type of scroll event that
-- occurred and the resultant new value. The application can handle the event
-- itself and return @True@ to prevent further processing. Or, by returning
-- @False@, it can pass the event to other handlers until the default Gtk+
-- handler is reached.
--
-- The value parameter is unrounded. An application that overrides the
-- 'changeValue' signal is responsible for clamping the value to the desired
-- number of decimal digits.
--
-- It is not possible to use delayed update policies in an overridden
-- 'changeValue' handler.
--
-- * Available since Gtk+ version 2.6
--
changeValue :: RangeClass self => Signal self (ScrollType -> Double -> IO Bool)
changeValue :: forall self.
RangeClass self =>
Signal self (ScrollType -> Double -> IO Bool)
changeValue = (Bool
 -> self
 -> (ScrollType -> Double -> IO Bool)
 -> IO (ConnectId self))
-> Signal self (ScrollType -> Double -> IO Bool)
forall object handler.
(Bool -> object -> handler -> IO (ConnectId object))
-> Signal object handler
Signal (String
-> Bool
-> self
-> (ScrollType -> Double -> IO Bool)
-> IO (ConnectId self)
forall a obj.
(Enum a, GObjectClass obj) =>
String
-> Bool -> obj -> (a -> Double -> IO Bool) -> IO (ConnectId obj)
connect_ENUM_DOUBLE__BOOL String
"change-value")


--------------------
-- Deprecated Signals




-- | Emitted when a scroll action is performed on a range. It allows
-- an application to determine the type of scroll event that
-- occurred and the resultant new value. The application can handle
-- the event itself and return 'True' to prevent further
-- processing. Or, by returning 'False', it can pass the event to
-- other handlers until the default GTK+ handler is reached.
--
-- * Since Gtk 2.6
--
onRangeChangeValue, afterRangeChangeValue :: RangeClass self => self
 -> (ScrollType -> Double -> IO Bool)
 -> IO (ConnectId self)
onRangeChangeValue :: forall self.
RangeClass self =>
self -> (ScrollType -> Double -> IO Bool) -> IO (ConnectId self)
onRangeChangeValue = String
-> Bool
-> self
-> (ScrollType -> Double -> IO Bool)
-> IO (ConnectId self)
forall a obj.
(Enum a, GObjectClass obj) =>
String
-> Bool -> obj -> (a -> Double -> IO Bool) -> IO (ConnectId obj)
connect_ENUM_DOUBLE__BOOL String
"change_value" Bool
False
afterRangeChangeValue :: forall self.
RangeClass self =>
self -> (ScrollType -> Double -> IO Bool) -> IO (ConnectId self)
afterRangeChangeValue = String
-> Bool
-> self
-> (ScrollType -> Double -> IO Bool)
-> IO (ConnectId self)
forall a obj.
(Enum a, GObjectClass obj) =>
String
-> Bool -> obj -> (a -> Double -> IO Bool) -> IO (ConnectId obj)
connect_ENUM_DOUBLE__BOOL String
"change_value" Bool
True


-- | Emitted when the range value is changed either programmatically or by
-- user action.
--
onRangeValueChanged, afterRangeValueChanged :: RangeClass self => self
 -> IO ()
 -> IO (ConnectId self)
onRangeValueChanged :: forall self.
RangeClass self =>
self -> IO () -> IO (ConnectId self)
onRangeValueChanged = String -> Bool -> self -> IO () -> IO (ConnectId self)
forall obj.
GObjectClass obj =>
String -> Bool -> obj -> IO () -> IO (ConnectId obj)
connect_NONE__NONE String
"value_changed" Bool
False
afterRangeValueChanged :: forall self.
RangeClass self =>
self -> IO () -> IO (ConnectId self)
afterRangeValueChanged = String -> Bool -> self -> IO () -> IO (ConnectId self)
forall obj.
GObjectClass obj =>
String -> Bool -> obj -> IO () -> IO (ConnectId obj)
connect_NONE__NONE String
"value_changed" Bool
True

-- | Emitted when the range is adjusted by user action. Note the value can be
-- outside the bounds of the range since it depends on the mouse position.
--
-- Usually you should use 'onRangeValueChanged' \/ 'afterRangeValueChanged'
-- instead.
--
onAdjustBounds, afterAdjustBounds :: RangeClass self => self
 -> (Double -> IO ())
 -> IO (ConnectId self)
onAdjustBounds :: forall self.
RangeClass self =>
self -> (Double -> IO ()) -> IO (ConnectId self)
onAdjustBounds = String -> Bool -> self -> (Double -> IO ()) -> IO (ConnectId self)
forall obj.
GObjectClass obj =>
String -> Bool -> obj -> (Double -> IO ()) -> IO (ConnectId obj)
connect_DOUBLE__NONE String
"adjust_bounds" Bool
False
afterAdjustBounds :: forall self.
RangeClass self =>
self -> (Double -> IO ()) -> IO (ConnectId self)
afterAdjustBounds = String -> Bool -> self -> (Double -> IO ()) -> IO (ConnectId self)
forall obj.
GObjectClass obj =>
String -> Bool -> obj -> (Double -> IO ()) -> IO (ConnectId obj)
connect_DOUBLE__NONE String
"adjust_bounds" Bool
True

-- | Emitted when the user presses a key (e.g. Page Up, Home, Right Arrow) to
-- move the slider. The 'ScrollType' parameter gives the key that was pressed.
--
-- Usually you should use 'onRangeValueChanged' \/
-- 'afterRangeValueChanged' instead.
--
onMoveSlider, afterMoveSlider :: RangeClass self => self
 -> (ScrollType -> IO ())
 -> IO (ConnectId self)
onMoveSlider :: forall self.
RangeClass self =>
self -> (ScrollType -> IO ()) -> IO (ConnectId self)
onMoveSlider = String
-> Bool -> self -> (ScrollType -> IO ()) -> IO (ConnectId self)
forall a obj.
(Enum a, GObjectClass obj) =>
String -> Bool -> obj -> (a -> IO ()) -> IO (ConnectId obj)
connect_ENUM__NONE String
"move_slider" Bool
False
afterMoveSlider :: forall self.
RangeClass self =>
self -> (ScrollType -> IO ()) -> IO (ConnectId self)
afterMoveSlider = String
-> Bool -> self -> (ScrollType -> IO ()) -> IO (ConnectId self)
forall a obj.
(Enum a, GObjectClass obj) =>
String -> Bool -> obj -> (a -> IO ()) -> IO (ConnectId obj)
connect_ENUM__NONE String
"move_slider" Bool
True

foreign import ccall unsafe "gtk_range_get_adjustment"
  gtk_range_get_adjustment :: ((Ptr Range) -> (IO (Ptr Adjustment)))

foreign import ccall safe "gtk_range_set_adjustment"
  gtk_range_set_adjustment :: ((Ptr Range) -> ((Ptr Adjustment) -> (IO ())))

foreign import ccall unsafe "gtk_range_get_update_policy"
  gtk_range_get_update_policy :: ((Ptr Range) -> (IO CInt))

foreign import ccall safe "gtk_range_set_update_policy"
  gtk_range_set_update_policy :: ((Ptr Range) -> (CInt -> (IO ())))

foreign import ccall unsafe "gtk_range_get_inverted"
  gtk_range_get_inverted :: ((Ptr Range) -> (IO CInt))

foreign import ccall safe "gtk_range_set_inverted"
  gtk_range_set_inverted :: ((Ptr Range) -> (CInt -> (IO ())))

foreign import ccall unsafe "gtk_range_get_value"
  gtk_range_get_value :: ((Ptr Range) -> (IO CDouble))

foreign import ccall safe "gtk_range_set_value"
  gtk_range_set_value :: ((Ptr Range) -> (CDouble -> (IO ())))

foreign import ccall safe "gtk_range_set_increments"
  gtk_range_set_increments :: ((Ptr Range) -> (CDouble -> (CDouble -> (IO ()))))

foreign import ccall safe "gtk_range_set_range"
  gtk_range_set_range :: ((Ptr Range) -> (CDouble -> (CDouble -> (IO ()))))

foreign import ccall safe "gtk_range_set_lower_stepper_sensitivity"
  gtk_range_set_lower_stepper_sensitivity :: ((Ptr Range) -> (CInt -> (IO ())))

foreign import ccall safe "gtk_range_get_lower_stepper_sensitivity"
  gtk_range_get_lower_stepper_sensitivity :: ((Ptr Range) -> (IO CInt))

foreign import ccall safe "gtk_range_set_upper_stepper_sensitivity"
  gtk_range_set_upper_stepper_sensitivity :: ((Ptr Range) -> (CInt -> (IO ())))

foreign import ccall safe "gtk_range_get_upper_stepper_sensitivity"
  gtk_range_get_upper_stepper_sensitivity :: ((Ptr Range) -> (IO CInt))

foreign import ccall safe "gtk_range_get_min_slider_size"
  gtk_range_get_min_slider_size :: ((Ptr Range) -> (IO CInt))

foreign import ccall safe "gtk_range_get_range_rect"
  gtk_range_get_range_rect :: ((Ptr Range) -> ((Ptr ()) -> (IO ())))

foreign import ccall safe "gtk_range_get_slider_range"
  gtk_range_get_slider_range :: ((Ptr Range) -> ((Ptr CInt) -> ((Ptr CInt) -> (IO ()))))

foreign import ccall safe "gtk_range_get_slider_size_fixed"
  gtk_range_get_slider_size_fixed :: ((Ptr Range) -> (IO CInt))

foreign import ccall safe "gtk_range_set_min_slider_size"
  gtk_range_set_min_slider_size :: ((Ptr Range) -> (CInt -> (IO ())))

foreign import ccall safe "gtk_range_set_slider_size_fixed"
  gtk_range_set_slider_size_fixed :: ((Ptr Range) -> (CInt -> (IO ())))

foreign import ccall unsafe "gtk_sensitivity_type_get_type"
  gtk_sensitivity_type_get_type :: CUInt