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