1{-# LANGUAGE TemplateHaskell #-}
2module GUI.MainWindow (
3    MainWindow,
4    mainWindowNew,
5    MainWindowActions(..),
6
7    setFileLoaded,
8    setStatusMessage,
9    sidebarSetVisibility,
10    eventsSetVisibility,
11
12  ) where
13
14import Graphics.UI.Gtk as Gtk
15import qualified System.Glib.GObject as Glib
16
17import GUI.DataFiles (loadLogo)
18
19-------------------------------------------------------------------------------
20
21data MainWindow = MainWindow {
22       mainWindow         :: Window,
23
24       sidebarBox,
25       eventsBox          :: Widget,
26
27       statusBar          :: Statusbar,
28       statusBarCxt       :: ContextId
29     }
30
31instance Glib.GObjectClass  MainWindow where
32  toGObject = toGObject . mainWindow
33  unsafeCastGObject = error "cannot downcast to MainView type"
34
35instance Gtk.ObjectClass    MainWindow
36instance Gtk.WidgetClass    MainWindow
37instance Gtk.ContainerClass MainWindow
38instance Gtk.BinClass       MainWindow
39instance Gtk.WindowClass    MainWindow
40
41data MainWindowActions = MainWindowActions {
42
43       -- Menu actions
44       mainWinOpen          :: IO (),
45       mainWinExport        :: IO (),
46       mainWinQuit          :: IO (),
47       mainWinViewSidebar   :: Bool -> IO (),
48       mainWinViewEvents    :: Bool -> IO (),
49       mainWinViewBW        :: Bool -> IO (),
50       mainWinViewReload    :: IO (),
51       mainWinWebsite       :: IO (),
52       mainWinTutorial      :: IO (),
53       mainWinAbout         :: IO (),
54
55       -- Toolbar actions
56       mainWinJumpStart     :: IO (),
57       mainWinJumpEnd       :: IO (),
58       mainWinJumpCursor    :: IO (),
59       mainWinJumpZoomIn    :: IO (),
60       mainWinJumpZoomOut   :: IO (),
61       mainWinJumpZoomFit   :: IO (),
62       mainWinScrollLeft    :: IO (),
63       mainWinScrollRight   :: IO (),
64       mainWinDisplayLabels :: Bool -> IO ()
65     }
66
67-------------------------------------------------------------------------------
68
69setFileLoaded :: MainWindow -> Maybe FilePath -> IO ()
70setFileLoaded mainWin Nothing =
71  set (mainWindow mainWin) [
72      windowTitle := "ThreadScope"
73    ]
74setFileLoaded mainWin (Just file) =
75  set (mainWindow mainWin) [
76      windowTitle := file ++ " - ThreadScope"
77    ]
78
79setStatusMessage :: MainWindow -> String -> IO ()
80setStatusMessage mainWin msg = do
81  statusbarPop  (statusBar mainWin) (statusBarCxt mainWin)
82  statusbarPush (statusBar mainWin) (statusBarCxt mainWin) (' ':msg)
83  return ()
84
85sidebarSetVisibility :: MainWindow -> Bool -> IO ()
86sidebarSetVisibility mainWin visible =
87  set (sidebarBox mainWin) [ widgetVisible := visible ]
88
89eventsSetVisibility :: MainWindow -> Bool -> IO ()
90eventsSetVisibility mainWin visible =
91  set (eventsBox mainWin) [ widgetVisible := visible ]
92
93-------------------------------------------------------------------------------
94
95mainWindowNew :: Builder -> MainWindowActions -> IO MainWindow
96mainWindowNew builder actions = do
97
98  let getWidget cast name = builderGetObject builder cast name
99
100
101  mainWindow         <- getWidget castToWindow "main_window"
102  statusBar          <- getWidget castToStatusbar "statusbar"
103
104  sidebarBox         <- getWidget castToWidget "sidebar"
105  eventsBox          <- getWidget castToWidget "eventsbox"
106
107  bwToggle           <- getWidget castToCheckMenuItem "black_and_white"
108  labModeToggle      <- getWidget castToCheckMenuItem "view_labels_mode"
109  sidebarToggle      <- getWidget castToCheckMenuItem "view_sidebar"
110  eventsToggle       <- getWidget castToCheckMenuItem "view_events"
111  openMenuItem       <- getWidget castToMenuItem "openMenuItem"
112  exportMenuItem     <- getWidget castToMenuItem "exportMenuItem"
113  reloadMenuItem     <- getWidget castToMenuItem "view_reload"
114  quitMenuItem       <- getWidget castToMenuItem "quitMenuItem"
115  websiteMenuItem    <- getWidget castToMenuItem "websiteMenuItem"
116  tutorialMenuItem   <- getWidget castToMenuItem "tutorialMenuItem"
117  aboutMenuItem      <- getWidget castToMenuItem "aboutMenuItem"
118
119  firstMenuItem      <- getWidget castToMenuItem "move_first"
120  centreMenuItem     <- getWidget castToMenuItem "move_centre"
121  lastMenuItem       <- getWidget castToMenuItem "move_last"
122
123  zoomInMenuItem     <- getWidget castToMenuItem "move_zoomin"
124  zoomOutMenuItem    <- getWidget castToMenuItem "move_zoomout"
125  zoomFitMenuItem    <- getWidget castToMenuItem "move_zoomfit"
126
127  openButton         <- getWidget castToToolButton "cpus_open"
128
129  firstButton        <- getWidget castToToolButton "cpus_first"
130  centreButton       <- getWidget castToToolButton "cpus_centre"
131  lastButton         <- getWidget castToToolButton "cpus_last"
132
133  zoomInButton       <- getWidget castToToolButton "cpus_zoomin"
134  zoomOutButton      <- getWidget castToToolButton "cpus_zoomout"
135  zoomFitButton      <- getWidget castToToolButton "cpus_zoomfit"
136
137  ------------------------------------------------------------------------
138  -- Show everything
139  widgetShowAll mainWindow
140
141  ------------------------------------------------------------------------
142
143  logo <- $loadLogo
144  set mainWindow [ windowIcon := logo ]
145
146  ------------------------------------------------------------------------
147  -- Status bar functionality
148
149  statusBarCxt <- statusbarGetContextId statusBar "file"
150  statusbarPush statusBar statusBarCxt "No eventlog loaded."
151
152  ------------------------------------------------------------------------
153  -- Bind all the events
154
155  -- Menus
156  on openMenuItem      menuItemActivate $ mainWinOpen actions
157  on exportMenuItem    menuItemActivate $ mainWinExport actions
158
159  on quitMenuItem menuItemActivate $ mainWinQuit actions
160  on mainWindow   objectDestroy    $ mainWinQuit actions
161
162  on sidebarToggle  checkMenuItemToggled $ checkMenuItemGetActive sidebarToggle
163                                       >>= mainWinViewSidebar   actions
164  on eventsToggle   checkMenuItemToggled $ checkMenuItemGetActive eventsToggle
165                                       >>= mainWinViewEvents    actions
166  on bwToggle       checkMenuItemToggled $ checkMenuItemGetActive bwToggle
167                                       >>= mainWinViewBW        actions
168  on labModeToggle  checkMenuItemToggled $ checkMenuItemGetActive labModeToggle
169                                       >>= mainWinDisplayLabels actions
170  on reloadMenuItem menuItemActivate     $ mainWinViewReload actions
171
172  on websiteMenuItem  menuItemActivate    $ mainWinWebsite actions
173  on tutorialMenuItem menuItemActivate    $ mainWinTutorial actions
174  on aboutMenuItem    menuItemActivate    $ mainWinAbout actions
175
176  on firstMenuItem   menuItemActivate     $ mainWinJumpStart  actions
177  on centreMenuItem  menuItemActivate     $ mainWinJumpCursor actions
178  on lastMenuItem    menuItemActivate     $ mainWinJumpEnd    actions
179
180  on zoomInMenuItem  menuItemActivate     $ mainWinJumpZoomIn  actions
181  on zoomOutMenuItem menuItemActivate     $ mainWinJumpZoomOut actions
182  on zoomFitMenuItem menuItemActivate     $ mainWinJumpZoomFit actions
183
184  -- Toolbar
185  onToolButtonClicked openButton $ mainWinOpen       actions
186
187  onToolButtonClicked firstButton  $ mainWinJumpStart  actions
188  onToolButtonClicked centreButton $ mainWinJumpCursor actions
189  onToolButtonClicked lastButton   $ mainWinJumpEnd    actions
190
191  onToolButtonClicked zoomInButton  $ mainWinJumpZoomIn  actions
192  onToolButtonClicked zoomOutButton $ mainWinJumpZoomOut actions
193  onToolButtonClicked zoomFitButton $ mainWinJumpZoomFit actions
194
195  return MainWindow {..}
196