Ticket #1130: foo2.hs

File foo2.hs, 1.5 kB (added by guest, 6 years ago)
Line 
1module Main where
2
3import Control.Monad
4import Graphics.UI.Gtk
5import Graphics.UI.Gtk.ModelView as M
6import System.Time
7
8main :: IO ()
9main = do initGUI
10          win <- windowNew
11          onDestroy win mainQuit
12          myview <- makeMyView
13          containerAdd win (vView myview)
14          set win [containerBorderWidth := 30]
15          widgetShowAll win
16          mainGUI
17
18data MyView = MyView {vView :: M.TreeView, ccView :: [(M.TreeViewColumn, M.CellRendererText)]}
19
20makeMyView :: IO MyView
21makeMyView = do v <- M.treeViewNew
22                M.treeViewSetHeadersVisible v True
23                let titles = ["t1", "t2", "t3"]
24                cols <- mapM (const M.treeViewColumnNew) titles
25                zipWithM_ M.treeViewColumnSetTitle cols titles
26                cells <- mapM (const M.cellRendererTextNew) titles
27                zipWithM_ (\co ce -> M.cellLayoutPackStart co ce True) cols cells
28                mapM_ (M.treeViewAppendColumn v) cols
29                rows <- makeRows
30                model <- M.listStoreNew rows
31                M.treeViewSetModel v model
32                let f t = [M.cellText := t]
33                let functions = map ((f .) . flip (!!)) [0..]
34                zipWithM_ (\(co, ce) g -> M.cellLayoutSetAttributes co ce model g) (zip cols cells) functions
35                return $ MyView v $ zip cols cells
36
37makeRows :: IO [[String]]
38makeRows = do hoy <- getClockTime >>= toCalendarTime
39              return $ replicate 2 ["a", "b", "c"]
40