{-# LANGUAGE CPP #-}
-- ThreadScope: a graphical viewer for Haskell event log information.
-- Maintainer: satnams@microsoft.com, s.singh@ieee.org

module Main where

-- Imports for GTK/Glade
import Graphics.UI.Gtk
import Graphics.UI.Gtk.Glade
import Graphics.Rendering.Cairo 
import qualified Graphics.Rendering.Cairo as C
import Graphics.UI.Gtk.ModelView as New

-- Imports from Haskell library
import System.Environment
import Control.Monad
import Data.IORef
import Data.Maybe
import qualified Data.Function
import Data.List
#ifndef mingw32_HOST_OS
import System.Posix
#endif
import Control.Concurrent
import Control.Exception

import Paths_threadscope

-- Imports for ThreadScope
import State
import About
import FileDialog
import Options
import ReadEvents
import EventsWindow
import Timeline
import SaveAsPDF
import SaveAsPNG
import Sidebar
import Traces

-------------------------------------------------------------------------------

main :: IO ()
main 
  = do -- Deal with command line argument processing.
       -- This application accepts one optional argument specifying 
       -- the event log.
       args <- getArgs
       let options = parseOptions args

       unsafeInitGUIForThreadedRTS
       state <- buildInitialState options

       startup options state

startup :: [Option] -> ViewerState -> IO ()
startup options state@ViewerState{..} 
  = do
       let
           filenames = [filename | Filename filename <- options]
           tracenames = [name | TestTrace name <- options]
       when (length filenames > 1)
         (putStrLn "usage: threadscope [eventlog_filename]")
       let filename = if filenames == [] then
                       ""
                      else
                        head filenames
           traceName = if tracenames == [] then
                         ""
                       else
                         head tracenames

       writeIORef filenameIORef (if filename == "" then
                                   Nothing
                                 else
                                   Just filename)
        
       widgetSetAppPaintable mainWindow True
       logoPath <- getDataFileName "threadscope.png"
       windowSetIconFromFile mainWindow logoPath

       ------------------------------------------------------------------------
       -- Status bar functionality
       ctx <- statusbarGetContextId statusBar "state"
       statusbarPush statusBar ctx "No eventlog loaded."

       ------------------------------------------------------------------------
       --- Get the label for the name of the event log

       -- B&W toggle button
       bwToggle `onToggle` timelineParamsChanged state

       -- No Labels toggle button
       showLabelsToggle `onToolButtonToggled` timelineParamsChanged state

       -- When a filename for an event log is specified open and
       -- parse the event log file and update the IORefs for 
       -- the capabilities and event array.
       when (filename /= "") $ registerEventsFromFile filename state

       -- Likewise for test traces
       when (traceName /= "") $ registerEventsFromTrace traceName state

       -- B&W toggle button
                      
       -- The File:Open menu option can be used to specify an
       -- eventlog file.
       openMenuItem `onActivateLeaf` do
         filename <- openFileDialog mainWindow
         when (isJust filename) $
           registerEventsFromFile (fromJust filename) state
                                     
       ------------------------------------------------------------------------
       -- Save as PDF functionality
       saveAsPDFMenuItem `onActivateLeaf` saveAsPDF state 

       ------------------------------------------------------------------------
       -- Save as PNG functionality
       saveAsPNGMenuItem `onActivateLeaf` saveAsPNG state 

       ------------------------------------------------------------------------
       -- Reload functionality
       onActivateLeaf reloadMenuItem $
          do mb_filename <- readIORef filenameIORef
             case mb_filename of
               Nothing -> return ()
               Just filename -> registerEventsFromFile filename state

       ------------------------------------------------------------------------
       -- CPUs view

       setupTimelineView state

       ------------------------------------------------------------------------
       -- Event view

       setupEventsWindow state

       ------------------------------------------------------------------------
       -- Sidebar

       setupSideBar state

       ------------------------------------------------------------------------
       -- Quit
       quitMenuItem `onActivateLeaf` mainQuit

       ------------------------------------------------------------------------
       -- About dialog
       aboutMenuItem `onActivateLeaf` showAboutDialog mainWindow

       ------------------------------------------------------------------------
       -- Quit behaviour
       onDestroy mainWindow mainQuit

       ------------------------------------------------------------------------
       -- Show all windows
       widgetShowAll mainWindow

#ifndef mingw32_HOST_OS
       main <- myThreadId
       installHandler sigINT (Catch (postGUIAsync (throw UserInterrupt))) Nothing
#endif

       ------------------------------------------------------------------------
       -- Enter main event loop for GUI.
       mainGUI

-------------------------------------------------------------------------------

buildInitialState :: [Option] -> IO ViewerState
buildInitialState options = do

       gladePath <- getDataFileName "threadscope.glade"
       Just xml <- xmlNew gladePath
       
       let debug = Debug `elem` options


       filenameIORef <- newIORef Nothing

       -- IORefs are used to communicate informaiton about the eventlog
       -- to the callback functions for windows, buttons etc.
       capabilitiesIORef <- newIORef Nothing
       hecsIORef         <- newIORef Nothing
       lastTxIORef       <- newIORef 0
       eventArrayIORef   <- newIORef (error "eventArrayIORef")
       scaleIORef        <- newIORef defaultScaleValue
       cursorIORef       <- newIORef 0

       mainWindow         <- xmlGetWidget xml castToWindow "main_window"
       statusBar          <- xmlGetWidget xml castToStatusbar "statusbar"
       hpaned             <- xmlGetWidget xml castToHPaned "hpaned"

       bwToggle           <- xmlGetWidget xml castToCheckMenuItem "black_and_white"
       sidebarToggle      <- xmlGetWidget xml castToCheckMenuItem "view_sidebar"
       openMenuItem       <- xmlGetWidget xml castToMenuItem "openMenuItem"
       saveAsPDFMenuItem  <- xmlGetWidget xml castToMenuItem "saveAsPDFMenuItem"
       saveAsPNGMenuItem     <- xmlGetWidget xml castToMenuItem "saveAsPNGMenuItem"
       reloadMenuItem     <- xmlGetWidget xml castToMenuItem "view_reload"
       quitMenuItem       <- xmlGetWidget xml castToMenuItem "quitMenuItem"
       aboutMenuItem      <- xmlGetWidget xml castToMenuItem "aboutMenuItem"

       timelineDrawingArea      <- xmlGetWidget xml castToDrawingArea
                                        "timeline_drawingarea"
       timelineLabelDrawingArea <- xmlGetWidget xml castToDrawingArea
                                        "timeline_labels_drawingarea"
       timelineKeyDrawingArea   <- xmlGetWidget xml castToDrawingArea
                                        "timeline_key_drawingarea"
       timelineHScrollbar       <- xmlGetWidget xml castToHScrollbar
                                        "timeline_hscroll"
       timelineVScrollbar       <- xmlGetWidget xml castToVScrollbar
                                        "timeline_vscroll"
       timelineAdj         <- rangeGetAdjustment timelineHScrollbar
       timelineVAdj        <- rangeGetAdjustment timelineVScrollbar

       timelineTraces     <- newIORef []
       timelinePrevView   <- newIORef Nothing

       zoomInButton       <- xmlGetWidget xml castToToolButton "cpus_zoomin"
       zoomOutButton      <- xmlGetWidget xml castToToolButton "cpus_zoomout"
       zoomFitButton      <- xmlGetWidget xml castToToolButton "cpus_zoomfit"

       showLabelsToggle   <- xmlGetWidget xml castToToggleToolButton "cpus_showlabels"
       firstButton        <- xmlGetWidget xml castToToolButton "cpus_first"
       lastButton         <- xmlGetWidget xml castToToolButton "cpus_last"
       centreButton       <- xmlGetWidget xml castToToolButton "cpus_centre"

       eventsFontExtents  <- newIORef (error "eventsFontExtents")
       eventsCursorIORef  <- newIORef Nothing
       eventsVScrollbar   <- xmlGetWidget xml castToVScrollbar "eventsVScroll"
       eventsAdj          <- rangeGetAdjustment eventsVScrollbar
       eventsDrawingArea  <- xmlGetWidget xml castToDrawingArea "eventsDrawingArea"
       eventsTextEntry    <- xmlGetWidget xml castToEntry "events_entry"
       eventsFindButton   <- xmlGetWidget xml castToToolButton "events_find"
       eventsFirstButton  <- xmlGetWidget xml castToToolButton "events_first"
       eventsHomeButton   <- xmlGetWidget xml castToToolButton "events_home"
       eventsLastButton   <- xmlGetWidget xml castToToolButton "events_last"

       sidebarVBox        <- xmlGetWidget xml castToVBox "sidebar_vbox"
       sidebarHBox        <- xmlGetWidget xml castToHBox "sidebar_hbox"
       sidebarCombo       <- xmlGetWidget xml castToComboBox "sidebar_combobox"
       sidebarComboState  <- newIORef sidebarBookmarks
       sidebarCloseButton <- xmlGetWidget xml castToButton "sidebar_close_button"
       bookmarkVBox       <- xmlGetWidget xml castToVBox "bookmarks_vbox"
       bookmarkTreeView   <- xmlGetWidget xml castToTreeView "bookmark_list"

       -- Bookmarks
       addBookmarkButton  <- xmlGetWidget xml castToToolButton "add_bookmark_button"
       deleteBookmarkButton <- xmlGetWidget xml castToToolButton "delete_bookmark" 
       gotoBookmarkButton  <- xmlGetWidget xml castToToolButton "goto_bookmark_button"
       bookmarkStore <- New.listStoreNew []
       New.treeViewSetModel bookmarkTreeView bookmarkStore  
       New.treeViewSetHeadersVisible bookmarkTreeView True
       bookmarkColumn <- New.treeViewColumnNew
       New.treeViewColumnSetTitle bookmarkColumn "Time"    
       cell <- New.cellRendererTextNew
       New.treeViewColumnPackStart bookmarkColumn cell True
       New.cellLayoutSetAttributes bookmarkColumn cell bookmarkStore  
          (\record -> [New.cellText := show record ++ " ns"])
       New.treeViewAppendColumn bookmarkTreeView bookmarkColumn

       -- Trace view
       tracesVBox <- vBoxNew False 0
       tracesTreeView <- treeViewNew
       tracesStore <- treeStoreNew []
       treeViewSetModel tracesTreeView tracesStore
       boxPackEnd tracesVBox tracesTreeView PackGrow 0

       return ViewerState { .. }