Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

113 lines (92 sloc) 3.359 kB
{--------------------------------------------------------------------------------
Test Grid.
--------------------------------------------------------------------------------}
module Main where
import Graphics.UI.WX
import Graphics.UI.WXCore hiding (Event)
main
= start gui
gui :: IO ()
gui
= do f <- frame [text := "Grid test", visible := False]
-- use text control as logger
textlog <- textCtrl f [wrap := WrapNone, enabled := False]
textCtrlMakeLogActiveTarget textlog
logMessage "logging enabled"
-- grids
g <- gridCtrl f []
gridSetGridLineColour g (colorSystem Color3DFace)
gridSetCellHighlightColour g black
appendColumns g (head names)
appendRows g (map show [1..length (tail names)])
mapM_ (setRow g) (zip [0..] (tail names))
gridAutoSize g
windowOnKeyDown g (onGridKeyDown g)
set g [on gridEvent := onGrid]
-- layout
set f [layout := column 5 [fill (dynamic (widget g))
,hfill (widget textlog)]
]
focusOn g
set f [visible := True] -- reduce flicker at startup.
return ()
where
onGridKeyDown g (EventKey key mods pt)
= case key of
KeyReturn ->
do logMessage "keyEnter"
gridMoveNext g
_ -> propagateEvent
onGrid ev
= case ev of
GridCellChange row col veto
-> logMessage ("cell changed: " ++ show (row,col))
_ -> propagateEvent
names
= [["First Name", "Last Name"]
,["Daan","Leijen"],["Arjan","van IJzendoorn"]
,["Martijn","Schrage"],["Andres","Loh"]]
setRow g (row,values)
= mapM_ (\(col,value) -> gridSetCellValue g row col value) (zip [0..] values)
{--------------------------------------------------------------------------------
Library?
--------------------------------------------------------------------------------}
gridCtrl :: Window a -> [Prop (Grid ())] -> IO (Grid ())
gridCtrl parent props
= feed2 props 0 $
initialWindow $ \id rect -> \props flags ->
do g <- gridCreate parent id rect flags
gridCreateGrid g 0 0 0
set g props
return g
gridEvent :: Event (Grid a) (EventGrid -> IO ())
gridEvent
= newEvent "gridEvent" gridGetOnGridEvent gridOnGridEvent
gridMoveNext :: Grid a -> IO ()
gridMoveNext g
= do row <- gridGetGridCursorRow g
col <- gridGetGridCursorCol g
rowCount <- gridGetNumberRows g
colCount <- gridGetNumberCols g
let (r,c) = if (row+1 >= rowCount)
then if (col+1 >= colCount)
then (0,0)
else (0,col+1)
else (row+1,col)
gridSetGridCursor g r c
gridMakeCellVisible g r c
return ()
appendColumns :: Grid a -> [String] -> IO ()
appendColumns g []
= return ()
appendColumns g labels
= do n <- gridGetNumberCols g
gridAppendCols g (length labels) True
mapM_ (\(i,label) -> gridSetColLabelValue g i label) (zip [n..] labels)
appendRows :: Grid a -> [String] -> IO ()
appendRows g []
= return ()
appendRows g labels
= do n <- gridGetNumberRows g
gridAppendRows g (length labels) True
mapM_ (\(i,label) -> gridSetRowLabelValue g i label) (zip [n..] labels)
Jump to Line
Something went wrong with that request. Please try again.