{-# LINE 2 "./Graphics/UI/Gtk/Abstract/Box.chs" #-}
-- -*-haskell-*-
-- GIMP Toolkit (GTK) Widget Box
--
-- Author : Axel Simon
--
-- Created: 15 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)
--
-- Base class for box containers
--
module Graphics.UI.Gtk.Abstract.Box (
-- * Detail
--
-- | 'Box' is an abstract widget which encapsulates functionality for a
-- particular kind of container, one that organizes a variable number of
-- widgets into a rectangular area. 'Box' currently has two derived classes,
-- 'HBox' and 'VBox'.
--
-- The rectangular area of a 'Box' is organized into either a single row or
-- a single column of child widgets depending upon whether the box is of type
-- 'HBox' or 'VBox', respectively. Thus, all children of a 'Box' are allocated
-- one dimension in common, which is the height of a row, or the width of a
-- column.
--
-- 'Box' uses a notion of /packing/. Packing refers to adding widgets with
-- reference to a particular position in a 'Container'. For a 'Box', there are
-- two reference positions: the /start/ and the /end/ of the box. For a 'VBox',
-- the start is defined as the top of the box and the end is defined as the
-- bottom. For a 'HBox' the start is defined as the left side and the end is
-- defined as the right side.
--
-- Use repeated calls to 'boxPackStart' to pack widgets into a 'Box' from
-- start to end. Use 'boxPackEnd' to add widgets from end to start. You may
-- intersperse these calls and add widgets from both ends of the same 'Box'.
-- Besides adding widgets at the start or the end of a box, you can also
-- specify the padding around each widget (in pixels) and a 'Packing'
-- parameter that denotes how to fill up unused space.
--
-- While the right amount of padding around each widget is a matter of
-- appearance, the 'Packing' paramter specifies the way the widgets in
-- the container behave when the window is resized and thereby affect
-- the usability. Hence, once you have created a window, you should resize
-- it and see if the widgets behave as expected. The 'Packing' parameter of
-- each child widget determines how excess space is used by that particular
-- widget. See the description of 'Packing' for a detailed explanaition.
--
-- Because 'Box' is a 'Container', you may also use
-- 'Graphics.UI.Gtk.Abstract.Container.containerAdd' to insert widgets into
-- the box, and they will be packed as if with 'boxPackStart' with 'PackRepel'
-- and 0 padding. Use 'Graphics.UI.Gtk.Abstract.Container.containerRemove' to
-- remove widgets from the 'Box'.
--
-- Use 'boxSetHomogeneous' to specify whether or not all children of the
-- 'Box' are forced to get the same amount of space. Note that the
-- 'Packing' options 'PackNatural' and 'PackRepel' coincide if space is
-- allotted homogeneously.
--
-- Use 'boxSetSpacing' to determine how much space will be minimally placed
-- between all children in the 'Box'.
--
-- Use 'boxReorderChild' to move a 'Box' child to a different place in the
-- box.
--
-- Use 'boxSetChildPacking' to reset the expand, fill, and padding
-- attributes of any 'Box' child. Use 'boxQueryChildPacking' to query these
-- fields.

-- * Class Hierarchy
-- |
-- @
-- | 'GObject'
-- | +----'Object'
-- | +----'Widget'
-- | +----'Container'
-- | +----Box
-- | +----'ButtonBox'
-- | +----'VBox'
-- | +----'HBox'
-- @

-- * Types
  Box,
  BoxClass,
  castToBox, gTypeBox,
  toBox,
  Packing(..),

-- * Methods
  boxPackStart,
  boxPackEnd,




  boxGetHomogeneous,
  boxSetHomogeneous,
  boxGetSpacing,
  boxSetSpacing,
  boxReorderChild,
  boxQueryChildPacking,
  boxSetChildPacking,

  boxGetBaselinePosition,
  boxSetBaselinePosition,


  boxGetCenterWidget,
  boxSetCenterWidget,


-- * Attributes
  boxSpacing,
  boxHomogeneous,

  boxBaselinePosition,


  boxCenterWidget,


-- * Child Attributes
  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


import Graphics.UI.Gtk.General.Enums (BaselinePosition)


import Graphics.UI.Gtk.Abstract.Object (makeNewObject)



{-# LINE 162 "./Graphics/UI/Gtk/Abstract/Box.chs" #-}

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

-- | Adds the @child@ widget to the box, packed with reference to the start of
-- the box. The
-- @child@ is packed after any other child packed with reference to the start
-- of the box.
--
--
boxPackStart :: (BoxClass self, WidgetClass child) => self
 -> child -- ^ @child@ - the 'Widget' to be added to the box.
 -> Packing
 -> Int -- ^ @padding@ - extra space in pixels to put between this child and
          -- its neighbors, over and above the global amount specified by
          -- spacing 'boxSetSpacing'. If @child@
          -- is a widget at one of the reference ends of @box@, then @padding@
          -- pixels are also put between @child@ and the reference edge of
          -- @box@.
 -> 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

-- | Adds the @child@ widget to the box, packed with reference to the end of
-- the box. The
-- @child@ is packed after (away from end of) any other child packed with
-- reference to the end of the box.
--
-- Note that
-- for 'boxPackEnd' the 'PackNatural' option will move a child to the right in
-- an 'HBox' or to the bottom in an 'VBox' if there is more space availble.
--
boxPackEnd :: (BoxClass self, WidgetClass child) => self
 -> child -- ^ @child@ - the 'Widget' to be added to the box.
 -> Packing
 -> Int -- ^ @padding@ - extra space in pixels to put between this child and
          -- its neighbors, over and above the global amount specified by
          -- spacing 'boxSetSpacing'. If @child@
          -- is a widget at one of the reference ends of @box@, then @padding@
          -- pixels are also put between @child@ and the reference edge of
          -- @box@.
 -> 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
{-# LINE 245 "./Graphics/UI/Gtk/Abstract/Box.chs" #-}
-- | Sets the homogeneous property,
-- controlling whether or not all children of the box are given equal space
--
boxSetHomogeneous :: BoxClass self => self
 -> Bool -- ^ @homogeneous@ - a boolean value, @True@ to create equal
          -- allotments, @False@ for variable allotments.
 -> 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)

-- | Returns whether the box is homogeneous (all children are the same size).
-- See 'boxSetHomogeneous'.
--
boxGetHomogeneous :: BoxClass self => self
 -> IO Bool -- ^ returns @True@ if the box is homogeneous.
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)

-- | Set the standard spacing between two children.
--
-- This space is in addition to the padding parameter that is given for each
-- child.
--
boxSetSpacing :: BoxClass self => self
 -> Int -- ^ @spacing@ - the number of pixels to put between children.
 -> 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)

-- | Moves @child@ to a new @position@ in the list of @box@ children. The list
-- contains both widgets packed 'PackStart' as well as widgets packed
-- 'PackEnd', in the order that these widgets were added to the box.
--
-- A widget's position in the box children list determines where the
-- widget is packed into the box. A child widget at some position in the list
-- will be packed just after all other widgets of the same packing type that
-- appear earlier in the list.
--
boxReorderChild :: (BoxClass self, WidgetClass child) => self
 -> child -- ^ @child@ - the 'Widget' to move.
 -> Int -- ^ @position@ - the new position for @child@ in the children list
          -- starting from 0. If negative, indicates the end of the list.
 -> 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)

-- | Returns information about how @child@ is packed into the box.
--
-- Returns information on the behaviour if free space is available
-- (in 'Packing'), the additional padding for this widget and if the widget
-- was inserted at the start or end of the container ('PackType').
--
boxQueryChildPacking :: (BoxClass self, WidgetClass child) => self
 -> child -- ^ @child@ - the 'Widget' of the child to query.
 -> IO (Packing,Int,PackType) -- ^ @(packing, padding, 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)

-- | Sets the way @child@ is packed into the box.
--
boxSetChildPacking :: (BoxClass self, WidgetClass child) => self
 -> child -- ^ @child@ - the 'Widget' of the child to set.
 -> Packing
 -> Int -- ^ @padding@
 -> PackType -- ^ @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


-- | Gets the value set by `boxSetBaselinePostion`
boxGetBaselinePosition :: BoxClass self => self
 -> IO BaselinePosition
boxGetBaselinePosition :: forall self. BoxClass self => self -> IO BaselinePosition
boxGetBaselinePosition self
self =
  (CInt -> BaselinePosition) -> IO CInt -> IO BaselinePosition
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Int -> BaselinePosition
forall a. Enum a => Int -> a
toEnum (Int -> BaselinePosition)
-> (CInt -> Int) -> CInt -> BaselinePosition
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 BaselinePosition) -> IO CInt -> IO BaselinePosition
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_baseline_position Ptr Box
argPtr1)
{-# LINE 352 "./Graphics/UI/Gtk/Abstract/Box.chs" #-}
    (toBox self)

-- | Sets the baseline position of a box. This affects only
-- horizontal boxes with at least one baseline aligned child.
-- If there is more vertical space available than requested,
-- and the baseline is not allocated by the parent then
-- `position` is used to allocate the baseline wrt the extra
-- space available.
boxSetBaselinePosition :: BoxClass self => self
 -> BaselinePosition
 -> IO ()
boxSetBaselinePosition :: forall self. BoxClass self => self -> BaselinePosition -> IO ()
boxSetBaselinePosition self
self BaselinePosition
position =
  (\(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_baseline_position Ptr Box
argPtr1 CInt
arg2)
{-# LINE 365 "./Graphics/UI/Gtk/Abstract/Box.chs" #-}
    (toBox self)
    (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> Int -> CInt
forall a b. (a -> b) -> a -> b
$ BaselinePosition -> Int
forall a. Enum a => a -> Int
fromEnum BaselinePosition
position)



-- | Retrieves the center widget of the box.
boxGetCenterWidget :: BoxClass self => self
 -> IO Widget
boxGetCenterWidget :: forall self. BoxClass self => self -> IO Widget
boxGetCenterWidget 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
$
  (\(Box ForeignPtr Box
arg1) -> ForeignPtr Box -> (Ptr Box -> IO (Ptr Widget)) -> IO (Ptr Widget)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Box
arg1 ((Ptr Box -> IO (Ptr Widget)) -> IO (Ptr Widget))
-> (Ptr Box -> IO (Ptr Widget)) -> IO (Ptr Widget)
forall a b. (a -> b) -> a -> b
$ \Ptr Box
argPtr1 ->Ptr Box -> IO (Ptr Widget)
gtk_box_get_center_widget Ptr Box
argPtr1)
{-# LINE 376 "./Graphics/UI/Gtk/Abstract/Box.chs" #-}
    (toBox self)

-- | Sets a center widget; that is a child widget that will be
-- centered with respect to the full width of the box, even if
-- the children at either side take up different amounts of space.
boxSetCenterWidget :: (BoxClass self, WidgetClass widget) => self
 -> widget
 -> IO ()
boxSetCenterWidget :: forall self widget.
(BoxClass self, WidgetClass widget) =>
self -> widget -> IO ()
boxSetCenterWidget self
self widget
position =
  (\(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_set_center_widget Ptr Box
argPtr1 Ptr Widget
argPtr2)
{-# LINE 386 "./Graphics/UI/Gtk/Abstract/Box.chs" #-}
    (toBox self)
    (widget -> Widget
forall o. WidgetClass o => o -> Widget
toWidget widget
position)


-- | Retrieves the standard spacing between widgets.
--
boxGetSpacing :: BoxClass self => self
 -> IO Int -- ^ returns spacing between children
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)

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

-- | The amount of space between children.
--
-- Allowed values: >= 0
--
-- Default value: 0
--
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

-- | Whether the children should all be the same size.
--
-- Default value: @False@
--
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


-- | The position of the baseline aligned widgets if extra space is available.
boxBaselinePosition :: BoxClass self => Attr self BaselinePosition
boxBaselinePosition :: forall self. BoxClass self => Attr self BaselinePosition
boxBaselinePosition = (self -> IO BaselinePosition)
-> (self -> BaselinePosition -> IO ())
-> ReadWriteAttr self BaselinePosition BaselinePosition
forall o a b.
(o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newAttr
  self -> IO BaselinePosition
forall self. BoxClass self => self -> IO BaselinePosition
boxGetBaselinePosition
  self -> BaselinePosition -> IO ()
forall self. BoxClass self => self -> BaselinePosition -> IO ()
boxSetBaselinePosition



-- | A child widget that will be centered with respect to the
-- full width of the box, even if the children at either side
-- take up different amounts of space.
boxCenterWidget :: (BoxClass self, WidgetClass widget) => ReadWriteAttr self Widget widget
boxCenterWidget :: forall self widget.
(BoxClass self, WidgetClass widget) =>
ReadWriteAttr self Widget widget
boxCenterWidget = (self -> IO Widget)
-> (self -> widget -> IO ()) -> ReadWriteAttr self Widget widget
forall o a b.
(o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newAttr
  self -> IO Widget
forall self. BoxClass self => self -> IO Widget
boxGetCenterWidget
  self -> widget -> IO ()
forall self widget.
(BoxClass self, WidgetClass widget) =>
self -> widget -> IO ()
boxSetCenterWidget


--------------------
-- Child Attributes


-- | The packing style of the child.
--
-- Default value: @'PackGrow'@
--
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)

-- | Extra space to put between the child and its neighbors, in pixels.
--
-- Allowed values: \<= @('maxBound' :: Int)@
--
-- Default value: 0
--
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"

-- | A 'PackType' indicating whether the child is packed with reference to the
-- start or end of the parent.
--
-- Default value: 'PackStart'
--
boxChildPackType :: (BoxClass self, WidgetClass child) => child -> Attr self PackType
boxChildPackType :: forall self child.
(BoxClass self, WidgetClass child) =>
child -> Attr self PackType
boxChildPackType = String -> CUInt -> child -> Attr self PackType
forall container child enum.
(ContainerClass container, WidgetClass child, Enum enum) =>
String -> CUInt -> child -> Attr container enum
newAttrFromContainerChildEnumProperty String
"pack-type"
                     CUInt
gtk_pack_type_get_type
{-# LINE 477 "./Graphics/UI/Gtk/Abstract/Box.chs" #-}

-- | The index of the child in the parent.
--
-- Allowed values: >= -1
--
-- Default value: 0
--
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_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_baseline_position"
  gtk_box_get_baseline_position :: ((Ptr Box) -> (IO CInt))

foreign import ccall unsafe "gtk_box_set_baseline_position"
  gtk_box_set_baseline_position :: ((Ptr Box) -> (CInt -> (IO ())))

foreign import ccall unsafe "gtk_box_get_center_widget"
  gtk_box_get_center_widget :: ((Ptr Box) -> (IO (Ptr Widget)))

foreign import ccall unsafe "gtk_box_set_center_widget"
  gtk_box_set_center_widget :: ((Ptr Box) -> ((Ptr Widget) -> (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 :: CUInt