{-# LINE 2 "./Graphics/UI/Gtk/Abstract/Box.chs" #-}
module Graphics.UI.Gtk.Abstract.Box (
Box,
BoxClass,
castToBox, gTypeBox,
toBox,
Packing(..),
boxPackStart,
boxPackEnd,
boxPackStartDefaults,
boxPackEndDefaults,
boxGetHomogeneous,
boxSetHomogeneous,
boxGetSpacing,
boxSetSpacing,
boxReorderChild,
boxQueryChildPacking,
boxSetChildPacking,
{-# LINE 128 "./Graphics/UI/Gtk/Abstract/Box.chs" #-}
boxSpacing,
boxHomogeneous,
boxChildPacking,
boxChildPadding,
boxChildPackType,
boxChildPosition,
) where
import Control.Monad (liftM)
import System.Glib.FFI
import System.Glib.Attributes
import Graphics.UI.Gtk.Types
{-# LINE 150 "./Graphics/UI/Gtk/Abstract/Box.chs" #-}
import Graphics.UI.Gtk.General.Enums (PackType(..), Packing(..),
toPacking, fromPacking)
import Graphics.UI.Gtk.Abstract.ContainerChildProperties
{-# LINE 161 "./Graphics/UI/Gtk/Abstract/Box.chs" #-}
{-# LINE 162 "./Graphics/UI/Gtk/Abstract/Box.chs" #-}
boxPackStart :: (BoxClass self, WidgetClass child) => self
-> child
-> Packing
-> Int
-> IO ()
boxPackStart :: forall self child.
(BoxClass self, WidgetClass child) =>
self -> child -> Packing -> Int -> IO ()
boxPackStart self
self child
child Packing
packing Int
padding =
(\(Box ForeignPtr Box
arg1) (Widget ForeignPtr Widget
arg2) CInt
arg3 CInt
arg4 CUInt
arg5 -> ForeignPtr Box -> (Ptr Box -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Box
arg1 ((Ptr Box -> IO ()) -> IO ()) -> (Ptr Box -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Box
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 Box -> Ptr Widget -> CInt -> CInt -> CUInt -> IO ()
gtk_box_pack_start Ptr Box
argPtr1 Ptr Widget
argPtr2 CInt
arg3 CInt
arg4 CUInt
arg5)
{-# LINE 184 "./Graphics/UI/Gtk/Abstract/Box.chs" #-}
(toBox self)
(child -> Widget
forall o. WidgetClass o => o -> Widget
toWidget child
child)
(Bool -> CInt
forall a. Num a => Bool -> a
fromBool Bool
expand)
(Bool -> CInt
forall a. Num a => Bool -> a
fromBool Bool
fill)
(Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
padding)
where (Bool
expand, Bool
fill) = Packing -> (Bool, Bool)
fromPacking Packing
packing
boxPackEnd :: (BoxClass self, WidgetClass child) => self
-> child
-> Packing
-> Int
-> IO ()
boxPackEnd :: forall self child.
(BoxClass self, WidgetClass child) =>
self -> child -> Packing -> Int -> IO ()
boxPackEnd self
self child
child Packing
packing Int
padding =
(\(Box ForeignPtr Box
arg1) (Widget ForeignPtr Widget
arg2) CInt
arg3 CInt
arg4 CUInt
arg5 -> ForeignPtr Box -> (Ptr Box -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Box
arg1 ((Ptr Box -> IO ()) -> IO ()) -> (Ptr Box -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Box
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 Box -> Ptr Widget -> CInt -> CInt -> CUInt -> IO ()
gtk_box_pack_end Ptr Box
argPtr1 Ptr Widget
argPtr2 CInt
arg3 CInt
arg4 CUInt
arg5)
{-# LINE 212 "./Graphics/UI/Gtk/Abstract/Box.chs" #-}
(toBox self)
(child -> Widget
forall o. WidgetClass o => o -> Widget
toWidget child
child)
(Bool -> CInt
forall a. Num a => Bool -> a
fromBool Bool
expand)
(Bool -> CInt
forall a. Num a => Bool -> a
fromBool Bool
fill)
(Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
padding)
where (Bool
expand, Bool
fill) = Packing -> (Bool, Bool)
fromPacking Packing
packing
boxPackStartDefaults :: (BoxClass self, WidgetClass widget) => self
-> widget
-> IO ()
boxPackStartDefaults :: forall self widget.
(BoxClass self, WidgetClass widget) =>
self -> widget -> IO ()
boxPackStartDefaults self
self widget
widget =
(\(Box ForeignPtr Box
arg1) (Widget ForeignPtr Widget
arg2) -> ForeignPtr Box -> (Ptr Box -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Box
arg1 ((Ptr Box -> IO ()) -> IO ()) -> (Ptr Box -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Box
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 Box -> Ptr Widget -> IO ()
gtk_box_pack_start_defaults Ptr Box
argPtr1 Ptr Widget
argPtr2)
{-# LINE 229 "./Graphics/UI/Gtk/Abstract/Box.chs" #-}
(toBox self)
(widget -> Widget
forall o. WidgetClass o => o -> Widget
toWidget widget
widget)
boxPackEndDefaults :: (BoxClass self, WidgetClass widget) => self
-> widget
-> IO ()
boxPackEndDefaults :: forall self widget.
(BoxClass self, WidgetClass widget) =>
self -> widget -> IO ()
boxPackEndDefaults self
self widget
widget =
(\(Box ForeignPtr Box
arg1) (Widget ForeignPtr Widget
arg2) -> ForeignPtr Box -> (Ptr Box -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Box
arg1 ((Ptr Box -> IO ()) -> IO ()) -> (Ptr Box -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Box
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 Box -> Ptr Widget -> IO ()
gtk_box_pack_end_defaults Ptr Box
argPtr1 Ptr Widget
argPtr2)
{-# LINE 241 "./Graphics/UI/Gtk/Abstract/Box.chs" #-}
(toBox self)
(widget -> Widget
forall o. WidgetClass o => o -> Widget
toWidget widget
widget)
boxSetHomogeneous :: BoxClass self => self
-> Bool
-> IO ()
boxSetHomogeneous :: forall self. BoxClass self => self -> Bool -> IO ()
boxSetHomogeneous self
self Bool
homogeneous =
(\(Box ForeignPtr Box
arg1) CInt
arg2 -> ForeignPtr Box -> (Ptr Box -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Box
arg1 ((Ptr Box -> IO ()) -> IO ()) -> (Ptr Box -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Box
argPtr1 ->Ptr Box -> CInt -> IO ()
gtk_box_set_homogeneous Ptr Box
argPtr1 CInt
arg2)
{-# LINE 254 "./Graphics/UI/Gtk/Abstract/Box.chs" #-}
(toBox self)
(Bool -> CInt
forall a. Num a => Bool -> a
fromBool Bool
homogeneous)
boxGetHomogeneous :: BoxClass self => self
-> IO Bool
boxGetHomogeneous :: forall self. BoxClass self => self -> IO Bool
boxGetHomogeneous 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
$
(\(Box ForeignPtr Box
arg1) -> ForeignPtr Box -> (Ptr Box -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Box
arg1 ((Ptr Box -> IO CInt) -> IO CInt)
-> (Ptr Box -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Box
argPtr1 ->Ptr Box -> IO CInt
gtk_box_get_homogeneous Ptr Box
argPtr1)
{-# LINE 265 "./Graphics/UI/Gtk/Abstract/Box.chs" #-}
(toBox self)
boxSetSpacing :: BoxClass self => self
-> Int
-> IO ()
boxSetSpacing :: forall self. BoxClass self => self -> Int -> IO ()
boxSetSpacing self
self Int
spacing =
(\(Box ForeignPtr Box
arg1) CInt
arg2 -> ForeignPtr Box -> (Ptr Box -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Box
arg1 ((Ptr Box -> IO ()) -> IO ()) -> (Ptr Box -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Box
argPtr1 ->Ptr Box -> CInt -> IO ()
gtk_box_set_spacing Ptr Box
argPtr1 CInt
arg2)
{-# LINE 277 "./Graphics/UI/Gtk/Abstract/Box.chs" #-}
(toBox self)
(Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
spacing)
boxReorderChild :: (BoxClass self, WidgetClass child) => self
-> child
-> Int
-> IO ()
boxReorderChild :: forall self child.
(BoxClass self, WidgetClass child) =>
self -> child -> Int -> IO ()
boxReorderChild self
self child
child Int
position =
(\(Box ForeignPtr Box
arg1) (Widget ForeignPtr Widget
arg2) CInt
arg3 -> ForeignPtr Box -> (Ptr Box -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Box
arg1 ((Ptr Box -> IO ()) -> IO ()) -> (Ptr Box -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Box
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 Box -> Ptr Widget -> CInt -> IO ()
gtk_box_reorder_child Ptr Box
argPtr1 Ptr Widget
argPtr2 CInt
arg3)
{-# LINE 296 "./Graphics/UI/Gtk/Abstract/Box.chs" #-}
(toBox self)
(child -> Widget
forall o. WidgetClass o => o -> Widget
toWidget child
child)
(Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
position)
boxQueryChildPacking :: (BoxClass self, WidgetClass child) => self
-> child
-> IO (Packing,Int,PackType)
boxQueryChildPacking :: forall self child.
(BoxClass self, WidgetClass child) =>
self -> child -> IO (Packing, Int, PackType)
boxQueryChildPacking self
self child
child =
(Ptr CInt -> IO (Packing, Int, PackType))
-> IO (Packing, Int, PackType)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Packing, Int, PackType))
-> IO (Packing, Int, PackType))
-> (Ptr CInt -> IO (Packing, Int, PackType))
-> IO (Packing, Int, PackType)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
expandPtr ->
(Ptr CInt -> IO (Packing, Int, PackType))
-> IO (Packing, Int, PackType)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Packing, Int, PackType))
-> IO (Packing, Int, PackType))
-> (Ptr CInt -> IO (Packing, Int, PackType))
-> IO (Packing, Int, PackType)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
fillPtr ->
(Ptr CUInt -> IO (Packing, Int, PackType))
-> IO (Packing, Int, PackType)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CUInt -> IO (Packing, Int, PackType))
-> IO (Packing, Int, PackType))
-> (Ptr CUInt -> IO (Packing, Int, PackType))
-> IO (Packing, Int, PackType)
forall a b. (a -> b) -> a -> b
$ \Ptr CUInt
paddingPtr ->
(Ptr CInt -> IO (Packing, Int, PackType))
-> IO (Packing, Int, PackType)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Packing, Int, PackType))
-> IO (Packing, Int, PackType))
-> (Ptr CInt -> IO (Packing, Int, PackType))
-> IO (Packing, Int, PackType)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
packPtr -> do
(\(Box ForeignPtr Box
arg1) (Widget ForeignPtr Widget
arg2) Ptr CInt
arg3 Ptr CInt
arg4 Ptr CUInt
arg5 Ptr CInt
arg6 -> ForeignPtr Box -> (Ptr Box -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Box
arg1 ((Ptr Box -> IO ()) -> IO ()) -> (Ptr Box -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Box
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 Box
-> Ptr Widget
-> Ptr CInt
-> Ptr CInt
-> Ptr CUInt
-> Ptr CInt
-> IO ()
gtk_box_query_child_packing Ptr Box
argPtr1 Ptr Widget
argPtr2 Ptr CInt
arg3 Ptr CInt
arg4 Ptr CUInt
arg5 Ptr CInt
arg6)
{-# LINE 315 "./Graphics/UI/Gtk/Abstract/Box.chs" #-}
(toBox self)
(child -> Widget
forall o. WidgetClass o => o -> Widget
toWidget child
child)
Ptr CInt
expandPtr
Ptr CInt
fillPtr
Ptr CUInt
paddingPtr
Ptr CInt
packPtr
Bool
expand <- (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
$ Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
expandPtr
Bool
fill <- (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
$ Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
fillPtr
Int
padding <- (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
$ Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CUInt
paddingPtr
PackType
pack <- (CInt -> PackType) -> IO CInt -> IO PackType
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Int -> PackType
forall a. Enum a => Int -> a
toEnum(Int -> PackType) -> (CInt -> Int) -> CInt -> PackType
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 PackType) -> IO CInt -> IO PackType
forall a b. (a -> b) -> a -> b
$ Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
packPtr
(Packing, Int, PackType) -> IO (Packing, Int, PackType)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Bool -> Packing
toPacking Bool
expand Bool
fill, Int
padding, PackType
pack)
boxSetChildPacking :: (BoxClass self, WidgetClass child) => self
-> child
-> Packing
-> Int
-> PackType
-> IO ()
boxSetChildPacking :: forall self child.
(BoxClass self, WidgetClass child) =>
self -> child -> Packing -> Int -> PackType -> IO ()
boxSetChildPacking self
self child
child Packing
packing Int
padding PackType
packType =
(\(Box ForeignPtr Box
arg1) (Widget ForeignPtr Widget
arg2) CInt
arg3 CInt
arg4 CUInt
arg5 CInt
arg6 -> ForeignPtr Box -> (Ptr Box -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Box
arg1 ((Ptr Box -> IO ()) -> IO ()) -> (Ptr Box -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Box
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 Box -> Ptr Widget -> CInt -> CInt -> CUInt -> CInt -> IO ()
gtk_box_set_child_packing Ptr Box
argPtr1 Ptr Widget
argPtr2 CInt
arg3 CInt
arg4 CUInt
arg5 CInt
arg6)
{-# LINE 337 "./Graphics/UI/Gtk/Abstract/Box.chs" #-}
(toBox self)
(child -> Widget
forall o. WidgetClass o => o -> Widget
toWidget child
child)
(Bool -> CInt
forall a. Num a => Bool -> a
fromBool Bool
expand)
(Bool -> CInt
forall a. Num a => Bool -> a
fromBool Bool
fill)
(Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
padding)
((Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (PackType -> Int) -> PackType -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackType -> Int
forall a. Enum a => a -> Int
fromEnum) PackType
packType)
where (Bool
expand, Bool
fill) = Packing -> (Bool, Bool)
fromPacking Packing
packing
{-# LINE 390 "./Graphics/UI/Gtk/Abstract/Box.chs" #-}
boxGetSpacing :: BoxClass self => self
-> IO Int
boxGetSpacing :: forall self. BoxClass self => self -> IO Int
boxGetSpacing 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
$
(\(Box ForeignPtr Box
arg1) -> ForeignPtr Box -> (Ptr Box -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Box
arg1 ((Ptr Box -> IO CInt) -> IO CInt)
-> (Ptr Box -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Box
argPtr1 ->Ptr Box -> IO CInt
gtk_box_get_spacing Ptr Box
argPtr1)
{-# LINE 397 "./Graphics/UI/Gtk/Abstract/Box.chs" #-}
(toBox self)
boxSpacing :: BoxClass self => Attr self Int
boxSpacing :: forall self. BoxClass self => Attr self Int
boxSpacing = (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. BoxClass self => self -> IO Int
boxGetSpacing
self -> Int -> IO ()
forall self. BoxClass self => self -> Int -> IO ()
boxSetSpacing
boxHomogeneous :: BoxClass self => Attr self Bool
boxHomogeneous :: forall self. BoxClass self => Attr self Bool
boxHomogeneous = (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. BoxClass self => self -> IO Bool
boxGetHomogeneous
self -> Bool -> IO ()
forall self. BoxClass self => self -> Bool -> IO ()
boxSetHomogeneous
{-# LINE 440 "./Graphics/UI/Gtk/Abstract/Box.chs" #-}
boxChildPacking :: (BoxClass self, WidgetClass child) => child -> Attr self Packing
boxChildPacking :: forall self child.
(BoxClass self, WidgetClass child) =>
child -> Attr self Packing
boxChildPacking child
child = (self -> IO Packing)
-> (self -> Packing -> IO ()) -> ReadWriteAttr self Packing Packing
forall o a b.
(o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newAttr
(\self
container -> do
Bool
expand <- String -> child -> self -> IO Bool
forall container child.
(ContainerClass container, WidgetClass child) =>
String -> child -> container -> IO Bool
containerChildGetPropertyBool String
"expand" child
child self
container
Bool
fill <- String -> child -> self -> IO Bool
forall container child.
(ContainerClass container, WidgetClass child) =>
String -> child -> container -> IO Bool
containerChildGetPropertyBool String
"fill" child
child self
container
Packing -> IO Packing
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Bool -> Packing
toPacking Bool
expand Bool
fill))
(\self
container Packing
packing ->
case Packing -> (Bool, Bool)
fromPacking Packing
packing of
(Bool
expand, Bool
fill) -> do
String -> child -> self -> Bool -> IO ()
forall container child.
(ContainerClass container, WidgetClass child) =>
String -> child -> container -> Bool -> IO ()
containerChildSetPropertyBool String
"expand" child
child self
container Bool
expand
String -> child -> self -> Bool -> IO ()
forall container child.
(ContainerClass container, WidgetClass child) =>
String -> child -> container -> Bool -> IO ()
containerChildSetPropertyBool String
"fill" child
child self
container Bool
fill)
boxChildPadding :: (BoxClass self, WidgetClass child) => child -> Attr self Int
boxChildPadding :: forall self child.
(BoxClass self, WidgetClass child) =>
child -> Attr self Int
boxChildPadding = String -> child -> Attr self Int
forall container child.
(ContainerClass container, WidgetClass child) =>
String -> child -> Attr container Int
newAttrFromContainerChildUIntProperty String
"padding"
boxChildPackType :: (BoxClass self, WidgetClass child) => child -> Attr self PackType
boxChildPackType :: forall self child.
(BoxClass self, WidgetClass child) =>
child -> Attr self PackType
boxChildPackType = String -> GType -> child -> Attr self PackType
forall container child enum.
(ContainerClass container, WidgetClass child, Enum enum) =>
String -> GType -> child -> Attr container enum
newAttrFromContainerChildEnumProperty String
"pack-type"
GType
gtk_pack_type_get_type
{-# LINE 477 "./Graphics/UI/Gtk/Abstract/Box.chs" #-}
boxChildPosition :: (BoxClass self, WidgetClass child) => child -> Attr self Int
boxChildPosition :: forall self child.
(BoxClass self, WidgetClass child) =>
child -> Attr self Int
boxChildPosition = String -> child -> Attr self Int
forall container child.
(ContainerClass container, WidgetClass child) =>
String -> child -> Attr container Int
newAttrFromContainerChildIntProperty String
"position"
foreign import ccall safe "gtk_box_pack_start"
gtk_box_pack_start :: ((Ptr Box) -> ((Ptr Widget) -> (CInt -> (CInt -> (CUInt -> (IO ()))))))
foreign import ccall safe "gtk_box_pack_end"
gtk_box_pack_end :: ((Ptr Box) -> ((Ptr Widget) -> (CInt -> (CInt -> (CUInt -> (IO ()))))))
foreign import ccall safe "gtk_box_pack_start_defaults"
gtk_box_pack_start_defaults :: ((Ptr Box) -> ((Ptr Widget) -> (IO ())))
foreign import ccall safe "gtk_box_pack_end_defaults"
gtk_box_pack_end_defaults :: ((Ptr Box) -> ((Ptr Widget) -> (IO ())))
foreign import ccall safe "gtk_box_set_homogeneous"
gtk_box_set_homogeneous :: ((Ptr Box) -> (CInt -> (IO ())))
foreign import ccall safe "gtk_box_get_homogeneous"
gtk_box_get_homogeneous :: ((Ptr Box) -> (IO CInt))
foreign import ccall safe "gtk_box_set_spacing"
gtk_box_set_spacing :: ((Ptr Box) -> (CInt -> (IO ())))
foreign import ccall safe "gtk_box_reorder_child"
gtk_box_reorder_child :: ((Ptr Box) -> ((Ptr Widget) -> (CInt -> (IO ()))))
foreign import ccall unsafe "gtk_box_query_child_packing"
gtk_box_query_child_packing :: ((Ptr Box) -> ((Ptr Widget) -> ((Ptr CInt) -> ((Ptr CInt) -> ((Ptr CUInt) -> ((Ptr CInt) -> (IO ())))))))
foreign import ccall safe "gtk_box_set_child_packing"
gtk_box_set_child_packing :: ((Ptr Box) -> ((Ptr Widget) -> (CInt -> (CInt -> (CUInt -> (CInt -> (IO ())))))))
foreign import ccall unsafe "gtk_box_get_spacing"
gtk_box_get_spacing :: ((Ptr Box) -> (IO CInt))
foreign import ccall unsafe "gtk_pack_type_get_type"
gtk_pack_type_get_type :: CULong