{-# LINE 2 "./Graphics/UI/Gtk/Misc/Adjustment.chs" #-}
-- -*-haskell-*-
-- GIMP Toolkit (GTK) Widget Adjustment
--
-- 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)
--
-- A 'Object' representing an adjustable bounded value
--
module Graphics.UI.Gtk.Misc.Adjustment (
-- * Detail
--
-- | The 'Adjustment' object represents a value which has an associated lower
-- and upper bound, together with step and page increments, and a page size. It
-- is used within several Gtk+ widgets, including 'SpinButton', 'Viewport', and
-- 'Range' (which is a base class for 'HScrollbar', 'VScrollbar', 'HScale', and
-- 'VScale').
--
-- The 'Adjustment' object does not update the value itself. Instead it is
-- left up to the owner of the 'Adjustment' to control the value.
--
-- The owner of the 'Adjustment' typically calls the
-- 'adjustmentValueChanged' and 'adjustmentChanged' functions after changing
-- the value and its bounds. This results in the emission of the
-- \"value_changed\" or \"changed\" signal respectively.

-- * Class Hierarchy
-- |
-- @
-- | 'GObject'
-- | +----'Object'
-- | +----Adjustment
-- @

-- * Types
  Adjustment,
  AdjustmentClass,
  castToAdjustment, gTypeAdjustment,
  toAdjustment,

-- * Constructors
  adjustmentNew,

-- * Methods
  adjustmentSetLower,
  adjustmentGetLower,
  adjustmentSetPageIncrement,
  adjustmentGetPageIncrement,
  adjustmentSetPageSize,
  adjustmentGetPageSize,
  adjustmentSetStepIncrement,
  adjustmentGetStepIncrement,
  adjustmentSetUpper,
  adjustmentGetUpper,
  adjustmentSetValue,
  adjustmentGetValue,
  adjustmentClampPage,
  adjustmentAdjChanged,
  adjustmentValueChanged,

-- * Attributes

  adjustmentValue,
  adjustmentLower,
  adjustmentUpper,
  adjustmentStepIncrement,
  adjustmentPageIncrement,
  adjustmentPageSize,


-- * Signals
  onAdjChanged,
  afterAdjChanged,
  onValueChanged,
  afterValueChanged,
  ) 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 103 "./Graphics/UI/Gtk/Misc/Adjustment.chs" #-}
import Graphics.UI.Gtk.Signals
{-# LINE 104 "./Graphics/UI/Gtk/Misc/Adjustment.chs" #-}


{-# LINE 106 "./Graphics/UI/Gtk/Misc/Adjustment.chs" #-}

--------------------
-- Constructors

-- | Creates a new 'Adjustment'.
--
-- The creation function take every value that is contained in the object:
-- @value@ is the initial value and should be between the @upper@ and @lower@
-- bounds of the slider. Clicking on the arrows increases this value by
-- @stepIncrement@. Clicking in the slider advances by @pageIncrement@. The
-- @pageSize@ is needed to determine if the end of the slider is still in the
-- range.
--
adjustmentNew ::
    Double -- ^ @value@ - the initial value.
 -> Double -- ^ @lower@ - the minimum value.
 -> Double -- ^ @upper@ - the maximum value.
 -> Double -- ^ @stepIncrement@ - the step increment.
 -> Double -- ^ @pageIncrement@ - the page increment.
 -> Double -- ^ @pageSize@ - the page size.
 -> IO Adjustment
adjustmentNew :: Double
-> Double -> Double -> Double -> Double -> Double -> IO Adjustment
adjustmentNew Double
value Double
lower Double
upper Double
stepIncrement Double
pageIncrement Double
pageSize =
  (ForeignPtr Adjustment -> Adjustment, FinalizerPtr Adjustment)
-> IO (Ptr Adjustment) -> IO Adjustment
forall obj.
GObjectClass 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
$ (Ptr Adjustment -> Ptr Adjustment)
-> IO (Ptr Adjustment) -> IO (Ptr Adjustment)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Ptr Adjustment -> Ptr Adjustment
forall a b. Ptr a -> Ptr b
castPtr (IO (Ptr Adjustment) -> IO (Ptr Adjustment))
-> IO (Ptr Adjustment) -> IO (Ptr Adjustment)
forall a b. (a -> b) -> a -> b
$
  CDouble
-> CDouble
-> CDouble
-> CDouble
-> CDouble
-> CDouble
-> IO (Ptr Adjustment)
gtk_adjustment_new
{-# LINE 130 "./Graphics/UI/Gtk/Misc/Adjustment.chs" #-}
    (realToFrac value)
    (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
lower)
    (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
upper)
    (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
stepIncrement)
    (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
pageIncrement)
    (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
pageSize)

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

-- | Set the lower value.
adjustmentSetLower :: Adjustment -> Double -> IO ()
adjustmentSetLower :: Adjustment -> Double -> IO ()
adjustmentSetLower = String -> Adjustment -> Double -> IO ()
forall gobj. GObjectClass gobj => String -> gobj -> Double -> IO ()
objectSetPropertyDouble String
"lower"

-- | Retrieve the lower value.
adjustmentGetLower :: Adjustment -> IO Double
adjustmentGetLower :: Adjustment -> IO Double
adjustmentGetLower = String -> Adjustment -> IO Double
forall gobj. GObjectClass gobj => String -> gobj -> IO Double
objectGetPropertyDouble String
"lower"

-- | Set the page increment value.
adjustmentSetPageIncrement :: Adjustment -> Double -> IO ()
adjustmentSetPageIncrement :: Adjustment -> Double -> IO ()
adjustmentSetPageIncrement = String -> Adjustment -> Double -> IO ()
forall gobj. GObjectClass gobj => String -> gobj -> Double -> IO ()
objectSetPropertyDouble String
"page-increment"

-- | Retrieve the pageincrement value.
adjustmentGetPageIncrement :: Adjustment -> IO Double
adjustmentGetPageIncrement :: Adjustment -> IO Double
adjustmentGetPageIncrement = String -> Adjustment -> IO Double
forall gobj. GObjectClass gobj => String -> gobj -> IO Double
objectGetPropertyDouble String
"page-increment"

-- | Set the page size value.
adjustmentSetPageSize :: Adjustment -> Double -> IO ()
adjustmentSetPageSize :: Adjustment -> Double -> IO ()
adjustmentSetPageSize = String -> Adjustment -> Double -> IO ()
forall gobj. GObjectClass gobj => String -> gobj -> Double -> IO ()
objectSetPropertyDouble String
"page_size"

-- | Retrieve the page size value.
adjustmentGetPageSize :: Adjustment -> IO Double
adjustmentGetPageSize :: Adjustment -> IO Double
adjustmentGetPageSize = String -> Adjustment -> IO Double
forall gobj. GObjectClass gobj => String -> gobj -> IO Double
objectGetPropertyDouble String
"page_size"

-- | Set the step-increment value.
adjustmentSetStepIncrement :: Adjustment -> Double -> IO ()
adjustmentSetStepIncrement :: Adjustment -> Double -> IO ()
adjustmentSetStepIncrement = String -> Adjustment -> Double -> IO ()
forall gobj. GObjectClass gobj => String -> gobj -> Double -> IO ()
objectSetPropertyDouble String
"step-increment"

-- | Retrieve the step-increment value.
adjustmentGetStepIncrement :: Adjustment -> IO Double
adjustmentGetStepIncrement :: Adjustment -> IO Double
adjustmentGetStepIncrement = String -> Adjustment -> IO Double
forall gobj. GObjectClass gobj => String -> gobj -> IO Double
objectGetPropertyDouble String
"step-increment"

-- | Set the upper value.
adjustmentSetUpper :: Adjustment -> Double -> IO ()
adjustmentSetUpper :: Adjustment -> Double -> IO ()
adjustmentSetUpper = String -> Adjustment -> Double -> IO ()
forall gobj. GObjectClass gobj => String -> gobj -> Double -> IO ()
objectSetPropertyDouble String
"upper"

-- | Retrieve the upper value.
adjustmentGetUpper :: Adjustment -> IO Double
adjustmentGetUpper :: Adjustment -> IO Double
adjustmentGetUpper = String -> Adjustment -> IO Double
forall gobj. GObjectClass gobj => String -> gobj -> IO Double
objectGetPropertyDouble String
"upper"

-- | Sets the current value of the Adjustment object. The value is clamped to
-- lie between the adjustment's @lower@ and @upper@ values. See 'adjustmentNew'
-- for details of these properties.
--
-- Note that for adjustments which are used in a 'Scrollbar', the effective
-- range of allowed values goes from @lower@ to @upper - page_size@.
--
adjustmentSetValue :: Adjustment -> Double -> IO ()
adjustmentSetValue :: Adjustment -> Double -> IO ()
adjustmentSetValue Adjustment
self Double
value =
  (\(Adjustment ForeignPtr Adjustment
arg1) CDouble
arg2 -> ForeignPtr Adjustment -> (Ptr Adjustment -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Adjustment
arg1 ((Ptr Adjustment -> IO ()) -> IO ())
-> (Ptr Adjustment -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Adjustment
argPtr1 ->Ptr Adjustment -> CDouble -> IO ()
gtk_adjustment_set_value Ptr Adjustment
argPtr1 CDouble
arg2)
{-# LINE 190 "./Graphics/UI/Gtk/Misc/Adjustment.chs" #-}
    self
    (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
value)

-- | Gets the current value of the adjustment. See 'adjustmentSetValue'.
--
adjustmentGetValue :: Adjustment -> IO Double
adjustmentGetValue :: Adjustment -> IO Double
adjustmentGetValue Adjustment
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
$
  (\(Adjustment ForeignPtr Adjustment
arg1) -> ForeignPtr Adjustment
-> (Ptr Adjustment -> IO CDouble) -> IO CDouble
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Adjustment
arg1 ((Ptr Adjustment -> IO CDouble) -> IO CDouble)
-> (Ptr Adjustment -> IO CDouble) -> IO CDouble
forall a b. (a -> b) -> a -> b
$ \Ptr Adjustment
argPtr1 ->Ptr Adjustment -> IO CDouble
gtk_adjustment_get_value Ptr Adjustment
argPtr1)
{-# LINE 199 "./Graphics/UI/Gtk/Misc/Adjustment.chs" #-}
    self

-- | Updates the 'Adjustment' @value@ to ensure that the range between @lower@
-- and @upper@ is in the current page (i.e. between @value@ and @value +
-- pageSize@). If the range is larger than the page size, then only the start
-- of it will be in the current page. A \"changed\" signal will be emitted if
-- the value is changed.
--
adjustmentClampPage :: Adjustment
 -> Double -- ^ @lower@ - the lower value.
 -> Double -- ^ @upper@ - the upper value.
 -> IO ()
adjustmentClampPage :: Adjustment -> Double -> Double -> IO ()
adjustmentClampPage Adjustment
self Double
lower Double
upper =
  (\(Adjustment ForeignPtr Adjustment
arg1) CDouble
arg2 CDouble
arg3 -> ForeignPtr Adjustment -> (Ptr Adjustment -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Adjustment
arg1 ((Ptr Adjustment -> IO ()) -> IO ())
-> (Ptr Adjustment -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Adjustment
argPtr1 ->Ptr Adjustment -> CDouble -> CDouble -> IO ()
gtk_adjustment_clamp_page Ptr Adjustment
argPtr1 CDouble
arg2 CDouble
arg3)
{-# LINE 213 "./Graphics/UI/Gtk/Misc/Adjustment.chs" #-}
    self
    (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
lower)
    (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
upper)

-- | Emit the 'onAdjChanged' signal.
--
adjustmentAdjChanged :: Adjustment -> IO ()
adjustmentAdjChanged :: Adjustment -> IO ()
adjustmentAdjChanged = (\(Adjustment ForeignPtr Adjustment
arg1) -> ForeignPtr Adjustment -> (Ptr Adjustment -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Adjustment
arg1 ((Ptr Adjustment -> IO ()) -> IO ())
-> (Ptr Adjustment -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Adjustment
argPtr1 ->Ptr Adjustment -> IO ()
gtk_adjustment_changed Ptr Adjustment
argPtr1)
{-# LINE 221 "./Graphics/UI/Gtk/Misc/Adjustment.chs" #-}

-- | Emit the 'onValueChanged' signal.
--
-- * When adjusting the or bounds, this function can be called to enforce a
-- visual update of the containing widget.
--
adjustmentValueChanged :: Adjustment -> IO ()
adjustmentValueChanged :: Adjustment -> IO ()
adjustmentValueChanged = (\(Adjustment ForeignPtr Adjustment
arg1) -> ForeignPtr Adjustment -> (Ptr Adjustment -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Adjustment
arg1 ((Ptr Adjustment -> IO ()) -> IO ())
-> (Ptr Adjustment -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Adjustment
argPtr1 ->Ptr Adjustment -> IO ()
gtk_adjustment_value_changed Ptr Adjustment
argPtr1)
{-# LINE 229 "./Graphics/UI/Gtk/Misc/Adjustment.chs" #-}

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


-- | The value of the adjustment.
--
-- Default value: 0
--
adjustmentValue :: Attr Adjustment Double
adjustmentValue :: Attr Adjustment Double
adjustmentValue = (Adjustment -> IO Double)
-> (Adjustment -> Double -> IO ()) -> Attr Adjustment Double
forall o a b.
(o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newAttr
  Adjustment -> IO Double
adjustmentGetValue
  Adjustment -> Double -> IO ()
adjustmentSetValue

-- | The minimum value of the adjustment.
--
-- Default value: 0
--
adjustmentLower :: Attr Adjustment Double
adjustmentLower :: Attr Adjustment Double
adjustmentLower = String -> Attr Adjustment Double
forall gobj. GObjectClass gobj => String -> Attr gobj Double
newAttrFromDoubleProperty String
"lower"

-- | The maximum value of the adjustment. Note that values will be restricted
-- by @upper - page-size@ if the page-size property is nonzero.
--
-- Default value: 0
--
adjustmentUpper :: Attr Adjustment Double
adjustmentUpper :: Attr Adjustment Double
adjustmentUpper = String -> Attr Adjustment Double
forall gobj. GObjectClass gobj => String -> Attr gobj Double
newAttrFromDoubleProperty String
"upper"

-- | The step increment of the adjustment.
--
-- Default value: 0
--
adjustmentStepIncrement :: Attr Adjustment Double
adjustmentStepIncrement :: Attr Adjustment Double
adjustmentStepIncrement = String -> Attr Adjustment Double
forall gobj. GObjectClass gobj => String -> Attr gobj Double
newAttrFromDoubleProperty String
"step-increment"

-- | The page increment of the adjustment.
--
-- Default value: 0
--
adjustmentPageIncrement :: Attr Adjustment Double
adjustmentPageIncrement :: Attr Adjustment Double
adjustmentPageIncrement = String -> Attr Adjustment Double
forall gobj. GObjectClass gobj => String -> Attr gobj Double
newAttrFromDoubleProperty String
"page-increment"

-- | The page size of the adjustment. Note that the page-size is irrelevant
-- and should be set to zero if the adjustment is used for a simple scalar
-- value, e.g. in a 'SpinButton'.
--
-- Default value: 0
--
adjustmentPageSize :: Attr Adjustment Double
adjustmentPageSize :: Attr Adjustment Double
adjustmentPageSize = String -> Attr Adjustment Double
forall gobj. GObjectClass gobj => String -> Attr gobj Double
newAttrFromDoubleProperty String
"page-size"


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

-- | Emitted when one or more of the 'Adjustment' fields have been changed,
-- other than the value field.
--
onAdjChanged, afterAdjChanged :: Adjustment
 -> IO ()
 -> IO (ConnectId Adjustment)
onAdjChanged :: Adjustment -> IO () -> IO (ConnectId Adjustment)
onAdjChanged = String
-> ConnectAfter -> Adjustment -> IO () -> IO (ConnectId Adjustment)
forall obj.
GObjectClass obj =>
String -> ConnectAfter -> obj -> IO () -> IO (ConnectId obj)
connect_NONE__NONE String
"changed" ConnectAfter
False
afterAdjChanged :: Adjustment -> IO () -> IO (ConnectId Adjustment)
afterAdjChanged = String
-> ConnectAfter -> Adjustment -> IO () -> IO (ConnectId Adjustment)
forall obj.
GObjectClass obj =>
String -> ConnectAfter -> obj -> IO () -> IO (ConnectId obj)
connect_NONE__NONE String
"changed" ConnectAfter
True

-- | Emitted when the 'Adjustment' value field has been changed.
--
onValueChanged, afterValueChanged :: Adjustment
 -> IO ()
 -> IO (ConnectId Adjustment)
onValueChanged :: Adjustment -> IO () -> IO (ConnectId Adjustment)
onValueChanged = String
-> ConnectAfter -> Adjustment -> IO () -> IO (ConnectId Adjustment)
forall obj.
GObjectClass obj =>
String -> ConnectAfter -> obj -> IO () -> IO (ConnectId obj)
connect_NONE__NONE String
"value-changed" ConnectAfter
False
afterValueChanged :: Adjustment -> IO () -> IO (ConnectId Adjustment)
afterValueChanged = String
-> ConnectAfter -> Adjustment -> IO () -> IO (ConnectId Adjustment)
forall obj.
GObjectClass obj =>
String -> ConnectAfter -> obj -> IO () -> IO (ConnectId obj)
connect_NONE__NONE String
"value-changed" ConnectAfter
True

foreign import ccall unsafe "gtk_adjustment_new"
  gtk_adjustment_new :: (CDouble -> (CDouble -> (CDouble -> (CDouble -> (CDouble -> (CDouble -> (IO (Ptr Adjustment))))))))

foreign import ccall safe "gtk_adjustment_set_value"
  gtk_adjustment_set_value :: ((Ptr Adjustment) -> (CDouble -> (IO ())))

foreign import ccall safe "gtk_adjustment_get_value"
  gtk_adjustment_get_value :: ((Ptr Adjustment) -> (IO CDouble))

foreign import ccall safe "gtk_adjustment_clamp_page"
  gtk_adjustment_clamp_page :: ((Ptr Adjustment) -> (CDouble -> (CDouble -> (IO ()))))

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

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