Ticket #1130: foo2.hs

module Main where

import Control.Monad
import Graphics.UI.Gtk
import Graphics.UI.Gtk.ModelView as M
import System.Time

main :: IO ()
main = do initGUI
          win <- windowNew
          onDestroy win mainQuit
          myview <- makeMyView
          containerAdd win (vView myview)
          set win [containerBorderWidth := 30]
          widgetShowAll win
          mainGUI

data MyView = MyView {vView :: M.TreeView, ccView :: [(M.TreeViewColumn, M.CellRendererText)]}

makeMyView :: IO MyView
makeMyView = do v <- M.treeViewNew
                M.treeViewSetHeadersVisible v True
                let titles = ["t1", "t2", "t3"]
                cols <- mapM (const M.treeViewColumnNew) titles
                zipWithM_ M.treeViewColumnSetTitle cols titles
                cells <- mapM (const M.cellRendererTextNew) titles
                zipWithM_ (\co ce -> M.cellLayoutPackStart co ce True) cols cells
                mapM_ (M.treeViewAppendColumn v) cols
                rows <- makeRows
                model <- M.listStoreNew rows
                M.treeViewSetModel v model
                let f t = [M.cellText := t]
                let functions = map ((f .) . flip (!!)) [0..]
                zipWithM_ (\(co, ce) g -> M.cellLayoutSetAttributes co ce model g) (zip cols cells) functions
                return $ MyView v $ zip cols cells

makeRows :: IO [[String]]
makeRows = do hoy <- getClockTime >>= toCalendarTime
              return $ replicate 2 ["a", "b", "c"]