{-# LINE 2 "./Graphics/UI/Gtk/Buttons/ScaleButton.chs" #-}
module Graphics.UI.Gtk.Buttons.ScaleButton (
ScaleButton,
ScaleButtonClass,
castToScaleButton,
toScaleButton,
scaleButtonNew,
scaleButtonSetIcons,
scaleButtonGetPopup,
scaleButtonGetPlusButton,
scaleButtonGetMinusButton,
scaleButtonValue,
scaleButtonSize,
scaleButtonAdjustment,
scaleButtonIcons,
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" #-}
scaleButtonNew :: GlibString string
=> IconSize
-> Double
-> Double
-> Double
-> [string]
-> 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.
ObjectClass 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
scaleButtonSetIcons :: (ScaleButtonClass self, GlibString string) => self
-> [string]
-> 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
scaleButtonGetPopup :: ScaleButtonClass self => self
-> IO Widget
self
self =
(ForeignPtr Widget -> Widget, FinalizerPtr Widget)
-> IO (Ptr Widget) -> IO Widget
forall obj.
ObjectClass 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)
scaleButtonGetPlusButton :: ScaleButtonClass self => self
-> IO Widget
scaleButtonGetPlusButton :: forall self. ScaleButtonClass self => self -> IO Widget
scaleButtonGetPlusButton self
self =
(ForeignPtr Widget -> Widget, FinalizerPtr Widget)
-> IO (Ptr Widget) -> IO Widget
forall obj.
ObjectClass 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)
scaleButtonGetMinusButton :: ScaleButtonClass self => self
-> IO Widget
scaleButtonGetMinusButton :: forall self. ScaleButtonClass self => self -> IO Widget
scaleButtonGetMinusButton self
self =
(ForeignPtr Widget -> Widget, FinalizerPtr Widget)
-> IO (Ptr Widget) -> IO Widget
forall obj.
ObjectClass 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)
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"
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" #-}
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" #-}
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" #-}
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")
scaleButtonPopup :: ScaleButtonClass self => Signal self (IO ())
= (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")
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"
:: ((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 :: CULong
foreign import ccall unsafe "gtk_adjustment_get_type"
gtk_adjustment_get_type :: CULong
foreign import ccall safe "g_strv_get_type"
g_strv_get_type :: CULong