Ticket #1130: foo.hs

File foo.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          setmodel myview
14          containerAdd win (vView myview)
15          set win [containerBorderWidth := 30]
16          widgetShowAll win
17          mainGUI
18
19data MyView = MyView {vView :: M.TreeView, ccView :: [(M.TreeViewColumn, M.CellRendererText)]}
20
21makeMyView :: IO MyView
22makeMyView = do v <- M.treeViewNew
23                M.treeViewSetHeadersVisible v True
24                let titles = ["t1", "t2", "t3"]
25                cols <- mapM (const M.treeViewColumnNew) titles
26                zipWithM_ M.treeViewColumnSetTitle cols titles
27                cells <- mapM (const M.cellRendererTextNew) titles
28                zipWithM_ (\co ce -> M.cellLayoutPackStart co ce True) cols cells
29                mapM_ (M.treeViewAppendColumn v) cols
30                return $ MyView v $ zip cols cells
31
32makeRows :: IO [[String]]
33makeRows = do hoy <- getClockTime >>= toCalendarTime
34              return $ replicate 2 ["a", "b", "c"]
35
36setmodel :: MyView -> IO ()
37setmodel mv = do rows <- makeRows
38                 model <- M.listStoreNew rows
39                 M.treeViewSetModel (vView mv) model
40                 let f t = [M.cellText := t]
41                 let functions = map ((f .) . flip (!!)) [0..]
42                 zipWithM_ (\(co, ce) g -> M.cellLayoutSetAttributes co ce model g) (ccView mv) functions