{-# LINE 2 "./Graphics/UI/Gtk/Entry/SpinButton.chs" #-}
-- -*-haskell-*-
-- GIMP Toolkit (GTK) Widget SpinButton
--
-- 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)
--
-- Retrieve an integer or floating-point number from the user
--
module Graphics.UI.Gtk.Entry.SpinButton (
-- * Detail
--
-- | A 'SpinButton' is an ideal way to allow the user to set the value of some
-- attribute. Rather than having to directly type a number into a 'Entry',
-- 'SpinButton' allows the user to click on one of two arrows to increment or
-- decrement the displayed value. A value can still be typed in, with the bonus
-- that it can be checked to ensure it is in a given range.
--
-- The main properties of a 'SpinButton' are through a 'Adjustment'. See the
-- 'Adjustment' section for more details about an adjustment's properties.

-- * Class Hierarchy
-- |
-- @
-- | 'GObject'
-- | +----'Object'
-- | +----'Widget'
-- | +----'Entry'
-- | +----SpinButton
-- @

-- * Types
  SpinButton,
  SpinButtonClass,
  castToSpinButton, gTypeSpinButton,
  toSpinButton,

-- * Constructors
  spinButtonNew,
  spinButtonNewWithRange,

-- * Methods
  spinButtonConfigure,
  spinButtonSetAdjustment,
  spinButtonGetAdjustment,
  spinButtonSetDigits,
  spinButtonGetDigits,
  spinButtonSetIncrements,
  spinButtonGetIncrements,
  spinButtonSetRange,
  spinButtonGetRange,
  spinButtonGetValue,
  spinButtonGetValueAsInt,
  spinButtonSetValue,
  SpinButtonUpdatePolicy(..),
  spinButtonSetUpdatePolicy,
  spinButtonGetUpdatePolicy,
  spinButtonSetNumeric,
  spinButtonGetNumeric,
  SpinType(..),
  spinButtonSpin,
  spinButtonSetWrap,
  spinButtonGetWrap,
  spinButtonSetSnapToTicks,
  spinButtonGetSnapToTicks,
  spinButtonUpdate,

-- * Attributes
  spinButtonAdjustment,
  spinButtonClimbRate,
  spinButtonDigits,
  spinButtonSnapToTicks,
  spinButtonNumeric,
  spinButtonWrap,
  spinButtonUpdatePolicy,
  spinButtonValue,

-- * Signals
  onInput,
  afterInput,
  onOutput,
  afterOutput,
  onValueSpinned,
  afterValueSpinned
  ) 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 112 "./Graphics/UI/Gtk/Entry/SpinButton.chs" #-}
import Graphics.UI.Gtk.Signals
{-# LINE 113 "./Graphics/UI/Gtk/Entry/SpinButton.chs" #-}
import Graphics.UI.Gtk.General.Structs (inputError)
import Graphics.UI.Gtk.General.Enums (SpinButtonUpdatePolicy(..), SpinType(..))


{-# LINE 117 "./Graphics/UI/Gtk/Entry/SpinButton.chs" #-}

--------------------
-- Interfaces

instance EditableClass SpinButton

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

-- | Creates a new 'SpinButton'.
--
spinButtonNew ::
    Adjustment -- ^ @adjustment@ - the 'Adjustment' object that this spin
                  -- button should use.
 -> Double -- ^ @climbRate@ - specifies how much the spin button
                  -- changes when an arrow is clicked on.
 -> Int -- ^ @digits@ - the number of decimal places to display.
 -> IO SpinButton
spinButtonNew :: Adjustment -> Double -> Int -> IO SpinButton
spinButtonNew Adjustment
adjustment Double
climbRate Int
digits =
  (ForeignPtr SpinButton -> SpinButton, FinalizerPtr SpinButton)
-> IO (Ptr SpinButton) -> IO SpinButton
forall obj.
ObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
makeNewObject (ForeignPtr SpinButton -> SpinButton, FinalizerPtr SpinButton)
forall {a}. (ForeignPtr SpinButton -> SpinButton, FinalizerPtr a)
mkSpinButton (IO (Ptr SpinButton) -> IO SpinButton)
-> IO (Ptr SpinButton) -> IO SpinButton
forall a b. (a -> b) -> a -> b
$
  (Ptr Widget -> Ptr SpinButton)
-> IO (Ptr Widget) -> IO (Ptr SpinButton)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Ptr Widget -> Ptr SpinButton
forall a b. Ptr a -> Ptr b
castPtr :: Ptr Widget -> Ptr SpinButton) (IO (Ptr Widget) -> IO (Ptr SpinButton))
-> IO (Ptr Widget) -> IO (Ptr SpinButton)
forall a b. (a -> b) -> a -> b
$
  (\(Adjustment ForeignPtr Adjustment
arg1) CDouble
arg2 CUInt
arg3 -> ForeignPtr Adjustment
-> (Ptr Adjustment -> IO (Ptr Widget)) -> IO (Ptr Widget)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Adjustment
arg1 ((Ptr Adjustment -> IO (Ptr Widget)) -> IO (Ptr Widget))
-> (Ptr Adjustment -> IO (Ptr Widget)) -> IO (Ptr Widget)
forall a b. (a -> b) -> a -> b
$ \Ptr Adjustment
argPtr1 ->Ptr Adjustment -> CDouble -> CUInt -> IO (Ptr Widget)
gtk_spin_button_new Ptr Adjustment
argPtr1 CDouble
arg2 CUInt
arg3)
{-# LINE 139 "./Graphics/UI/Gtk/Entry/SpinButton.chs" #-}
    adjustment
    (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
climbRate)
    (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
digits)

-- | This is a convenience constructor that allows creation of a numeric
-- 'SpinButton' without manually creating an adjustment. The value is initially
-- set to the minimum value and a page increment of 10 * @step@ is the default.
-- The precision of the spin button is equivalent to the precision of @step@.
--
-- Note that the way in which the precision is derived works best if @step@
-- is a power of ten. If the resulting precision is not suitable for your
-- needs, use 'spinButtonSetDigits' to correct it.
--
spinButtonNewWithRange ::
    Double -- ^ @min@ - Minimum allowable value
 -> Double -- ^ @max@ - Maximum allowable value
 -> Double -- ^ @step@ - Increment added or subtracted by spinning the
                  -- widget
 -> IO SpinButton
spinButtonNewWithRange :: Double -> Double -> Double -> IO SpinButton
spinButtonNewWithRange Double
min Double
max Double
step =
  (ForeignPtr SpinButton -> SpinButton, FinalizerPtr SpinButton)
-> IO (Ptr SpinButton) -> IO SpinButton
forall obj.
ObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
makeNewObject (ForeignPtr SpinButton -> SpinButton, FinalizerPtr SpinButton)
forall {a}. (ForeignPtr SpinButton -> SpinButton, FinalizerPtr a)
mkSpinButton (IO (Ptr SpinButton) -> IO SpinButton)
-> IO (Ptr SpinButton) -> IO SpinButton
forall a b. (a -> b) -> a -> b
$
  (Ptr Widget -> Ptr SpinButton)
-> IO (Ptr Widget) -> IO (Ptr SpinButton)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Ptr Widget -> Ptr SpinButton
forall a b. Ptr a -> Ptr b
castPtr :: Ptr Widget -> Ptr SpinButton) (IO (Ptr Widget) -> IO (Ptr SpinButton))
-> IO (Ptr Widget) -> IO (Ptr SpinButton)
forall a b. (a -> b) -> a -> b
$
  CDouble -> CDouble -> CDouble -> IO (Ptr Widget)
gtk_spin_button_new_with_range
{-# LINE 162 "./Graphics/UI/Gtk/Entry/SpinButton.chs" #-}
    (realToFrac min)
    (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
max)
    (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
step)

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

-- | Changes the properties of an existing spin button. The adjustment, climb
-- rate, and number of decimal places are all changed accordingly, after this
-- function call.
--
spinButtonConfigure :: SpinButtonClass self => self
 -> Adjustment -- ^ @adjustment@ - a 'Adjustment'.
 -> Double -- ^ @climbRate@ - the new climb rate.
 -> Int -- ^ @digits@ - the number of decimal places to display in the
               -- spin button.
 -> IO ()
spinButtonConfigure :: forall self.
SpinButtonClass self =>
self -> Adjustment -> Double -> Int -> IO ()
spinButtonConfigure self
self Adjustment
adjustment Double
climbRate Int
digits =
  (\(SpinButton ForeignPtr SpinButton
arg1) (Adjustment ForeignPtr Adjustment
arg2) CDouble
arg3 CUInt
arg4 -> ForeignPtr SpinButton -> (Ptr SpinButton -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr SpinButton
arg1 ((Ptr SpinButton -> IO ()) -> IO ())
-> (Ptr SpinButton -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr SpinButton
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 SpinButton -> Ptr Adjustment -> CDouble -> CUInt -> IO ()
gtk_spin_button_configure Ptr SpinButton
argPtr1 Ptr Adjustment
argPtr2 CDouble
arg3 CUInt
arg4)
{-# LINE 181 "./Graphics/UI/Gtk/Entry/SpinButton.chs" #-}
    (toSpinButton self)
    Adjustment
adjustment
    (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
climbRate)
    (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
digits)

-- | Replaces the 'Adjustment' associated with the spin button.
--
spinButtonSetAdjustment :: SpinButtonClass self => self
 -> Adjustment -- ^ @adjustment@ - a 'Adjustment' to replace the existing
               -- adjustment
 -> IO ()
spinButtonSetAdjustment :: forall self. SpinButtonClass self => self -> Adjustment -> IO ()
spinButtonSetAdjustment self
self Adjustment
adjustment =
  (\(SpinButton ForeignPtr SpinButton
arg1) (Adjustment ForeignPtr Adjustment
arg2) -> ForeignPtr SpinButton -> (Ptr SpinButton -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr SpinButton
arg1 ((Ptr SpinButton -> IO ()) -> IO ())
-> (Ptr SpinButton -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr SpinButton
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 SpinButton -> Ptr Adjustment -> IO ()
gtk_spin_button_set_adjustment Ptr SpinButton
argPtr1 Ptr Adjustment
argPtr2)
{-# LINE 194 "./Graphics/UI/Gtk/Entry/SpinButton.chs" #-}
    (toSpinButton self)
    Adjustment
adjustment

-- | Get the adjustment associated with a 'SpinButton'
--
spinButtonGetAdjustment :: SpinButtonClass self => self
 -> IO Adjustment -- ^ returns the 'Adjustment' of @spinButton@
spinButtonGetAdjustment :: forall self. SpinButtonClass self => self -> IO Adjustment
spinButtonGetAdjustment 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
$
  (\(SpinButton ForeignPtr SpinButton
arg1) -> ForeignPtr SpinButton
-> (Ptr SpinButton -> IO (Ptr Adjustment)) -> IO (Ptr Adjustment)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr SpinButton
arg1 ((Ptr SpinButton -> IO (Ptr Adjustment)) -> IO (Ptr Adjustment))
-> (Ptr SpinButton -> IO (Ptr Adjustment)) -> IO (Ptr Adjustment)
forall a b. (a -> b) -> a -> b
$ \Ptr SpinButton
argPtr1 ->Ptr SpinButton -> IO (Ptr Adjustment)
gtk_spin_button_get_adjustment Ptr SpinButton
argPtr1)
{-# LINE 204 "./Graphics/UI/Gtk/Entry/SpinButton.chs" #-}
    (toSpinButton self)

-- | Set the precision to be displayed by @spinButton@. Up to 20 digit
-- precision is allowed.
--
spinButtonSetDigits :: SpinButtonClass self => self
 -> Int -- ^ @digits@ - the number of digits after the decimal point to be
          -- displayed for the spin button's value
 -> IO ()
spinButtonSetDigits :: forall self. SpinButtonClass self => self -> Int -> IO ()
spinButtonSetDigits self
self Int
digits =
  (\(SpinButton ForeignPtr SpinButton
arg1) CUInt
arg2 -> ForeignPtr SpinButton -> (Ptr SpinButton -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr SpinButton
arg1 ((Ptr SpinButton -> IO ()) -> IO ())
-> (Ptr SpinButton -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr SpinButton
argPtr1 ->Ptr SpinButton -> CUInt -> IO ()
gtk_spin_button_set_digits Ptr SpinButton
argPtr1 CUInt
arg2)
{-# LINE 215 "./Graphics/UI/Gtk/Entry/SpinButton.chs" #-}
    (toSpinButton self)
    (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
digits)

-- | Fetches the precision of @spinButton@. See 'spinButtonSetDigits'.
--
spinButtonGetDigits :: SpinButtonClass self => self
 -> IO Int -- ^ returns the current precision
spinButtonGetDigits :: forall self. SpinButtonClass self => self -> IO Int
spinButtonGetDigits self
self =
  (CUInt -> Int) -> IO CUInt -> IO Int
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO CUInt -> IO Int) -> IO CUInt -> IO Int
forall a b. (a -> b) -> a -> b
$
  (\(SpinButton ForeignPtr SpinButton
arg1) -> ForeignPtr SpinButton -> (Ptr SpinButton -> IO CUInt) -> IO CUInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr SpinButton
arg1 ((Ptr SpinButton -> IO CUInt) -> IO CUInt)
-> (Ptr SpinButton -> IO CUInt) -> IO CUInt
forall a b. (a -> b) -> a -> b
$ \Ptr SpinButton
argPtr1 ->Ptr SpinButton -> IO CUInt
gtk_spin_button_get_digits Ptr SpinButton
argPtr1)
{-# LINE 225 "./Graphics/UI/Gtk/Entry/SpinButton.chs" #-}
    (toSpinButton self)

-- | Sets the step and page increments for the spin button. This affects how
-- quickly the value changes when the spin button's arrows are activated.
--
spinButtonSetIncrements :: SpinButtonClass self => self
 -> Double -- ^ @step@ - increment applied for a button 1 press.
 -> Double -- ^ @page@ - increment applied for a button 2 press.
 -> IO ()
spinButtonSetIncrements :: forall self.
SpinButtonClass self =>
self -> Double -> Double -> IO ()
spinButtonSetIncrements self
self Double
step Double
page =
  (\(SpinButton ForeignPtr SpinButton
arg1) CDouble
arg2 CDouble
arg3 -> ForeignPtr SpinButton -> (Ptr SpinButton -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr SpinButton
arg1 ((Ptr SpinButton -> IO ()) -> IO ())
-> (Ptr SpinButton -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr SpinButton
argPtr1 ->Ptr SpinButton -> CDouble -> CDouble -> IO ()
gtk_spin_button_set_increments Ptr SpinButton
argPtr1 CDouble
arg2 CDouble
arg3)
{-# LINE 236 "./Graphics/UI/Gtk/Entry/SpinButton.chs" #-}
    (toSpinButton 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)

-- | Gets the current step and page the increments used by the spin button. See
-- 'spinButtonSetIncrements'.
--
spinButtonGetIncrements :: SpinButtonClass self => self
 -> IO (Double, Double) -- ^ @(step, page)@ - step increment and page increment
spinButtonGetIncrements :: forall self. SpinButtonClass self => self -> IO (Double, Double)
spinButtonGetIncrements self
self =
  (Ptr CDouble -> IO (Double, Double)) -> IO (Double, Double)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CDouble -> IO (Double, Double)) -> IO (Double, Double))
-> (Ptr CDouble -> IO (Double, Double)) -> IO (Double, Double)
forall a b. (a -> b) -> a -> b
$ \Ptr CDouble
stepPtr ->
  (Ptr CDouble -> IO (Double, Double)) -> IO (Double, Double)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CDouble -> IO (Double, Double)) -> IO (Double, Double))
-> (Ptr CDouble -> IO (Double, Double)) -> IO (Double, Double)
forall a b. (a -> b) -> a -> b
$ \Ptr CDouble
pagePtr -> do
  (\(SpinButton ForeignPtr SpinButton
arg1) Ptr CDouble
arg2 Ptr CDouble
arg3 -> ForeignPtr SpinButton -> (Ptr SpinButton -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr SpinButton
arg1 ((Ptr SpinButton -> IO ()) -> IO ())
-> (Ptr SpinButton -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr SpinButton
argPtr1 ->Ptr SpinButton -> Ptr CDouble -> Ptr CDouble -> IO ()
gtk_spin_button_get_increments Ptr SpinButton
argPtr1 Ptr CDouble
arg2 Ptr CDouble
arg3)
{-# LINE 249 "./Graphics/UI/Gtk/Entry/SpinButton.chs" #-}
    (toSpinButton self)
    Ptr CDouble
stepPtr
    Ptr CDouble
pagePtr
  CDouble
step <- Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek Ptr CDouble
stepPtr
  CDouble
page <- Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek Ptr CDouble
pagePtr
  (Double, Double) -> IO (Double, Double)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
step, CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
page)

-- | Sets the minimum and maximum allowable values for the spin button
--
spinButtonSetRange :: SpinButtonClass self => self
 -> Double -- ^ @min@ - minimum allowable value
 -> Double -- ^ @max@ - maximum allowable value
 -> IO ()
spinButtonSetRange :: forall self.
SpinButtonClass self =>
self -> Double -> Double -> IO ()
spinButtonSetRange self
self Double
min Double
max =
  (\(SpinButton ForeignPtr SpinButton
arg1) CDouble
arg2 CDouble
arg3 -> ForeignPtr SpinButton -> (Ptr SpinButton -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr SpinButton
arg1 ((Ptr SpinButton -> IO ()) -> IO ())
-> (Ptr SpinButton -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr SpinButton
argPtr1 ->Ptr SpinButton -> CDouble -> CDouble -> IO ()
gtk_spin_button_set_range Ptr SpinButton
argPtr1 CDouble
arg2 CDouble
arg3)
{-# LINE 264 "./Graphics/UI/Gtk/Entry/SpinButton.chs" #-}
    (toSpinButton 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)

-- | Gets the range allowed for the spin button. See 'spinButtonSetRange'.
--
spinButtonGetRange :: SpinButtonClass self => self
 -> IO (Double, Double) -- ^ @(min, max)@ - minimum and maximum allowed value
spinButtonGetRange :: forall self. SpinButtonClass self => self -> IO (Double, Double)
spinButtonGetRange self
self =
  (Ptr CDouble -> IO (Double, Double)) -> IO (Double, Double)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CDouble -> IO (Double, Double)) -> IO (Double, Double))
-> (Ptr CDouble -> IO (Double, Double)) -> IO (Double, Double)
forall a b. (a -> b) -> a -> b
$ \Ptr CDouble
minPtr ->
  (Ptr CDouble -> IO (Double, Double)) -> IO (Double, Double)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CDouble -> IO (Double, Double)) -> IO (Double, Double))
-> (Ptr CDouble -> IO (Double, Double)) -> IO (Double, Double)
forall a b. (a -> b) -> a -> b
$ \Ptr CDouble
maxPtr -> do
  (\(SpinButton ForeignPtr SpinButton
arg1) Ptr CDouble
arg2 Ptr CDouble
arg3 -> ForeignPtr SpinButton -> (Ptr SpinButton -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr SpinButton
arg1 ((Ptr SpinButton -> IO ()) -> IO ())
-> (Ptr SpinButton -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr SpinButton
argPtr1 ->Ptr SpinButton -> Ptr CDouble -> Ptr CDouble -> IO ()
gtk_spin_button_get_range Ptr SpinButton
argPtr1 Ptr CDouble
arg2 Ptr CDouble
arg3)
{-# LINE 276 "./Graphics/UI/Gtk/Entry/SpinButton.chs" #-}
    (toSpinButton self)
    Ptr CDouble
minPtr
    Ptr CDouble
maxPtr
  CDouble
min <- Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek Ptr CDouble
minPtr
  CDouble
max <- Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek Ptr CDouble
maxPtr
  (Double, Double) -> IO (Double, Double)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
min, CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
max)

-- | Get the value of the spin button as a floating point value.
--
spinButtonGetValue :: SpinButtonClass self => self -> IO Double
spinButtonGetValue :: forall self. SpinButtonClass self => self -> IO Double
spinButtonGetValue 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
$
  (\(SpinButton ForeignPtr SpinButton
arg1) -> ForeignPtr SpinButton
-> (Ptr SpinButton -> IO CDouble) -> IO CDouble
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr SpinButton
arg1 ((Ptr SpinButton -> IO CDouble) -> IO CDouble)
-> (Ptr SpinButton -> IO CDouble) -> IO CDouble
forall a b. (a -> b) -> a -> b
$ \Ptr SpinButton
argPtr1 ->Ptr SpinButton -> IO CDouble
gtk_spin_button_get_value Ptr SpinButton
argPtr1)
{-# LINE 289 "./Graphics/UI/Gtk/Entry/SpinButton.chs" #-}
    (toSpinButton self)

-- | Get the value of the spin button as an integral value.
--
spinButtonGetValueAsInt :: SpinButtonClass self => self -> IO Int
spinButtonGetValueAsInt :: forall self. SpinButtonClass self => self -> IO Int
spinButtonGetValueAsInt self
self =
  (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
$
  (\(SpinButton ForeignPtr SpinButton
arg1) -> ForeignPtr SpinButton -> (Ptr SpinButton -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr SpinButton
arg1 ((Ptr SpinButton -> IO CInt) -> IO CInt)
-> (Ptr SpinButton -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr SpinButton
argPtr1 ->Ptr SpinButton -> IO CInt
gtk_spin_button_get_value_as_int Ptr SpinButton
argPtr1)
{-# LINE 297 "./Graphics/UI/Gtk/Entry/SpinButton.chs" #-}
    (toSpinButton self)

-- | Set the value of the spin button.
--
spinButtonSetValue :: SpinButtonClass self => self -> Double -> IO ()
spinButtonSetValue :: forall self. SpinButtonClass self => self -> Double -> IO ()
spinButtonSetValue self
self Double
value =
  (\(SpinButton ForeignPtr SpinButton
arg1) CDouble
arg2 -> ForeignPtr SpinButton -> (Ptr SpinButton -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr SpinButton
arg1 ((Ptr SpinButton -> IO ()) -> IO ())
-> (Ptr SpinButton -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr SpinButton
argPtr1 ->Ptr SpinButton -> CDouble -> IO ()
gtk_spin_button_set_value Ptr SpinButton
argPtr1 CDouble
arg2)
{-# LINE 304 "./Graphics/UI/Gtk/Entry/SpinButton.chs" #-}
    (toSpinButton self)
    (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
value)

-- | Sets the update behavior of a spin button. This determines whether the
-- spin button is always updated or only when a valid value is set.
--
spinButtonSetUpdatePolicy :: SpinButtonClass self => self
 -> SpinButtonUpdatePolicy -- ^ @policy@ - a 'SpinButtonUpdatePolicy' value
 -> IO ()
spinButtonSetUpdatePolicy :: forall self.
SpinButtonClass self =>
self -> SpinButtonUpdatePolicy -> IO ()
spinButtonSetUpdatePolicy self
self SpinButtonUpdatePolicy
policy =
  (\(SpinButton ForeignPtr SpinButton
arg1) CInt
arg2 -> ForeignPtr SpinButton -> (Ptr SpinButton -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr SpinButton
arg1 ((Ptr SpinButton -> IO ()) -> IO ())
-> (Ptr SpinButton -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr SpinButton
argPtr1 ->Ptr SpinButton -> CInt -> IO ()
gtk_spin_button_set_update_policy Ptr SpinButton
argPtr1 CInt
arg2)
{-# LINE 315 "./Graphics/UI/Gtk/Entry/SpinButton.chs" #-}
    (toSpinButton self)
    ((Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt)
-> (SpinButtonUpdatePolicy -> Int)
-> SpinButtonUpdatePolicy
-> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SpinButtonUpdatePolicy -> Int
forall a. Enum a => a -> Int
fromEnum) SpinButtonUpdatePolicy
policy)

-- | Gets the update behavior of a spin button. See
-- 'spinButtonSetUpdatePolicy'.
--
spinButtonGetUpdatePolicy :: SpinButtonClass self => self
 -> IO SpinButtonUpdatePolicy -- ^ returns the current update policy
spinButtonGetUpdatePolicy :: forall self.
SpinButtonClass self =>
self -> IO SpinButtonUpdatePolicy
spinButtonGetUpdatePolicy self
self =
  (CInt -> SpinButtonUpdatePolicy)
-> IO CInt -> IO SpinButtonUpdatePolicy
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Int -> SpinButtonUpdatePolicy
forall a. Enum a => Int -> a
toEnum (Int -> SpinButtonUpdatePolicy)
-> (CInt -> Int) -> CInt -> SpinButtonUpdatePolicy
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 SpinButtonUpdatePolicy)
-> IO CInt -> IO SpinButtonUpdatePolicy
forall a b. (a -> b) -> a -> b
$
  (\(SpinButton ForeignPtr SpinButton
arg1) -> ForeignPtr SpinButton -> (Ptr SpinButton -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr SpinButton
arg1 ((Ptr SpinButton -> IO CInt) -> IO CInt)
-> (Ptr SpinButton -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr SpinButton
argPtr1 ->Ptr SpinButton -> IO CInt
gtk_spin_button_get_update_policy Ptr SpinButton
argPtr1)
{-# LINE 326 "./Graphics/UI/Gtk/Entry/SpinButton.chs" #-}
    (toSpinButton self)

-- | Sets the flag that determines if non-numeric text can be typed into the
-- spin button.
--
spinButtonSetNumeric :: SpinButtonClass self => self
 -> Bool -- ^ @numeric@ - flag indicating if only numeric entry is allowed.
 -> IO ()
spinButtonSetNumeric :: forall self. SpinButtonClass self => self -> Bool -> IO ()
spinButtonSetNumeric self
self Bool
numeric =
  (\(SpinButton ForeignPtr SpinButton
arg1) CInt
arg2 -> ForeignPtr SpinButton -> (Ptr SpinButton -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr SpinButton
arg1 ((Ptr SpinButton -> IO ()) -> IO ())
-> (Ptr SpinButton -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr SpinButton
argPtr1 ->Ptr SpinButton -> CInt -> IO ()
gtk_spin_button_set_numeric Ptr SpinButton
argPtr1 CInt
arg2)
{-# LINE 336 "./Graphics/UI/Gtk/Entry/SpinButton.chs" #-}
    (toSpinButton self)
    (Bool -> CInt
forall a. Num a => Bool -> a
fromBool Bool
numeric)

-- | Returns whether non-numeric text can be typed into the spin button. See
-- 'spinButtonSetNumeric'.
--
spinButtonGetNumeric :: SpinButtonClass self => self
 -> IO Bool -- ^ returns @True@ if only numeric text can be entered
spinButtonGetNumeric :: forall self. SpinButtonClass self => self -> IO Bool
spinButtonGetNumeric 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
$
  (\(SpinButton ForeignPtr SpinButton
arg1) -> ForeignPtr SpinButton -> (Ptr SpinButton -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr SpinButton
arg1 ((Ptr SpinButton -> IO CInt) -> IO CInt)
-> (Ptr SpinButton -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr SpinButton
argPtr1 ->Ptr SpinButton -> IO CInt
gtk_spin_button_get_numeric Ptr SpinButton
argPtr1)
{-# LINE 347 "./Graphics/UI/Gtk/Entry/SpinButton.chs" #-}
    (toSpinButton self)

-- | Increment or decrement a spin button's value in a specified direction by
-- a specified amount.
--
spinButtonSpin :: SpinButtonClass self => self
 -> SpinType -- ^ @direction@ - a 'SpinType' indicating the direction to spin.
 -> Double -- ^ @increment@ - step increment to apply in the specified
             -- direction.
 -> IO ()
spinButtonSpin :: forall self.
SpinButtonClass self =>
self -> SpinType -> Double -> IO ()
spinButtonSpin self
self SpinType
direction Double
increment =
  (\(SpinButton ForeignPtr SpinButton
arg1) CInt
arg2 CDouble
arg3 -> ForeignPtr SpinButton -> (Ptr SpinButton -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr SpinButton
arg1 ((Ptr SpinButton -> IO ()) -> IO ())
-> (Ptr SpinButton -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr SpinButton
argPtr1 ->Ptr SpinButton -> CInt -> CDouble -> IO ()
gtk_spin_button_spin Ptr SpinButton
argPtr1 CInt
arg2 CDouble
arg3)
{-# LINE 359 "./Graphics/UI/Gtk/Entry/SpinButton.chs" #-}
    (toSpinButton self)
    ((Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (SpinType -> Int) -> SpinType -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SpinType -> Int
forall a. Enum a => a -> Int
fromEnum) SpinType
direction)
    (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
increment)

-- | Sets the flag that determines if a spin button value wraps around to the
-- opposite limit when the upper or lower limit of the range is exceeded.
--
spinButtonSetWrap :: SpinButtonClass self => self
 -> Bool -- ^ @wrap@ - a flag indicating if wrapping behavior is performed.
 -> IO ()
spinButtonSetWrap :: forall self. SpinButtonClass self => self -> Bool -> IO ()
spinButtonSetWrap self
self Bool
wrap =
  (\(SpinButton ForeignPtr SpinButton
arg1) CInt
arg2 -> ForeignPtr SpinButton -> (Ptr SpinButton -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr SpinButton
arg1 ((Ptr SpinButton -> IO ()) -> IO ())
-> (Ptr SpinButton -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr SpinButton
argPtr1 ->Ptr SpinButton -> CInt -> IO ()
gtk_spin_button_set_wrap Ptr SpinButton
argPtr1 CInt
arg2)
{-# LINE 371 "./Graphics/UI/Gtk/Entry/SpinButton.chs" #-}
    (toSpinButton self)
    (Bool -> CInt
forall a. Num a => Bool -> a
fromBool Bool
wrap)

-- | Returns whether the spin button's value wraps around to the opposite
-- limit when the upper or lower limit of the range is exceeded. See
-- 'spinButtonSetWrap'.
--
spinButtonGetWrap :: SpinButtonClass self => self
 -> IO Bool -- ^ returns @True@ if the spin button wraps around
spinButtonGetWrap :: forall self. SpinButtonClass self => self -> IO Bool
spinButtonGetWrap 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
$
  (\(SpinButton ForeignPtr SpinButton
arg1) -> ForeignPtr SpinButton -> (Ptr SpinButton -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr SpinButton
arg1 ((Ptr SpinButton -> IO CInt) -> IO CInt)
-> (Ptr SpinButton -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr SpinButton
argPtr1 ->Ptr SpinButton -> IO CInt
gtk_spin_button_get_wrap Ptr SpinButton
argPtr1)
{-# LINE 383 "./Graphics/UI/Gtk/Entry/SpinButton.chs" #-}
    (toSpinButton self)

-- | Sets the policy as to whether values are corrected to the nearest step
-- increment when a spin button is activated after providing an invalid value.
--
spinButtonSetSnapToTicks :: SpinButtonClass self => self
 -> Bool -- ^ @snapToTicks@ - a flag indicating if invalid values should be
          -- corrected.
 -> IO ()
spinButtonSetSnapToTicks :: forall self. SpinButtonClass self => self -> Bool -> IO ()
spinButtonSetSnapToTicks self
self Bool
snapToTicks =
  (\(SpinButton ForeignPtr SpinButton
arg1) CInt
arg2 -> ForeignPtr SpinButton -> (Ptr SpinButton -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr SpinButton
arg1 ((Ptr SpinButton -> IO ()) -> IO ())
-> (Ptr SpinButton -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr SpinButton
argPtr1 ->Ptr SpinButton -> CInt -> IO ()
gtk_spin_button_set_snap_to_ticks Ptr SpinButton
argPtr1 CInt
arg2)
{-# LINE 394 "./Graphics/UI/Gtk/Entry/SpinButton.chs" #-}
    (toSpinButton self)
    (Bool -> CInt
forall a. Num a => Bool -> a
fromBool Bool
snapToTicks)

-- | Returns whether the values are corrected to the nearest step. See
-- 'spinButtonSetSnapToTicks'.
--
spinButtonGetSnapToTicks :: SpinButtonClass self => self
 -> IO Bool -- ^ returns @True@ if values are snapped to the nearest step.
spinButtonGetSnapToTicks :: forall self. SpinButtonClass self => self -> IO Bool
spinButtonGetSnapToTicks 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
$
  (\(SpinButton ForeignPtr SpinButton
arg1) -> ForeignPtr SpinButton -> (Ptr SpinButton -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr SpinButton
arg1 ((Ptr SpinButton -> IO CInt) -> IO CInt)
-> (Ptr SpinButton -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr SpinButton
argPtr1 ->Ptr SpinButton -> IO CInt
gtk_spin_button_get_snap_to_ticks Ptr SpinButton
argPtr1)
{-# LINE 405 "./Graphics/UI/Gtk/Entry/SpinButton.chs" #-}
    (toSpinButton self)

-- | Manually force an update of the spin button.
--
spinButtonUpdate :: SpinButtonClass self => self -> IO ()
spinButtonUpdate :: forall self. SpinButtonClass self => self -> IO ()
spinButtonUpdate self
self =
  (\(SpinButton ForeignPtr SpinButton
arg1) -> ForeignPtr SpinButton -> (Ptr SpinButton -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr SpinButton
arg1 ((Ptr SpinButton -> IO ()) -> IO ())
-> (Ptr SpinButton -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr SpinButton
argPtr1 ->Ptr SpinButton -> IO ()
gtk_spin_button_update Ptr SpinButton
argPtr1)
{-# LINE 412 "./Graphics/UI/Gtk/Entry/SpinButton.chs" #-}
    (toSpinButton self)

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

-- | The adjustment that holds the value of the spinbutton.
--
spinButtonAdjustment :: SpinButtonClass self => Attr self Adjustment
spinButtonAdjustment :: forall self. SpinButtonClass self => Attr self Adjustment
spinButtonAdjustment = (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. SpinButtonClass self => self -> IO Adjustment
spinButtonGetAdjustment
  self -> Adjustment -> IO ()
forall self. SpinButtonClass self => self -> Adjustment -> IO ()
spinButtonSetAdjustment

-- | The acceleration rate when you hold down a button.
--
-- Allowed values: >= 0
--
-- Default value: 0
--
spinButtonClimbRate :: SpinButtonClass self => Attr self Double
spinButtonClimbRate :: forall self. SpinButtonClass self => Attr self Double
spinButtonClimbRate = String -> Attr self Double
forall gobj. GObjectClass gobj => String -> Attr gobj Double
newAttrFromDoubleProperty String
"climb-rate"

-- | The number of decimal places to display.
--
-- Allowed values: \<= 20
--
-- Default value: 0
--
spinButtonDigits :: SpinButtonClass self => Attr self Int
spinButtonDigits :: forall self. SpinButtonClass self => Attr self Int
spinButtonDigits = (self -> IO Int)
-> (self -> Int -> IO ()) -> ReadWriteAttr self Int Int
forall o a b.
(o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newAttr
  self -> IO Int
forall self. SpinButtonClass self => self -> IO Int
spinButtonGetDigits
  self -> Int -> IO ()
forall self. SpinButtonClass self => self -> Int -> IO ()
spinButtonSetDigits

-- | Whether erroneous values are automatically changed to a spin button's
-- nearest step increment.
--
-- Default value: @False@
--
spinButtonSnapToTicks :: SpinButtonClass self => Attr self Bool
spinButtonSnapToTicks :: forall self. SpinButtonClass self => Attr self Bool
spinButtonSnapToTicks = (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. SpinButtonClass self => self -> IO Bool
spinButtonGetSnapToTicks
  self -> Bool -> IO ()
forall self. SpinButtonClass self => self -> Bool -> IO ()
spinButtonSetSnapToTicks

-- | Whether non-numeric characters should be ignored.
--
-- Default value: @False@
--
spinButtonNumeric :: SpinButtonClass self => Attr self Bool
spinButtonNumeric :: forall self. SpinButtonClass self => Attr self Bool
spinButtonNumeric = (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. SpinButtonClass self => self -> IO Bool
spinButtonGetNumeric
  self -> Bool -> IO ()
forall self. SpinButtonClass self => self -> Bool -> IO ()
spinButtonSetNumeric

-- | Whether a spin button should wrap upon reaching its limits.
--
-- Default value: @False@
--
spinButtonWrap :: SpinButtonClass self => Attr self Bool
spinButtonWrap :: forall self. SpinButtonClass self => Attr self Bool
spinButtonWrap = (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. SpinButtonClass self => self -> IO Bool
spinButtonGetWrap
  self -> Bool -> IO ()
forall self. SpinButtonClass self => self -> Bool -> IO ()
spinButtonSetWrap

-- | Whether the spin button should update always, or only when the value is
-- legal.
--
-- Default value: 'UpdateAlways'
--
spinButtonUpdatePolicy :: SpinButtonClass self => Attr self SpinButtonUpdatePolicy
spinButtonUpdatePolicy :: forall self.
SpinButtonClass self =>
Attr self SpinButtonUpdatePolicy
spinButtonUpdatePolicy = (self -> IO SpinButtonUpdatePolicy)
-> (self -> SpinButtonUpdatePolicy -> IO ())
-> ReadWriteAttr self SpinButtonUpdatePolicy SpinButtonUpdatePolicy
forall o a b.
(o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newAttr
  self -> IO SpinButtonUpdatePolicy
forall self.
SpinButtonClass self =>
self -> IO SpinButtonUpdatePolicy
spinButtonGetUpdatePolicy
  self -> SpinButtonUpdatePolicy -> IO ()
forall self.
SpinButtonClass self =>
self -> SpinButtonUpdatePolicy -> IO ()
spinButtonSetUpdatePolicy

-- | Reads the current value, or sets a new value.
--
-- Default value: 0
--
spinButtonValue :: SpinButtonClass self => Attr self Double
spinButtonValue :: forall self. SpinButtonClass self => Attr self Double
spinButtonValue = (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. SpinButtonClass self => self -> IO Double
spinButtonGetValue
  self -> Double -> IO ()
forall self. SpinButtonClass self => self -> Double -> IO ()
spinButtonSetValue

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

-- | Install a custom input handler.
--
-- * This signal is called upon each time the value of the SpinButton is set
-- by spinButtonSetValue. The function can return Nothing if the value is no
-- good.
--
onInput, afterInput :: SpinButtonClass sb => sb -> (IO (Maybe Double)) ->
                       IO (ConnectId sb)
onInput :: forall sb.
SpinButtonClass sb =>
sb -> IO (Maybe Double) -> IO (ConnectId sb)
onInput sb
sb IO (Maybe Double)
user = String
-> Bool -> sb -> (Ptr CDouble -> IO Int) -> IO (ConnectId sb)
forall obj a.
GObjectClass obj =>
String -> Bool -> obj -> (Ptr a -> IO Int) -> IO (ConnectId obj)
connect_PTR__INT String
"input" Bool
False sb
sb ((Ptr CDouble -> IO Int) -> IO (ConnectId sb))
-> (Ptr CDouble -> IO Int) -> IO (ConnectId sb)
forall a b. (a -> b) -> a -> b
$ \Ptr CDouble
dPtr -> do
  Maybe Double
mVal <- IO (Maybe Double)
user
  case Maybe Double
mVal of
    (Just Double
val) -> do
      Ptr CDouble -> CDouble -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr CDouble
dPtr ((Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
val)::(CDouble))
      Int -> IO Int
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
0
    Maybe Double
Nothing -> Int -> IO Int
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
inputError)
afterInput :: forall sb.
SpinButtonClass sb =>
sb -> IO (Maybe Double) -> IO (ConnectId sb)
afterInput sb
sb IO (Maybe Double)
user = String
-> Bool -> sb -> (Ptr CDouble -> IO Int) -> IO (ConnectId sb)
forall obj a.
GObjectClass obj =>
String -> Bool -> obj -> (Ptr a -> IO Int) -> IO (ConnectId obj)
connect_PTR__INT String
"input" Bool
True sb
sb ((Ptr CDouble -> IO Int) -> IO (ConnectId sb))
-> (Ptr CDouble -> IO Int) -> IO (ConnectId sb)
forall a b. (a -> b) -> a -> b
$ \Ptr CDouble
dPtr -> do
  Maybe Double
mVal <- IO (Maybe Double)
user
  case Maybe Double
mVal of
    (Just Double
val) -> do
      Ptr CDouble -> CDouble -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr CDouble
dPtr ((Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
val)::(CDouble))
      Int -> IO Int
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
0
    Maybe Double
Nothing -> Int -> IO Int
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
inputError)

-- | Install a custom output handler.
--
-- * This handler makes it possible to query the current value and to render
-- something completely different to the screen using entrySetText. The
-- return value must be False in order to let the default output routine run
-- after this signal returns.
--
onOutput, afterOutput :: SpinButtonClass sb => sb -> IO Bool ->
                         IO (ConnectId sb)
onOutput :: forall sb. SpinButtonClass sb => sb -> IO Bool -> IO (ConnectId sb)
onOutput = String -> Bool -> sb -> IO Bool -> IO (ConnectId sb)
forall obj.
GObjectClass obj =>
String -> Bool -> obj -> IO Bool -> IO (ConnectId obj)
connect_NONE__BOOL String
"output" Bool
False
afterOutput :: forall sb. SpinButtonClass sb => sb -> IO Bool -> IO (ConnectId sb)
afterOutput = String -> Bool -> sb -> IO Bool -> IO (ConnectId sb)
forall obj.
GObjectClass obj =>
String -> Bool -> obj -> IO Bool -> IO (ConnectId obj)
connect_NONE__BOOL String
"output" Bool
True

-- | The value of the spin button has changed.
--
onValueSpinned, afterValueSpinned :: SpinButtonClass sb => sb -> IO () ->
                                     IO (ConnectId sb)
onValueSpinned :: forall sb. SpinButtonClass sb => sb -> IO () -> IO (ConnectId sb)
onValueSpinned = String -> Bool -> sb -> IO () -> IO (ConnectId sb)
forall obj.
GObjectClass obj =>
String -> Bool -> obj -> IO () -> IO (ConnectId obj)
connect_NONE__NONE String
"value-changed" Bool
False
afterValueSpinned :: forall sb. SpinButtonClass sb => sb -> IO () -> IO (ConnectId sb)
afterValueSpinned = String -> Bool -> sb -> IO () -> IO (ConnectId sb)
forall obj.
GObjectClass obj =>
String -> Bool -> obj -> IO () -> IO (ConnectId obj)
connect_NONE__NONE String
"value-changed" Bool
True

foreign import ccall safe "gtk_spin_button_new"
  gtk_spin_button_new :: ((Ptr Adjustment) -> (CDouble -> (CUInt -> (IO (Ptr Widget)))))

foreign import ccall unsafe "gtk_spin_button_new_with_range"
  gtk_spin_button_new_with_range :: (CDouble -> (CDouble -> (CDouble -> (IO (Ptr Widget)))))

foreign import ccall safe "gtk_spin_button_configure"
  gtk_spin_button_configure :: ((Ptr SpinButton) -> ((Ptr Adjustment) -> (CDouble -> (CUInt -> (IO ())))))

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

foreign import ccall unsafe "gtk_spin_button_get_adjustment"
  gtk_spin_button_get_adjustment :: ((Ptr SpinButton) -> (IO (Ptr Adjustment)))

foreign import ccall safe "gtk_spin_button_set_digits"
  gtk_spin_button_set_digits :: ((Ptr SpinButton) -> (CUInt -> (IO ())))

foreign import ccall safe "gtk_spin_button_get_digits"
  gtk_spin_button_get_digits :: ((Ptr SpinButton) -> (IO CUInt))

foreign import ccall safe "gtk_spin_button_set_increments"
  gtk_spin_button_set_increments :: ((Ptr SpinButton) -> (CDouble -> (CDouble -> (IO ()))))

foreign import ccall unsafe "gtk_spin_button_get_increments"
  gtk_spin_button_get_increments :: ((Ptr SpinButton) -> ((Ptr CDouble) -> ((Ptr CDouble) -> (IO ()))))

foreign import ccall safe "gtk_spin_button_set_range"
  gtk_spin_button_set_range :: ((Ptr SpinButton) -> (CDouble -> (CDouble -> (IO ()))))

foreign import ccall unsafe "gtk_spin_button_get_range"
  gtk_spin_button_get_range :: ((Ptr SpinButton) -> ((Ptr CDouble) -> ((Ptr CDouble) -> (IO ()))))

foreign import ccall unsafe "gtk_spin_button_get_value"
  gtk_spin_button_get_value :: ((Ptr SpinButton) -> (IO CDouble))

foreign import ccall unsafe "gtk_spin_button_get_value_as_int"
  gtk_spin_button_get_value_as_int :: ((Ptr SpinButton) -> (IO CInt))

foreign import ccall safe "gtk_spin_button_set_value"
  gtk_spin_button_set_value :: ((Ptr SpinButton) -> (CDouble -> (IO ())))

foreign import ccall safe "gtk_spin_button_set_update_policy"
  gtk_spin_button_set_update_policy :: ((Ptr SpinButton) -> (CInt -> (IO ())))

foreign import ccall unsafe "gtk_spin_button_get_update_policy"
  gtk_spin_button_get_update_policy :: ((Ptr SpinButton) -> (IO CInt))

foreign import ccall safe "gtk_spin_button_set_numeric"
  gtk_spin_button_set_numeric :: ((Ptr SpinButton) -> (CInt -> (IO ())))

foreign import ccall unsafe "gtk_spin_button_get_numeric"
  gtk_spin_button_get_numeric :: ((Ptr SpinButton) -> (IO CInt))

foreign import ccall safe "gtk_spin_button_spin"
  gtk_spin_button_spin :: ((Ptr SpinButton) -> (CInt -> (CDouble -> (IO ()))))

foreign import ccall safe "gtk_spin_button_set_wrap"
  gtk_spin_button_set_wrap :: ((Ptr SpinButton) -> (CInt -> (IO ())))

foreign import ccall safe "gtk_spin_button_get_wrap"
  gtk_spin_button_get_wrap :: ((Ptr SpinButton) -> (IO CInt))

foreign import ccall safe "gtk_spin_button_set_snap_to_ticks"
  gtk_spin_button_set_snap_to_ticks :: ((Ptr SpinButton) -> (CInt -> (IO ())))

foreign import ccall unsafe "gtk_spin_button_get_snap_to_ticks"
  gtk_spin_button_get_snap_to_ticks :: ((Ptr SpinButton) -> (IO CInt))

foreign import ccall safe "gtk_spin_button_update"
  gtk_spin_button_update :: ((Ptr SpinButton) -> (IO ()))