{-# LINE 2 "./Graphics/UI/Gtk/Buttons/ScaleButton.chs" #-}
-- -*-haskell-*-
-- GIMP Toolkit (GTK) Widget ScaleButton
--
-- Author : Andy Stewart
--
-- Created: 22 Mar 2010
--
-- Copyright (C) 2010 Andy Stewart
--
-- 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 button which pops up a scale
--
-- * Module available since Gtk+ version 2.12
--
module Graphics.UI.Gtk.Buttons.ScaleButton (

-- * Detail
--
-- | 'ScaleButton' provides a button which pops up a scale widget. This kind
-- of widget is commonly used for volume controls in multimedia applications,
-- and Gtk+ provides a 'VolumeButton' subclass that is tailored for this use
-- case.

-- * Class Hierarchy
--
-- |
-- @
-- | 'GObject'
-- | +----'Object'
-- | +----'Widget'
-- | +----'Container'
-- | +----'Bin'
-- | +----'Button'
-- | +----ScaleButton
-- | +----'VolumeButton'
-- @


-- * Types
  ScaleButton,
  ScaleButtonClass,
  castToScaleButton,
  toScaleButton,

-- * Constructors
  scaleButtonNew,

-- * Methods
  scaleButtonSetIcons,

  scaleButtonGetPopup,
  scaleButtonGetPlusButton,
  scaleButtonGetMinusButton,


-- * Attributes
  scaleButtonValue,
  scaleButtonSize,
  scaleButtonAdjustment,
  scaleButtonIcons,

-- * Signals
  scaleButtonPopdown,
  scaleButtonPopup,
  scaleButtonValueChanged,

  ) where

import Control.Monad (liftM)

import System.Glib.FFI
import System.Glib.UTFString
import System.Glib.Attributes
import System.Glib.Properties
import Graphics.UI.Gtk.Abstract.Object (makeNewObject)
import Graphics.UI.Gtk.General.Structs (IconSize(..))
import Graphics.UI.Gtk.Types
{-# LINE 93 "./Graphics/UI/Gtk/Buttons/ScaleButton.chs" #-}
import Graphics.UI.Gtk.Signals
{-# LINE 94 "./Graphics/UI/Gtk/Buttons/ScaleButton.chs" #-}


{-# LINE 96 "./Graphics/UI/Gtk/Buttons/ScaleButton.chs" #-}


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

-- instance OrientableClass ScaleButton

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

-- | Creates a 'ScaleButton', with a range between @min@ and @max@, with a
-- stepping of @step@.
--
scaleButtonNew :: GlibString string
 => IconSize -- ^ @size@ - a stock icon size
 -> Double -- ^ @min@ - the minimum value of the scale (usually 0)
 -> Double -- ^ @max@ - the maximum value of the scale (usually 100)
 -> Double -- ^ @step@ - the stepping of value when a scroll-wheel event, or
             -- up\/down arrow event occurs (usually 2)
 -> [string] -- ^ @icons@
 -> IO ScaleButton
scaleButtonNew :: forall string.
GlibString string =>
IconSize
-> Double -> Double -> Double -> [string] -> IO ScaleButton
scaleButtonNew IconSize
size Double
min Double
max Double
step [string]
icons =
  (ForeignPtr ScaleButton -> ScaleButton, FinalizerPtr ScaleButton)
-> IO (Ptr ScaleButton) -> IO ScaleButton
forall obj.
GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
makeNewObject (ForeignPtr ScaleButton -> ScaleButton, FinalizerPtr ScaleButton)
forall {a}. (ForeignPtr ScaleButton -> ScaleButton, FinalizerPtr a)
mkScaleButton (IO (Ptr ScaleButton) -> IO ScaleButton)
-> IO (Ptr ScaleButton) -> IO ScaleButton
forall a b. (a -> b) -> a -> b
$
  (Ptr Widget -> Ptr ScaleButton)
-> IO (Ptr Widget) -> IO (Ptr ScaleButton)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Ptr Widget -> Ptr ScaleButton
forall a b. Ptr a -> Ptr b
castPtr :: Ptr Widget -> Ptr ScaleButton) (IO (Ptr Widget) -> IO (Ptr ScaleButton))
-> IO (Ptr Widget) -> IO (Ptr ScaleButton)
forall a b. (a -> b) -> a -> b
$
  [string] -> (Ptr CString -> IO (Ptr Widget)) -> IO (Ptr Widget)
forall s a. GlibString s => [s] -> (Ptr CString -> IO a) -> IO a
withUTFStringArray0 [string]
icons ((Ptr CString -> IO (Ptr Widget)) -> IO (Ptr Widget))
-> (Ptr CString -> IO (Ptr Widget)) -> IO (Ptr Widget)
forall a b. (a -> b) -> a -> b
$ \Ptr CString
iconsPtr ->
  CInt
-> CDouble -> CDouble -> CDouble -> Ptr CString -> IO (Ptr Widget)
gtk_scale_button_new
{-# LINE 122 "./Graphics/UI/Gtk/Buttons/ScaleButton.chs" #-}
    ((fromIntegral . fromEnum) size)
    (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)
    (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
step)
    Ptr CString
iconsPtr

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

-- | Sets the icons to be used by the scale button. For details, see the "icons" property.
scaleButtonSetIcons :: (ScaleButtonClass self, GlibString string) => self
 -> [string] -- ^ @icons@
 -> IO ()
scaleButtonSetIcons :: forall self string.
(ScaleButtonClass self, GlibString string) =>
self -> [string] -> IO ()
scaleButtonSetIcons self
self [string]
icons =
  [string] -> (Ptr CString -> IO ()) -> IO ()
forall s a. GlibString s => [s] -> (Ptr CString -> IO a) -> IO a
withUTFStringArray0 [string]
icons ((Ptr CString -> IO ()) -> IO ())
-> (Ptr CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CString
iconsPtr ->
  (\(ScaleButton ForeignPtr ScaleButton
arg1) Ptr CString
arg2 -> ForeignPtr ScaleButton -> (Ptr ScaleButton -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ScaleButton
arg1 ((Ptr ScaleButton -> IO ()) -> IO ())
-> (Ptr ScaleButton -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr ScaleButton
argPtr1 ->Ptr ScaleButton -> Ptr CString -> IO ()
gtk_scale_button_set_icons Ptr ScaleButton
argPtr1 Ptr CString
arg2)
{-# LINE 138 "./Graphics/UI/Gtk/Buttons/ScaleButton.chs" #-}
    (toScaleButton self)
    Ptr CString
iconsPtr


-- | Retrieves the popup of the 'ScaleButton'.
--
-- * Available since Gtk+ version 2.14
--
scaleButtonGetPopup :: ScaleButtonClass self => self
 -> IO Widget -- ^ returns the popup of the 'ScaleButton'
scaleButtonGetPopup :: forall self. ScaleButtonClass self => self -> IO Widget
scaleButtonGetPopup self
self =
  (ForeignPtr Widget -> Widget, FinalizerPtr Widget)
-> IO (Ptr Widget) -> IO Widget
forall obj.
GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
makeNewObject (ForeignPtr Widget -> Widget, FinalizerPtr Widget)
forall {a}. (ForeignPtr Widget -> Widget, FinalizerPtr a)
mkWidget (IO (Ptr Widget) -> IO Widget) -> IO (Ptr Widget) -> IO Widget
forall a b. (a -> b) -> a -> b
$
  (\(ScaleButton ForeignPtr ScaleButton
arg1) -> ForeignPtr ScaleButton
-> (Ptr ScaleButton -> IO (Ptr Widget)) -> IO (Ptr Widget)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ScaleButton
arg1 ((Ptr ScaleButton -> IO (Ptr Widget)) -> IO (Ptr Widget))
-> (Ptr ScaleButton -> IO (Ptr Widget)) -> IO (Ptr Widget)
forall a b. (a -> b) -> a -> b
$ \Ptr ScaleButton
argPtr1 ->Ptr ScaleButton -> IO (Ptr Widget)
gtk_scale_button_get_popup Ptr ScaleButton
argPtr1)
{-# LINE 151 "./Graphics/UI/Gtk/Buttons/ScaleButton.chs" #-}
    (toScaleButton self)

-- | Retrieves the plus button of the 'ScaleButton'.
--
-- * Available since Gtk+ version 2.14
--
scaleButtonGetPlusButton :: ScaleButtonClass self => self
 -> IO Widget -- ^ returns the plus button of the 'ScaleButton'.
scaleButtonGetPlusButton :: forall self. ScaleButtonClass self => self -> IO Widget
scaleButtonGetPlusButton self
self =
  (ForeignPtr Widget -> Widget, FinalizerPtr Widget)
-> IO (Ptr Widget) -> IO Widget
forall obj.
GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
makeNewObject (ForeignPtr Widget -> Widget, FinalizerPtr Widget)
forall {a}. (ForeignPtr Widget -> Widget, FinalizerPtr a)
mkWidget (IO (Ptr Widget) -> IO Widget) -> IO (Ptr Widget) -> IO Widget
forall a b. (a -> b) -> a -> b
$
  (\(ScaleButton ForeignPtr ScaleButton
arg1) -> ForeignPtr ScaleButton
-> (Ptr ScaleButton -> IO (Ptr Widget)) -> IO (Ptr Widget)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ScaleButton
arg1 ((Ptr ScaleButton -> IO (Ptr Widget)) -> IO (Ptr Widget))
-> (Ptr ScaleButton -> IO (Ptr Widget)) -> IO (Ptr Widget)
forall a b. (a -> b) -> a -> b
$ \Ptr ScaleButton
argPtr1 ->Ptr ScaleButton -> IO (Ptr Widget)
gtk_scale_button_get_plus_button Ptr ScaleButton
argPtr1)
{-# LINE 162 "./Graphics/UI/Gtk/Buttons/ScaleButton.chs" #-}
    (toScaleButton self)

-- | Retrieves the minus button of the 'ScaleButton'.
--
-- * Available since Gtk+ version 2.14
--
scaleButtonGetMinusButton :: ScaleButtonClass self => self
 -> IO Widget -- ^ returns the minus button of the 'ScaleButton'.
scaleButtonGetMinusButton :: forall self. ScaleButtonClass self => self -> IO Widget
scaleButtonGetMinusButton self
self =
  (ForeignPtr Widget -> Widget, FinalizerPtr Widget)
-> IO (Ptr Widget) -> IO Widget
forall obj.
GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
makeNewObject (ForeignPtr Widget -> Widget, FinalizerPtr Widget)
forall {a}. (ForeignPtr Widget -> Widget, FinalizerPtr a)
mkWidget (IO (Ptr Widget) -> IO Widget) -> IO (Ptr Widget) -> IO Widget
forall a b. (a -> b) -> a -> b
$
  (\(ScaleButton ForeignPtr ScaleButton
arg1) -> ForeignPtr ScaleButton
-> (Ptr ScaleButton -> IO (Ptr Widget)) -> IO (Ptr Widget)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ScaleButton
arg1 ((Ptr ScaleButton -> IO (Ptr Widget)) -> IO (Ptr Widget))
-> (Ptr ScaleButton -> IO (Ptr Widget)) -> IO (Ptr Widget)
forall a b. (a -> b) -> a -> b
$ \Ptr ScaleButton
argPtr1 ->Ptr ScaleButton -> IO (Ptr Widget)
gtk_scale_button_get_minus_button Ptr ScaleButton
argPtr1)
{-# LINE 173 "./Graphics/UI/Gtk/Buttons/ScaleButton.chs" #-}
    (toScaleButton self)


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

-- | The value of the scale.
--
-- Default value: 0
scaleButtonValue :: ScaleButtonClass self => Attr self Double
scaleButtonValue :: forall self. ScaleButtonClass self => Attr self Double
scaleButtonValue = String -> Attr self Double
forall gobj. GObjectClass gobj => String -> Attr gobj Double
newAttrFromDoubleProperty String
"value"

-- | The icon size.
--
-- Default value: ''IconSizeSmallToolbar''
scaleButtonSize :: ScaleButtonClass self => Attr self IconSize
scaleButtonSize :: forall self. ScaleButtonClass self => Attr self IconSize
scaleButtonSize = String -> GType -> Attr self IconSize
forall gobj enum.
(GObjectClass gobj, Enum enum) =>
String -> GType -> Attr gobj enum
newAttrFromEnumProperty String
"size"
                    GType
gtk_icon_size_get_type
{-# LINE 191 "./Graphics/UI/Gtk/Buttons/ScaleButton.chs" #-}

-- | The 'Adjustment' that contains the current value of this scale button object.
scaleButtonAdjustment :: ScaleButtonClass self => Attr self Adjustment
scaleButtonAdjustment :: forall self. ScaleButtonClass self => Attr self Adjustment
scaleButtonAdjustment = String -> GType -> ReadWriteAttr self Adjustment Adjustment
forall gobj gobj' gobj''.
(GObjectClass gobj, GObjectClass gobj', GObjectClass gobj'') =>
String -> GType -> ReadWriteAttr gobj gobj' gobj''
newAttrFromObjectProperty String
"adjustment"
                          GType
gtk_adjustment_get_type
{-# LINE 196 "./Graphics/UI/Gtk/Buttons/ScaleButton.chs" #-}

-- | The names of the icons to be used by the scale button. The first item in the array will be used in
-- the button when the current value is the lowest value, the second item for the highest value. All
-- the subsequent icons will be used for all the other values, spread evenly over the range of values.
--
-- If there's only one icon name in the icons array, it will be used for all the values. If only two
-- icon names are in the icons array, the first one will be used for the bottom 50% of the scale, and
-- the second one for the top 50%.
--
-- It is recommended to use at least 3 icons so that the 'ScaleButton' reflects the current value of
-- the scale better for the users.
--
-- Since 2.12
scaleButtonIcons :: (ScaleButtonClass self, GlibString string) => ReadWriteAttr self [string] (Maybe [string])
scaleButtonIcons :: forall self string.
(ScaleButtonClass self, GlibString string) =>
ReadWriteAttr self [string] (Maybe [string])
scaleButtonIcons =
  (self -> IO [string])
-> (self -> Maybe [string] -> IO ())
-> ReadWriteAttr self [string] (Maybe [string])
forall o a b.
(o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newAttr ((Ptr [string] -> IO [string])
-> GType -> String -> self -> IO [string]
forall gobj boxed.
GObjectClass gobj =>
(Ptr boxed -> IO boxed) -> GType -> String -> gobj -> IO boxed
objectGetPropertyBoxedOpaque (Ptr CString -> IO [string]
forall s. GlibString s => Ptr CString -> IO [s]
peekUTFStringArray0 (Ptr CString -> IO [string])
-> (Ptr [string] -> Ptr CString) -> Ptr [string] -> IO [string]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr [string] -> Ptr CString
forall a b. Ptr a -> Ptr b
castPtr) GType
gtype String
"search-path")
          ((Maybe [string] -> (Ptr (Maybe [string]) -> IO ()) -> IO ())
-> GType -> String -> self -> Maybe [string] -> IO ()
forall gobj boxed.
GObjectClass gobj =>
(boxed -> (Ptr boxed -> IO ()) -> IO ())
-> GType -> String -> gobj -> boxed -> IO ()
objectSetPropertyBoxedOpaque (\Maybe [string]
dirs Ptr (Maybe [string]) -> IO ()
f -> ([string] -> (Ptr CString -> IO ()) -> IO ())
-> Maybe [string] -> (Ptr CString -> IO ()) -> IO ()
forall a b c.
(a -> (Ptr b -> IO c) -> IO c)
-> Maybe a -> (Ptr b -> IO c) -> IO c
maybeWith [string] -> (Ptr CString -> IO ()) -> IO ()
forall s a. GlibString s => [s] -> (Ptr CString -> IO a) -> IO a
withUTFStringArray0 Maybe [string]
dirs (Ptr (Maybe [string]) -> IO ()
f (Ptr (Maybe [string]) -> IO ())
-> (Ptr CString -> Ptr (Maybe [string])) -> Ptr CString -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr CString -> Ptr (Maybe [string])
forall a b. Ptr a -> Ptr b
castPtr)) GType
gtype String
"search-path")
  where gtype :: GType
gtype = GType
g_strv_get_type
{-# LINE 214 "./Graphics/UI/Gtk/Buttons/ScaleButton.chs" #-}


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

-- | The 'scaleButtonValueChanged' signal is emitted when the value field has changed.
--
scaleButtonValueChanged :: ScaleButtonClass self => Signal self (Double -> IO ())
scaleButtonValueChanged :: forall self. ScaleButtonClass self => Signal self (Double -> IO ())
scaleButtonValueChanged = (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
"value_changed")

-- | The 'popup' signal is a keybinding signal which gets emitted to popup the scale widget.
--
-- The default bindings for this signal are Space, Enter and Return.
scaleButtonPopup :: ScaleButtonClass self => Signal self (IO ())
scaleButtonPopup :: forall self. ScaleButtonClass self => Signal self (IO ())
scaleButtonPopup = (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
"popup")

-- | The 'popdown' signal is a keybinding signal which gets emitted to popdown the scale widget.
--
-- The default binding for this signal is Escape.
scaleButtonPopdown :: ScaleButtonClass self => Signal self (IO ())
scaleButtonPopdown :: forall self. ScaleButtonClass self => Signal self (IO ())
scaleButtonPopdown = (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
"popdown")

foreign import ccall safe "gtk_scale_button_new"
  gtk_scale_button_new :: (CInt -> (CDouble -> (CDouble -> (CDouble -> ((Ptr (Ptr CChar)) -> (IO (Ptr Widget)))))))

foreign import ccall safe "gtk_scale_button_set_icons"
  gtk_scale_button_set_icons :: ((Ptr ScaleButton) -> ((Ptr (Ptr CChar)) -> (IO ())))

foreign import ccall safe "gtk_scale_button_get_popup"
  gtk_scale_button_get_popup :: ((Ptr ScaleButton) -> (IO (Ptr Widget)))

foreign import ccall safe "gtk_scale_button_get_plus_button"
  gtk_scale_button_get_plus_button :: ((Ptr ScaleButton) -> (IO (Ptr Widget)))

foreign import ccall safe "gtk_scale_button_get_minus_button"
  gtk_scale_button_get_minus_button :: ((Ptr ScaleButton) -> (IO (Ptr Widget)))

foreign import ccall unsafe "gtk_icon_size_get_type"
  gtk_icon_size_get_type :: CUInt

foreign import ccall unsafe "gtk_adjustment_get_type"
  gtk_adjustment_get_type :: CUInt

foreign import ccall safe "g_strv_get_type"
  g_strv_get_type :: CUInt