1module GUI.BookmarkView (
2    BookmarkView,
3    bookmarkViewNew,
4    BookmarkViewActions(..),
5
6    bookmarkViewGet,
7    bookmarkViewAdd,
8    bookmarkViewRemove,
9    bookmarkViewClear,
10    bookmarkViewSetLabel,
11  ) where
12
13import GHC.RTS.Events (Timestamp)
14
15import Graphics.UI.Gtk
16import qualified Graphics.UI.Gtk.ModelView.TreeView.Compat as Compat
17import Numeric
18import Data.Text (Text)
19
20---------------------------------------------------------------------------
21
22-- | Abstract bookmark view object.
23--
24data BookmarkView = BookmarkView {
25       bookmarkStore :: ListStore (Timestamp, Text)
26     }
27
28-- | The actions to take in response to TraceView events.
29--
30data BookmarkViewActions = BookmarkViewActions {
31       bookmarkViewAddBookmark    :: IO (),
32       bookmarkViewRemoveBookmark :: Int -> IO (),
33       bookmarkViewGotoBookmark   :: Timestamp -> IO (),
34       bookmarkViewEditLabel      :: Int -> Text -> IO ()
35     }
36
37---------------------------------------------------------------------------
38
39bookmarkViewAdd :: BookmarkView -> Timestamp -> Text -> IO ()
40bookmarkViewAdd BookmarkView{bookmarkStore} ts label = do
41  listStoreAppend bookmarkStore (ts, label)
42  return ()
43
44bookmarkViewRemove :: BookmarkView -> Int -> IO ()
45bookmarkViewRemove BookmarkView{bookmarkStore} n = do
46  listStoreRemove bookmarkStore n
47  return ()
48
49bookmarkViewClear :: BookmarkView -> IO ()
50bookmarkViewClear BookmarkView{bookmarkStore} =
51  listStoreClear bookmarkStore
52
53bookmarkViewGet :: BookmarkView -> IO [(Timestamp, Text)]
54bookmarkViewGet BookmarkView{bookmarkStore} =
55  listStoreToList bookmarkStore
56
57bookmarkViewSetLabel :: BookmarkView -> Int -> Text -> IO ()
58bookmarkViewSetLabel BookmarkView{bookmarkStore} n label = do
59  (ts,_) <- listStoreGetValue bookmarkStore n
60  listStoreSetValue bookmarkStore n (ts, label)
61
62---------------------------------------------------------------------------
63
64bookmarkViewNew :: Builder -> BookmarkViewActions -> IO BookmarkView
65bookmarkViewNew builder BookmarkViewActions{..} = do
66
67    let getWidget cast name = builderGetObject builder cast name
68
69    ---------------------------------------------------------------------------
70
71    bookmarkTreeView <- getWidget castToTreeView "bookmark_list"
72    bookmarkStore    <- listStoreNew []
73    columnTs         <- treeViewColumnNew
74    cellTs           <- cellRendererTextNew
75    columnLabel      <- treeViewColumnNew
76    cellLabel        <- cellRendererTextNew
77    selection        <- treeViewGetSelection bookmarkTreeView
78
79    treeViewColumnSetTitle columnTs    "Time"
80    treeViewColumnSetTitle columnLabel "Label"
81    treeViewColumnPackStart columnTs    cellTs    False
82    treeViewColumnPackStart columnLabel cellLabel True
83    treeViewAppendColumn bookmarkTreeView columnTs
84    treeViewAppendColumn bookmarkTreeView columnLabel
85
86    Compat.treeViewSetModel bookmarkTreeView (Just bookmarkStore)
87
88    cellLayoutSetAttributes columnTs cellTs bookmarkStore $ \(ts,_) ->
89      [ cellText := showFFloat (Just 6) (fromIntegral ts / 1000000) "s" ]
90
91    cellLayoutSetAttributes columnLabel cellLabel bookmarkStore $ \(_,label) ->
92      [ cellText := label ]
93
94    ---------------------------------------------------------------------------
95
96    addBookmarkButton    <- getWidget castToToolButton "add_bookmark_button"
97    deleteBookmarkButton <- getWidget castToToolButton "delete_bookmark"
98    gotoBookmarkButton   <- getWidget castToToolButton "goto_bookmark_button"
99
100    onToolButtonClicked addBookmarkButton $
101      bookmarkViewAddBookmark
102
103    onToolButtonClicked deleteBookmarkButton $ do
104      selected <- treeSelectionGetSelected selection
105      case selected of
106        Nothing   -> return ()
107        Just iter ->
108          let pos = listStoreIterToIndex iter
109           in bookmarkViewRemoveBookmark pos
110
111    onToolButtonClicked gotoBookmarkButton $ do
112      selected <- treeSelectionGetSelected selection
113      case selected of
114        Nothing   -> return ()
115        Just iter -> do
116          let pos = listStoreIterToIndex iter
117          (ts,_) <- listStoreGetValue bookmarkStore pos
118          bookmarkViewGotoBookmark ts
119
120    onRowActivated bookmarkTreeView $ \[pos] _ -> do
121      (ts, _) <- listStoreGetValue bookmarkStore pos
122      bookmarkViewGotoBookmark ts
123
124    set cellLabel [ cellTextEditable := True ]
125    on cellLabel edited $ \[pos] val -> do
126      bookmarkViewEditLabel pos val
127
128    ---------------------------------------------------------------------------
129
130    return BookmarkView{..}
131