diff --git a/Graphics/UI/Gtk.chs b/Graphics/UI/Gtk.chs --- a/Graphics/UI/Gtk.chs +++ b/Graphics/UI/Gtk.chs @@ -221,6 +221,7 @@ module Graphics.UI.Gtk.Layout.Layout, module Graphics.UI.Gtk.Layout.Notebook, #if GTK_MAJOR_VERSION >= 3 + module Graphics.UI.Gtk.Layout.Grid, module Graphics.UI.Gtk.Layout.Overlay, #endif module Graphics.UI.Gtk.Layout.Expander, @@ -486,6 +487,7 @@ import Graphics.UI.Gtk.Layout.Layout import Graphics.UI.Gtk.Layout.Notebook #if GTK_MAJOR_VERSION >= 3 +import Graphics.UI.Gtk.Layout.Grid import Graphics.UI.Gtk.Layout.Overlay #endif import Graphics.UI.Gtk.Layout.Expander diff --git a/Graphics/UI/Gtk/General/Enums.chs b/Graphics/UI/Gtk/General/Enums.chs --- a/Graphics/UI/Gtk/General/Enums.chs +++ b/Graphics/UI/Gtk/General/Enums.chs @@ -32,6 +32,9 @@ #endif ArrowType(..), AttachOptions(..), +#if GTK_CHECK_VERSION(3,10,0) + BaselinePosition(..), +#endif MouseButton(..), ButtonBoxStyle(..), CalendarDisplayOptions(..), @@ -139,6 +142,16 @@ {#enum AttachOptions {underscoreToCase} deriving(Bounded,Eq,Show)#} instance Flags AttachOptions + +#if GTK_CHECK_VERSION(3,10,0) +-- | Whenever a container has some form of natural row it may align children in +-- that row along a common typographical baseline. If the amount of verical space +-- in the row is taller than the total requested height of the baseline-aligned +-- children then it can use a BaselinePosition to select where to put the +-- baseline inside the extra availible space. +-- +{#enum BaselinePosition {underscoreToCase} deriving (Eq,Show)#} +#endif -- | Mouse buttons. -- diff --git a/Graphics/UI/Gtk/Layout/Grid.chs b/Graphics/UI/Gtk/Layout/Grid.chs new file mode 100644 --- /dev/null +++ b/Graphics/UI/Gtk/Layout/Grid.chs @@ -0,0 +1,380 @@ +{-# LANGUAGE CPP #-} +-- -*-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, + +#if GTK_CHECK_VERSION(3,2,0) + gridGetChildAt, + gridInsertRow, + gridInsertColumn, + gridInsertNextTo, +#endif + +#if GTK_CHECK_VERSION(3,10,0) + gridRemoveRow, + gridRemoveColumn, + gridGetBaselineRow, + gridSetBaselineRow, + gridGetRowBaselinePosition, + gridSetRowBaselinePosition +#endif + + ) where + +import Control.Monad (liftM) + +import System.Glib.FFI +import Graphics.UI.Gtk.Abstract.Object (makeNewObject) +{#import Graphics.UI.Gtk.Types#} +import Graphics.UI.Gtk.General.Enums (PositionType) + +#if GTK_CHECK_VERSION(3,10,0) +import Graphics.UI.Gtk.General.Enums (BaselinePosition) +#endif + +{# context lib="gtk" prefix="gtk" #} + +--------------------- +-- Constructors + +-- | Creates a new grid widget. +-- +gridNew :: IO Grid +gridNew = + makeNewObject mkGrid $ + liftM (castPtr :: Ptr Widget -> Ptr Grid) $ + {# call unsafe grid_new #} + +--------------------- +-- 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 = + {# call grid_attach #} + (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 = + {# call grid_attach_next_to #} + (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 = + {# call grid_set_row_homogeneous #} + (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 $ + {# call grid_get_row_homogeneous #} + (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 = + {# call grid_set_row_spacing #} + (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 $ + {# call grid_get_row_spacing #} + (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 = + {# call grid_set_row_homogeneous #} + (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 $ + {# call grid_get_column_homogeneous #} + (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 = + {# call grid_set_column_spacing #} + (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 $ + {# call grid_get_column_spacing #} + (toGrid self) + +#if GTK_CHECK_VERSION(3,2,0) + +-- | 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 <- {# call grid_get_child_at #} + (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 = + {# call grid_insert_row #} + (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 = + {# call grid_insert_column #} + (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 = + {# call grid_insert_next_to #} + (toGrid self) + (toWidget sib) + (fromIntegral $ fromEnum pos) + +#endif + +#if GTK_CHECK_VERSION(3,10,0) + +-- | 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 = + {# call grid_remove_row #} + (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 = + {# call grid_remove_column #} + (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 $ + {# call grid_get_baseline_row #} + (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 = + {# call grid_set_baseline_row #} + (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) $ + {# call grid_get_row_baseline_position #} + (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 = + {# call grid_set_row_baseline_position #} + (toGrid self) + (fromIntegral row) + (fromIntegral $ fromEnum pos) + +#endif diff --git a/Graphics/UI/Gtk/Types.chs b/Graphics/UI/Gtk/Types.chs --- a/Graphics/UI/Gtk/Types.chs +++ b/Graphics/UI/Gtk/Types.chs @@ -422,6 +422,10 @@ toStatusbar, mkStatusbar, unStatusbar, castToStatusbar, gTypeStatusbar, + Grid(Grid), GridClass, + toGrid, + mkGrid, unGrid, + castToGrid, gTypeGrid, Fixed(Fixed), FixedClass, toFixed, mkFixed, unFixed, @@ -3209,6 +3213,31 @@ gTypeStatusbar :: GType gTypeStatusbar = {# call fun unsafe gtk_statusbar_get_type #} + +-- *********************************************************************** Grid + +{#pointer *GtkGrid as Grid foreign newtype #} deriving (Eq,Ord) + +mkGrid = (Grid, objectUnrefFromMainloop) +unGrid (Grid o) = o + +class ContainerClass o => GridClass o +toGrid :: GridClass o => o -> Grid +toGrid = unsafeCastGObject . toGObject + +instance GridClass Grid +instance ContainerClass Grid +instance WidgetClass Grid +instance GObjectClass Grid where + toGObject = GObject . castForeignPtr . unGrid + unsafeCastGObject = Grid . castForeignPtr . unGObject + +castToGrid :: GObjectClass obj => obj -> Grid +castToGrid = castTo gTypeGrid "Grid" + +gTypeGrid :: GType +gTypeGrid = + {# call fun unsafe gtk_grid_get_type #} -- ********************************************************************** Fixed diff --git a/gtk3.cabal b/gtk3.cabal --- a/gtk3.cabal +++ b/gtk3.cabal @@ -1,5 +1,5 @@ Name: gtk3 -Version: 0.13.9 +Version: 0.14.0 License: LGPL-2.1 License-file: COPYING Copyright: (c) 2001-2010 The Gtk2Hs Team @@ -10,7 +10,7 @@ Stability: provisional homepage: http://projects.haskell.org/gtk2hs/ bug-reports: https://github.com/gtk2hs/gtk2hs/issues -Synopsis: Binding to the Gtk+ graphical user interface library. +Synopsis: Binding to the Gtk+ 3 graphical user interface library Description: This is the core library of the Gtk2Hs suite of libraries for Haskell based on Gtk+. Gtk+ is an extensive and mature multi-platform toolkit for creating graphical user interfaces. @@ -223,6 +223,7 @@ Graphics.UI.Gtk.Layout.AspectFrame Graphics.UI.Gtk.Layout.Expander Graphics.UI.Gtk.Layout.Fixed + Graphics.UI.Gtk.Layout.Grid Graphics.UI.Gtk.Layout.HBox Graphics.UI.Gtk.Layout.HButtonBox Graphics.UI.Gtk.Layout.HPaned @@ -371,6 +372,9 @@ cc-options: -fno-exceptions extra-libraries: kernel32 + if os(windows) + cpp-options: -D__USE_MINGW_ANSI_STDIO=1 + x-c2hs-Header: hsgtk.h x-Types-Hierarchy: hierarchy3.list @@ -387,7 +391,7 @@ main-is: ActionMenu.hs if !flag(build-demos) buildable: False - build-depends: gtk3==0.13.9, base, transformers, text + build-depends: gtk3==0.14.0, base, transformers, text Executable gtk2hs-demo-buttonBox default-language: Haskell98 @@ -395,7 +399,7 @@ main-is: ButtonBox.hs if !flag(build-demos) buildable: False - build-depends: gtk3==0.13.9, base, transformers + build-depends: gtk3==0.14.0, base, transformers Executable gtk2hs-demo-carsim default-language: Haskell98 @@ -403,7 +407,7 @@ main-is: CarSim.hs if !flag(build-demos) buildable: False - build-depends: gtk3==0.13.9, base, transformers, time, cairo + build-depends: gtk3==0.14.0, base, transformers, time, cairo Executable gtk2hs-demo-progress default-language: Haskell98 @@ -411,7 +415,7 @@ main-is: Progress.hs if !flag(build-demos) buildable: False - build-depends: gtk3==0.13.9, base, transformers + build-depends: gtk3==0.14.0, base, transformers Executable gtk2hs-demo-progressThreadedRTS default-language: Haskell98 @@ -419,7 +423,7 @@ main-is: ProgressThreadedRTS.hs if !flag(build-demos) buildable: False - build-depends: gtk3==0.13.9, base, transformers + build-depends: gtk3==0.14.0, base, transformers ghc-options: -threaded Executable gtk2hs-demo-fastDraw @@ -428,7 +432,7 @@ main-is: FastDraw.hs if !flag(build-demos) buildable: False - build-depends: gtk3==0.13.9, base, transformers, array, cairo + build-depends: gtk3==0.14.0, base, transformers, array, cairo Executable gtk2hs-demo-fonts default-language: Haskell98 @@ -436,7 +440,7 @@ main-is: Fonts.hs if !flag(build-demos) buildable: False - build-depends: gtk3==0.13.9, base + build-depends: gtk3==0.14.0, base Executable gtk2hs-demo-builder default-language: Haskell98 @@ -444,7 +448,7 @@ main-is: GtkBuilderTest.hs if !flag(build-demos) buildable: False - build-depends: gtk3==0.13.9, base, transformers + build-depends: gtk3==0.14.0, base, transformers Executable gtk2hs-demo-helloworld default-language: Haskell98 @@ -452,7 +456,7 @@ main-is: World.hs if !flag(build-demos) buildable: False - build-depends: gtk3==0.13.9, base, transformers + build-depends: gtk3==0.14.0, base, transformers Executable gtk2hs-demo-layout default-language: Haskell98 @@ -460,7 +464,7 @@ main-is: Layout.hs if !flag(build-demos) buildable: False - build-depends: gtk3==0.13.9, base, transformers, cairo, text + build-depends: gtk3==0.14.0, base, transformers, cairo, text Executable gtk2hs-demo-menudemo default-language: Haskell98 @@ -468,7 +472,7 @@ main-is: MenuDemo.hs if !flag(build-demos) buildable: False - build-depends: gtk3==0.13.9, base, transformers, text + build-depends: gtk3==0.14.0, base, transformers, text Executable gtk2hs-demo-combodemo default-language: Haskell98 @@ -476,7 +480,7 @@ main-is: ComboDemo.hs if !flag(build-demos) buildable: False - build-depends: gtk3==0.13.9, text, base, transformers + build-depends: gtk3==0.14.0, text, base, transformers Executable gtk2hs-demo-notebook default-language: Haskell98 @@ -484,7 +488,7 @@ main-is: Notebook.hs if !flag(build-demos) buildable: False - build-depends: gtk3==0.13.9, base, transformers, text + build-depends: gtk3==0.14.0, base, transformers, text Executable gtk2hs-demo-statusIcon default-language: Haskell98 @@ -492,7 +496,7 @@ main-is: StatusIcon.hs if !flag(build-demos) buildable: False - build-depends: gtk3==0.13.9, base, transformers + build-depends: gtk3==0.14.0, base, transformers Executable gtk2hs-demo-arabic default-language: Haskell98 @@ -500,7 +504,7 @@ main-is: Arabic.hs if !flag(build-demos) buildable: False - build-depends: gtk3==0.13.9, base, transformers, text + build-depends: gtk3==0.14.0, base, transformers, text Executable gtk2hs-demo-overlay default-language: Haskell98 @@ -508,4 +512,4 @@ main-is: Overlay.hs if !flag(build-demos) buildable: False - build-depends: gtk3==0.13.9, base, transformers + build-depends: gtk3==0.14.0, base, transformers diff --git a/hierarchy3.list b/hierarchy3.list --- a/hierarchy3.list +++ b/hierarchy3.list @@ -129,6 +129,7 @@ GtkInfoBar GtkFileChooserButton GtkStatusbar + GtkGrid GtkFixed GtkPaned GtkHPaned