{-# LINE 2 "./Graphics/UI/Gtk/Buttons/Button.chs" #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LINE 3 "./Graphics/UI/Gtk/Buttons/Button.chs" #-}
module Graphics.UI.Gtk.Buttons.Button (
Button,
ButtonClass,
castToButton, gTypeButton,
toButton,
buttonNew,
buttonNewWithLabel,
buttonNewWithMnemonic,
buttonNewFromStock,
buttonPressed,
buttonReleased,
buttonClicked,
buttonEnter,
buttonLeave,
ReliefStyle(..),
buttonSetRelief,
buttonGetRelief,
buttonSetLabel,
buttonGetLabel,
buttonSetUseStock,
buttonGetUseStock,
buttonSetUseUnderline,
buttonGetUseUnderline,
buttonSetFocusOnClick,
buttonGetFocusOnClick,
buttonSetAlignment,
buttonGetAlignment,
buttonGetImage,
buttonSetImage,
PositionType(..),
buttonSetImagePosition,
buttonGetImagePosition,
buttonGetEventWindow,
buttonLabel,
buttonUseUnderline,
buttonUseStock,
buttonFocusOnClick,
buttonRelief,
buttonXalign,
buttonYalign,
buttonImage,
buttonImagePosition,
buttonActivated,
{-# LINE 138 "./Graphics/UI/Gtk/Buttons/Button.chs" #-}
) 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.Types
{-# LINE 148 "./Graphics/UI/Gtk/Buttons/Button.chs" #-}
import Graphics.UI.Gtk.Signals
{-# LINE 149 "./Graphics/UI/Gtk/Buttons/Button.chs" #-}
import Graphics.UI.Gtk.General.Enums (ReliefStyle(..), PositionType(..))
import Graphics.UI.Gtk.General.StockItems
{-# LINE 153 "./Graphics/UI/Gtk/Buttons/Button.chs" #-}
buttonNew :: IO Button
buttonNew :: IO Button
buttonNew =
(ForeignPtr Button -> Button, FinalizerPtr Button)
-> IO (Ptr Button) -> IO Button
forall obj.
GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
makeNewObject (ForeignPtr Button -> Button, FinalizerPtr Button)
forall {a}. (ForeignPtr Button -> Button, FinalizerPtr a)
mkButton (IO (Ptr Button) -> IO Button) -> IO (Ptr Button) -> IO Button
forall a b. (a -> b) -> a -> b
$
(Ptr Widget -> Ptr Button) -> IO (Ptr Widget) -> IO (Ptr Button)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Ptr Widget -> Ptr Button
forall a b. Ptr a -> Ptr b
castPtr :: Ptr Widget -> Ptr Button) (IO (Ptr Widget) -> IO (Ptr Button))
-> IO (Ptr Widget) -> IO (Ptr Button)
forall a b. (a -> b) -> a -> b
$
IO (Ptr Widget)
gtk_button_new
{-# LINE 165 "./Graphics/UI/Gtk/Buttons/Button.chs" #-}
buttonNewWithLabel :: GlibString string
=> string
-> IO Button
buttonNewWithLabel :: forall string. GlibString string => string -> IO Button
buttonNewWithLabel string
label =
(ForeignPtr Button -> Button, FinalizerPtr Button)
-> IO (Ptr Button) -> IO Button
forall obj.
GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
makeNewObject (ForeignPtr Button -> Button, FinalizerPtr Button)
forall {a}. (ForeignPtr Button -> Button, FinalizerPtr a)
mkButton (IO (Ptr Button) -> IO Button) -> IO (Ptr Button) -> IO Button
forall a b. (a -> b) -> a -> b
$
(Ptr Widget -> Ptr Button) -> IO (Ptr Widget) -> IO (Ptr Button)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Ptr Widget -> Ptr Button
forall a b. Ptr a -> Ptr b
castPtr :: Ptr Widget -> Ptr Button) (IO (Ptr Widget) -> IO (Ptr Button))
-> IO (Ptr Widget) -> IO (Ptr Button)
forall a b. (a -> b) -> a -> b
$
string -> (CString -> IO (Ptr Widget)) -> IO (Ptr Widget)
forall a. string -> (CString -> IO a) -> IO a
forall s a. GlibString s => s -> (CString -> IO a) -> IO a
withUTFString string
label ((CString -> IO (Ptr Widget)) -> IO (Ptr Widget))
-> (CString -> IO (Ptr Widget)) -> IO (Ptr Widget)
forall a b. (a -> b) -> a -> b
$ \CString
labelPtr ->
CString -> IO (Ptr Widget)
gtk_button_new_with_label
{-# LINE 176 "./Graphics/UI/Gtk/Buttons/Button.chs" #-}
labelPtr
buttonNewWithMnemonic :: GlibString string
=> string
-> IO Button
buttonNewWithMnemonic :: forall string. GlibString string => string -> IO Button
buttonNewWithMnemonic string
label =
(ForeignPtr Button -> Button, FinalizerPtr Button)
-> IO (Ptr Button) -> IO Button
forall obj.
GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
makeNewObject (ForeignPtr Button -> Button, FinalizerPtr Button)
forall {a}. (ForeignPtr Button -> Button, FinalizerPtr a)
mkButton (IO (Ptr Button) -> IO Button) -> IO (Ptr Button) -> IO Button
forall a b. (a -> b) -> a -> b
$
(Ptr Widget -> Ptr Button) -> IO (Ptr Widget) -> IO (Ptr Button)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Ptr Widget -> Ptr Button
forall a b. Ptr a -> Ptr b
castPtr :: Ptr Widget -> Ptr Button) (IO (Ptr Widget) -> IO (Ptr Button))
-> IO (Ptr Widget) -> IO (Ptr Button)
forall a b. (a -> b) -> a -> b
$
string -> (CString -> IO (Ptr Widget)) -> IO (Ptr Widget)
forall a. string -> (CString -> IO a) -> IO a
forall s a. GlibString s => s -> (CString -> IO a) -> IO a
withUTFString string
label ((CString -> IO (Ptr Widget)) -> IO (Ptr Widget))
-> (CString -> IO (Ptr Widget)) -> IO (Ptr Widget)
forall a b. (a -> b) -> a -> b
$ \CString
labelPtr ->
CString -> IO (Ptr Widget)
gtk_button_new_with_mnemonic
{-# LINE 193 "./Graphics/UI/Gtk/Buttons/Button.chs" #-}
labelPtr
buttonNewFromStock ::
StockId
-> IO Button
buttonNewFromStock :: StockId -> IO Button
buttonNewFromStock StockId
stockId =
(ForeignPtr Button -> Button, FinalizerPtr Button)
-> IO (Ptr Button) -> IO Button
forall obj.
GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
makeNewObject (ForeignPtr Button -> Button, FinalizerPtr Button)
forall {a}. (ForeignPtr Button -> Button, FinalizerPtr a)
mkButton (IO (Ptr Button) -> IO Button) -> IO (Ptr Button) -> IO Button
forall a b. (a -> b) -> a -> b
$
(Ptr Widget -> Ptr Button) -> IO (Ptr Widget) -> IO (Ptr Button)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Ptr Widget -> Ptr Button
forall a b. Ptr a -> Ptr b
castPtr :: Ptr Widget -> Ptr Button) (IO (Ptr Widget) -> IO (Ptr Button))
-> IO (Ptr Widget) -> IO (Ptr Button)
forall a b. (a -> b) -> a -> b
$
StockId -> (CString -> IO (Ptr Widget)) -> IO (Ptr Widget)
forall s a. GlibString s => s -> (CString -> IO a) -> IO a
forall a. StockId -> (CString -> IO a) -> IO a
withUTFString StockId
stockId ((CString -> IO (Ptr Widget)) -> IO (Ptr Widget))
-> (CString -> IO (Ptr Widget)) -> IO (Ptr Widget)
forall a b. (a -> b) -> a -> b
$ \CString
stockIdPtr ->
String -> IO (Ptr Widget) -> IO (Ptr Widget)
forall a. String -> IO (Ptr a) -> IO (Ptr a)
throwIfNull String
"buttonNewFromStock: Invalid stock identifier." (IO (Ptr Widget) -> IO (Ptr Widget))
-> IO (Ptr Widget) -> IO (Ptr Widget)
forall a b. (a -> b) -> a -> b
$
CString -> IO (Ptr Widget)
gtk_button_new_from_stock
{-# LINE 209 "./Graphics/UI/Gtk/Buttons/Button.chs" #-}
stockIdPtr
buttonPressed :: ButtonClass self => self -> IO ()
buttonPressed :: forall self. ButtonClass self => self -> IO ()
buttonPressed self
self =
(\(Button ForeignPtr Button
arg1) -> ForeignPtr Button -> (Ptr Button -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Button
arg1 ((Ptr Button -> IO ()) -> IO ()) -> (Ptr Button -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Button
argPtr1 ->Ptr Button -> IO ()
gtk_button_pressed Ptr Button
argPtr1)
{-# LINE 219 "./Graphics/UI/Gtk/Buttons/Button.chs" #-}
(toButton self)
buttonReleased :: ButtonClass self => self -> IO ()
buttonReleased :: forall self. ButtonClass self => self -> IO ()
buttonReleased self
self =
(\(Button ForeignPtr Button
arg1) -> ForeignPtr Button -> (Ptr Button -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Button
arg1 ((Ptr Button -> IO ()) -> IO ()) -> (Ptr Button -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Button
argPtr1 ->Ptr Button -> IO ()
gtk_button_released Ptr Button
argPtr1)
{-# LINE 226 "./Graphics/UI/Gtk/Buttons/Button.chs" #-}
(toButton self)
buttonClicked :: ButtonClass self => self -> IO ()
buttonClicked :: forall self. ButtonClass self => self -> IO ()
buttonClicked self
self =
(\(Button ForeignPtr Button
arg1) -> ForeignPtr Button -> (Ptr Button -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Button
arg1 ((Ptr Button -> IO ()) -> IO ()) -> (Ptr Button -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Button
argPtr1 ->Ptr Button -> IO ()
gtk_button_clicked Ptr Button
argPtr1)
{-# LINE 235 "./Graphics/UI/Gtk/Buttons/Button.chs" #-}
(toButton self)
buttonEnter :: ButtonClass self => self -> IO ()
buttonEnter :: forall self. ButtonClass self => self -> IO ()
buttonEnter self
self =
(\(Button ForeignPtr Button
arg1) -> ForeignPtr Button -> (Ptr Button -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Button
arg1 ((Ptr Button -> IO ()) -> IO ()) -> (Ptr Button -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Button
argPtr1 ->Ptr Button -> IO ()
gtk_button_enter Ptr Button
argPtr1)
{-# LINE 242 "./Graphics/UI/Gtk/Buttons/Button.chs" #-}
(toButton self)
buttonLeave :: ButtonClass self => self -> IO ()
buttonLeave :: forall self. ButtonClass self => self -> IO ()
buttonLeave self
self =
(\(Button ForeignPtr Button
arg1) -> ForeignPtr Button -> (Ptr Button -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Button
arg1 ((Ptr Button -> IO ()) -> IO ()) -> (Ptr Button -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Button
argPtr1 ->Ptr Button -> IO ()
gtk_button_leave Ptr Button
argPtr1)
{-# LINE 249 "./Graphics/UI/Gtk/Buttons/Button.chs" #-}
(toButton self)
buttonSetRelief :: ButtonClass self => self
-> ReliefStyle
-> IO ()
buttonSetRelief :: forall self. ButtonClass self => self -> ReliefStyle -> IO ()
buttonSetRelief self
self ReliefStyle
newstyle =
(\(Button ForeignPtr Button
arg1) CInt
arg2 -> ForeignPtr Button -> (Ptr Button -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Button
arg1 ((Ptr Button -> IO ()) -> IO ()) -> (Ptr Button -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Button
argPtr1 ->Ptr Button -> CInt -> IO ()
gtk_button_set_relief Ptr Button
argPtr1 CInt
arg2)
{-# LINE 260 "./Graphics/UI/Gtk/Buttons/Button.chs" #-}
(toButton self)
((Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (ReliefStyle -> Int) -> ReliefStyle -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReliefStyle -> Int
forall a. Enum a => a -> Int
fromEnum) ReliefStyle
newstyle)
buttonGetRelief :: ButtonClass self => self
-> IO ReliefStyle
buttonGetRelief :: forall self. ButtonClass self => self -> IO ReliefStyle
buttonGetRelief self
self =
(CInt -> ReliefStyle) -> IO CInt -> IO ReliefStyle
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Int -> ReliefStyle
forall a. Enum a => Int -> a
toEnum (Int -> ReliefStyle) -> (CInt -> Int) -> CInt -> ReliefStyle
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 ReliefStyle) -> IO CInt -> IO ReliefStyle
forall a b. (a -> b) -> a -> b
$
(\(Button ForeignPtr Button
arg1) -> ForeignPtr Button -> (Ptr Button -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Button
arg1 ((Ptr Button -> IO CInt) -> IO CInt)
-> (Ptr Button -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Button
argPtr1 ->Ptr Button -> IO CInt
gtk_button_get_relief Ptr Button
argPtr1)
{-# LINE 270 "./Graphics/UI/Gtk/Buttons/Button.chs" #-}
(toButton self)
buttonSetLabel :: (ButtonClass self, GlibString string) => self -> string -> IO ()
buttonSetLabel :: forall self string.
(ButtonClass self, GlibString string) =>
self -> string -> IO ()
buttonSetLabel self
self string
label =
string -> (CString -> IO ()) -> IO ()
forall a. string -> (CString -> IO a) -> IO a
forall s a. GlibString s => s -> (CString -> IO a) -> IO a
withUTFString string
label ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
labelPtr ->
(\(Button ForeignPtr Button
arg1) CString
arg2 -> ForeignPtr Button -> (Ptr Button -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Button
arg1 ((Ptr Button -> IO ()) -> IO ()) -> (Ptr Button -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Button
argPtr1 ->Ptr Button -> CString -> IO ()
gtk_button_set_label Ptr Button
argPtr1 CString
arg2)
{-# LINE 281 "./Graphics/UI/Gtk/Buttons/Button.chs" #-}
(toButton self)
CString
labelPtr
buttonGetLabel :: (ButtonClass self, GlibString string) => self -> IO string
buttonGetLabel :: forall self string.
(ButtonClass self, GlibString string) =>
self -> IO string
buttonGetLabel self
self = do
CString
strPtr <- (\(Button ForeignPtr Button
arg1) -> ForeignPtr Button -> (Ptr Button -> IO CString) -> IO CString
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Button
arg1 ((Ptr Button -> IO CString) -> IO CString)
-> (Ptr Button -> IO CString) -> IO CString
forall a b. (a -> b) -> a -> b
$ \Ptr Button
argPtr1 ->Ptr Button -> IO CString
gtk_button_get_label Ptr Button
argPtr1)
{-# LINE 293 "./Graphics/UI/Gtk/Buttons/Button.chs" #-}
(toButton self)
if CString
strPtrCString -> CString -> Bool
forall a. Eq a => a -> a -> Bool
==CString
forall a. Ptr a
nullPtr then string -> IO string
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return string
"" else CString -> IO string
forall s. GlibString s => CString -> IO s
peekUTFString CString
strPtr
buttonSetUseStock :: ButtonClass self => self
-> Bool
-> IO ()
buttonSetUseStock :: forall self. ButtonClass self => self -> Bool -> IO ()
buttonSetUseStock self
self Bool
useStock =
(\(Button ForeignPtr Button
arg1) CInt
arg2 -> ForeignPtr Button -> (Ptr Button -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Button
arg1 ((Ptr Button -> IO ()) -> IO ()) -> (Ptr Button -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Button
argPtr1 ->Ptr Button -> CInt -> IO ()
gtk_button_set_use_stock Ptr Button
argPtr1 CInt
arg2)
{-# LINE 309 "./Graphics/UI/Gtk/Buttons/Button.chs" #-}
(toButton self)
(Bool -> CInt
forall a. Num a => Bool -> a
fromBool Bool
useStock)
buttonGetUseStock :: ButtonClass self => self
-> IO Bool
buttonGetUseStock :: forall self. ButtonClass self => self -> IO Bool
buttonGetUseStock 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
$
(\(Button ForeignPtr Button
arg1) -> ForeignPtr Button -> (Ptr Button -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Button
arg1 ((Ptr Button -> IO CInt) -> IO CInt)
-> (Ptr Button -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Button
argPtr1 ->Ptr Button -> IO CInt
gtk_button_get_use_stock Ptr Button
argPtr1)
{-# LINE 320 "./Graphics/UI/Gtk/Buttons/Button.chs" #-}
(toButton self)
buttonSetUseUnderline :: ButtonClass self => self
-> Bool
-> IO ()
buttonSetUseUnderline :: forall self. ButtonClass self => self -> Bool -> IO ()
buttonSetUseUnderline self
self Bool
useUnderline =
(\(Button ForeignPtr Button
arg1) CInt
arg2 -> ForeignPtr Button -> (Ptr Button -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Button
arg1 ((Ptr Button -> IO ()) -> IO ()) -> (Ptr Button -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Button
argPtr1 ->Ptr Button -> CInt -> IO ()
gtk_button_set_use_underline Ptr Button
argPtr1 CInt
arg2)
{-# LINE 335 "./Graphics/UI/Gtk/Buttons/Button.chs" #-}
(toButton self)
(Bool -> CInt
forall a. Num a => Bool -> a
fromBool Bool
useUnderline)
buttonGetUseUnderline :: ButtonClass self => self
-> IO Bool
buttonGetUseUnderline :: forall self. ButtonClass self => self -> IO Bool
buttonGetUseUnderline 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
$
(\(Button ForeignPtr Button
arg1) -> ForeignPtr Button -> (Ptr Button -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Button
arg1 ((Ptr Button -> IO CInt) -> IO CInt)
-> (Ptr Button -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Button
argPtr1 ->Ptr Button -> IO CInt
gtk_button_get_use_underline Ptr Button
argPtr1)
{-# LINE 347 "./Graphics/UI/Gtk/Buttons/Button.chs" #-}
(toButton self)
buttonSetFocusOnClick :: ButtonClass self => self
-> Bool
-> IO ()
buttonSetFocusOnClick :: forall self. ButtonClass self => self -> Bool -> IO ()
buttonSetFocusOnClick self
self Bool
focusOnClick =
(\(Button ForeignPtr Button
arg1) CInt
arg2 -> ForeignPtr Button -> (Ptr Button -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Button
arg1 ((Ptr Button -> IO ()) -> IO ()) -> (Ptr Button -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Button
argPtr1 ->Ptr Button -> CInt -> IO ()
gtk_button_set_focus_on_click Ptr Button
argPtr1 CInt
arg2)
{-# LINE 363 "./Graphics/UI/Gtk/Buttons/Button.chs" #-}
(toButton self)
(Bool -> CInt
forall a. Num a => Bool -> a
fromBool Bool
focusOnClick)
buttonGetFocusOnClick :: ButtonClass self => self
-> IO Bool
buttonGetFocusOnClick :: forall self. ButtonClass self => self -> IO Bool
buttonGetFocusOnClick 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
$
(\(Button ForeignPtr Button
arg1) -> ForeignPtr Button -> (Ptr Button -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Button
arg1 ((Ptr Button -> IO CInt) -> IO CInt)
-> (Ptr Button -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Button
argPtr1 ->Ptr Button -> IO CInt
gtk_button_get_focus_on_click Ptr Button
argPtr1)
{-# LINE 377 "./Graphics/UI/Gtk/Buttons/Button.chs" #-}
(toButton self)
buttonSetAlignment :: ButtonClass self => self
-> (Float, Float)
-> IO ()
buttonSetAlignment :: forall self. ButtonClass self => self -> (Float, Float) -> IO ()
buttonSetAlignment self
self (Float
xalign, Float
yalign) =
(\(Button ForeignPtr Button
arg1) CFloat
arg2 CFloat
arg3 -> ForeignPtr Button -> (Ptr Button -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Button
arg1 ((Ptr Button -> IO ()) -> IO ()) -> (Ptr Button -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Button
argPtr1 ->Ptr Button -> CFloat -> CFloat -> IO ()
gtk_button_set_alignment Ptr Button
argPtr1 CFloat
arg2 CFloat
arg3)
{-# LINE 392 "./Graphics/UI/Gtk/Buttons/Button.chs" #-}
(toButton self)
(Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
xalign)
(Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
yalign)
buttonGetAlignment :: ButtonClass self => self
-> IO (Float, Float)
buttonGetAlignment :: forall self. ButtonClass self => self -> IO (Float, Float)
buttonGetAlignment self
self =
(Ptr CFloat -> IO (Float, Float)) -> IO (Float, Float)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CFloat -> IO (Float, Float)) -> IO (Float, Float))
-> (Ptr CFloat -> IO (Float, Float)) -> IO (Float, Float)
forall a b. (a -> b) -> a -> b
$ \Ptr CFloat
xalignPtr ->
(Ptr CFloat -> IO (Float, Float)) -> IO (Float, Float)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CFloat -> IO (Float, Float)) -> IO (Float, Float))
-> (Ptr CFloat -> IO (Float, Float)) -> IO (Float, Float)
forall a b. (a -> b) -> a -> b
$ \Ptr CFloat
yalignPtr -> do
(\(Button ForeignPtr Button
arg1) Ptr CFloat
arg2 Ptr CFloat
arg3 -> ForeignPtr Button -> (Ptr Button -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Button
arg1 ((Ptr Button -> IO ()) -> IO ()) -> (Ptr Button -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Button
argPtr1 ->Ptr Button -> Ptr CFloat -> Ptr CFloat -> IO ()
gtk_button_get_alignment Ptr Button
argPtr1 Ptr CFloat
arg2 Ptr CFloat
arg3)
{-# LINE 407 "./Graphics/UI/Gtk/Buttons/Button.chs" #-}
(toButton self)
Ptr CFloat
xalignPtr
Ptr CFloat
yalignPtr
CFloat
xalign <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek Ptr CFloat
xalignPtr
CFloat
yalign <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek Ptr CFloat
yalignPtr
(Float, Float) -> IO (Float, Float)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
xalign, CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
yalign)
buttonGetImage :: ButtonClass self => self
-> IO (Maybe Widget)
buttonGetImage :: forall self. ButtonClass self => self -> IO (Maybe Widget)
buttonGetImage self
self =
(IO (Ptr Widget) -> IO Widget)
-> IO (Ptr Widget) -> IO (Maybe Widget)
forall a. (IO (Ptr a) -> IO a) -> IO (Ptr a) -> IO (Maybe a)
maybeNull ((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 (Maybe Widget))
-> IO (Ptr Widget) -> IO (Maybe Widget)
forall a b. (a -> b) -> a -> b
$
(\(Button ForeignPtr Button
arg1) -> ForeignPtr Button
-> (Ptr Button -> IO (Ptr Widget)) -> IO (Ptr Widget)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Button
arg1 ((Ptr Button -> IO (Ptr Widget)) -> IO (Ptr Widget))
-> (Ptr Button -> IO (Ptr Widget)) -> IO (Ptr Widget)
forall a b. (a -> b) -> a -> b
$ \Ptr Button
argPtr1 ->Ptr Button -> IO (Ptr Widget)
gtk_button_get_image Ptr Button
argPtr1)
{-# LINE 427 "./Graphics/UI/Gtk/Buttons/Button.chs" #-}
(toButton self)
buttonSetImage :: (ButtonClass self, WidgetClass image) => self
-> image
-> IO ()
buttonSetImage :: forall self image.
(ButtonClass self, WidgetClass image) =>
self -> image -> IO ()
buttonSetImage self
self image
image =
(\(Button ForeignPtr Button
arg1) (Widget ForeignPtr Widget
arg2) -> ForeignPtr Button -> (Ptr Button -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Button
arg1 ((Ptr Button -> IO ()) -> IO ()) -> (Ptr Button -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Button
argPtr1 ->ForeignPtr Widget -> (Ptr Widget -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Widget
arg2 ((Ptr Widget -> IO ()) -> IO ()) -> (Ptr Widget -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Widget
argPtr2 ->Ptr Button -> Ptr Widget -> IO ()
gtk_button_set_image Ptr Button
argPtr1 Ptr Widget
argPtr2)
{-# LINE 439 "./Graphics/UI/Gtk/Buttons/Button.chs" #-}
(toButton self)
(image -> Widget
forall o. WidgetClass o => o -> Widget
toWidget image
image)
buttonSetImagePosition :: ButtonClass self => self
-> PositionType
-> IO ()
buttonSetImagePosition :: forall self. ButtonClass self => self -> PositionType -> IO ()
buttonSetImagePosition self
self PositionType
position =
(\(Button ForeignPtr Button
arg1) CInt
arg2 -> ForeignPtr Button -> (Ptr Button -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Button
arg1 ((Ptr Button -> IO ()) -> IO ()) -> (Ptr Button -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Button
argPtr1 ->Ptr Button -> CInt -> IO ()
gtk_button_set_image_position Ptr Button
argPtr1 CInt
arg2)
{-# LINE 454 "./Graphics/UI/Gtk/Buttons/Button.chs" #-}
(toButton self)
((Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (PositionType -> Int) -> PositionType -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PositionType -> Int
forall a. Enum a => a -> Int
fromEnum) PositionType
position)
buttonGetImagePosition :: ButtonClass self => self
-> IO PositionType
buttonGetImagePosition :: forall self. ButtonClass self => self -> IO PositionType
buttonGetImagePosition self
self =
(CInt -> PositionType) -> IO CInt -> IO PositionType
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Int -> PositionType
forall a. Enum a => Int -> a
toEnum (Int -> PositionType) -> (CInt -> Int) -> CInt -> PositionType
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 PositionType) -> IO CInt -> IO PositionType
forall a b. (a -> b) -> a -> b
$
(\(Button ForeignPtr Button
arg1) -> ForeignPtr Button -> (Ptr Button -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Button
arg1 ((Ptr Button -> IO CInt) -> IO CInt)
-> (Ptr Button -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Button
argPtr1 ->Ptr Button -> IO CInt
gtk_button_get_image_position Ptr Button
argPtr1)
{-# LINE 467 "./Graphics/UI/Gtk/Buttons/Button.chs" #-}
(toButton self)
buttonGetEventWindow :: ButtonClass self => self
-> IO (Maybe DrawWindow)
buttonGetEventWindow :: forall self. ButtonClass self => self -> IO (Maybe DrawWindow)
buttonGetEventWindow self
self =
(IO (Ptr DrawWindow) -> IO DrawWindow)
-> IO (Ptr DrawWindow) -> IO (Maybe DrawWindow)
forall a. (IO (Ptr a) -> IO a) -> IO (Ptr a) -> IO (Maybe a)
maybeNull ((ForeignPtr DrawWindow -> DrawWindow, FinalizerPtr DrawWindow)
-> IO (Ptr DrawWindow) -> IO DrawWindow
forall obj.
GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
makeNewGObject (ForeignPtr DrawWindow -> DrawWindow, FinalizerPtr DrawWindow)
forall {a}. (ForeignPtr DrawWindow -> DrawWindow, FinalizerPtr a)
mkDrawWindow) (IO (Ptr DrawWindow) -> IO (Maybe DrawWindow))
-> IO (Ptr DrawWindow) -> IO (Maybe DrawWindow)
forall a b. (a -> b) -> a -> b
$
(\(Button ForeignPtr Button
arg1) -> ForeignPtr Button
-> (Ptr Button -> IO (Ptr DrawWindow)) -> IO (Ptr DrawWindow)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Button
arg1 ((Ptr Button -> IO (Ptr DrawWindow)) -> IO (Ptr DrawWindow))
-> (Ptr Button -> IO (Ptr DrawWindow)) -> IO (Ptr DrawWindow)
forall a b. (a -> b) -> a -> b
$ \Ptr Button
argPtr1 ->Ptr Button -> IO (Ptr DrawWindow)
gtk_button_get_event_window Ptr Button
argPtr1)
{-# LINE 480 "./Graphics/UI/Gtk/Buttons/Button.chs" #-}
(toButton self)
buttonLabel :: (ButtonClass self, GlibString string) => Attr self string
buttonLabel :: forall self string.
(ButtonClass self, GlibString string) =>
Attr self string
buttonLabel = (self -> IO string)
-> (self -> string -> IO ()) -> ReadWriteAttr self string string
forall o a b.
(o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newAttr
self -> IO string
forall self string.
(ButtonClass self, GlibString string) =>
self -> IO string
buttonGetLabel
self -> string -> IO ()
forall self string.
(ButtonClass self, GlibString string) =>
self -> string -> IO ()
buttonSetLabel
buttonUseUnderline :: ButtonClass self => Attr self Bool
buttonUseUnderline :: forall self. ButtonClass self => Attr self Bool
buttonUseUnderline = (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. ButtonClass self => self -> IO Bool
buttonGetUseUnderline
self -> Bool -> IO ()
forall self. ButtonClass self => self -> Bool -> IO ()
buttonSetUseUnderline
buttonUseStock :: ButtonClass self => Attr self Bool
buttonUseStock :: forall self. ButtonClass self => Attr self Bool
buttonUseStock = (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. ButtonClass self => self -> IO Bool
buttonGetUseStock
self -> Bool -> IO ()
forall self. ButtonClass self => self -> Bool -> IO ()
buttonSetUseStock
buttonFocusOnClick :: ButtonClass self => Attr self Bool
buttonFocusOnClick :: forall self. ButtonClass self => Attr self Bool
buttonFocusOnClick = (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. ButtonClass self => self -> IO Bool
buttonGetFocusOnClick
self -> Bool -> IO ()
forall self. ButtonClass self => self -> Bool -> IO ()
buttonSetFocusOnClick
buttonRelief :: ButtonClass self => Attr self ReliefStyle
buttonRelief :: forall self. ButtonClass self => Attr self ReliefStyle
buttonRelief = (self -> IO ReliefStyle)
-> (self -> ReliefStyle -> IO ())
-> ReadWriteAttr self ReliefStyle ReliefStyle
forall o a b.
(o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newAttr
self -> IO ReliefStyle
forall self. ButtonClass self => self -> IO ReliefStyle
buttonGetRelief
self -> ReliefStyle -> IO ()
forall self. ButtonClass self => self -> ReliefStyle -> IO ()
buttonSetRelief
buttonXalign :: ButtonClass self => Attr self Float
buttonXalign :: forall self. ButtonClass self => Attr self Float
buttonXalign = String -> Attr self Float
forall gobj. GObjectClass gobj => String -> Attr gobj Float
newAttrFromFloatProperty String
"xalign"
buttonYalign :: ButtonClass self => Attr self Float
buttonYalign :: forall self. ButtonClass self => Attr self Float
buttonYalign = String -> Attr self Float
forall gobj. GObjectClass gobj => String -> Attr gobj Float
newAttrFromFloatProperty String
"yalign"
buttonImage :: (ButtonClass self, WidgetClass image) => ReadWriteAttr self (Maybe Widget) image
buttonImage :: forall self image.
(ButtonClass self, WidgetClass image) =>
ReadWriteAttr self (Maybe Widget) image
buttonImage = (self -> IO (Maybe Widget))
-> (self -> image -> IO ())
-> ReadWriteAttr self (Maybe Widget) image
forall o a b.
(o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newAttr
self -> IO (Maybe Widget)
forall self. ButtonClass self => self -> IO (Maybe Widget)
buttonGetImage
self -> image -> IO ()
forall self image.
(ButtonClass self, WidgetClass image) =>
self -> image -> IO ()
buttonSetImage
buttonImagePosition :: ButtonClass self => Attr self PositionType
buttonImagePosition :: forall self. ButtonClass self => Attr self PositionType
buttonImagePosition = String -> GType -> Attr self PositionType
forall gobj enum.
(GObjectClass gobj, Enum enum) =>
String -> GType -> Attr gobj enum
newAttrFromEnumProperty String
"image-position"
GType
gtk_position_type_get_type
{-# LINE 582 "./Graphics/UI/Gtk/Buttons/Button.chs" #-}
buttonActivated :: ButtonClass self => Signal self (IO ())
buttonActivated :: forall self. ButtonClass self => Signal self (IO ())
buttonActivated = (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
"clicked")
foreign import ccall unsafe "gtk_button_new"
gtk_button_new :: (IO (Ptr Widget))
foreign import ccall unsafe "gtk_button_new_with_label"
gtk_button_new_with_label :: ((Ptr CChar) -> (IO (Ptr Widget)))
foreign import ccall unsafe "gtk_button_new_with_mnemonic"
gtk_button_new_with_mnemonic :: ((Ptr CChar) -> (IO (Ptr Widget)))
foreign import ccall unsafe "gtk_button_new_from_stock"
gtk_button_new_from_stock :: ((Ptr CChar) -> (IO (Ptr Widget)))
foreign import ccall safe "gtk_button_pressed"
gtk_button_pressed :: ((Ptr Button) -> (IO ()))
foreign import ccall safe "gtk_button_released"
gtk_button_released :: ((Ptr Button) -> (IO ()))
foreign import ccall safe "gtk_button_clicked"
gtk_button_clicked :: ((Ptr Button) -> (IO ()))
foreign import ccall safe "gtk_button_enter"
gtk_button_enter :: ((Ptr Button) -> (IO ()))
foreign import ccall safe "gtk_button_leave"
gtk_button_leave :: ((Ptr Button) -> (IO ()))
foreign import ccall safe "gtk_button_set_relief"
gtk_button_set_relief :: ((Ptr Button) -> (CInt -> (IO ())))
foreign import ccall unsafe "gtk_button_get_relief"
gtk_button_get_relief :: ((Ptr Button) -> (IO CInt))
foreign import ccall safe "gtk_button_set_label"
gtk_button_set_label :: ((Ptr Button) -> ((Ptr CChar) -> (IO ())))
foreign import ccall unsafe "gtk_button_get_label"
gtk_button_get_label :: ((Ptr Button) -> (IO (Ptr CChar)))
foreign import ccall safe "gtk_button_set_use_stock"
gtk_button_set_use_stock :: ((Ptr Button) -> (CInt -> (IO ())))
foreign import ccall unsafe "gtk_button_get_use_stock"
gtk_button_get_use_stock :: ((Ptr Button) -> (IO CInt))
foreign import ccall safe "gtk_button_set_use_underline"
gtk_button_set_use_underline :: ((Ptr Button) -> (CInt -> (IO ())))
foreign import ccall unsafe "gtk_button_get_use_underline"
gtk_button_get_use_underline :: ((Ptr Button) -> (IO CInt))
foreign import ccall unsafe "gtk_button_set_focus_on_click"
gtk_button_set_focus_on_click :: ((Ptr Button) -> (CInt -> (IO ())))
foreign import ccall unsafe "gtk_button_get_focus_on_click"
gtk_button_get_focus_on_click :: ((Ptr Button) -> (IO CInt))
foreign import ccall unsafe "gtk_button_set_alignment"
gtk_button_set_alignment :: ((Ptr Button) -> (CFloat -> (CFloat -> (IO ()))))
foreign import ccall unsafe "gtk_button_get_alignment"
gtk_button_get_alignment :: ((Ptr Button) -> ((Ptr CFloat) -> ((Ptr CFloat) -> (IO ()))))
foreign import ccall safe "gtk_button_get_image"
gtk_button_get_image :: ((Ptr Button) -> (IO (Ptr Widget)))
foreign import ccall safe "gtk_button_set_image"
gtk_button_set_image :: ((Ptr Button) -> ((Ptr Widget) -> (IO ())))
foreign import ccall safe "gtk_button_set_image_position"
gtk_button_set_image_position :: ((Ptr Button) -> (CInt -> (IO ())))
foreign import ccall safe "gtk_button_get_image_position"
gtk_button_get_image_position :: ((Ptr Button) -> (IO CInt))
foreign import ccall safe "gtk_button_get_event_window"
gtk_button_get_event_window :: ((Ptr Button) -> (IO (Ptr DrawWindow)))
foreign import ccall unsafe "gtk_position_type_get_type"
gtk_position_type_get_type :: CULong