{-# LINE 2 "./Graphics/UI/Gtk/Layout/Grid.chs" #-}
-- -*-haskell-*-
-- GIMP Toolkit (GTK) Widget Alignment
--
-- 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)
--
-- A widget which controls the alignment and size of its child
--
module Graphics.UI.Gtk.Layout.Grid (
-- * Detail
--
-- | 'Grid' packs widgets into rows and columns.
--
-- * Class Hierarchy
-- |
-- @
-- | 'GObject'
-- | +----'Object'
-- | +----'Widget'
-- | +----'Container'
-- | +----Grid
-- @

-- * Types
  Grid,
  GridClass,
  castToGrid,
  gTypeGrid,
  toGrid,

-- * Constructors
  gridNew,

-- * Methods
  gridAttach,
  gridAttachNextTo,
  gridSetRowHomogeneous,
  gridGetRowHomogeneous,
  gridSetRowSpacing,
  gridGetRowSpacing,
  gridSetColumnHomogeneous,
  gridGetColumnHomogeneous,
  gridSetColumnSpacing,
  gridGetColumnSpacing,


  gridGetChildAt,
  gridInsertRow,
  gridInsertColumn,
  gridInsertNextTo,



  gridRemoveRow,
  gridRemoveColumn,
  gridGetBaselineRow,
  gridSetBaselineRow,
  gridGetRowBaselinePosition,
  gridSetRowBaselinePosition


 ) where

import Control.Monad (liftM)

import System.Glib.FFI
import Graphics.UI.Gtk.Abstract.Object (makeNewObject)
import Graphics.UI.Gtk.Types
{-# LINE 88 "./Graphics/UI/Gtk/Layout/Grid.chs" #-}
import Graphics.UI.Gtk.General.Enums (PositionType)


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



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

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

-- | Creates a new grid widget.
--
gridNew :: IO Grid
gridNew =
 makeNewObject mkGrid $
 liftM (castPtr :: Ptr Widget -> Ptr Grid) $
 gtk_grid_new
{-# LINE 106 "./Graphics/UI/Gtk/Layout/Grid.chs" #-}

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

-- | Adds a widget to the grid. The position of child is determined by left and top.
-- the number of "cells" that child will occupy is determined by width and height.
--
gridAttach :: (GridClass self, WidgetClass child)
 => self -- ^ @self@ - the grid.
 -> child -- ^ @child@ - the widget to add.
 -> Int -- ^ @left@ - the column number of to attach the left side of child to.
 -> Int -- ^ @top@ - the row number to attach the top side of child to.
 -> Int -- ^ @width@ - the number of columns that child will span.
 -> Int -- ^ @height@ - the number of rows that child will span.
 -> IO ()
gridAttach self child left top width height =
 (\(Grid arg1) (Widget arg2) arg3 arg4 arg5 arg6 -> withForeignPtr arg1 $ \argPtr1 ->withForeignPtr arg2 $ \argPtr2 ->gtk_grid_attach argPtr1 argPtr2 arg3 arg4 arg5 arg6)
{-# LINE 123 "./Graphics/UI/Gtk/Layout/Grid.chs" #-}
    (toGrid self)
    (toWidget child)
    (fromIntegral left)
    (fromIntegral top)
    (fromIntegral width)
    (fromIntegral height)

-- | Adds a widget to the grid. The widget is placed next to sibling , on the side
-- determined by side . When sibling is Nothing, the widget is placed in row (for
-- left or right placement) or column 0 (for top or bottom placement), at the end
-- indicated by side.
--
-- Attaching widgets labeled [1], [2], [3] with sibling == Nothing and side == GTK_POS_LEFT
-- yields a layout of 3[1].
--
gridAttachNextTo :: (GridClass self, WidgetClass child, WidgetClass sibling)
 => self -- ^ @self@ - the grid.
 -> child -- ^ @child@ - the widget to add
 -> Maybe sibling -- ^ @sib@ - the child of grid that child will be placed next to.
 -> PositionType -- ^ @pos@ - the side of the sibling that child is positioned next to.
 -> Int -- ^ @width@ - the number of columns that child will span.
 -> Int -- ^ @height@ - the number of rows that child will span.
 -> IO()
gridAttachNextTo self child sib pos width height =
 (\(Grid arg1) (Widget arg2) (Widget arg3) arg4 arg5 arg6 -> withForeignPtr arg1 $ \argPtr1 ->withForeignPtr arg2 $ \argPtr2 ->withForeignPtr arg3 $ \argPtr3 ->gtk_grid_attach_next_to argPtr1 argPtr2 argPtr3 arg4 arg5 arg6)
{-# LINE 148 "./Graphics/UI/Gtk/Layout/Grid.chs" #-}
    (toGrid self)
    (toWidget child)
    (maybe (Widget nullForeignPtr) toWidget sib)
    (fromIntegral $ fromEnum pos)
    (fromIntegral width)
    (fromIntegral height)

-- | Sets whether all rows of grid will have the same height.
--
gridSetRowHomogeneous :: GridClass self
 => self -- ^ @self@ - the grid.
 -> Bool -- ^ @homogeneous@ - True to make row homogeneous.
 -> IO ()
gridSetRowHomogeneous self homogeneous =
 (\(Grid arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->gtk_grid_set_row_homogeneous argPtr1 arg2)
{-# LINE 163 "./Graphics/UI/Gtk/Layout/Grid.chs" #-}
    (toGrid self)
    (fromBool homogeneous)

-- | Returns whether all rows of grid have the same height.
--
gridGetRowHomogeneous :: GridClass self
 => self -- ^ @self@ - the grid.
 -> IO Bool -- ^ returns whether all rows of grid have same height.
gridGetRowHomogeneous self =
 liftM toBool $
 (\(Grid arg1) -> withForeignPtr arg1 $ \argPtr1 ->gtk_grid_get_row_homogeneous argPtr1)
{-# LINE 174 "./Graphics/UI/Gtk/Layout/Grid.chs" #-}
    (toGrid self)

-- | Sets the amount of space between rows of grid.
--
gridSetRowSpacing :: GridClass self
 => self -- ^ @self@ - the grid.
 -> Int -- ^ @spacing@ - the amount of space to insert between rows.
 -> IO ()
gridSetRowSpacing self spacing =
 (\(Grid arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->gtk_grid_set_row_spacing argPtr1 arg2)
{-# LINE 184 "./Graphics/UI/Gtk/Layout/Grid.chs" #-}
    (toGrid self)
    (fromIntegral spacing)

-- | Returns the amount of space between the rows of grid.
--
gridGetRowSpacing :: GridClass self
 => self -- ^ @self@ - the grid.
 -> IO Int -- ^ returns the spacing of grid.
gridGetRowSpacing self =
 liftM fromIntegral $
 (\(Grid arg1) -> withForeignPtr arg1 $ \argPtr1 ->gtk_grid_get_row_spacing argPtr1)
{-# LINE 195 "./Graphics/UI/Gtk/Layout/Grid.chs" #-}
    (toGrid self)

-- | Sets whether all columns of grid will have the same width.
--
gridSetColumnHomogeneous :: GridClass self
 => self -- ^ @self@ - the grid.
 -> Bool -- ^ @homogeneous@ - True to make columns homogeneous.
 -> IO ()
gridSetColumnHomogeneous self homogeneous =
 (\(Grid arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->gtk_grid_set_column_homogeneous argPtr1 arg2)
{-# LINE 205 "./Graphics/UI/Gtk/Layout/Grid.chs" #-}
    (toGrid self)
    (fromBool homogeneous)

-- | Returns whether all columns of grid have the same width.
--
gridGetColumnHomogeneous :: GridClass self
 => self -- ^ @self@ - the grid.
 -> IO Bool -- ^ returns whether all columns of grid have the same width.
gridGetColumnHomogeneous self =
 liftM toBool $
 (\(Grid arg1) -> withForeignPtr arg1 $ \argPtr1 ->gtk_grid_get_column_homogeneous argPtr1)
{-# LINE 216 "./Graphics/UI/Gtk/Layout/Grid.chs" #-}
    (toGrid self)

-- | Sets the amount of space between columns of grid.
--
gridSetColumnSpacing :: GridClass self
 => self -- ^ @self@ - the grid.
 -> Int -- ^ @spacing@ - the amount of space to insert between columns.
 -> IO ()
gridSetColumnSpacing self spacing =
 (\(Grid arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->gtk_grid_set_column_spacing argPtr1 arg2)
{-# LINE 226 "./Graphics/UI/Gtk/Layout/Grid.chs" #-}
    (toGrid self)
    (fromIntegral spacing)

-- | Returns the amount of space between the columns of grid.
--
gridGetColumnSpacing :: GridClass self
 => self -- ^ @self@ - the grid.
 -> IO Int -- ^ returns the spacing of grid.
gridGetColumnSpacing self =
 liftM fromIntegral $
 (\(Grid arg1) -> withForeignPtr arg1 $ \argPtr1 ->gtk_grid_get_column_spacing argPtr1)
{-# LINE 237 "./Graphics/UI/Gtk/Layout/Grid.chs" #-}
    (toGrid self)



-- | Gets the child of grid whose area covers the grid cell whose upper left corner is at
-- left , top .
--
gridGetChildAt :: GridClass self
 => self -- ^ @self@ - the grid.
 -> Int -- ^ @left@ - the left edge of the cell.
 -> Int -- ^ @top@ - the top edge of the cell.
 -> IO (Maybe Widget) -- ^ returns the child at the given position or Nothing.
gridGetChildAt self left top = do
 ptr <- (\(Grid arg1) arg2 arg3 -> withForeignPtr arg1 $ \argPtr1 ->gtk_grid_get_child_at argPtr1 arg2 arg3)
{-# LINE 251 "./Graphics/UI/Gtk/Layout/Grid.chs" #-}
           (toGrid self)
           (fromIntegral left)
           (fromIntegral top)
 if ptr == nullPtr
    then return Nothing
    else liftM Just $ makeNewObject mkWidget (return ptr)

-- | Inserts a row at the specified position. Children which are attached at or below this
-- position are moved one row down. Children which span across this position are grown to
-- span the new row.
--
gridInsertRow :: GridClass self
 => self -- ^ @self@ - the grid.
 -> Int -- ^ @pos@ - the position to insert the row at.
 -> IO ()
gridInsertRow self pos =
 (\(Grid arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->gtk_grid_insert_row argPtr1 arg2)
{-# LINE 268 "./Graphics/UI/Gtk/Layout/Grid.chs" #-}
    (toGrid self)
    (fromIntegral pos)

-- | Inserts a column at the specified position. Children which are attached at or to the
-- right of this position are moved one column to the right. Children which span across
-- this position are grown to span the new column
--
gridInsertColumn :: GridClass self
 => self -- ^ @self@ - the grid.
 -> Int -- ^ @pos@ - the positiion to insert the column at.
 -> IO ()
gridInsertColumn self pos =
 (\(Grid arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->gtk_grid_insert_column argPtr1 arg2)
{-# LINE 281 "./Graphics/UI/Gtk/Layout/Grid.chs" #-}
    (toGrid self)
    (fromIntegral pos)

-- | Inserts a row or column at the specified position. The new row or column is placed
-- next to sibling , on the side determined by side. If side is GTK_POS_TOP or
-- GTK_POS_BOTTOM, a row is inserted. If side is GTK_POS_LEFT of GTK_POS_RIGHT, a
-- column is inserted.
--
gridInsertNextTo :: (GridClass self, WidgetClass sibling)
 => self -- ^ @self@ - the grid.
 -> sibling -- ^ @sib@ - the child of grid that the new row or column will be placed next to.
 -> PositionType -- ^ @pos@ - the isde of the sibling that child is positioned next to.
 -> IO ()
gridInsertNextTo self sib pos =
 (\(Grid arg1) (Widget arg2) arg3 -> withForeignPtr arg1 $ \argPtr1 ->withForeignPtr arg2 $ \argPtr2 ->gtk_grid_insert_next_to argPtr1 argPtr2 arg3)
{-# LINE 296 "./Graphics/UI/Gtk/Layout/Grid.chs" #-}
    (toGrid self)
    (toWidget sib)
    (fromIntegral $ fromEnum pos)





-- | Removes a row from the grid. Children that are placed in this row are removed,
-- spanning children that overlap this row have their height reduced by one, and children
-- below the row are moved up.
--
gridRemoveRow :: GridClass self
 => self -- ^ @self@ - the grid.
 -> Int -- ^ @pos@ - the position of the row to remove.
 -> IO ()
gridRemoveRow self pos =
 (\(Grid arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->gtk_grid_remove_row argPtr1 arg2)
{-# LINE 314 "./Graphics/UI/Gtk/Layout/Grid.chs" #-}
    (toGrid self)
    (fromIntegral pos)

-- | Removes a column from the grid. Children that are placed in this column are removed,
-- spanning children that overlap this column have their width reduced by one, and
-- children after the column are moved to the left.
--
gridRemoveColumn :: GridClass self
 => self -- ^ @self@ - the grid.
 -> Int -- ^ @pos@ -the position of the column to remove.
 -> IO ()
gridRemoveColumn self pos =
 (\(Grid arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->gtk_grid_remove_column argPtr1 arg2)
{-# LINE 327 "./Graphics/UI/Gtk/Layout/Grid.chs" #-}
    (toGrid self)
    (fromIntegral pos)

-- | Returns which row defines the global baseline of grid.
--
gridGetBaselineRow :: GridClass self
 => self -- ^ @self@ - the grid.
 -> IO Int -- ^ returns the row index defining the global baseline.
gridGetBaselineRow self =
 liftM fromIntegral $
 (\(Grid arg1) -> withForeignPtr arg1 $ \argPtr1 ->gtk_grid_get_baseline_row argPtr1)
{-# LINE 338 "./Graphics/UI/Gtk/Layout/Grid.chs" #-}
    (toGrid self)

-- | Sets which row defines the global baseline for the entire grid. Each row in
-- the grid can have its own local baseline, but only one of those is global,
-- meaning it will be the baseline in the parent of the grid.
--
gridSetBaselineRow :: GridClass self
 => self -- ^ @self@ - the grid.
 -> Int -- ^ @row@ - the row index.
 -> IO ()
gridSetBaselineRow self row =
 (\(Grid arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->gtk_grid_set_baseline_row argPtr1 arg2)
{-# LINE 350 "./Graphics/UI/Gtk/Layout/Grid.chs" #-}
    (toGrid self)
    (fromIntegral row)

-- | Returns the baseline position of row as set by gridSetRowBaselinePosition
-- or the default value BASELINE_POSITION_CENTER
--
gridGetRowBaselinePosition :: GridClass self
 => self -- ^ @self@ - the grid.
 -> Int -- ^ @row@ - a row index.
 -> IO BaselinePosition -- ^ returns the baseline position of row.
gridGetRowBaselinePosition self row =
 liftM (toEnum . fromIntegral) $
 (\(Grid arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->gtk_grid_get_row_baseline_position argPtr1 arg2)
{-# LINE 363 "./Graphics/UI/Gtk/Layout/Grid.chs" #-}
    (toGrid self)
    (fromIntegral row)

-- | Sets how the baseline should be positioned on row of the grid, in case that row
-- is assigned more space than is requested.
--
gridSetRowBaselinePosition :: GridClass self
 => self -- ^ @self@ - the grid.
 -> Int -- ^ @row@ - a row index.
 -> BaselinePosition -- ^ @pos@ - a BaselinePosition.
 -> IO ()
gridSetRowBaselinePosition self row pos =
 (\(Grid arg1) arg2 arg3 -> withForeignPtr arg1 $ \argPtr1 ->gtk_grid_set_row_baseline_position argPtr1 arg2 arg3)
{-# LINE 376 "./Graphics/UI/Gtk/Layout/Grid.chs" #-}
    (toGrid self)
    (fromIntegral row)
    (fromIntegral $ fromEnum pos)

foreign import ccall unsafe "gtk_grid_new"
  gtk_grid_new :: (IO (Ptr Widget))

foreign import ccall safe "gtk_grid_attach"
  gtk_grid_attach :: ((Ptr Grid) -> ((Ptr Widget) -> (CInt -> (CInt -> (CInt -> (CInt -> (IO ())))))))

foreign import ccall safe "gtk_grid_attach_next_to"
  gtk_grid_attach_next_to :: ((Ptr Grid) -> ((Ptr Widget) -> ((Ptr Widget) -> (CInt -> (CInt -> (CInt -> (IO ())))))))

foreign import ccall safe "gtk_grid_set_row_homogeneous"
  gtk_grid_set_row_homogeneous :: ((Ptr Grid) -> (CInt -> (IO ())))

foreign import ccall safe "gtk_grid_get_row_homogeneous"
  gtk_grid_get_row_homogeneous :: ((Ptr Grid) -> (IO CInt))

foreign import ccall safe "gtk_grid_set_row_spacing"
  gtk_grid_set_row_spacing :: ((Ptr Grid) -> (CUInt -> (IO ())))

foreign import ccall safe "gtk_grid_get_row_spacing"
  gtk_grid_get_row_spacing :: ((Ptr Grid) -> (IO CUInt))

foreign import ccall safe "gtk_grid_set_column_homogeneous"
  gtk_grid_set_column_homogeneous :: ((Ptr Grid) -> (CInt -> (IO ())))

foreign import ccall safe "gtk_grid_get_column_homogeneous"
  gtk_grid_get_column_homogeneous :: ((Ptr Grid) -> (IO CInt))

foreign import ccall safe "gtk_grid_set_column_spacing"
  gtk_grid_set_column_spacing :: ((Ptr Grid) -> (CUInt -> (IO ())))

foreign import ccall safe "gtk_grid_get_column_spacing"
  gtk_grid_get_column_spacing :: ((Ptr Grid) -> (IO CUInt))

foreign import ccall safe "gtk_grid_get_child_at"
  gtk_grid_get_child_at :: ((Ptr Grid) -> (CInt -> (CInt -> (IO (Ptr Widget)))))

foreign import ccall safe "gtk_grid_insert_row"
  gtk_grid_insert_row :: ((Ptr Grid) -> (CInt -> (IO ())))

foreign import ccall safe "gtk_grid_insert_column"
  gtk_grid_insert_column :: ((Ptr Grid) -> (CInt -> (IO ())))

foreign import ccall safe "gtk_grid_insert_next_to"
  gtk_grid_insert_next_to :: ((Ptr Grid) -> ((Ptr Widget) -> (CInt -> (IO ()))))

foreign import ccall safe "gtk_grid_remove_row"
  gtk_grid_remove_row :: ((Ptr Grid) -> (CInt -> (IO ())))

foreign import ccall safe "gtk_grid_remove_column"
  gtk_grid_remove_column :: ((Ptr Grid) -> (CInt -> (IO ())))

foreign import ccall safe "gtk_grid_get_baseline_row"
  gtk_grid_get_baseline_row :: ((Ptr Grid) -> (IO CInt))

foreign import ccall safe "gtk_grid_set_baseline_row"
  gtk_grid_set_baseline_row :: ((Ptr Grid) -> (CInt -> (IO ())))

foreign import ccall safe "gtk_grid_get_row_baseline_position"
  gtk_grid_get_row_baseline_position :: ((Ptr Grid) -> (CInt -> (IO CInt)))

foreign import ccall safe "gtk_grid_set_row_baseline_position"
  gtk_grid_set_row_baseline_position :: ((Ptr Grid) -> (CInt -> (CInt -> (IO ()))))