Copyright | (c) Daan Leijen & Wijnand van Suijlen 2003 |
---|---|
License | wxWindows |
Maintainer | wxhaskell-devel@lists.sourceforge.net |
Stability | provisional |
Portability | portable |
Safe Haskell | None |
Language | Haskell98 |
Combinators to specify layout. (These combinators use wxWidgets Sizer
objects).
Layout can be specified using windowSetLayout
. For example:
do f <- frameCreateTopFrame "Test" ok <- buttonCreate f idAny "Bye" rectNull 0 windowSetLayout f (widget ok) ...
The windowSetLayout
function takes Layout
as its argument.
The widget
combinator creates a layout from a window. The space
combinator creates
an empty layout with a specific width and height. Furthermore, we have the label
combinator
to create a static label label and boxed
to create a labeled border around a layout.
The grid
combinator lays out elements in a table with a given space between the elements.
Here is for example a layout for retrieving an x and y coordinate from the user, with 5 pixels space
between the controls:
boxed "coordinates" (grid 5 5 [[label "x", widget xinput] ,[label "y", widget yinput]])
Combinators like row
and column
are specific instances of grids. We can use
these combinator to good effect to add an ok and cancel button at the bottom of our dialog:
column 5 [ boxed "coordinates" (grid 5 5 [[label "x", widget xinput] ,[label "y", widget yinput]]) , row 5 [widget ok, widget cancel]]
Layout tranformers influence attributes of a layout. The margin
combinator adds a
margin around a layout. The align combinators specify how a combinator is aligned when
the assigned area is larger than the layout itself. We can use these transformers to
add a margin around our dialog and to align the buttons to the bottom right (instead of the
default top-left):
margin 10 $ column 5 [ boxed "coordinates" (grid 5 5 [[label "x", widget xinput] ,[label "y", widget yinput]]) , alignBottomRight $ row 5 [widget ok, widget cancel]]
Besides aligning a layout in its assigned area, we can also specify that a layout should
expand to fill the assigned area. The shaped
combinator fills an area while maintaining the
original proportions (or aspect ratio) of a layout. The expand
combinator always tries to fill
the entire area (and alignment is ignored).
The final attribute is the stretch of a layout. A stretchable layout may get a larger area assigned than the minimally required area. This can be used to fill out the entire parent area -- this happens for example when a user enlarges a dialog.
The default stretch and expansion mode of layout containers, like grid
and boxed
, depends on the
stretch of the child layouts. A column of a grid is only stretchable when all
elements of that column have horizontal stretch. The same holds for rows with vertical stretch.
When any column or row is stretchable, the grid itself will also be stretchable in that direction
and the grid will expand
to fill the assigned area by default (instead of being static
). Just like
a grid, other containers, like container
, boxed
, tabs
, row
, and column
, will also propagate the stretch
and expansion mode of their child layouts.
Armed with the stretch
combinators we can make our dialog resizeable.
We let the input widgets resize horizontally. Furthermore, the button row will resize
vertically and horizontally with the buttons aligned to the bottom right. Due to the
stretch propagation rules, the grid
and boxed
stretch horizontally and expand
to fill the
assigned area. The horizontal row
does not stretch by default (and we need to use
an explicit stretch
) and it does not expand into the assigned area by default (and therefore
alignment works properly).
margin 10 $ column 5 [ boxed "coordinates" (grid 5 5 [[label "x", hstretch $ expand $ widget xinput] ,[label "y", hstretch $ expand $ widget yinput]]) , stretch $ alignBottomRight $ row 5 [widget ok, widget cancel]]
There are some common uses of stretchable combinators. The fill
combinators combine
stretch and expansion. For example, hfill
is defined as (hstretch . expand
). The float
combinators combine alignment and stretch
. For example, floatBottomRight
is defined
as (stretch . alignBottomRight
). There are also horizontal and vertical float combinators,
like hfloatCentre
and vfloatBottom
. Here is the above example using fill
and float:
margin 10 $ column 5 [ boxed "coordinates" (grid 5 5 [[label "x", hfill $ widget xinput] ,[label "y", hfill $ widget yinput]]) , floatBottomRight $ row 5 [widget ok, widget cancel]]
The glue
combinators are stretchable empty space. For example, hglue
is defined as (hstretch (space 0 0)
). We can use glue to mimic alignment. Here is the above
layout specified with glue. Note that we use hspace
to manually insert
space between the elements or otherwise there would be space between the glue and
the ok button.
margin 10 $ column 5 [ boxed "coordinates" (grid 5 5 [[label "x", hfill $ widget xinput] ,[label "y", hfill $ widget yinput]]) , glue , row 0 [hglue, widget ok, hspace 5, widget cancel]]
Splitter windows can also be specified with layout; you get somewhat less functionality
but it is quite convenient for most applications. A horizontal split is done using
hsplit
while a vertical split is specified with a vsplit
.
The layout for notebooks is specified with the tabs
combinator. The following
example shows this (and note also how we use container
to set the layout of panels):
nbook <- notebookCreate ... panel1 <- panelCreate nbook ... ... panel2 <- panelCreate nbook ... ... windowSetLayout frame (tabs nbook [tab "page one" $ container panel1 $ margin 10 $ floatCentre $ widget ok ,tab "page two" $ container panel2 $ margin 10 $ hfill $ widget quit])
The pages always need to be embedded inside a container
(normally a Panel
). The
title of the pages is determined from the label of the container widget.
Note: /At the moment, extra space is divided evenly among stretchable layouts. We plan to add
a (proportion :: Int -> Layout -> Layout
) combinator in the future to stretch layouts
according to a relative weight, but unfortunately, that entails implementing a better
FlexGrid
sizer for wxWidgets./
- data Layout
- sizerFromLayout :: Window a -> Layout -> IO (Sizer ())
- type TabPage = (String, Bitmap (), Layout)
- windowSetLayout :: Window a -> Layout -> IO ()
- layoutFromWindow :: Window a -> Layout
- windowReFit :: Window a -> IO ()
- windowReFitMinimal :: Window a -> IO ()
- windowReLayout :: Window a -> IO ()
- windowReLayoutMinimal :: Window a -> IO ()
- class Widget w where
- label :: String -> Layout
- rule :: Int -> Int -> Layout
- hrule :: Int -> Layout
- vrule :: Int -> Layout
- sizer :: Sizer a -> Layout
- row :: Int -> [Layout] -> Layout
- column :: Int -> [Layout] -> Layout
- grid :: Int -> Int -> [[Layout]] -> Layout
- boxed :: String -> Layout -> Layout
- container :: Window a -> Layout -> Layout
- tab :: String -> Layout -> TabPage
- imageTab :: String -> Bitmap () -> Layout -> TabPage
- tabs :: Notebook a -> [TabPage] -> Layout
- hsplit :: SplitterWindow a -> Int -> Int -> Layout -> Layout -> Layout
- vsplit :: SplitterWindow a -> Int -> Int -> Layout -> Layout -> Layout
- glue :: Layout
- hglue :: Layout
- vglue :: Layout
- space :: Int -> Int -> Layout
- hspace :: Int -> Layout
- vspace :: Int -> Layout
- empty :: Layout
- dynamic :: Layout -> Layout
- static :: Layout -> Layout
- stretch :: Layout -> Layout
- hstretch :: Layout -> Layout
- vstretch :: Layout -> Layout
- minsize :: Size -> Layout -> Layout
- rigid :: Layout -> Layout
- shaped :: Layout -> Layout
- expand :: Layout -> Layout
- fill :: Layout -> Layout
- hfill :: Layout -> Layout
- vfill :: Layout -> Layout
- margin :: Int -> Layout -> Layout
- marginWidth :: Int -> Layout -> Layout
- marginNone :: Layout -> Layout
- marginLeft :: Layout -> Layout
- marginTop :: Layout -> Layout
- marginRight :: Layout -> Layout
- marginBottom :: Layout -> Layout
- floatTopLeft :: Layout -> Layout
- floatTop :: Layout -> Layout
- floatTopRight :: Layout -> Layout
- floatLeft :: Layout -> Layout
- floatCentre :: Layout -> Layout
- floatCenter :: Layout -> Layout
- floatRight :: Layout -> Layout
- floatBottomLeft :: Layout -> Layout
- floatBottom :: Layout -> Layout
- floatBottomRight :: Layout -> Layout
- hfloatLeft :: Layout -> Layout
- hfloatCentre :: Layout -> Layout
- hfloatCenter :: Layout -> Layout
- hfloatRight :: Layout -> Layout
- vfloatTop :: Layout -> Layout
- vfloatCentre :: Layout -> Layout
- vfloatCenter :: Layout -> Layout
- vfloatBottom :: Layout -> Layout
- center :: Layout -> Layout
- centre :: Layout -> Layout
- alignTopLeft :: Layout -> Layout
- alignTop :: Layout -> Layout
- alignTopRight :: Layout -> Layout
- alignLeft :: Layout -> Layout
- alignCentre :: Layout -> Layout
- alignCenter :: Layout -> Layout
- alignRight :: Layout -> Layout
- alignBottomLeft :: Layout -> Layout
- alignBottom :: Layout -> Layout
- alignBottomRight :: Layout -> Layout
- halignLeft :: Layout -> Layout
- halignCentre :: Layout -> Layout
- halignCenter :: Layout -> Layout
- halignRight :: Layout -> Layout
- valignTop :: Layout -> Layout
- valignCentre :: Layout -> Layout
- valignCenter :: Layout -> Layout
- valignBottom :: Layout -> Layout
- nullLayouts :: [Layout]
Types
Abstract data type that represents the layout of controls in a window.
type TabPage = (String, Bitmap (), Layout) Source
A tab page in a notebook: a title, a possible bitmap and a layout.
Window
windowSetLayout :: Window a -> Layout -> IO () Source
Set the layout of a window (automatically calls sizerFromLayout
).
layoutFromWindow :: Window a -> Layout Source
(primitive) Lift a basic control to a Layout
.
windowReFit :: Window a -> IO () Source
Fits a widget properly by calling windowReLayout
on
the parent frame or dialog (windowGetFrameParent
).
windowReFitMinimal :: Window a -> IO () Source
Fits a widget properly by calling windowReLayout
on
the parent frame or dialog (windowGetFrameParent
).
windowReLayout :: Window a -> IO () Source
Re-invoke layout algorithm to fit a window around its
children. It will enlarge when the current
client size is too small, but not shrink when the window
is already large enough. (in contrast, windowReLayoutMinimal
will
also shrink a window so that it always minimally sized).
windowReLayoutMinimal :: Window a -> IO () Source
Re-invoke layout algorithm to fit a window around its
children. It will resize the window to its minimal
acceptable size (windowFit
).
Layouts
Widgets
Anything in the widget class can be layed out.
label :: String -> Layout Source
(primitive) Create a static label label (= StaticText
).
Containers
row :: Int -> [Layout] -> Layout Source
Layout elements in a horizontal direction with a certain amount of space between the elements.
column :: Int -> [Layout] -> Layout Source
Layout elements in a vertical direction with a certain amount of space between the elements.
grid :: Int -> Int -> [[Layout]] -> Layout Source
(primitive) The expression (grid w h rows
) creates a grid of rows
. The w
argument
is the extra horizontal space between elements and h
the extra vertical space between elements.
(implemented using the FlexGrid
sizer).
Only when all elements of a column have horizontal stretch (see stretch
and hstretch
), the entire
column will stretch horizontally, and the same holds for rows with vertical stretch.
When any column or row in a grid can stretch, the grid itself will also stretch in that direction
and the grid will expand
to fill the assigned area by default (instead of being static
).
imageTab :: String -> Bitmap () -> Layout -> TabPage Source
Create a tab page with a certain title, icon, and layout.
hsplit :: SplitterWindow a -> Int -> Int -> Layout -> Layout -> Layout Source
Add a horizontal sash bar between two windows. The two integer arguments specify the width of the sash bar (5) and the initial height of the top pane respectively.
vsplit :: SplitterWindow a -> Int -> Int -> Layout -> Layout -> Layout Source
Add a vertical sash bar between two windows. The two integer arguments specify the width of the sash bar (5) and the initial width of the left pane respectively.
Glue
Whitespace
Transformers
dynamic :: Layout -> Layout Source
Adjust the minimal size of a control dynamically when the content changes.
This is used for example to correctly layout static text or buttons when the
text or label changes at runtime. This property is automatically set for
StaticText
, label
s, and button
s.
Stretch
static :: Layout -> Layout Source
(primitive) The layout is not stretchable. In a grid
, the row and column that contain this layout will
not be resizeable. Note that a static
layout can still be assigned an area that is larger
than its preferred size due to grid alignment constraints.
(default, except for containers like grid
and boxed
where it depends on the child layouts).
stretch :: Layout -> Layout Source
(primitive) The layout is stretchable and can be assigned a larger area in both the horizontal and vertical
direction. See also combinators like fill
and floatCentre
.
hstretch :: Layout -> Layout Source
(primitive) The layout is stretchable in the horizontal direction. See also combinators like hfill
and hfloatCentre
.
vstretch :: Layout -> Layout Source
(primitive) The layout is stretchable in the vertical direction. See also combinators like vfill
and vfloatCentre
.
Expansion
shaped :: Layout -> Layout Source
(primitive) Expand the layout to fill the assigned area but maintain the original proportions of the layout. Note that the layout can still be aligned in a horizontal or vertical direction.
expand :: Layout -> Layout Source
(primitive) Expand the layout to fill the assigned area entirely, even when the original proportions can not
be maintained. Note that alignment will have no effect on such layout. See also fill
.
Fill
Margin
marginWidth :: Int -> Layout -> Layout Source
(primitive) Set the width of the margin (default is 10 pixels).
marginNone :: Layout -> Layout Source
(primitive) Remove the margin of a layout (default).
marginLeft :: Layout -> Layout Source
(primitive) Add a margin to the left.
marginRight :: Layout -> Layout Source
(primitive) Add a right margin.
marginBottom :: Layout -> Layout Source
(primitive) Add a margin to the bottom.
Floating alignment
floatTopLeft :: Layout -> Layout Source
Make the layout stretchable and align it in the top-left corner of the assigned area (default).
floatTop :: Layout -> Layout Source
Make the layout stretchable and align it centered on the top of the assigned area.
floatTopRight :: Layout -> Layout Source
Make the layout stretchable and align it to the top-right of the assigned area.
floatLeft :: Layout -> Layout Source
Make the layout stretchable and align it centered to the left of the assigned area.
floatCentre :: Layout -> Layout Source
Make the layout stretchable and align it in the center of the assigned area.
floatCenter :: Layout -> Layout Source
Make the layout stretchable and align it in the center of the assigned area.
floatRight :: Layout -> Layout Source
Make the layout stretchable and align it centered to the right of the assigned area.
floatBottomLeft :: Layout -> Layout Source
Make the layout stretchable and align it to the bottom-left of the assigned area.
floatBottom :: Layout -> Layout Source
Make the layout stretchable and align it centered on the bottom of the assigned area.
floatBottomRight :: Layout -> Layout Source
Make the layout stretchable and align it to the bottom-right of the assigned area.
Horizontal floating alignment
hfloatLeft :: Layout -> Layout Source
Make the layout horizontally stretchable and align to the left.
hfloatCentre :: Layout -> Layout Source
Make the layout horizontally stretchable and align to the center.
hfloatCenter :: Layout -> Layout Source
Make the layout horizontally stretchable and align to the center.
hfloatRight :: Layout -> Layout Source
Make the layout horizontally stretchable and align to the right.
Vertical floating alignment
vfloatCentre :: Layout -> Layout Source
Make the layout vertically stretchable and align to the center.
vfloatCenter :: Layout -> Layout Source
Make the layout vertically stretchable and align to the center.
vfloatBottom :: Layout -> Layout Source
Make the layout vertically stretchable and align to the bottom.
Alignment
alignTopLeft :: Layout -> Layout Source
Align the layout in the top-left corner of the assigned area (default).
alignTopRight :: Layout -> Layout Source
Align the layout to the top-right of the assigned area.
alignCentre :: Layout -> Layout Source
Align the layout in the center of the assigned area.
alignCenter :: Layout -> Layout Source
Align the layout in the center of the assigned area.
alignRight :: Layout -> Layout Source
Align the layout centered to the right of the assigned area.
alignBottomLeft :: Layout -> Layout Source
Align the layout to the bottom-left of the assigned area.
alignBottom :: Layout -> Layout Source
Align the layout centered on the bottom of the assigned area.
alignBottomRight :: Layout -> Layout Source
Align the layout to the bottom-right of the assigned area.
Horizontal alignment
halignLeft :: Layout -> Layout Source
(primitive) Align horizontally to the left when the layout is assigned to a larger area (default).
halignCentre :: Layout -> Layout Source
(primitive) Center horizontally when assigned to a larger area.
halignCenter :: Layout -> Layout Source
(primitive) Center horizontally when assigned to a larger area.
halignRight :: Layout -> Layout Source
(primitive) Align horizontally to the right when the layout is assigned to a larger area.
Vertical alignment
valignTop :: Layout -> Layout Source
(primitive) Align vertically to the top when the layout is assigned to a larger area (default).
valignCentre :: Layout -> Layout Source
(primitive) Center vertically when the layout is assigned to a larger area.
valignCenter :: Layout -> Layout Source
(primitive) Center vertically when the layout is assigned to a larger area.
valignBottom :: Layout -> Layout Source
(primitive) Align vertically to the bottom when the layout is assigned to a larger area.
nullLayouts :: [Layout] Source