{-# LINE 2 "./Graphics/UI/Gtk/Layout/Layout.chs" #-}
-- -*-haskell-*-
-- GIMP Toolkit (GTK) Widget Layout
--
-- 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)
--
-- Infinite scrollable area containing child widgets and\/or custom drawing
--
module Graphics.UI.Gtk.Layout.Layout (
-- * Detail
--
-- | 'Layout' is similar to 'DrawingArea' in that it's a \"blank slate\" and
-- doesn't do anything but paint a blank background by default. It's different
-- in that it supports scrolling natively (you can add it to a
-- 'ScrolledWindow'), and it can contain child widgets, since it's a
-- 'Container'. However if you\'re just going to draw, a 'DrawingArea' is a
-- better choice since it has lower overhead.

-- * Class Hierarchy
-- |
-- @
-- | 'GObject'
-- | +----'Object'
-- | +----'Widget'
-- | +----'Container'
-- | +----Layout
-- @

-- * Types
  Layout,
  LayoutClass,
  castToLayout, gTypeLayout,
  toLayout,

-- * Constructors
  layoutNew,

-- * Methods
  layoutPut,
  layoutMove,
  layoutSetSize,
  layoutGetSize,
  layoutGetHAdjustment,
  layoutGetVAdjustment,
  layoutSetHAdjustment,
  layoutSetVAdjustment,
  layoutGetDrawWindow,

-- * Attributes
  layoutHAdjustment,
  layoutVAdjustment,
  layoutWidth,
  layoutHeight,

-- * Child Attributes
  layoutChildX,
  layoutChildY,

-- * Signals
  onSetScrollAdjustments,
  afterSetScrollAdjustments,
  ) where

import Data.Maybe (fromMaybe)
import Control.Monad (liftM)

import System.Glib.FFI
import System.Glib.Attributes
import System.Glib.Properties
import Graphics.UI.Gtk.Abstract.Object (makeNewObject)
import Graphics.UI.Gtk.Types
{-# LINE 91 "./Graphics/UI/Gtk/Layout/Layout.chs" #-}
import Graphics.UI.Gtk.Signals
{-# LINE 92 "./Graphics/UI/Gtk/Layout/Layout.chs" #-}
import Graphics.UI.Gtk.Abstract.ContainerChildProperties


{-# LINE 95 "./Graphics/UI/Gtk/Layout/Layout.chs" #-}

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

-- | Creates a new 'Layout'. Unless you have a specific adjustment you'd like
-- the layout to use for scrolling, pass @Nothing@ for @hadjustment@ and
-- @vadjustment@.
--
layoutNew ::
    Maybe Adjustment -- ^ @hadjustment@ - horizontal scroll adjustment, or
                     -- @Nothing@
 -> Maybe Adjustment -- ^ @vadjustment@ - vertical scroll adjustment, or
                     -- @Nothing@
 -> IO Layout
layoutNew :: Maybe Adjustment -> Maybe Adjustment -> IO Layout
layoutNew Maybe Adjustment
hadjustment Maybe Adjustment
vadjustment =
  (ForeignPtr Layout -> Layout, FinalizerPtr Layout)
-> IO (Ptr Layout) -> IO Layout
forall obj.
ObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
makeNewObject (ForeignPtr Layout -> Layout, FinalizerPtr Layout)
forall {a}. (ForeignPtr Layout -> Layout, FinalizerPtr a)
mkLayout (IO (Ptr Layout) -> IO Layout) -> IO (Ptr Layout) -> IO Layout
forall a b. (a -> b) -> a -> b
$
  (Ptr Widget -> Ptr Layout) -> IO (Ptr Widget) -> IO (Ptr Layout)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Ptr Widget -> Ptr Layout
forall a b. Ptr a -> Ptr b
castPtr :: Ptr Widget -> Ptr Layout) (IO (Ptr Widget) -> IO (Ptr Layout))
-> IO (Ptr Widget) -> IO (Ptr Layout)
forall a b. (a -> b) -> a -> b
$
  (\(Adjustment ForeignPtr Adjustment
arg1) (Adjustment ForeignPtr Adjustment
arg2) -> ForeignPtr Adjustment
-> (Ptr Adjustment -> IO (Ptr Widget)) -> IO (Ptr Widget)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Adjustment
arg1 ((Ptr Adjustment -> IO (Ptr Widget)) -> IO (Ptr Widget))
-> (Ptr Adjustment -> IO (Ptr Widget)) -> IO (Ptr Widget)
forall a b. (a -> b) -> a -> b
$ \Ptr Adjustment
argPtr1 ->ForeignPtr Adjustment
-> (Ptr Adjustment -> IO (Ptr Widget)) -> IO (Ptr Widget)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Adjustment
arg2 ((Ptr Adjustment -> IO (Ptr Widget)) -> IO (Ptr Widget))
-> (Ptr Adjustment -> IO (Ptr Widget)) -> IO (Ptr Widget)
forall a b. (a -> b) -> a -> b
$ \Ptr Adjustment
argPtr2 ->Ptr Adjustment -> Ptr Adjustment -> IO (Ptr Widget)
gtk_layout_new Ptr Adjustment
argPtr1 Ptr Adjustment
argPtr2)
{-# LINE 113 "./Graphics/UI/Gtk/Layout/Layout.chs" #-}
    (fromMaybe (Adjustment nullForeignPtr) hadjustment)
    (Adjustment -> Maybe Adjustment -> Adjustment
forall a. a -> Maybe a -> a
fromMaybe (ForeignPtr Adjustment -> Adjustment
Adjustment ForeignPtr Adjustment
forall a. ForeignPtr a
nullForeignPtr) Maybe Adjustment
vadjustment)

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

-- | Adds @childWidget@ to @layout@, at position @(x,y)@. @layout@ becomes
-- the new parent container of @childWidget@.
--
layoutPut :: (LayoutClass self, WidgetClass childWidget) => self
 -> childWidget -- ^ @childWidget@ - child widget
 -> Int -- ^ @x@ - X position of child widget
 -> Int -- ^ @y@ - Y position of child widget
 -> IO ()
layoutPut :: forall self childWidget.
(LayoutClass self, WidgetClass childWidget) =>
self -> childWidget -> Int -> Int -> IO ()
layoutPut self
self childWidget
childWidget Int
x Int
y =
  (\(Layout ForeignPtr Layout
arg1) (Widget ForeignPtr Widget
arg2) CInt
arg3 CInt
arg4 -> ForeignPtr Layout -> (Ptr Layout -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Layout
arg1 ((Ptr Layout -> IO ()) -> IO ()) -> (Ptr Layout -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Layout
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 Layout -> Ptr Widget -> CInt -> CInt -> IO ()
gtk_layout_put Ptr Layout
argPtr1 Ptr Widget
argPtr2 CInt
arg3 CInt
arg4)
{-# LINE 129 "./Graphics/UI/Gtk/Layout/Layout.chs" #-}
    (toLayout self)
    (childWidget -> Widget
forall o. WidgetClass o => o -> Widget
toWidget childWidget
childWidget)
    (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x)
    (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
y)

-- | Moves a current child of @layout@ to a new position.
--
layoutMove :: (LayoutClass self, WidgetClass childWidget) => self
 -> childWidget -- ^ @childWidget@ - a current child of @layout@
 -> Int -- ^ @x@ - X position to move to
 -> Int -- ^ @y@ - Y position to move to
 -> IO ()
layoutMove :: forall self childWidget.
(LayoutClass self, WidgetClass childWidget) =>
self -> childWidget -> Int -> Int -> IO ()
layoutMove self
self childWidget
childWidget Int
x Int
y =
  (\(Layout ForeignPtr Layout
arg1) (Widget ForeignPtr Widget
arg2) CInt
arg3 CInt
arg4 -> ForeignPtr Layout -> (Ptr Layout -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Layout
arg1 ((Ptr Layout -> IO ()) -> IO ()) -> (Ptr Layout -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Layout
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 Layout -> Ptr Widget -> CInt -> CInt -> IO ()
gtk_layout_move Ptr Layout
argPtr1 Ptr Widget
argPtr2 CInt
arg3 CInt
arg4)
{-# LINE 143 "./Graphics/UI/Gtk/Layout/Layout.chs" #-}
    (toLayout self)
    (childWidget -> Widget
forall o. WidgetClass o => o -> Widget
toWidget childWidget
childWidget)
    (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x)
    (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
y)

-- | Sets the size of the scrollable area of the layout.
--
layoutSetSize :: LayoutClass self => self
 -> Int -- ^ @width@ - width of entire scrollable area
 -> Int -- ^ @height@ - height of entire scrollable area
 -> IO ()
layoutSetSize :: forall self. LayoutClass self => self -> Int -> Int -> IO ()
layoutSetSize self
self Int
width Int
height =
  (\(Layout ForeignPtr Layout
arg1) CUInt
arg2 CUInt
arg3 -> ForeignPtr Layout -> (Ptr Layout -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Layout
arg1 ((Ptr Layout -> IO ()) -> IO ()) -> (Ptr Layout -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Layout
argPtr1 ->Ptr Layout -> CUInt -> CUInt -> IO ()
gtk_layout_set_size Ptr Layout
argPtr1 CUInt
arg2 CUInt
arg3)
{-# LINE 156 "./Graphics/UI/Gtk/Layout/Layout.chs" #-}
    (toLayout self)
    (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
width)
    (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
height)

-- | Gets the size that has been set on the layout, and that determines the
-- total extents of the layout's scrollbar area. See 'layoutSetSize'.
--
layoutGetSize :: LayoutClass self => self
 -> IO (Int, Int) -- ^ @(width, height)@
layoutGetSize :: forall self. LayoutClass self => self -> IO (Int, Int)
layoutGetSize self
self =
  (Ptr CUInt -> IO (Int, Int)) -> IO (Int, Int)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CUInt -> IO (Int, Int)) -> IO (Int, Int))
-> (Ptr CUInt -> IO (Int, Int)) -> IO (Int, Int)
forall a b. (a -> b) -> a -> b
$ \Ptr CUInt
widthPtr ->
  (Ptr CUInt -> IO (Int, Int)) -> IO (Int, Int)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CUInt -> IO (Int, Int)) -> IO (Int, Int))
-> (Ptr CUInt -> IO (Int, Int)) -> IO (Int, Int)
forall a b. (a -> b) -> a -> b
$ \Ptr CUInt
heightPtr -> do
  (\(Layout ForeignPtr Layout
arg1) Ptr CUInt
arg2 Ptr CUInt
arg3 -> ForeignPtr Layout -> (Ptr Layout -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Layout
arg1 ((Ptr Layout -> IO ()) -> IO ()) -> (Ptr Layout -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Layout
argPtr1 ->Ptr Layout -> Ptr CUInt -> Ptr CUInt -> IO ()
gtk_layout_get_size Ptr Layout
argPtr1 Ptr CUInt
arg2 Ptr CUInt
arg3)
{-# LINE 169 "./Graphics/UI/Gtk/Layout/Layout.chs" #-}
    (toLayout self)
    Ptr CUInt
widthPtr
    Ptr CUInt
heightPtr
  CUInt
width <-Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CUInt
widthPtr
  CUInt
height <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CUInt
heightPtr
  (Int, Int) -> IO (Int, Int)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CUInt
width, CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CUInt
height)

-- | This function should only be called after the layout has been placed in a
-- 'ScrolledWindow' or otherwise configured for scrolling. It returns the
-- 'Adjustment' used for communication between the horizontal scrollbar and
-- @layout@.
--
-- See 'ScrolledWindow', 'Scrollbar', 'Adjustment' for details.
--
layoutGetHAdjustment :: LayoutClass self => self
 -> IO Adjustment -- ^ returns horizontal scroll adjustment
layoutGetHAdjustment :: forall self. LayoutClass self => self -> IO Adjustment
layoutGetHAdjustment self
self =
  (ForeignPtr Adjustment -> Adjustment, FinalizerPtr Adjustment)
-> IO (Ptr Adjustment) -> IO Adjustment
forall obj.
ObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
makeNewObject (ForeignPtr Adjustment -> Adjustment, FinalizerPtr Adjustment)
forall {a}. (ForeignPtr Adjustment -> Adjustment, FinalizerPtr a)
mkAdjustment (IO (Ptr Adjustment) -> IO Adjustment)
-> IO (Ptr Adjustment) -> IO Adjustment
forall a b. (a -> b) -> a -> b
$
  (\(Layout ForeignPtr Layout
arg1) -> ForeignPtr Layout
-> (Ptr Layout -> IO (Ptr Adjustment)) -> IO (Ptr Adjustment)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Layout
arg1 ((Ptr Layout -> IO (Ptr Adjustment)) -> IO (Ptr Adjustment))
-> (Ptr Layout -> IO (Ptr Adjustment)) -> IO (Ptr Adjustment)
forall a b. (a -> b) -> a -> b
$ \Ptr Layout
argPtr1 ->Ptr Layout -> IO (Ptr Adjustment)
gtk_layout_get_hadjustment Ptr Layout
argPtr1)
{-# LINE 188 "./Graphics/UI/Gtk/Layout/Layout.chs" #-}
    (toLayout self)

-- | This function should only be called after the layout has been placed in a
-- 'ScrolledWindow' or otherwise configured for scrolling. It returns the
-- 'Adjustment' used for communication between the vertical scrollbar and
-- @layout@.
--
-- See 'ScrolledWindow', 'Scrollbar', 'Adjustment' for details.
--
layoutGetVAdjustment :: LayoutClass self => self
 -> IO Adjustment -- ^ returns vertical scroll adjustment
layoutGetVAdjustment :: forall self. LayoutClass self => self -> IO Adjustment
layoutGetVAdjustment self
self =
  (ForeignPtr Adjustment -> Adjustment, FinalizerPtr Adjustment)
-> IO (Ptr Adjustment) -> IO Adjustment
forall obj.
ObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
makeNewObject (ForeignPtr Adjustment -> Adjustment, FinalizerPtr Adjustment)
forall {a}. (ForeignPtr Adjustment -> Adjustment, FinalizerPtr a)
mkAdjustment (IO (Ptr Adjustment) -> IO Adjustment)
-> IO (Ptr Adjustment) -> IO Adjustment
forall a b. (a -> b) -> a -> b
$
  (\(Layout ForeignPtr Layout
arg1) -> ForeignPtr Layout
-> (Ptr Layout -> IO (Ptr Adjustment)) -> IO (Ptr Adjustment)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Layout
arg1 ((Ptr Layout -> IO (Ptr Adjustment)) -> IO (Ptr Adjustment))
-> (Ptr Layout -> IO (Ptr Adjustment)) -> IO (Ptr Adjustment)
forall a b. (a -> b) -> a -> b
$ \Ptr Layout
argPtr1 ->Ptr Layout -> IO (Ptr Adjustment)
gtk_layout_get_vadjustment Ptr Layout
argPtr1)
{-# LINE 202 "./Graphics/UI/Gtk/Layout/Layout.chs" #-}
    (toLayout self)

-- | Sets the horizontal scroll adjustment for the layout.
--
-- See 'ScrolledWindow', 'Scrollbar', 'Adjustment' for details.
--
layoutSetHAdjustment :: LayoutClass self => self
 -> Adjustment -- ^ @adjustment@ - new scroll adjustment
 -> IO ()
layoutSetHAdjustment :: forall self. LayoutClass self => self -> Adjustment -> IO ()
layoutSetHAdjustment self
self Adjustment
adjustment =
  (\(Layout ForeignPtr Layout
arg1) (Adjustment ForeignPtr Adjustment
arg2) -> ForeignPtr Layout -> (Ptr Layout -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Layout
arg1 ((Ptr Layout -> IO ()) -> IO ()) -> (Ptr Layout -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Layout
argPtr1 ->ForeignPtr Adjustment -> (Ptr Adjustment -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Adjustment
arg2 ((Ptr Adjustment -> IO ()) -> IO ())
-> (Ptr Adjustment -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Adjustment
argPtr2 ->Ptr Layout -> Ptr Adjustment -> IO ()
gtk_layout_set_hadjustment Ptr Layout
argPtr1 Ptr Adjustment
argPtr2)
{-# LINE 213 "./Graphics/UI/Gtk/Layout/Layout.chs" #-}
    (toLayout self)
    Adjustment
adjustment

-- | Sets the vertical scroll adjustment for the layout.
--
-- See 'ScrolledWindow', 'Scrollbar', 'Adjustment' for details.
--
layoutSetVAdjustment :: LayoutClass self => self
 -> Adjustment -- ^ @adjustment@ - new scroll adjustment
 -> IO ()
layoutSetVAdjustment :: forall self. LayoutClass self => self -> Adjustment -> IO ()
layoutSetVAdjustment self
self Adjustment
adjustment =
  (\(Layout ForeignPtr Layout
arg1) (Adjustment ForeignPtr Adjustment
arg2) -> ForeignPtr Layout -> (Ptr Layout -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Layout
arg1 ((Ptr Layout -> IO ()) -> IO ()) -> (Ptr Layout -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Layout
argPtr1 ->ForeignPtr Adjustment -> (Ptr Adjustment -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Adjustment
arg2 ((Ptr Adjustment -> IO ()) -> IO ())
-> (Ptr Adjustment -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Adjustment
argPtr2 ->Ptr Layout -> Ptr Adjustment -> IO ()
gtk_layout_set_vadjustment Ptr Layout
argPtr1 Ptr Adjustment
argPtr2)
{-# LINE 225 "./Graphics/UI/Gtk/Layout/Layout.chs" #-}
    (toLayout self)
    Adjustment
adjustment

-- | Retrieves the 'Drawable' part of the layout used for drawing operations.
--
layoutGetDrawWindow :: Layout -> IO DrawWindow
layoutGetDrawWindow :: Layout -> IO DrawWindow
layoutGetDrawWindow Layout
lay = (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 DrawWindow)
-> IO (Ptr DrawWindow) -> IO DrawWindow
forall a b. (a -> b) -> a -> b
$
  (\(Layout ForeignPtr Layout
arg1) -> ForeignPtr Layout
-> (Ptr Layout -> IO (Ptr DrawWindow)) -> IO (Ptr DrawWindow)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Layout
arg1 ((Ptr Layout -> IO (Ptr DrawWindow)) -> IO (Ptr DrawWindow))
-> (Ptr Layout -> IO (Ptr DrawWindow)) -> IO (Ptr DrawWindow)
forall a b. (a -> b) -> a -> b
$ \Ptr Layout
argPtr1 ->Ptr Layout -> IO (Ptr DrawWindow)
gtk_layout_get_bin_window Ptr Layout
argPtr1)
{-# LINE 233 "./Graphics/UI/Gtk/Layout/Layout.chs" #-}
    (toLayout lay)

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

-- | The 'Adjustment' for the horizontal position.
--
layoutHAdjustment :: LayoutClass self => Attr self Adjustment
layoutHAdjustment :: forall self. LayoutClass self => Attr self Adjustment
layoutHAdjustment = (self -> IO Adjustment)
-> (self -> Adjustment -> IO ())
-> ReadWriteAttr self Adjustment Adjustment
forall o a b.
(o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newAttr
  self -> IO Adjustment
forall self. LayoutClass self => self -> IO Adjustment
layoutGetHAdjustment
  self -> Adjustment -> IO ()
forall self. LayoutClass self => self -> Adjustment -> IO ()
layoutSetHAdjustment

-- | The 'Adjustment' for the vertical position.
--
layoutVAdjustment :: LayoutClass self => Attr self Adjustment
layoutVAdjustment :: forall self. LayoutClass self => Attr self Adjustment
layoutVAdjustment = (self -> IO Adjustment)
-> (self -> Adjustment -> IO ())
-> ReadWriteAttr self Adjustment Adjustment
forall o a b.
(o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newAttr
  self -> IO Adjustment
forall self. LayoutClass self => self -> IO Adjustment
layoutGetVAdjustment
  self -> Adjustment -> IO ()
forall self. LayoutClass self => self -> Adjustment -> IO ()
layoutSetVAdjustment

-- | The width of the layout.
--
-- Allowed values: \<= @('maxBound' :: Int)@
--
-- Default value: 100
--
layoutWidth :: LayoutClass self => Attr self Int
layoutWidth :: forall self. LayoutClass self => Attr self Int
layoutWidth = String -> Attr self Int
forall gobj. GObjectClass gobj => String -> Attr gobj Int
newAttrFromUIntProperty String
"width"

-- | The height of the layout.
--
-- Allowed values: \<= @('maxBound' :: Int)@
--
-- Default value: 100
--
layoutHeight :: LayoutClass self => Attr self Int
layoutHeight :: forall self. LayoutClass self => Attr self Int
layoutHeight = String -> Attr self Int
forall gobj. GObjectClass gobj => String -> Attr gobj Int
newAttrFromUIntProperty String
"height"

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

-- | X position of child widget.
--
-- Default value: 0
--
layoutChildX :: (LayoutClass self, WidgetClass child) => child -> Attr self Int
layoutChildX :: forall self child.
(LayoutClass self, WidgetClass child) =>
child -> Attr self Int
layoutChildX = String -> child -> Attr self Int
forall container child.
(ContainerClass container, WidgetClass child) =>
String -> child -> Attr container Int
newAttrFromContainerChildIntProperty String
"x"

-- | Y position of child widget.
--
-- Default value: 0
--
layoutChildY :: (LayoutClass self, WidgetClass child) => child -> Attr self Int
layoutChildY :: forall self child.
(LayoutClass self, WidgetClass child) =>
child -> Attr self Int
layoutChildY = String -> child -> Attr self Int
forall container child.
(ContainerClass container, WidgetClass child) =>
String -> child -> Attr container Int
newAttrFromContainerChildIntProperty String
"y"

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

-- | In case the adjustments are replaced, this signal is emitted.
--
onSetScrollAdjustments, afterSetScrollAdjustments :: LayoutClass self => self
 -> (Adjustment -> Adjustment -> IO ())
 -> IO (ConnectId self)
onSetScrollAdjustments :: forall self.
LayoutClass self =>
self -> (Adjustment -> Adjustment -> IO ()) -> IO (ConnectId self)
onSetScrollAdjustments = String
-> ConnectAfter
-> self
-> (Adjustment -> Adjustment -> IO ())
-> IO (ConnectId self)
forall a' b' obj.
(GObjectClass a', GObjectClass b', GObjectClass obj) =>
String
-> ConnectAfter -> obj -> (a' -> b' -> IO ()) -> IO (ConnectId obj)
connect_OBJECT_OBJECT__NONE String
"set-scroll-adjustments" ConnectAfter
False
afterSetScrollAdjustments :: forall self.
LayoutClass self =>
self -> (Adjustment -> Adjustment -> IO ()) -> IO (ConnectId self)
afterSetScrollAdjustments = String
-> ConnectAfter
-> self
-> (Adjustment -> Adjustment -> IO ())
-> IO (ConnectId self)
forall a' b' obj.
(GObjectClass a', GObjectClass b', GObjectClass obj) =>
String
-> ConnectAfter -> obj -> (a' -> b' -> IO ()) -> IO (ConnectId obj)
connect_OBJECT_OBJECT__NONE String
"set-scroll-adjustments" ConnectAfter
True

foreign import ccall unsafe "gtk_layout_new"
  gtk_layout_new :: ((Ptr Adjustment) -> ((Ptr Adjustment) -> (IO (Ptr Widget))))

foreign import ccall safe "gtk_layout_put"
  gtk_layout_put :: ((Ptr Layout) -> ((Ptr Widget) -> (CInt -> (CInt -> (IO ())))))

foreign import ccall safe "gtk_layout_move"
  gtk_layout_move :: ((Ptr Layout) -> ((Ptr Widget) -> (CInt -> (CInt -> (IO ())))))

foreign import ccall safe "gtk_layout_set_size"
  gtk_layout_set_size :: ((Ptr Layout) -> (CUInt -> (CUInt -> (IO ()))))

foreign import ccall unsafe "gtk_layout_get_size"
  gtk_layout_get_size :: ((Ptr Layout) -> ((Ptr CUInt) -> ((Ptr CUInt) -> (IO ()))))

foreign import ccall unsafe "gtk_layout_get_hadjustment"
  gtk_layout_get_hadjustment :: ((Ptr Layout) -> (IO (Ptr Adjustment)))

foreign import ccall unsafe "gtk_layout_get_vadjustment"
  gtk_layout_get_vadjustment :: ((Ptr Layout) -> (IO (Ptr Adjustment)))

foreign import ccall safe "gtk_layout_set_hadjustment"
  gtk_layout_set_hadjustment :: ((Ptr Layout) -> ((Ptr Adjustment) -> (IO ())))

foreign import ccall safe "gtk_layout_set_vadjustment"
  gtk_layout_set_vadjustment :: ((Ptr Layout) -> ((Ptr Adjustment) -> (IO ())))

foreign import ccall safe "gtk_layout_get_bin_window"
  gtk_layout_get_bin_window :: ((Ptr Layout) -> (IO (Ptr DrawWindow)))