module Graphics.UI.WXCore.Layout(
Layout, sizerFromLayout
, TabPage
, windowSetLayout, layoutFromWindow
, windowReFit, windowReFitMinimal
, windowReLayout, windowReLayoutMinimal
, Widget, widget, label, rule, hrule, vrule, sizer
, row, column
, grid, boxed, container, tab, imageTab, tabs
, hsplit, vsplit
, glue, hglue, vglue
, space, hspace, vspace, empty
, dynamic
, static, stretch, hstretch, vstretch, minsize
, rigid, shaped, expand
, fill, hfill, vfill
, margin, marginWidth, marginNone
, marginLeft, marginTop, marginRight, marginBottom
, floatTopLeft, floatTop, floatTopRight
, floatLeft, floatCentre, floatCenter, floatRight
, floatBottomLeft, floatBottom, floatBottomRight
, hfloatLeft, hfloatCentre, hfloatCenter, hfloatRight
, vfloatTop, vfloatCentre, vfloatCenter, vfloatBottom
, center, centre
, alignTopLeft, alignTop, alignTopRight
, alignLeft, alignCentre, alignCenter, alignRight
, alignBottomLeft, alignBottom, alignBottomRight
, halignLeft, halignCentre, halignCenter, halignRight
, valignTop, valignCentre, valignCenter, valignBottom
, nullLayouts
) where
import Data.List( transpose )
import Graphics.UI.WXCore.WxcTypes
import Graphics.UI.WXCore.WxcDefs
import Graphics.UI.WXCore.WxcClasses
import Graphics.UI.WXCore.WxcClassInfo
import Graphics.UI.WXCore.Types
import Graphics.UI.WXCore.Frame
class Widget w where
widget :: w -> Layout
instance Widget Layout where
widget layout
= layout
instance Widget (Window a) where
widget w
= layoutFromWindow w
fill :: Layout -> Layout
fill
= stretch . expand
hfill :: Layout -> Layout
hfill
= hstretch . expand
vfill :: Layout -> Layout
vfill
= vstretch . expand
row :: Int -> [Layout] -> Layout
row w row'
= grid w 0 [row']
column :: Int -> [Layout] -> Layout
column h col
= grid 0 h (map (\x -> [x]) col)
floatCenter :: Layout -> Layout
floatCenter
= floatCentre
floatCentre :: Layout -> Layout
floatCentre
= stretch . alignCentre
floatTopLeft :: Layout -> Layout
floatTopLeft
= stretch . alignTopLeft
floatTop :: Layout -> Layout
floatTop
= stretch . alignTop
floatTopRight :: Layout -> Layout
floatTopRight
= stretch . alignTopRight
floatLeft :: Layout -> Layout
floatLeft
= stretch . alignLeft
floatRight :: Layout -> Layout
floatRight
= stretch . alignRight
floatBottomLeft :: Layout -> Layout
floatBottomLeft
= stretch . alignBottomLeft
floatBottom :: Layout -> Layout
floatBottom
= stretch . alignBottom
floatBottomRight :: Layout -> Layout
floatBottomRight
= stretch . alignBottomRight
hfloatCenter :: Layout -> Layout
hfloatCenter
= hfloatCentre
hfloatCentre :: Layout -> Layout
hfloatCentre
= hstretch . alignCentre
hfloatLeft :: Layout -> Layout
hfloatLeft
= hstretch . alignLeft
hfloatRight :: Layout -> Layout
hfloatRight
= hstretch . alignRight
vfloatCenter :: Layout -> Layout
vfloatCenter
= vfloatCentre
vfloatCentre :: Layout -> Layout
vfloatCentre
= vstretch . alignCentre
vfloatTop :: Layout -> Layout
vfloatTop
= vstretch . alignTop
vfloatBottom :: Layout -> Layout
vfloatBottom
= vstretch . alignBottom
center :: Layout -> Layout
center
= centre
centre :: Layout -> Layout
centre
= alignCentre
alignCenter :: Layout -> Layout
alignCenter
= alignCentre
alignCentre :: Layout -> Layout
alignCentre
= halignCentre . valignCentre
alignTopLeft :: Layout -> Layout
alignTopLeft
= valignTop . halignLeft
alignTop :: Layout -> Layout
alignTop
= valignTop . halignCentre
alignTopRight :: Layout -> Layout
alignTopRight
= valignTop . halignRight
alignLeft :: Layout -> Layout
alignLeft
= valignCentre . halignLeft
alignRight :: Layout -> Layout
alignRight
= valignCentre . halignRight
alignBottomLeft :: Layout -> Layout
alignBottomLeft
= valignBottom . halignLeft
alignBottom :: Layout -> Layout
alignBottom
= valignBottom . halignCentre
alignBottomRight :: Layout -> Layout
alignBottomRight
= valignBottom . halignRight
glue :: Layout
glue
= stretch empty
vglue :: Layout
vglue
= vstretch empty
hglue :: Layout
hglue
= hstretch empty
empty :: Layout
empty
= space 0 0
hspace :: Int -> Layout
hspace w
= space w 0
vspace :: Int -> Layout
vspace h
= space 0 h
minsize :: Size -> Layout -> Layout
minsize sz' layout
= updateOptions layout (\options' -> options'{ minSize = Just sz' })
rigid :: Layout -> Layout
rigid layout
= updateOptions layout (\options' -> options'{ fillMode = FillNone })
shaped :: Layout -> Layout
shaped layout
= updateOptions layout (\options' -> options'{ fillMode = FillShaped })
expand :: Layout -> Layout
expand layout
= updateOptions layout (\options' -> options'{ fillMode = Fill })
static :: Layout -> Layout
static layout
= updateOptions layout (\options' -> options'{ stretchV = False, stretchH = False })
stretch :: Layout -> Layout
stretch layout
= updateOptions layout (\options' -> options'{ stretchV = True, stretchH = True })
vstretch :: Layout -> Layout
vstretch layout
= updateOptions layout (\options' -> options'{ stretchV = True, stretchH = False })
hstretch :: Layout -> Layout
hstretch layout
= updateOptions layout (\options' -> options'{ stretchH = True, stretchV = False })
margin :: Int -> Layout -> Layout
margin i layout
= updateOptions layout (\options' -> options'{ margins = [MarginLeft,MarginRight,MarginTop,MarginBottom], marginW = i })
marginWidth :: Int -> Layout -> Layout
marginWidth w layout
= updateOptions layout (\options' -> options'{ marginW = w })
marginNone :: Layout -> Layout
marginNone layout
= updateOptions layout (\options' -> options'{ margins = [] })
marginLeft :: Layout -> Layout
marginLeft layout
= updateOptions layout (\options' -> options'{ margins = MarginLeft:margins options' })
marginRight :: Layout -> Layout
marginRight layout
= updateOptions layout (\options' -> options'{ margins = MarginRight:margins options' })
marginTop :: Layout -> Layout
marginTop layout
= updateOptions layout (\options' -> options'{ margins = MarginTop:margins options' })
marginBottom :: Layout -> Layout
marginBottom layout
= updateOptions layout (\options' -> options'{ margins = MarginBottom:margins options' })
halignLeft :: Layout -> Layout
halignLeft layout
= updateOptions layout (\options' -> options'{ alignH = AlignLeft })
halignRight :: Layout -> Layout
halignRight layout
= updateOptions layout (\options' -> options'{ alignH = AlignRight })
halignCenter :: Layout -> Layout
halignCenter
= halignCentre
halignCentre :: Layout -> Layout
halignCentre layout
= updateOptions layout (\options' -> options'{ alignH = AlignHCentre })
valignTop :: Layout -> Layout
valignTop layout
= updateOptions layout (\options' -> options'{ alignV = AlignTop })
valignBottom :: Layout -> Layout
valignBottom layout
= updateOptions layout (\options' -> options'{ alignV = AlignBottom })
valignCenter :: Layout -> Layout
valignCenter layout
= valignCentre layout
valignCentre :: Layout -> Layout
valignCentre layout
= updateOptions layout (\options' -> options'{ alignV = AlignVCentre })
dynamic :: Layout -> Layout
dynamic layout
= updateOptions layout (\options' -> options'{ adjustMinSize = True })
updateOptions :: Layout -> (LayoutOptions -> LayoutOptions) -> Layout
updateOptions layout f
= layout{ options = f (options layout) }
boxed :: String -> Layout -> Layout
boxed txt' content'
= TextBox optionsDefault{ stretchV = hasvstretch, stretchH = hashstretch
, fillMode = hasfill, adjustMinSize = True }
txt' (extramargin content')
where
hasvstretch = stretchV (options content')
hashstretch = stretchH (options content')
hasfill = if (hasvstretch || hashstretch) then Fill else FillNone
extramargin | null (margins (options content')) = marginWidth 5 . marginTop
| otherwise = id
label :: String -> Layout
label txt'
= Label optionsDefault txt'
grid :: Int -> Int -> [[Layout]] -> Layout
grid w h rows'
= Grid optionsDefault{ stretchV = hasvstretch, stretchH = hashstretch, fillMode = hasfill } (sz w h) rows'
where
hasvstretch = any (all (stretchV.options)) rows'
hashstretch = any (all (stretchH.options)) (transpose rows')
hasfill = if (hasvstretch || hashstretch) then Fill else FillNone
container :: Window a -> Layout -> Layout
container window layout
= WidgetContainer optionsDefault{ stretchV = hasvstretch, stretchH = hashstretch, fillMode = hasfill }
(downcastWindow window) layout
where
hasvstretch = stretchV (options layout)
hashstretch = stretchH (options layout)
hasfill = if (hasvstretch || hashstretch) then Fill else FillNone
layoutFromWindow :: Window a -> Layout
layoutFromWindow window
= Widget optionsDefault{ adjustMinSize = adjust } (downcastWindow window)
where
adjust = instanceOf window classButton
|| instanceOf window classStaticText
space :: Int -> Int -> Layout
space w h
= Spacer optionsDefault (Size w h)
rule :: Int -> Int -> Layout
rule w h
= Line optionsDefault (Size w h)
vrule :: Int -> Layout
vrule h
= rule 1 h
hrule :: Int -> Layout
hrule w
= rule w 1
sizer :: Sizer a -> Layout
sizer s
= XSizer optionsDefault (downcastSizer s)
type TabPage = (String,Bitmap (),Layout)
tab :: String -> Layout -> TabPage
tab title layout
= (title,objectNull,layout)
imageTab :: String -> Bitmap () -> Layout -> TabPage
imageTab title bitmap layout
= (title,bitmap,layout)
tabs :: Notebook a -> [TabPage] -> Layout
tabs notebook pages'
= XNotebook optionsDefault{ stretchV = hasvstretch, stretchH = hashstretch, fillMode = hasfill }
(downcastNotebook notebook) pages'
where
hasvstretch = all stretchV [options layout | (_,_,layout) <- pages']
hashstretch = all stretchH [options layout | (_,_,layout) <- pages']
hasfill = if (hasvstretch || hashstretch) then Fill else FillNone
hsplit :: SplitterWindow a -> Int -> Int -> Layout -> Layout -> Layout
hsplit
= split True
vsplit :: SplitterWindow a -> Int -> Int -> Layout -> Layout -> Layout
vsplit
= split False
split :: Bool -> SplitterWindow a -> Int -> Int -> Layout -> Layout -> Layout
split splitHorizontal' splitter' sashWidth' paneWidth' pane1' pane2'
= Splitter optionsDefault (downcastSplitterWindow splitter') pane1' pane2' splitHorizontal' sashWidth' paneWidth'
optionsDefault :: LayoutOptions
optionsDefault
= LayoutOptions False False [] 10 AlignLeft AlignTop FillNone Nothing False
data Layout = Grid { options :: LayoutOptions, gap :: Size, rows :: [[Layout]] }
| Widget { options :: LayoutOptions, win :: Window () }
| Spacer { options :: LayoutOptions, spacesize :: Size }
| Label { options :: LayoutOptions, txt :: String }
| TextBox { options :: LayoutOptions, txt :: String, content :: Layout }
| Line { options :: LayoutOptions, linesize :: Size }
| XSizer { options :: LayoutOptions, xsizer :: Sizer () }
| WidgetContainer{ options :: LayoutOptions, win :: Window (), content :: Layout }
| XNotebook { options :: LayoutOptions, nbook :: Notebook (), pages :: [(String,Bitmap (),Layout)] }
| Splitter { options :: LayoutOptions, splitter :: SplitterWindow ()
, pane1 :: Layout, pane2 :: Layout
, splitHorizontal :: Bool, sashWidth :: Int, paneWidth :: Int }
data LayoutOptions
= LayoutOptions{ stretchH :: Bool, stretchV :: Bool
, margins :: [Margin], marginW :: Int
, alignH :: HAlign, alignV :: VAlign
, fillMode :: FillMode
, minSize :: Maybe Size
, adjustMinSize :: Bool
}
data FillMode = FillNone | FillShaped | Fill
data HAlign = AlignLeft | AlignRight | AlignHCentre
data VAlign = AlignTop | AlignBottom | AlignVCentre
data Margin = MarginTop | MarginLeft | MarginRight | MarginBottom
nullLayoutOptions :: LayoutOptions
nullLayoutOptions =
LayoutOptions
False False
[] 0
AlignHCentre AlignVCentre
FillNone
Nothing
False
nullLayout :: Layout
nullLayout = nullLayouts !! 0
nullLayouts :: [Layout]
nullLayouts =
[ Grid { options = nullLayoutOptions, gap = (Size 0 0)
, rows = [[]]
}
, Widget { options = nullLayoutOptions, win = objectNull }
, Spacer { options = nullLayoutOptions, spacesize = (Size 0 0) }
, Label { options = nullLayoutOptions, txt = "" }
, TextBox { options = nullLayoutOptions, txt = ""
, content = nullLayout
}
, Line { options = nullLayoutOptions, linesize = (Size 0 0) }
, XSizer { options = nullLayoutOptions, xsizer = objectNull }
, WidgetContainer { options = nullLayoutOptions, win = objectNull
, content = nullLayout
}
, XNotebook { options = nullLayoutOptions, nbook = objectNull
, pages = [("", objectNull, nullLayout)]
}
, Splitter { options = nullLayoutOptions, splitter = objectNull
, pane1 = nullLayout, pane2 = nullLayout
, splitHorizontal = False, sashWidth = 0, paneWidth = 0
}
]
windowReFit :: Window a -> IO ()
windowReFit w
= do p <- windowGetFrameParent w
windowReLayout p
windowReFitMinimal :: Window a -> IO ()
windowReFitMinimal w
= do p <- windowGetFrameParent w
windowReLayoutMinimal p
windowReLayout :: Window a -> IO ()
windowReLayout w
= do _ <- windowLayout w
old <- windowGetClientSize w
szr <- windowGetSizer w
when (not (objectIsNull szr)) (sizerSetSizeHints szr w)
windowFit w
new <- windowGetClientSize w
windowSetClientSize w (sizeMax old new)
windowReLayoutMinimal :: Window a -> IO ()
windowReLayoutMinimal w
= do _ <- windowLayout w
szr <- windowGetSizer w
when (not (objectIsNull szr)) (sizerSetSizeHints szr w)
windowFit w
windowSetLayout :: Window a -> Layout -> IO ()
windowSetLayout window layout
= do sizer' <- sizerFromLayout window layout
windowSetAutoLayout window True
windowSetSizer window sizer'
sizerSetSizeHints sizer' window
return ()
sizerFromLayout :: Window a -> Layout -> IO (Sizer ())
sizerFromLayout parent layout
= insert objectNull (grid 0 0 [[stretch layout]])
where
insert :: Sizer () -> Layout -> IO (Sizer ())
insert container' (Spacer options' sz')
= do sizerAddWithOptions 0 (sizerAdd container' sz') (\_sz -> return ()) options'
return container'
insert container' (Widget options' win')
= do sizerAddWindowWithOptions container' win' options'
return container'
insert container' (Grid goptions gap' rows')
= do g <- flexGridSizerCreate (length rows') (maximum (map length rows')) (sizeH gap') (sizeW gap')
mapM_ (stretchRow g) (zip [0..] (map (all (stretchV.options)) rows'))
mapM_ (stretchCol g) (zip [0..] (map (all (stretchH.options)) (transpose rows')))
mapM_ (insert (downcastSizer g)) (concat rows')
when (container' /= objectNull)
(sizerAddSizerWithOptions container' g goptions)
return (downcastSizer g)
insert container' (Label options' txt')
= do t <- staticTextCreate parent idAny txt' rectNull 0
sizerAddWindowWithOptions container' t options'
return container'
insert container' (TextBox options' txt' layout')
= do box <- staticBoxCreate parent idAny txt' rectNull (wxCLIP_CHILDREN .+. wxNO_FULL_REPAINT_ON_RESIZE)
sizer' <- staticBoxSizerCreate box wxVERTICAL
_ <- insert (downcastSizer sizer') layout'
when (container' /= objectNull)
(sizerAddSizerWithOptions container' sizer' options')
windowLower box
return (downcastSizer sizer')
insert container' (Line options' (Size w h))
= do l <- staticLineCreate parent idAny (rectNull{ rectWidth = w, rectHeight = h })
(if (w >= h) then wxHORIZONTAL else wxVERTICAL)
sizerAddWindowWithOptions container' l options'
return container'
insert container' (XSizer options' sizer')
= do sizerAddSizerWithOptions container' sizer' options'
return container'
insert container' (WidgetContainer options' win' layout')
= do windowSetLayout win' layout'
sizerAddWindowWithOptions container' win' options'
return container'
insert container' (Splitter options' splitter' pane1' pane2' splitHorizontal' _sashWidth paneWidth')
= do splitterWindowSetMinimumPaneSize splitter' 20
sizerAddWindowWithOptions container' splitter' options'
_ <- if splitHorizontal'
then splitterWindowSplitHorizontally splitter' win1 win2 paneWidth'
else splitterWindowSplitVertically splitter' win1 win2 paneWidth'
paneSetLayout pane1'
paneSetLayout pane2'
return container'
where
win1 = getWinFromLayout pane1'
win2 = getWinFromLayout pane2'
getWinFromLayout layout'
= case layout' of
Widget _ win' -> downcastWindow win'
WidgetContainer _ win' _ -> downcastWindow win'
Splitter _ splitter'' _ _ _ _ _ -> downcastWindow splitter''
_other -> error "Layout: hsplit/vsplit need widgets or containers as arguments"
paneSetLayout layout'
= case layout' of
Widget _ _win
-> return ()
WidgetContainer _options win' layout''
-> windowSetLayout win' layout''
Splitter _options splitter'' pane1'' pane2'' splitHorizontal'' _sashWidth paneWidth''
-> do splitterWindowSetMinimumPaneSize splitter'' 20
let win1' = getWinFromLayout pane1''
win2' = getWinFromLayout pane2''
_ <- if splitHorizontal''
then splitterWindowSplitHorizontally splitter'' win1' win2' paneWidth''
else splitterWindowSplitVertically splitter'' win1' win2' paneWidth''
paneSetLayout pane1''
paneSetLayout pane2''
return ()
_other
-> error "Layout: hsplit/vsplit need widgets or containers as arguments"
insert container' (XNotebook options' nbook' pages')
= do pages'' <- addImages objectNull pages'
mapM_ addPage pages''
sizerAddWindowWithOptions container' nbook' options'
return container'
where
addPage (title,idx,WidgetContainer _options win' layout')
= do pagetitle <- if (null title)
then windowGetLabel win'
else return title
_ <- notebookAddPage nbook' win' pagetitle False idx
windowSetLayout win' layout'
addPage (_title, _idx, _other)
= error "Graphics.UI.WXCore.sizerFromLayout: notebook page needs to be a 'container' layout!"
addImages il []
= if (objectIsNull il)
then return []
else do notebookAssignImageList nbook' il
return []
addImages il ((title, bm, layout'):xs) | objectIsNull bm
= do xs' <- addImages il xs
return ((title,1,layout'):xs')
addImages il ((title, bm, layout'):xs)
= do il' <- addImage il bm
i <- imageListGetImageCount il'
xs' <- addImages il' xs
return ((title,i,layout'):xs')
addImage il bm
= if (objectIsNull il)
then do w <- bitmapGetWidth bm
h <- bitmapGetHeight bm
il' <- imageListCreate (sz w h) False 1
_ <- imageListAddBitmap il' bm objectNull
return il'
else imageListAddBitmap il bm objectNull >>
return il
stretchRow g (i,stretch')
= when stretch' (flexGridSizerAddGrowableRow g i)
stretchCol g (i,stretch')
= when stretch' (flexGridSizerAddGrowableCol g i)
sizerAddWindowWithOptions :: Sizer a -> Window b -> LayoutOptions -> IO ()
sizerAddWindowWithOptions container' window options'
= sizerAddWithOptions (flagsAdjustMinSize window options')
(sizerAddWindow container' window) (sizerSetItemMinSizeWindow container' window) options'
sizerAddSizerWithOptions :: Sizer a -> Sizer b -> LayoutOptions -> IO ()
sizerAddSizerWithOptions container' sizer' options'
= sizerAddWithOptions 0 (sizerAddSizer container' sizer') (sizerSetItemMinSizeSizer container' sizer') options'
sizerAddWithOptions :: Int -> (Int -> Int -> Int -> Ptr p -> IO ()) -> (Size -> IO ()) -> LayoutOptions -> IO ()
sizerAddWithOptions miscflags addSizer setMinSize options'
= do addSizer 1 (flags options' .+. miscflags) (marginW options') ptrNull
case minSize options' of
Nothing -> return ()
Just sz' -> setMinSize sz'
flags options'
= flagsFillMode (fillMode options') .+. flagsMargins (margins options')
.+. flagsHAlign (alignH options') .+. flagsVAlign (alignV options')
flagsFillMode fillMode'
= case fillMode' of
FillNone -> 0
FillShaped -> wxSHAPED
Fill -> wxEXPAND
flagsHAlign halign
= case halign of
AlignLeft -> wxALIGN_LEFT
AlignRight -> wxALIGN_RIGHT
AlignHCentre -> wxALIGN_CENTRE_HORIZONTAL
flagsVAlign valign
= case valign of
AlignTop -> wxALIGN_TOP
AlignBottom -> wxALIGN_BOTTOM
AlignVCentre -> wxALIGN_CENTRE_VERTICAL
flagsMargins margins'
= bits (map flagsMargin margins')
flagsMargin margin'
= case margin' of
MarginTop -> wxTOP
MarginLeft -> wxLEFT
MarginBottom -> wxBOTTOM
MarginRight -> wxRIGHT
flagsAdjustMinSize _window _options = 0