edentv (empty) → 4.1.0.0
raw patch · 12 files changed
+9694/−0 lines, 12 filesdep +arraydep +basedep +binarysetup-changed
Dependencies added: array, base, binary, bytestring, cairo, containers, directory, filepath, ghc-events-parallel, glade, gtk, mtl, zip-archive
Files
- EdenTV.hs +1196/−0
- EdenTvBasic.hs +183/−0
- EdenTvInteract.hs +892/−0
- EdenTvType.hs +388/−0
- EdenTvViewer.hs +974/−0
- RTSEventsParser.hs +1177/−0
- RTSEventsParserOld.lhs +1009/−0
- Setup.lhs +4/−0
- TinyZipper.lhs +31/−0
- edentv.cabal +54/−0
- edentv.glade +3112/−0
- gpl.txt +674/−0
+ EdenTV.hs view
@@ -0,0 +1,1196 @@+{- The Eden Trace Viewer (or simply EdenTV) is a tool that can generate diagrams to visualize the behaviour of Eden programs.+ Copyright (C) 2005-2010 Phillips Universitaet Marburg++ This program is free software; you can redistribute it and/or modify+ it under the terms of the GNU General Public License as published by+ the Free Software Foundation; either version 3 of the License, or+ (at your option) any later version.+ This program is distributed in the hope that it will be useful,+ but WITHOUT ANY WARRANTY; without even the implied warranty of+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+ GNU General Public License for more details.+ You should have received a copy of the GNU General Public License+ along with this program; if not, write to the Free Software Foundation,+ Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA++-}++module Main (main) where++import Graphics.UI.Gtk hiding (deleteEvent, destroyEvent, eventButton)+import Graphics.UI.Gtk.Gdk.Events +import Graphics.UI.Gtk.Windows.MessageDialog++import Graphics.UI.Gtk.Glade+import Graphics.UI.Gtk.General.StockItems++import Graphics.Rendering.Cairo hiding (version)++import Control.Concurrent+import Control.Monad.Fix+import Control.Monad++import EdenTvType+import EdenTvBasic+import EdenTvInteract+import EdenTvViewer+import System.Environment+import System.Exit+import System.Directory+import System.FilePath.Posix+import System.Directory+import System.CPUTime+import System.IO+import Data.List+import RTSEventsParser++import Debug.Trace++import Paths_edentv( -- version,+ getDataFileName+ ) -- this file is generated by cabal+import qualified Paths_edentv+import Data.Version(versionBranch) -- to extract version from there +++-- unsafe CAF to detect the file name once and return it as a+-- constant immediately for every call later:+-- cafGladeFile = unsafePerformIO $ do+-- let filename = "edentv.glade" -- change only here if desired+-- gladefile <- getDataFileName filename+-- inDataDir <- doesFileExist gladefile+-- if inDataDir +-- then return gladefile+-- else return filename -- default: local+++-- Datadir, usually "share/edentv-<VERSION>" holds the glade file.+-- Load the glade file from install path or local, specify root and domain+-- (XML is allegedly cached internally, but check is always repeated)+edentvGladeFile :: Maybe String -> Maybe String -> IO (Maybe GladeXML)+edentvGladeFile root domain+ = let filename = "edentv.glade" -- change only here if desired+ in do gladefile <- getDataFileName filename+ inDataDir <- doesFileExist gladefile+ inLocalDir <- doesFileExist filename+ case (inDataDir, inLocalDir) of+ (True, _) -> + xmlNewWithRootAndDomain gladefile root domain+ (False, True) -> + xmlNewWithRootAndDomain filename root domain+ (False, False) ->+ return Nothing++version,subversion :: String+-- version = "4.0"+version = show (head ( versionBranch Paths_edentv.version ))+subversion = "0"+regpath = "/apps/unimar/edentv/lastPath"+++-- some general GTK-Events:+deleteEvent :: Event -> IO Bool+deleteEvent _ = do return False+destroyEvent, quitEvent, closeEvent :: IO ()+destroyEvent = do mainQuit+quitEvent = do mainQuit+closeEvent = do return ()++data WindowsState = WS {+ windowsMenus :: [Menu]+ }++type WidgetCollection = (Menu, MenuItem, MenuItem, MenuItem, MVar WindowsState)+-- Wins, menuOpen, menuOpenWithoutMsgs, menuExit, state+-- openEvent: open a new Tracefile+openEvent :: Window -> WidgetCollection -> MVar EdenTvState -> Bool -> IO ()+openEvent parent ws edentvState ignoreMessages = do+ --Select Tracefile to load+ fileSelect <- fileChooserDialogNew (Just "Select Tracefile") (Just parent)+ FileChooserActionOpen [("OK",ResponseOk),("Cancel",ResponseCancel)]+ globalState <- readMVar edentvState+ let oldPath = lastPath globalState+ if null oldPath+ then return True+ else fileChooserSetCurrentFolder fileSelect oldPath+ widgetShow fileSelect+ response <- dialogRun fileSelect+ case response of -- which Button was pressed?+ ResponseOk -> do+ Just fileName <- fileChooserGetFilename fileSelect+ path <- fileChooserGetCurrentFolder fileSelect+ case path of Just filePath -> swapMVar edentvState (globalState { lastPath = filePath })+ Nothing -> return globalState+ widgetDestroy fileSelect+ -- display dialog with progress indicator+ tryToOpen fileName ws ignoreMessages False edentvState+ _ -> do+ putMVar edentvState (globalState { lastPath = oldPath })+ widgetDestroy fileSelect -- any other response++tryToOpen :: String -> WidgetCollection -> Bool -> Bool -> MVar EdenTvState -> IO ()+tryToOpen filename ws ignoreMessages showMessages edentvState = do+ dlg <- dialogNew+ windowSetTitle dlg "parsing file..."+ button <- dialogAddButton dlg stockCancel ResponseCancel+ upper <- dialogGetUpper dlg+ pg <- progressBarNew+ boxPackStartDefaults upper pg+ widgetShowAll dlg+ -- animate the progressbar+ threadProgress <- forkIO (showProgress pg)+ hID <- idleAdd (yield >> return True) priorityDefaultIdle+ -- start concurrent process to read tracefile+ threadTrace <- forkIO (openTracefile filename ws dlg ignoreMessages showMessages edentvState)+ -- Cancel-event!+ onClicked button (opCancel threadTrace dlg)+ dialogRun dlg -- wating for end of parsing or user interrupt+ killThread threadProgress+ idleRemove hID+ widgetDestroy dlg+ where+ showProgress :: ProgressBar -> IO ()+ showProgress pb = do+ progressBarPulse pb+ threadDelay 200000+ showProgress pb+ opCancel :: ThreadId -> Dialog -> IO ()+ opCancel thread dialog = do+ killThread thread+ dialogResponse dialog ResponseOk++hLines :: Show a => Handle -> [a] -> IO ()+hLines h (x:xs) = do+ hPutStrLn h (show x)+ hLines h xs+hLines _ _ = return ()+++++++-- open a new Trace-Window and display the Trace+openTracefile :: String -> WidgetCollection -> Dialog -> Bool -> Bool -> MVar EdenTvState -> IO ()+openTracefile filename widgets@(winList,mainOpen, mainOpenWithoutMsgs, exitApp, winMenus) + dialog ignoreMessages showMessages edentvState+ = do+ putStrLn (filename ++ ":")+ time <- getCPUTime+ traces' <- (traceRTSFile filename ignoreMessages)+ case traces' of+ Failed msg -> do+ dialogResponse dialog ResponseOk+ errorMessage ("Tracefile seems not to be valid:\n" ++ msg)+ Ok traces -> do+ -- build window and render traces:+ let ((m,p,t),mt,(maxStartupTimeInSeconds, _), (msgs,amsgs,hmsgs,pTree,rcvtimes),(minT,maxT,maxST,_,maxD),(nm,allP,nt)) = traces+ np = length p+ strRunT = formatFloat (maxT - minT)+ allMsgs = sum (map (\ (_,_,_,d) -> d) hmsgs) + length msgs+ time' <- getCPUTime+ let timeString = ("\n Traces computed in " +++ show (fromIntegral (time' - time) / 1000000000000) ++ " seconds.")+ putStrLn timeString+ + -- load XML-description from gladefile+ maybeGladeXML <- edentvGladeFile (Just "EdTVTrace") Nothing+ let gladeXML = case maybeGladeXML of+ (Just glade) -> glade+ Nothing -> error "missing file: \"edentv.glade\"!"+ -- get access to the widgets from gladefile+ window <- xmlGetWidget gladeXML castToWindow "EdTVTrace"+ pic <- xmlGetWidget gladeXML castToDrawingArea "drawingarea"+ win <- widgetGetDrawWindow pic+ viewport <- xmlGetWidget gladeXML castToViewport "viewport"+ scrldWnd <- xmlGetWidget gladeXML castToScrolledWindow "scrolledwindow"+ + buttonLocalNull <- xmlGetWidget gladeXML castToToggleToolButton "localNull"+ buttonMessages <- xmlGetWidget gladeXML castToToggleToolButton "messages"+ buttonInfo <- xmlGetWidget gladeXML castToToolButton "infoButton"+ buttonConfMsgs <- xmlGetWidget gladeXML castToToolButton "msgs-relations"+ traceZoomInH <- xmlGetWidget gladeXML castToToolButton "zoomInH"+ traceZoomInV <- xmlGetWidget gladeXML castToToolButton "zoomInV"+ traceZoomIn <- xmlGetWidget gladeXML castToMenuItem "zoom_in"+ traceZoomOutH <- xmlGetWidget gladeXML castToToolButton "zoomOutH"+ traceZoomOutV <- xmlGetWidget gladeXML castToToolButton "zoomOutV"+ traceZoomOut <- xmlGetWidget gladeXML castToMenuItem "zoom_out"+ moveUp <- xmlGetWidget gladeXML castToToolButton "go_up"+ moveDown <- xmlGetWidget gladeXML castToToolButton "go_down"+ viewselect <- xmlGetWidget gladeXML castToComboBox "viewselect"+ buttonToPng <- xmlGetWidget gladeXML castToToolButton "saveAsPng"+ + winm <- xmlGetWidget gladeXML castToMenu "windows_menu"+ menuClose <- xmlGetWidget gladeXML castToMenuItem "close"+ menuQuit <- xmlGetWidget gladeXML castToMenuItem "tquit"+ menuOpen <- xmlGetWidget gladeXML castToMenuItem "topen"+ + menuOpenWithoutMsgs <- xmlGetWidget gladeXML castToMenuItem "topenWithoutMsgs"+ menuSave <- xmlGetWidget gladeXML castToMenuItem "save"+ menuAllM <- xmlGetWidget gladeXML castToRadioMenuItem "showAllMachines"+ menuAllP <- xmlGetWidget gladeXML castToRadioMenuItem "showAllProcesses"+ menuAllGP <- xmlGetWidget gladeXML castToRadioMenuItem "showAllGProcesses"+ menuAllT <- xmlGetWidget gladeXML castToRadioMenuItem "showAllThreads"+ menuSort <- xmlGetWidget gladeXML castToMenuItem "sort"+ menuShowRange <- xmlGetWidget gladeXML castToMenuItem "edit_range"+ menuEditTicks <- xmlGetWidget gladeXML castToMenuItem "edit_ticks"+ menuTotal <- xmlGetWidget gladeXML castToMenuItem "totalView"+ menuMarker <- xmlGetWidget gladeXML castToCheckMenuItem "show_marker"+ menuStartupMarker <- xmlGetWidget gladeXML castToCheckMenuItem "show_startup"+ menuHideStartupPhase <- xmlGetWidget gladeXML castToCheckMenuItem "hide_startup_phase"+ menuBlockMsgs <- xmlGetWidget gladeXML castToCheckMenuItem "show_blockmsgs"+ menuDataMsgs <- xmlGetWidget gladeXML castToCheckMenuItem "show_data_messages"+ menuSystemMsgs <- xmlGetWidget gladeXML castToCheckMenuItem "show_system_messages"+ menuRefresh <- xmlGetWidget gladeXML castToMenuItem "refresh"+ menuAbout <- xmlGetWidget gladeXML castToMenuItem "tabout"+ + -- add labels for tool-items so that a label is displayed in the toolbar overflow menu + addMenuLabelToToolItem gladeXML "toolitemViewSelect" "Select View"+ addMenuLabelToToolItem gladeXML "toolitemSort" "Sort"+ addMenuLabelToToolItem gladeXML "toolitemZoomH" "Zoom Horizontal"+ addMenuLabelToToolItem gladeXML "toolitemZoomV" "Zoom Vertical"+ + -- the statusbar:+ statusbar <- xmlGetWidget gladeXML castToStatusbar "traceStatusBar"+ let statusString = " Runtime: " ++ strRunT ++ "s, " +++ show nm ++ " Machines, " +++ show allP ++ " Processes, " +++ show nt ++ " Threads, " +++ show (length msgs + (length hmsgs)) ++ " Conversations, " +++ show allMsgs ++ " Messages"+ botID <- statusbarGetContextId statusbar statusString+ + statusbarPush statusbar botID statusString+ -- initial settings+ comboBoxSetActive viewselect 0 -- default to view machines+ let listOfMachineIds = map (\(mId,_,_,_,_) -> mId) m+ listOfProcessIds = map (\(pId,_,_,_,_) -> pId) p + st <- newMVar (initMatrix nm (length p) nt listOfMachineIds listOfProcessIds filename ignoreMessages)+ -- filename in titlebar+ let winTitle = "Trace " ++ (takeFileName filename)+ windowSetTitle window winTitle+ -- create entry for windows-menu in main window (and now all other open windows too)+ ws <- takeMVar winMenus+ -- update all menus which are found in ws to display new tracefile item+ sequence_ $ map (\winList -> do + newListItem <- menuItemNewWithLabel winTitle+ submenu <- menuNew+ showItem <- menuItemNewWithLabel "Show"+ refreshItem <- menuItemNewWithLabel "Refresh"+ menuShellAppend winList newListItem+ menuShellAppend submenu showItem+ menuShellAppend submenu refreshItem+ menuItemSetSubmenu newListItem submenu+ widgetShow newListItem+ onActivateLeaf showItem (windowPresent window)+ onActivateLeaf refreshItem (widgetQueueDraw pic)+ widgetShowAll newListItem+ onDestroy window (widgetDestroy newListItem)+ onDestroy window (do + oldWS <- takeMVar winMenus + let oldM = windowsMenus oldWS+ --putStrLn "removing old menu from update list"+ --putStrLn (show $ length oldM)+ let removeSelf (x:xs)+ | x == winm = xs+ | otherwise = x : (removeSelf xs)+ removeSelf [] = []+ newM = removeSelf oldM+ --putStrLn (show $ length newM)+ putMVar winMenus (oldWS{windowsMenus=newM})+ )) (windowsMenus ws)+ -- get list of windows and build a windows menu from ground up+ -- for this window+ activeWins <- windowListToplevels + sequence_ $ map (\window -> do + title <- (windowGetTitle window)+ if isPrefixOf "Trace" title -- only show if window is a tracefile window+ then do+ newListItem <- menuItemNewWithLabel title+ submenu <- menuNew+ showItem <- menuItemNewWithLabel "Show"+ refreshItem <- menuItemNewWithLabel "Refresh"+ menuShellAppend winm newListItem+ menuShellAppend submenu showItem+ menuShellAppend submenu refreshItem+ menuItemSetSubmenu newListItem submenu+ widgetShow newListItem+ onActivateLeaf showItem (windowPresent window)+ onActivateLeaf refreshItem (widgetQueueDraw pic)+ widgetShowAll newListItem+ onDestroy window (widgetDestroy newListItem)+ return ()+ else return ()) activeWins+ -- register this windows menu for future updates+ putMVar winMenus (ws{windowsMenus=(winm:(windowsMenus ws))})+ + -- option buttons:+ -- zoom in/out, horizontal/vertical+ -- when zooming out also refresh the drawing area to get rid of the old drawings+ onToolButtonClicked traceZoomInH (zoom pic (*2) (id) viewport)+ onToolButtonClicked traceZoomInV (zoom pic (id) (*2) viewport)+ onToolButtonClicked traceZoomOutH (do zoom pic (`div` 2) (id) viewport; widgetQueueDraw pic)+ onToolButtonClicked traceZoomOutV (do zoom pic (id) (`div` 2) viewport; widgetQueueDraw pic)+ onActivateLeaf traceZoomIn (zoom pic (*2) (*2) viewport)+ onActivateLeaf traceZoomOut (do zoom pic (`div` 2) (`div` 2) viewport; widgetQueueDraw pic)+ + -- mouse zoom event+ onScroll pic (\ event -> do+ let scrollDirection = eventDirection event+ + when (scrollDirection == ScrollUp || scrollDirection == ScrollDown) $ do+ -- mouse position on the drawing area+ let mousePosX = eventX event+ let mousePosY = eventY event+ + let zoomFactor+ | scrollDirection == ScrollUp = (*2)+ | otherwise = (`div` 2)+ + zoomAt mousePosX mousePosY pic zoomFactor viewport+ widgetQueueDraw pic+ + return (True))+ + -- toggle local/global zero => refresh picture+ onToolButtonToggled buttonLocalNull (widgetQueueDraw pic)+ -- close the "parsing file"-dialog+ dialogResponse dialog ResponseOk+ + -- events from the menu+ -- close window, not program+ onActivateLeaf menuClose (widgetDestroy window) + -- close window AND program+ onActivateLeaf menuQuit (do + widgetActivate exitApp+ return ())+ -- open new tracefile, use controls of main window+ onActivateLeaf menuOpen (do + widgetActivate mainOpen+ return ())+ -- open new tracefile without msgs, use controls of main window+ onActivateLeaf menuOpenWithoutMsgs (do + widgetActivate mainOpenWithoutMsgs+ return ())+ + -- redraw+ onActivateLeaf menuBlockMsgs (widgetQueueDraw pic)+ onActivateLeaf menuDataMsgs (widgetQueueDraw pic)+ onActivateLeaf menuSystemMsgs (widgetQueueDraw pic)+ onActivateLeaf menuHideStartupPhase (widgetQueueDraw pic)+ + -- save image to file (menu entry)+ onActivateLeaf menuSave (do + windowPresent window+ + v <- comboBoxGetActive viewselect+ drawStartupMarker <- checkMenuItemGetActive menuStartupMarker+ hideStartupPhase <- checkMenuItemGetActive menuHideStartupPhase+ drawBlockMsgs <- checkMenuItemGetActive menuBlockMsgs+ drawDataMsgs <- checkMenuItemGetActive menuDataMsgs+ drawSystemMsgs <- checkMenuItemGetActive menuSystemMsgs+ + saveToFile drawBlockMsgs drawStartupMarker hideStartupPhase drawDataMsgs drawSystemMsgs traces (nt,np,nm) v st edentvState pic)+ -- sort current view+ onActivateLeaf menuSort ( do + state <- takeMVar st+ -- which view has to be sorted?+ v <- comboBoxGetActive viewselect+ case v of -- set the right list to default:+ 3 -> putMVar st (state { matrixGP = [1..(fromIntegral nm)] })+ 2 -> putMVar st (state { matrixT = [1..(fromIntegral nt)] })+ 1 -> putMVar st (state { matrixP = [1..(fromIntegral np)] })+ 0 -> putMVar st (state { matrixM = [1..(fromIntegral nm)] })+ widgetQueueDraw pic) -- refresh picture+ onActivateLeaf menuShowRange ( + do -- show specific range+ (Just gladeXML) <- edentvGladeFile (Just "range_win") Nothing+ rangeDlg <- xmlGetWidget gladeXML castToWindow "range_win"+ spinBegin <- xmlGetWidget gladeXML castToSpinButton "range_begin"+ spinEnd <- xmlGetWidget gladeXML castToSpinButton "range_end"+ buttonShow <- xmlGetWidget gladeXML castToButton "show_intervall"++ viewRange <- viewportGetHAdjustment viewport++ viewLower <- adjustmentGetLower viewRange+ viewUpper <- adjustmentGetUpper viewRange+ viewInit <- adjustmentGetValue viewRange+ viewStep <- adjustmentGetStepIncrement viewRange++ --putStrLn ("posX init: " ++ (show viewInit))++ state <- readMVar st+ let useDiff = locTime state+ ((vx,vy,vw,vh),(ulx,uly,lrx,lry)) <- getCorners pic+ + + hideStartupPhase <- checkMenuItemGetActive menuHideStartupPhase+ let minT'+ | hideStartupPhase = maxStartupTimeInSeconds+ | otherwise = minT+ let getTimeFromPosition x+ | useDiff = posToTime minT' (maxT+maxST) ulx lrx x+ | otherwise = posToTime minT' maxT ulx lrx x+ + let timeBeginInit = getTimeFromPosition (viewInit+ulx)+ timeBeginLower + | hideStartupPhase = 0+ | otherwise = minT'+ timeBeginUpper + | hideStartupPhase = maxT - minT'+ | otherwise = maxT+ timeEndInit = getTimeFromPosition (viewInit+(fromIntegral vw))+ timeEndLower = timeBeginLower+ timeEndUpper = timeBeginUpper+ timeStep = getTimeFromPosition viewStep+ + beginAdjustment <- adjustmentNew timeBeginInit timeBeginLower timeBeginUpper timeStep 0 0+ endAdjustment <- adjustmentNew timeEndInit timeEndLower timeEndUpper timeStep 0 0++ spinButtonConfigure spinBegin beginAdjustment timeStep 5+ spinButtonConfigure spinEnd endAdjustment timeStep 5+ + onClicked buttonShow (do+ --putStrLn "Ok?"+ timeX <- spinButtonGetValue spinBegin+ timeX2 <- spinButtonGetValue spinEnd+ --let scale_total = (maxT-minT)+ let scale = (((fromIntegral vw) - ulx) / (timeX2 - timeX)) * (maxT - minT')+ (w,h) <- widgetGetSize pic+ widgetSetSizeRequest pic (minimum [round scale, 32000]) (h)+ + let newlrx = (realToFrac (round scale)) - 20+ let getPositionFromTime x+ | useDiff = timeToPos minT' (maxT+maxST) ulx newlrx x+ | otherwise = timeToPos minT' maxT ulx newlrx x+ + let posX = (getPositionFromTime timeX) - ulx+ -- At the moment the drawing area might no have changed+ -- its size yet. So if we try to set the adjustment value now,+ -- the adjustment might not be changed because the new value is not+ -- between lowerValue and upperValue.+ -- So instead we set an event, which is called when the drawing area+ -- has changed its size, so that we can safely scroll to the right + -- position.+ viewAdj <- viewportGetHAdjustment viewport+ mfix $ \ handlerId -> afterAdjChanged viewAdj (do+ adjustmentSetValue viewAdj posX+ -- remove the event again+ signalDisconnect handlerId)+ + return ()+ )++ windowSetTitle rangeDlg "Show Range"+ windowSetTransientFor rangeDlg window+ widgetShowAll rangeDlg+ + )++ onActivateLeaf menuEditTicks ( + do -- show ticks setup+ (Just gladeXML) <- edentvGladeFile (Just "ticks_win") Nothing+ ticksDlg <- xmlGetWidget gladeXML castToWindow "ticks_win"+ ticksSkip <- xmlGetWidget gladeXML castToSpinButton "ticks_skip"+ ticksMark <- xmlGetWidget gladeXML castToSpinButton "ticks_mark"+ buttonSet <- xmlGetWidget gladeXML castToButton "set_ticks"+ buttonAuto <- xmlGetWidget gladeXML castToCheckButton "auto_ticks"++ state <- readMVar st+ let useDiff = locTime state + auto = autoTicks state+ tSkip = tickSkip state+ tMark = tickMark state+ maxSkip+ | useDiff = maxT + maxST+ | otherwise = maxT+ + skipAdjustment <- adjustmentNew tSkip 0.00001 maxSkip 0.1 0 0+ markAdjustment <- adjustmentNew (fromIntegral tMark) 1 32000 1 0 0+ toggleButtonSetActive buttonAuto auto++ spinButtonConfigure ticksSkip skipAdjustment 0.1 5+ spinButtonConfigure ticksMark markAdjustment 1 0+ + onClicked buttonSet (do+ --putStrLn "Ok?"+ valSkip <- spinButtonGetValue ticksSkip+ valMark <- spinButtonGetValue ticksMark+ valAuto <- toggleButtonGetActive buttonAuto+ state <- takeMVar st+ putMVar st (state { autoTicks=valAuto, tickSkip=valSkip, tickMark=floor valMark })+ widgetQueueDraw pic+ )+++ windowSetTitle ticksDlg "Edit Ticks"+ windowSetTransientFor ticksDlg window+ widgetShowAll ticksDlg+ + ) + onActivateLeaf menuTotal (do -- zoom picture to the size of this window+ visibleRegion <- drawableGetVisibleRegion win+ Rectangle _ _ w h <- regionGetClipbox visibleRegion -- get dimensions+ widgetSetSizeRequest pic (minimum [w, 32000]) (minimum [h, 32000]))+ onActivateLeaf menuRefresh (widgetQueueDraw pic) -- refresh picture (remove artefacts)+ onActivateLeaf menuAbout showAboutDlg -- show program information+ onActivateLeaf menuStartupMarker (widgetQueueDraw pic)+ -- Actions/Events from Toolbar+ onExpose pic (\_ -> do+ v <- comboBoxGetActive viewselect+ drawStartupMarker <- checkMenuItemGetActive menuStartupMarker+ hideStartupPhase <- checkMenuItemGetActive menuHideStartupPhase+ drawBlockMsgs <- checkMenuItemGetActive menuBlockMsgs+ drawDataMsgs <- checkMenuItemGetActive menuDataMsgs+ drawSystemMsgs <- checkMenuItemGetActive menuSystemMsgs+ case v of+ 3 -> drawAnyPic drawBlockMsgs drawStartupMarker hideStartupPhase drawDataMsgs drawSystemMsgs 0 0 (renderWithDrawable win) (drawGroupProcesses) pic traces st edentvState nm+ 2 -> drawAnyPic drawBlockMsgs drawStartupMarker hideStartupPhase drawDataMsgs drawSystemMsgs 0 0 (renderWithDrawable win) (drawThreads) pic traces st edentvState nt+ 1 -> drawAnyPic drawBlockMsgs drawStartupMarker hideStartupPhase drawDataMsgs drawSystemMsgs 0 0 (renderWithDrawable win) (drawProcesses) pic traces st edentvState np+ _ -> drawAnyPic drawBlockMsgs drawStartupMarker hideStartupPhase drawDataMsgs drawSystemMsgs 0 0 (renderWithDrawable win) (drawMachines) pic traces st edentvState nm+ return False)+ -- when the viewport slides over the image, the axes have to be redrawn:+ hAdj <- viewportGetHAdjustment viewport+ onValueChanged hAdj ( do+ ((vx,vy,vw,vh),(ulx,uly,lrx,lry)) <- getCorners pic+ drawWindowInvalidateRect win+ (Rectangle vx vy 100 vh) True)+ vAdj <- viewportGetVAdjustment viewport+ onValueChanged vAdj ( do+ ((vx,vy,vw,vh),(ulx,uly,lrx,lry)) <- getCorners pic+ let bot = 100+ drawWindowInvalidateRect win+ (Rectangle vx (vy+vh-bot) vw bot) True)+ onToolButtonClicked buttonToPng (do -- save image to file (toolbutton)+ widgetActivate menuSave+ return ())+ onActivateLeaf menuAllM ( do -- switch to machine view+ v <- comboBoxGetActive viewselect+ setTo <- checkMenuItemGetActive menuAllM+ if setTo && v /= 0+ then comboBoxSetActive viewselect 0+ else return ()+ )+ onActivateLeaf menuAllP ( do -- switch to process view+ v <- comboBoxGetActive viewselect+ setTo <- checkMenuItemGetActive menuAllP+ if setTo && v /= 1+ then comboBoxSetActive viewselect 1+ else return ()+ )+ onActivateLeaf menuAllGP ( do -- switch to process view+ v <- comboBoxGetActive viewselect+ setTo <- checkMenuItemGetActive menuAllGP+ if setTo && v /= 3+ then comboBoxSetActive viewselect 3+ else return ()+ )+ onActivateLeaf menuAllT ( do -- switch to thread view+ v <- comboBoxGetActive viewselect+ setTo <- checkMenuItemGetActive menuAllT+ if setTo && v /= 2+ then comboBoxSetActive viewselect 2+ else return ()+ )+ on viewselect changed (do+ state <- takeMVar st+ v <- comboBoxGetActive viewselect -- get the view to switch to+ -- update the menu items:+ case v of+ 3 -> checkMenuItemSetActive menuAllGP True+ 2 -> checkMenuItemSetActive menuAllT True+ 1 -> checkMenuItemSetActive menuAllP True+ 0 -> checkMenuItemSetActive menuAllM True+ -- save the view settings and refresh image:+ putMVar st (state { selRow = [], selView = v })+ widgetQueueDraw pic)+ onMotionNotify pic False (\e -> do -- the mouse has moved above the image:+ active <- checkMenuItemGetActive menuMarker+ let mx = eventX e+ my = eventY e+ if active -- then marker has to be redrawn+ then do+ hideStartupPhase <- checkMenuItemGetActive menuHideStartupPhase+ handleMouseMove st edentvState hideStartupPhase pic traces mx my+ else return ()+ state <- readMVar st+ if (clicked state) then handleDragnDrop st pic traces mx my else return ()+ return False)+ onButtonPress pic (\e -> do -- a mousebutton was pressed+ state <- takeMVar st+ win <- widgetGetDrawWindow pic+ ((vx,vy,vw,vh),(ulx,uly,lrx,lry)) <- getCorners pic+ let mx = eventX e+ my = eventY e+ activeClick = (mx > ulx && my > uly && mx < lrx && my < lry)+ pixbuf <- pixbufGetFromDrawable win (Rectangle 0 0 50 vh)+ putMVar st (state { clicked = activeClick, oldView = pixbuf })+ v <- comboBoxGetActive viewselect+ handleButtonPress pic v st e traces)++ onButtonRelease pic (\e -> do -- a mousebutton was released+ state <- takeMVar st+ ((vx,vy,vw,vh),(ulx,uly,lrx,lry)) <- getCorners pic+ let mx = eventX e+ my = eventY e+ didClick = clicked state+ putMVar st (state { clicked = False })+ v <- comboBoxGetActive viewselect+ if (mx > ulx && my > uly && mx < lrx && my < lry) && (didClick) + then performDragnDrop v st pic traces mx my+ else return ()+ widgetQueueDraw pic+ return False + )+ onToolButtonClicked buttonInfo ( do -- show traceinformation+ (Just gladeXML) <- edentvGladeFile (Just "info_win") Nothing+ infoDlg <- xmlGetWidget gladeXML castToWindow "info_win"+ windowSetTitle infoDlg ("Info - " ++ filename)+ windowSetTransientFor infoDlg window+ showTraceInfo traces filename (statusString {- ++ "\n("+ ++ show allMsgs ++ " Messages overall; "+ ++ show allP ++ " Processes overall)"-}) gladeXML+ widgetShowAll infoDlg)+ onToolButtonClicked buttonConfMsgs ( do -- show configure Messages Window+ (Just gladeXML) <- edentvGladeFile (Just "confmsgs_win") Nothing+ confDlg <- xmlGetWidget gladeXML castToWindow "confmsgs_win"+ v <- comboBoxGetActive viewselect++ buildConfMsg st gladeXML pic v+ + windowSetTitle confDlg "Configure Messages"+ windowSetTransientFor confDlg window+ widgetShowAll confDlg+ )+ onToolButtonClicked buttonLocalNull (do -- toggle local/global zero+ state <- takeMVar st+ localNull <- toggleToolButtonGetActive buttonLocalNull+ putMVar st (state { selRow = [], locTime = localNull })+ widgetQueueDraw pic)+ onToolButtonClicked buttonMessages (do -- show/hide Messages+ messagesOn <- toggleToolButtonGetActive buttonMessages+ state <- takeMVar st+ if (EdenTvType.ignoreMessages state)+ then do+ -- the trace file was read without parsing messages,+ -- so the file has to be read again+ putMVar st state+ if messagesOn + then do+ -- ask the user if the file should be re-parsed+ reparseDialog <- messageDialogNew+ (Just window)+ [DialogModal]+ MessageQuestion+ ButtonsOkCancel+ ("The current trace file has been opened without parsing the messages. " +++ "Should the file be read again and should the messages be displayed?")+ response <- dialogRun reparseDialog+ widgetDestroy reparseDialog+ case response of+ ResponseOk ->+ -- load file and also show messages+ tryToOpen (EdenTvType.filename state) widgets False True edentvState+ _ -> return()+ else return ()+ -- also disable the button again, because no messages are displayed+ -- in this window+ toggleToolButtonSetActive buttonMessages False+ else do+ -- messages were parsed while reading the trace file,+ -- so just show them+ putMVar st (state { selRow = [], showMsg = messagesOn })+ widgetQueueDraw pic)+ + -- change theposition of selected line+ onToolButtonClicked moveUp ( do+ v <- comboBoxGetActive viewselect+ handleMoveUp pic v st)+ onToolButtonClicked moveDown (do+ v <- comboBoxGetActive viewselect+ handleMoveDown pic v st)+ -- Show Trace-Window+ widgetShowAll window+ widgetQueueDraw pic+ -- traces drawn => all information consumed => file can be closed+ --hClose fileHdl+ + -- show messages on first display?+ if showMessages+ then toggleToolButtonSetActive buttonMessages True+ else return()+ where+ -- Zoom in/out horizontally by keeping the current position+ --+ zoomAt :: Double -> Double -> DrawingArea -> (Int -> Int) -> Viewport -> IO ()+ zoomAt mousePosX mousePosYFlipped pic zoomFactor viewport = do+ (w,h) <- widgetGetSize pic+ adjustmentH <- viewportGetHAdjustment viewport+ adjustmentV <- viewportGetVAdjustment viewport+ + -- point (0, 0) on the drawing area is in the lower left, but the+ -- coordinate system of the mouse position starts in upper left+ heightViewPort <- adjustmentGetPageSize adjustmentV+ let mousePosY = heightViewPort - mousePosYFlipped+ + -- get the current position+ (relativePosXViewPort, relativePosXTotal) + <- getRelativePositonAt mousePosX adjustmentH+ (relativePosYViewPort, relativePosYTotal)+ <- getRelativePositonAt mousePosY adjustmentV+ + -- restore the position once the new size is set+ restorePosition (setPositionAt adjustmentH relativePosXViewPort relativePosXTotal)+ (setPositionAt adjustmentV relativePosYViewPort relativePosYTotal)+ adjustmentH+ adjustmentV+ + widgetSetSizeRequest pic (minimum [zoomFactor w, 32000]) h+ + where+ -- chart borders in pixels+ pageBorderLeft = 55+ pageBorderRight = 20+ pageBorder = pageBorderLeft + pageBorderRight+ + -- Returns the relative position of the mouse pointer+ -- - relative to the viewable extent+ -- - relative to whole size (including the scrollable part)+ --+ getRelativePositonAt :: Double -> Adjustment -> IO (Double, Double)+ getRelativePositonAt position adj = do + min <- adjustmentGetLower adj+ max <- adjustmentGetUpper adj+ val <- adjustmentGetValue adj+ + viewableSize <- adjustmentGetPageSize adj+ let totalSize = max - min+ + return ((position - val - pageBorderLeft) / (viewableSize - pageBorder),+ (position - min - pageBorderLeft) / (totalSize - pageBorder))+ + setPositionAt :: Adjustment -> Double -> Double -> IO ()+ setPositionAt adj relativePosViewPort relativePosTotal = do+ min <- adjustmentGetLower adj+ max <- adjustmentGetUpper adj+ + viewableSize <- adjustmentGetPageSize adj+ let totalSize = max - min+ + let zoomPoint = (totalSize - pageBorder) * relativePosTotal+ let position = zoomPoint - ((viewableSize - pageBorder) * relativePosViewPort)+ let newValue+ | position < min = min+ | position + viewableSize > max = max - viewableSize+ | otherwise = position+ + adjustmentSetValue adj newValue+ + + zoom :: DrawingArea -> (Int -> Int) -> (Int -> Int) -> Viewport -> IO ()+ zoom pic fX fY viewport = do+ (w,h) <- widgetGetSize pic+ + -- get the current position+ adjustmentH <- viewportGetHAdjustment viewport+ adjustmentV <- viewportGetVAdjustment viewport+ relativePosX <- getRelativePositon adjustmentH+ relativePosY <- getRelativePositon adjustmentV+ + -- restore the position once the new size is set+ restorePosition (setPosition adjustmentH relativePosX)+ (setPosition adjustmentV relativePosY)+ adjustmentH+ adjustmentV+ + -- the resolution is restricted to 32K*32K,+ -- this is because DrawingArea immediately would allocate a backing store+ -- of 32k * 32k * (3 Bytes/pixel) memory and because x values are+ -- limited to short integer (-32768/+32767)+ widgetSetSizeRequest pic (minimum [fX w, 32000]) (minimum [fY h, 32000])+ + where+ -- Returns the relative position of the center point.+ --+ getRelativePositon :: Adjustment -> IO (Double)+ getRelativePositon adj = do + min <- adjustmentGetLower adj+ max <- adjustmentGetUpper adj+ val <- adjustmentGetValue adj+ pageSize <- adjustmentGetPageSize adj+ let center = val + (pageSize / 2)+ + return ((center - min) / (max - min))+ + setPosition :: Adjustment -> Double -> IO ()+ setPosition adj relativePos = do+ min <- adjustmentGetLower adj+ max <- adjustmentGetUpper adj+ pageSize <- adjustmentGetPageSize adj+ + let center = min + (max - min) * relativePos+ let newValue + | (center + (pageSize / 2)) >= max = max - pageSize+ | otherwise = (center - (pageSize / 2))+ + adjustmentSetValue adj newValue+ + restorePosition :: (IO ()) -> (IO ()) -> Adjustment -> Adjustment -> IO ()+ restorePosition setPositionH setPositionV adjustmentH adjustmentV = do+ mfix $ \ handlerId -> afterAdjChanged adjustmentH (do+ setPositionH+ signalDisconnect handlerId)+ mfix $ \ handlerId -> afterAdjChanged adjustmentV (do+ setPositionV+ signalDisconnect handlerId)+ return ()+ ++-- export to Picture:+-- Attention: parts of the window, that are off-screen, are not being exported!+--saveToFile :: DrawColor -> Events -> (Int,Int,Int) -> Int -> ViewerState -> DrawingArea -> IO ()+saveToFile drawBlockMsgs drawStartupMarker hideStartupPhase drawDataMsgs drawSystemMsgs traces (nt,np,nm) v st edentvState pic = do+ -- redraw window (refresh the image)+ widgetQueueDraw pic+ -- extract Image from Window:+ win <- widgetGetDrawWindow pic+ visibleRegion <- drawableGetVisibleRegion win+ visible <- regionGetClipbox visibleRegion+ let Rectangle visX visY visW visH = visible+ mPixbuf <- pixbufGetFromDrawable win visible+ -- ask for filename:+ selectFilename <- fileChooserDialogNew (Just "Save Picture") Nothing+ FileChooserActionSave [("_Save",ResponseOk),("Cancel",ResponseCancel)]+ dialogSetDefaultResponse selectFilename ResponseOk+ -- add filters for special filetypes:+ filterAll <- fileFilterNew+ filterAll `fileFilterAddPattern` "*.*"+ filterAll `fileFilterSetName` "all Files"+ filterImg <- fileFilterNew -- to select the filetype+ fileFilterAddPixbufFormats filterImg -- add imagetypes+ filterImg `fileFilterAddPattern` "*.pdf"+ filterImg `fileFilterSetName` "all known images"+ selectFilename `fileChooserAddFilter` filterAll -- add filters to dialog+ selectFilename `fileChooserAddFilter` filterImg+ filterPDF <- fileFilterNew+ filterPDF `fileFilterAddPattern` ("*.pdf")+ filterPDF `fileFilterSetName` "Portable Document Format (*.pdf)"+ selectFilename `fileChooserAddFilter` filterPDF+ addSpecialFilters selectFilename pixbufGetFormats+ -- show and run the dialog:+ widgetShow selectFilename+ response <- dialogRun selectFilename+ case response of+ ResponseCancel -> widgetDestroy selectFilename -- don't save the image+ ResponseOk -> do+ Just filename <- fileChooserGetFilename selectFilename+ let filetype = reverse (takeWhile (/= '.') (reverse filename)) -- extract the choosen filetype+ if (elem filetype ["bmp","jpg","jpeg","png", "pdf"]) -- filetype recognized?+ then do+ widgetDestroy selectFilename+ pathExists <- doesDirectoryExist filename+ fileExists <- doesFileExist filename+ doWrite <- if pathExists+ then do errorMessage (filename ++ " is a Directory.")+ return False+ else if fileExists+ then yesNoMessage (filename ++ " exists, overwrite?")+ else return True+ if doWrite+ then case mPixbuf of+ Nothing -> error "saveToFile: Window not visible"+ Just p -> do+ if (elem filetype ["bmp","jpg","jpeg","png"])+ then pixbufSave p filename (if filetype == "jpg" then "jpeg" else filetype) []+ else do+ + case v of+ 3 -> withPDFSurface filename (fromIntegral visW) (fromIntegral visH) (\s -> drawAnyPic drawBlockMsgs drawStartupMarker hideStartupPhase drawDataMsgs drawSystemMsgs (-(fromIntegral visX)) (-(fromIntegral visY)) (renderWith s) (drawGroupProcesses) pic traces st edentvState nt ) + 2 -> withPDFSurface filename (fromIntegral visW) (fromIntegral visH) (\s -> drawAnyPic drawBlockMsgs drawStartupMarker hideStartupPhase drawDataMsgs drawSystemMsgs (-(fromIntegral visX)) (-(fromIntegral visY)) (renderWith s) (drawThreads) pic traces st edentvState nt ) + 1 -> withPDFSurface filename (fromIntegral visW) (fromIntegral visH) (\s -> drawAnyPic drawBlockMsgs drawStartupMarker hideStartupPhase drawDataMsgs drawSystemMsgs (-(fromIntegral visX)) (-(fromIntegral visY)) (renderWith s) (drawProcesses) pic traces st edentvState nt )+ _ -> withPDFSurface filename (fromIntegral visW) (fromIntegral visH) (\s -> drawAnyPic drawBlockMsgs drawStartupMarker hideStartupPhase drawDataMsgs drawSystemMsgs (-(fromIntegral visX)) (-(fromIntegral visY)) (renderWith s) (drawMachines) pic traces st edentvState nt )+ else return ()+ else do -- unknown filetype+ widgetDestroy selectFilename+ maybeGladeXML <- edentvGladeFile (Just "dlg_err_save_filetype") Nothing+ let gladeXML = case maybeGladeXML of+ (Just glade) -> glade+ Nothing -> error "missing file: \"edentv.glade\"!"+ dlg <- xmlGetWidget gladeXML castToDialog "dlg_err_save_filetype"+ dlg `afterResponse` (\_ -> widgetDestroy dlg)+ widgetShowAll dlg+ -- allowed filetypes: png bmp wbmp gif ico ani jpeg pnm ras tiff xpm xbm tga+ -- supported: png, bmp, jpeg+ _ -> widgetDestroy selectFilename+ return ()+ where addSpecialFilters _ [] = return ()+ addSpecialFilters dlg (f:fs) = do+ filter <- fileFilterNew+ filter `fileFilterAddPattern` ("*." ++ f)+ case f of+ "pdf" -> do+ filter `fileFilterSetName` "Portable Document Format(*.pdf)"+ dlg `fileChooserAddFilter` filter+ "png" -> do+ filter `fileFilterSetName` "Portable Networks Graphics (*.png)"+ dlg `fileChooserAddFilter` filter+ "bmp" -> do+ filter `fileFilterSetName` "Windows Bitmap (*.bmp)"+ dlg `fileChooserAddFilter` filter+ "jpeg" -> do+ filter `fileFilterAddPattern` ("*.jpg")+ filter `fileFilterSetName` "Joint Photographic Experts Group (*.jpeg)"+ dlg `fileChooserAddFilter` filter+ _ -> return ()+ addSpecialFilters dlg fs++-- start GUI+main :: IO ()+main = do+ putStrLn ("This is EdenTV v" ++ version ++ ". Happy tracing!")+ initGUI -- for GTK++ -- load Glade-description+ maybeGladeXML <- edentvGladeFile (Just "EdTVMain") Nothing+ -- TODO: Search in current directory and in directory of EdenTV-executable+ let gladeXML = case maybeGladeXML of+ (Just glade) -> glade+ Nothing -> error "missing file: \"edentv.glade\"!"+ -- load Widgets from Glade-description+ -- main window+ windowMain <- xmlGetWidget gladeXML castToWindow "EdTVMain"+ + -- colorbuttons+ iCB <- xmlGetWidget gladeXML castToColorButton "idle_colorbutton"+ rCB <- xmlGetWidget gladeXML castToColorButton "running_colorbutton"+ sCB <- xmlGetWidget gladeXML castToColorButton "suspended_colorbutton"+ bCB <- xmlGetWidget gladeXML castToColorButton "blocked_colorbutton"+ -- other toolbar entries+ toolbarOpen <- xmlGetWidget gladeXML castToToolButton "toolbar_Open"+ -- menu entries+ menuFileOpen <- xmlGetWidget gladeXML castToMenuItem "menuFile_Open"+ menuFileOpenWithoutMsgs <- xmlGetWidget gladeXML castToMenuItem "menuFile_OpenWithoutMsgs"+ menuFileExit <- xmlGetWidget gladeXML castToMenuItem "menuFile_Quit"+ + cCol <- xmlGetWidget gladeXML castToRadioMenuItem "default_colors"+ cBW <- xmlGetWidget gladeXML castToRadioMenuItem "default_colBW"+ menuOptsSetColors <- xmlGetWidget gladeXML castToMenuItem "menuOptions_SetColors"+ + menuWindows <- xmlGetWidget gladeXML castToMenu "windows_menu"+ refreshWins <- xmlGetWidget gladeXML castToMenuItem "refresh_all"+ menuHelpAbout <- xmlGetWidget gladeXML castToMenuItem "menuHelp_About"+ -- menuSetTitle menuWindows "active Documents"+ + -- initial state with default colors+ edentvState <- newMVar (ES { lastPath = "", colors = getDefaultColors })+ + -- Eventhandling:+ onDelete windowMain deleteEvent+ onDestroy windowMain destroyEvent+ onActivateLeaf menuFileExit quitEvent+ onToolButtonClicked toolbarOpen (do {widgetActivate menuFileOpen; return ()}) -- open tracefile+ winMenus <- newMVar WS {windowsMenus=[menuWindows]}+ + -- open tracefile+ onActivateLeaf menuFileOpen + (openEvent windowMain (menuWindows,menuFileOpen,menuFileOpenWithoutMsgs,menuFileExit, winMenus) edentvState False) + -- open tracefile without parsing messages+ onActivateLeaf menuFileOpenWithoutMsgs + (openEvent windowMain (menuWindows,menuFileOpen,menuFileOpenWithoutMsgs,menuFileExit, winMenus) edentvState True) + + -- handling colors+ let updateMainColorButtons colorMap = do+ updateColorButton iCB (statusIdle colorMap)+ updateColorButton rCB (statusRunning colorMap)+ updateColorButton sCB (statusSuspended colorMap)+ updateColorButton bCB (statusBlocked colorMap)+ let setTemplateMenuInconsistent = do+ checkMenuItemSetInconsistent cCol True+ checkMenuItemSetInconsistent cBW True+ onActivateLeaf menuOptsSetColors (showSetColorDialog edentvState menuWindows updateMainColorButtons + setTemplateMenuInconsistent)+ + onActivateLeaf cCol ( do+ setDefaultColors cCol edentvState menuWindows updateMainColorButtons+ checkMenuItemSetInconsistent cBW False)+ onActivateLeaf cBW ( do+ setDefaultBW cBW edentvState menuWindows updateMainColorButtons+ checkMenuItemSetInconsistent cCol False)+ + onColorSet iCB (colorChanged iCB edentvState + (\ color colors -> colors {statusIdle = color}) menuWindows setTemplateMenuInconsistent)+ onColorSet rCB (colorChanged rCB edentvState + (\ color colors -> colors {statusRunning = color}) menuWindows setTemplateMenuInconsistent)+ onColorSet sCB (colorChanged sCB edentvState + (\ color colors -> colors {statusSuspended = color}) menuWindows setTemplateMenuInconsistent)+ onColorSet bCB (colorChanged bCB edentvState + (\ color colors -> colors {statusBlocked = color}) menuWindows setTemplateMenuInconsistent)+ + -- a list of all opened windows+ onActivateLeaf refreshWins (refreshAll menuWindows)+ onActivateLeaf menuHelpAbout showAboutDlg -- not supported on CentOS!!!+ + -- set default colors on start-up+ setDefaultColors cCol edentvState menuWindows updateMainColorButtons+ checkMenuItemSetActive cCol True+ + -- load tracefile if filename is in commandline+ args <- getArgs+ if (null args)+ then return ()+ else case (head args) of+ "--version" -> exitWith ExitSuccess+ "--help" -> do+ putStrLn " EdenTV just open main dialog of EdenTV"+ putStrLn " EdenTV <filename> run EdenTV and open <filename>"+ putStrLn " EdenTV --version print version and exit"+ putStrLn " EdenTV --help print this help and exit"+ exitWith ExitSuccess+ hArgs -> do+ cPath <- canonicalizePath hArgs+ let path = (reverse (tail (dropWhile (\c -> notElem c ['\\','/']) (reverse cPath))))+ swapMVar edentvState (ES { lastPath = path, colors = getDefaultColors })+ tryToOpen hArgs (menuWindows, menuFileOpen, menuFileOpenWithoutMsgs, menuFileExit, winMenus) False False edentvState+ -- for GTK++ widgetShowAll windowMain+ mainGUI+ where+ -- Called when one of the 4 colors in the main windows was changed+ --+ colorChanged colorButton edentvState setter openTraceWindows setTemplateMenuInconsistent = do+ globalState <- readMVar edentvState+ let colorMap = colors globalState+ newColor <- getColorFromColorButton colorButton+ + -- store new color in the state+ let colorMap' = setter newColor colorMap+ swapMVar edentvState (globalState {colors = colorMap' })+ + setTemplateMenuInconsistent+ refreshAll openTraceWindows++setDefaultColors, setDefaultBW :: RadioMenuItem -> MVar EdenTvState -> Menu -> (Colors -> IO ()) -> IO ()+setDefaultColors cCol edentvState openTraceWindows updateMainColorButtons = do+ isActive <- get cCol checkMenuItemActive+ when isActive $ do+ setNewColors edentvState (getDefaultColors) openTraceWindows updateMainColorButtons+ checkMenuItemSetInconsistent cCol False+setDefaultBW cBW edentvState openTraceWindows updateMainColorButtons = do+ isActive <- get cBW checkMenuItemActive+ when isActive $ do+ setNewColors edentvState (getDefaultColorsBW) openTraceWindows updateMainColorButtons+ checkMenuItemSetInconsistent cBW False++-- This function takes care of displaying the dialog to customize all+-- colors (not just the four shown in the main window). If the dialog is+-- closed with `Ok`, the new colors are stored in the state and all open+-- trace windows are refreshed.+--+showSetColorDialog :: MVar EdenTvState -> Menu -> (Colors -> IO ()) -> (IO ()) -> IO ()+showSetColorDialog edentvState openTraceWindows updateMainColorButtons setTemplateMenuInconsistent = do+ (Just gladeXML) <- edentvGladeFile (Just "dialogColors") Nothing+ colorsDialog <- xmlGetWidget gladeXML castToDialog "dialogColors"+ + globalState <- readMVar edentvState+ updateDialogFromState gladeXML (colors globalState)+ + dialogResponse <- dialogRun colorsDialog+ + case dialogResponse of + ResponseAccept -> do+ colors' <- updateStateFromDialog gladeXML (colors globalState)+ setNewColors edentvState colors' openTraceWindows updateMainColorButtons+ setTemplateMenuInconsistent+ + _ -> return ()+ + widgetDestroy colorsDialog+ return ()+ + where+ updateDialogFromState :: GladeXML -> Colors -> IO ()+ updateDialogFromState gladeXML colors = do + mapM_ (updateColorButtonById gladeXML colors) colorMapping+ + -- Sets the color of a color button using the current value in+ -- the state.+ --+ updateColorButtonById :: GladeXML -> Colors -> ColorMapping -> IO ()+ updateColorButtonById gladeXML colors (id, getter, _) = do+ let color = getter colors+ colorButton <- xmlGetWidget gladeXML castToColorButton id+ updateColorButton colorButton color+ + -- Retrieves the changed colors from the dialog and stores them in+ -- the state.+ --+ updateStateFromDialog :: GladeXML -> Colors -> IO (Colors)+ updateStateFromDialog gladeXML colors = do + newColors <- mapM getColor colorMapping+ let colors' = foldr applyColor colors $ zip colorMapping newColors+ return (colors')+ + where + applyColor :: (ColorMapping, ColorRGBA) -> Colors -> Colors+ applyColor ((_, _, setter), newColor) colors = setter newColor colors+ + getColor :: ColorMapping -> IO (ColorRGBA)+ getColor (id, _, _) = getColorFromColorButtonById gladeXML id+ + getColorFromColorButtonById :: GladeXML -> String -> IO (ColorRGBA)+ getColorFromColorButtonById gladeXML id = do+ colorButton <- xmlGetWidget gladeXML castToColorButton id+ getColorFromColorButton colorButton++-- Stores new colors in the state, updates the main windows color buttons and+-- refreshes all open trace windows.+--+setNewColors :: MVar EdenTvState -> Colors -> Menu -> (Colors -> IO ()) -> IO ()+setNewColors edentvState newColors openTraceWindows updateMainColorButtons = do+ globalState <- takeMVar edentvState+ putMVar edentvState (globalState {colors = newColors})+ updateMainColorButtons newColors+ refreshAll openTraceWindows++updateColorButton :: ColorButton -> ColorRGBA -> IO ()+updateColorButton colorButton color = do+ colorButtonSetColor colorButton (rgbColor color)+ colorButtonSetAlpha colorButton (alpha color)++getColorFromColorButton :: ColorButton -> IO (ColorRGBA)+getColorFromColorButton colorButton = do + rgbColor <- colorButtonGetColor colorButton+ alpha <- colorButtonGetAlpha colorButton+ + return (RGBA {rgbColor = rgbColor, alpha = alpha})+ ++addMenuLabelToToolItem :: GladeXML -> String -> String -> IO ()+addMenuLabelToToolItem gladeXML toolItemId labelCaption+ = do toolItem <- xmlGetWidget gladeXML castToToolItem toolItemId+ label <- imageMenuItemNewWithLabel labelCaption+ let labelId = toolItemId ++ "Label"+ toolItemSetProxyMenuItem toolItem labelId label++refreshAll :: Menu -> IO ()+refreshAll menu = do+ (_:winList) <- containerGetChildren menu+ refresh winList+ where refresh [] = return ()+ refresh (l:ls) = do+ Just submenu <- menuItemGetSubmenu (castToMenuItem l)+ (_:r:_) <- containerGetChildren (castToMenu submenu)+ widgetActivate r+ refresh ls++showAboutDlg = do+ dlg <- aboutDialogNew+ dlg `aboutDialogSetName` "EdenTV"+ dlg `aboutDialogSetVersion` version+ dlg `aboutDialogSetComments` "Trace Viewer for Eden Trace Files"+ dlg `aboutDialogSetLicense` Nothing+ dlg `aboutDialogSetWebsite` "http://www.mathematik.uni-marburg.de/~eden"+ dlg `aboutDialogSetWebsiteLabel` "Take me to Eden"+ dlg `aboutDialogSetAuthors` ["Bjoern Struckmeier","Bernhard Pickenbrock","","Betreuung:","Prof. Dr. Rita Loogen"]+ dlg `afterResponse` (\_ -> widgetDestroy dlg)+ widgetShowAll dlg+
+ EdenTvBasic.hs view
@@ -0,0 +1,183 @@+{- The Eden Trace Viewer (or simply EdenTV) is a tool that can generate diagrams to visualize the behaviour of Eden programs.+ Copyright (C) 2005-2010 Phillips Universitaet Marburg++ This program is free software; you can redistribute it and/or modify+ it under the terms of the GNU General Public License as published by+ the Free Software Foundation; either version 3 of the License, or+ (at your option) any later version.+ This program is distributed in the hope that it will be useful,+ but WITHOUT ANY WARRANTY; without even the implied warranty of+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+ GNU General Public License for more details.+ You should have received a copy of the GNU General Public License+ along with this program; if not, write to the Free Software Foundation,+ Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA++-}++++module EdenTvBasic where++import EdenTvType+import Graphics.Rendering.Cairo+import Graphics.UI.Gtk.Gdk.GC+import Numeric+import Data.Tree hiding (drawTree)+import Data.Word++-- adaption of Data.Tree.drawTree for (Tree a)+-- | Neat 2-dimensional drawing of a tree.+drawTree :: Show a => Tree a -> String+drawTree = unlines . drawTree_++drawTree_ :: Show a => Tree a -> [String]+drawTree_ (Node p pts) = show p : drawSubTrees pts+ where drawSubTrees [] = []+ drawSubTrees [t] =+ "|" : shift "`-- " " " (drawTree_ t)+ drawSubTrees (t:ts) =+ "|" : shift "+-- " "| " (drawTree_ t) ++ drawSubTrees ts+ shift first other = zipWith (++) (first : repeat other)++-- some standard colors+-- color___ :: Render ()+colorRedA = setSourceRGBA 0.8 0.0 0.0 0.7+colorGray = setSourceRGB 0.5 0.5 0.5+colorBlack = setSourceRGB 0.0 0.0 0.0++getDefaultColors :: Colors+getDefaultColors = Colors + { statusRunning = rgb 0 65535 0+ , statusSuspended = rgb 65535 65535 0+ , statusBlocked = rgb 65535 0 0+ , statusIdle = rgb 0 0 65535+ + , messagesSystem = rgb 41120 0 0+ , messagesHead = rgb 6553 6553 6553+ , messagesData = rgb 6553 6553 6553+ , messagesHeadLocal = rgb 3328 0 47616+ , messagesDataLocal = rgb 3328 0 47616+ , messagesBlock = rgb 19660 19660 19660+ , messagesReceive = rgb 6553 6553 6553+ + , markerLine = rgba 52428 0 0 45874+ , markerLabel = rgba 52428 0 0 45874+ , markerStartup = rgba 52428 0 0 45874+ + , chartBackground = rgb 65535 65535 65535+ , chartAxes = rgba 0 0 0 45874+ , chartAxesLabel = rgba 0 0 0 45874+ }++getDefaultColorsBW :: Colors+getDefaultColorsBW = Colors + { statusRunning = rgb 39500 39500 39500+ , statusSuspended = rgb 59000 59000 59000+ , statusBlocked = rgb 19500 19500 19500+ , statusIdle = rgb 0 0 0+ + , messagesSystem = rgb 32767 32767 32767+ , messagesHead = rgb 6553 6553 6553+ , messagesData = rgb 6553 6553 6553+ , messagesHeadLocal = rgb 6553 6553 6553+ , messagesDataLocal = rgb 6553 6553 6553+ , messagesBlock = rgb 19660 19660 19660+ , messagesReceive = rgb 6553 6553 6553+ + , markerLine = rgba 52428 0 0 45874+ , markerLabel = rgba 52428 0 0 45874+ , markerStartup = rgba 52428 0 0 45874+ + , chartBackground = rgb 65535 65535 65535+ , chartAxes = rgba 0 0 0 45874+ , chartAxesLabel = rgba 0 0 0 45874+ }++getColor :: (Colors -> ColorRGBA) -> Colors -> Render ()+getColor getter colors = setSourceRGBA r g b a+ where+ (r, g, b, a) = getCairoColor $ getter colors++getColorAlpha :: (Colors -> ColorRGBA) -> Colors -> Double -> Render ()+getColorAlpha getter colors alpha = setSourceRGBA r g b alpha+ where+ (r, g, b, _) = getCairoColor $ getter colors+ +getCairoColor :: ColorRGBA -> (Double, Double, Double, Double)+getCairoColor (RGBA (Color r g b) a) = (toCairo r, toCairo g, toCairo b, toCairo a)+ where+ -- Converts a GTK color value (0 - 65535) to a Cairo+ -- color value (0 - 1).+ toCairo :: Word16 -> Double+ toCairo val = (fromIntegral val) / 65535++type ColorGetter = Colors -> ColorRGBA+type ColorSetter = ColorRGBA -> Colors -> Colors+type ColorMapping = (String, ColorGetter, ColorSetter)++-- Maps the color buttons in the "Set Color" - dialog to the color values+-- in the state (`EdenTvState`).+colorMapping :: [ColorMapping]+colorMapping = + [ ("btnStatusRunning", statusRunning, \ color colors -> colors {statusRunning = color})+ , ("btnStatusSuspended", statusSuspended, \ color colors -> colors {statusSuspended = color})+ , ("btnStatusBlocked", statusBlocked, \ color colors -> colors {statusBlocked = color})+ , ("btnStatusIdle", statusIdle, \ color colors -> colors {statusIdle = color})+ + , ("btnMessagesSystem", messagesSystem, \ color colors -> colors {messagesSystem = color})+ , ("btnMessagesHead", messagesHead, \ color colors -> colors {messagesHead = color})+ , ("btnMessagesData", messagesData, \ color colors -> colors {messagesData = color})+ , ("btnMessagesBlock", messagesBlock, \ color colors -> colors {messagesBlock = color})+ , ("btnMessagesReceive", messagesReceive, \ color colors -> colors {messagesReceive = color})+ + , ("btnMarkerLine", markerLine, \ color colors -> colors {markerLine = color})+ , ("btnMarkerLabel", markerLabel, \ color colors -> colors {markerLabel = color})+ , ("btnMarkerStartup", markerStartup, \ color colors -> colors {markerStartup = color})+ + , ("btnChartBackground", chartBackground, \ color colors -> colors {chartBackground = color})+ , ("btnChartAxes", chartAxes, \ color colors -> colors {chartAxes = color})+ , ("btnAxesLabel", chartAxesLabel, \ color colors -> colors {chartAxesLabel = color})+ ]++-- ScreenSetup:+border, shadow :: Double+border = 5+shadow = 3++-- getStartTime : gap between local and global starttime of machine i+-- perhaps: use assoziative array / hashtable+getStartTime :: MachineID -> [(MachineID,Double)] -> Double+getStartTime _ [] = 0.0 -- machine not found?+getStartTime i ((m,t):ts)+ | m == i = t+ | otherwise = getStartTime i ts++posToTime :: Seconds -> Seconds -> Double -> Double -> Double -> Seconds+posToTime minT maxT ulx lrx x = ((x - ulx) * (maxT - minT) / (lrx - ulx))++timeToPos :: Seconds -> Seconds -> Double -> Double -> Seconds -> Double+timeToPos minT maxT ulx lrx y = ((y * (lrx - ulx)) / (maxT-minT) + ulx)++formatFloat :: RealFloat a => a -> String+formatFloat d = showFFloat (Just 6) d ""++switch :: Eq a => a -> a -> [a] -> [a]+{-switch m n matrix = switch' matrix+ where+ switch' (d:ds)+ | d == m = n : switch' ds+ | d == n = m : switch' ds+ | otherwise = d : switch' ds+ switch' _ = []+-}++-- faster switch (old one in O(2n), this one in O(n)):+switch m n (d:ds)+ | d == m = n : switch' n m ds+ | d == n = m : switch' m n ds+ | otherwise = d : switch m n ds+ where switch' o p (e:es)+ | e == o = p : es+ | otherwise = e : switch' o p es+ -- switch' _ _ [] = []
+ EdenTvInteract.hs view
@@ -0,0 +1,892 @@+{- The Eden Trace Viewer (or simply EdenTV) is a tool that can generate diagrams to visualize the behaviour of Eden programs.+ Copyright (C) 2005-2010 Phillips Universitaet Marburg++ This program is free software; you can redistribute it and/or modify+ it under the terms of the GNU General Public License as published by+ the Free Software Foundation; either version 3 of the License, or+ (at your option) any later version.+ This program is distributed in the hope that it will be useful,+ but WITHOUT ANY WARRANTY; without even the implied warranty of+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+ GNU General Public License for more details.+ You should have received a copy of the GNU General Public License+ along with this program; if not, write to the Free Software Foundation,+ Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA++-}++{-# OPTIONS_GHC -cpp #-}+-- JB first draft: commented out features missing in Gtk2hs-0.9.11+module EdenTvInteract where++import EdenTvType+import EdenTvBasic+import Graphics.UI.Gtk hiding (get, eventButton)+import Graphics.UI.Gtk.Gdk.Events+import qualified Graphics.UI.Gtk.Gdk.GC as G+import Graphics.UI.Gtk.Glade+-- JB: not in Gtk2hs-0.9.11 any more:+-- import Graphics.UI.Gtk.Mogul+import Graphics.UI.Gtk.ModelView.TreeView+import Graphics.UI.Gtk.ModelView.ListStore+import Graphics.Rendering.Cairo+import Data.Tree hiding (drawTree)+import Data.Char+import Control.Concurrent.MVar++import Data.List++import Debug.Trace++-- get dimensions of drawinarea:+-- visible Rect and the upper left and lower right corners to draw in+type Dim = (Double,Double,Double,Double)+type DimV = (Int,Int,Int,Int)+getCorners :: DrawingArea -> IO (DimV,Dim)+getCorners pic = do+ win <- widgetGetDrawWindow pic+ (w,h) <- widgetGetSize pic+ vR <- drawableGetVisibleRegion win+ Rectangle vx vy vw vh <- regionGetClipbox vR+ return ((vx, vy, vw, vh), (border + 50, border + 20,+ (realToFrac w) - 20, (realToFrac h) - 20))++++buildConfMsg :: MVar ViewerState -> GladeXML -> DrawingArea -> Int -> IO ()+buildConfMsg st glade pic v = do + -- get access to the widgets:+ confM <- xmlGetWidget glade castToTreeView "confM"+ confP <- xmlGetWidget glade castToTreeView "confP"+ noteb <- xmlGetWidget glade castToNotebook "notebook1"++ -- Machine checkBoxes+ mId <- treeViewColumnNew+ treeViewColumnSetTitle mId "machine id"+ treeViewAppendColumn confM mId+ rendererMId <- cellRendererTextNew+ cellLayoutPackStart mId rendererMId True++ mSnt <- treeViewColumnNew+ treeViewColumnSetTitle mSnt "show outgoing"+ treeViewAppendColumn confM mSnt+ rendererMSnt <- cellRendererToggleNew+ cellLayoutPackStart mSnt rendererMSnt True++ mRcv <- treeViewColumnNew+ treeViewColumnSetTitle mRcv "show incoming"+ treeViewAppendColumn confM mRcv+ rendererMRcv <- cellRendererToggleNew+ cellLayoutPackStart mRcv rendererMRcv True++++ state <- readMVar st+ dataM <- listStoreNew (confMachines state)++ -- activate right tab view+ case v of+ 1 -> notebookSetCurrentPage noteb 1+ 3 -> notebookSetCurrentPage noteb 1+ 0 -> notebookSetCurrentPage noteb 0+ _ -> notebookSetCurrentPage noteb 0+++ -- update the model when the toggle buttons are activated+ on rendererMRcv cellToggled $ \pathStr -> do+ let (i:_) = stringToTreePath pathStr+ (mid,(inb,outb)) <- listStoreGetValue dataM i+ listStoreSetValue dataM i (mid,(not inb,outb))+ on rendererMSnt cellToggled $ \pathStr -> do+ let (i:_) = stringToTreePath pathStr+ (mid,(inb,outb)) <- listStoreGetValue dataM i+ listStoreSetValue dataM i (mid,(inb,not outb))++ cellLayoutSetAttributes mId rendererMId dataM $ \(id,_) -> [ cellText := (show id) ]+ cellLayoutSetAttributes mRcv rendererMRcv dataM $ \(_,(inb,_)) -> [ cellToggleActive := inb ]+ cellLayoutSetAttributes mSnt rendererMSnt dataM $ \(_,(_,outb)) -> [ cellToggleActive := outb ]++ treeViewSetModel confM dataM+ treeViewColumnsAutosize confM++ buttonStoreM <- xmlGetWidget glade castToButton "store_m"+ buttonAllInM <- xmlGetWidget glade castToButton "all_in_m"+ buttonAllOutM <- xmlGetWidget glade castToButton "all_out_m"+ buttonNoneInM <- xmlGetWidget glade castToButton "none_in_m"+ buttonNoneOutM <- xmlGetWidget glade castToButton "none_out_m"++ onClicked buttonStoreM (do oldState <- takeMVar st+ val <- listStoreToList dataM+ --putStrLn ("saving: " ++ (show val))+ putMVar st (oldState {confMachines = val})+ widgetQueueDraw pic)++ onClicked buttonAllInM (do vals <- listStoreToList dataM+ let newVals = setAllIn True vals+ listStoreClear dataM+ sequence_ $ map (\x -> listStoreAppend dataM x) newVals)++ onClicked buttonAllOutM (do vals <- listStoreToList dataM+ let newVals = setAllOut True vals+ listStoreClear dataM+ sequence_ $ map (\x -> listStoreAppend dataM x) newVals)++ onClicked buttonNoneInM (do vals <- listStoreToList dataM+ let newVals = setAllIn False vals+ listStoreClear dataM+ sequence_ $ map (\x -> listStoreAppend dataM x) newVals)++ onClicked buttonNoneOutM (do vals <- listStoreToList dataM+ let newVals = setAllOut False vals+ listStoreClear dataM+ sequence_ $ map (\x -> listStoreAppend dataM x) newVals)++++ -- Process checkBoxes+ pId <- treeViewColumnNew+ treeViewColumnSetTitle pId "process id"+ treeViewAppendColumn confP pId+ rendererPId <- cellRendererTextNew+ cellLayoutPackStart pId rendererPId True++ pSnt <- treeViewColumnNew+ treeViewColumnSetTitle pSnt "show outgoing"+ treeViewAppendColumn confP pSnt+ rendererPSnt <- cellRendererToggleNew+ cellLayoutPackStart pSnt rendererPSnt True++ pRcv <- treeViewColumnNew+ treeViewColumnSetTitle pRcv "show incoming"+ treeViewAppendColumn confP pRcv+ rendererPRcv <- cellRendererToggleNew+ cellLayoutPackStart pRcv rendererPRcv True+++ state <- readMVar st+ dataP <- listStoreNew (confProcesses state)++ -- update the model when the toggle buttons are activated+ on rendererPRcv cellToggled $ \pathStr -> do+ let (i:_) = stringToTreePath pathStr+ (mid,(inb,outb)) <- listStoreGetValue dataP i+ listStoreSetValue dataP i (mid,(not inb,outb))+ on rendererPSnt cellToggled $ \pathStr -> do+ let (i:_) = stringToTreePath pathStr+ (mid,(inb,outb)) <- listStoreGetValue dataP i+ listStoreSetValue dataP i (mid,(inb,not outb))++ cellLayoutSetAttributes pId rendererPId dataP $ \(id,_) -> [ cellText := (show id) ]+ cellLayoutSetAttributes pRcv rendererPRcv dataP $ \(_,(inb,_)) -> [ cellToggleActive := inb ]+ cellLayoutSetAttributes pSnt rendererPSnt dataP $ \(_,(_,outb)) -> [ cellToggleActive := outb ]++ treeViewSetModel confP dataP+ treeViewColumnsAutosize confP++ buttonStoreP <- xmlGetWidget glade castToButton "store_p"+ buttonAllInP <- xmlGetWidget glade castToButton "all_in_p"+ buttonAllOutP <- xmlGetWidget glade castToButton "all_out_p"+ buttonNoneInP <- xmlGetWidget glade castToButton "none_in_p"+ buttonNoneOutP <- xmlGetWidget glade castToButton "none_out_p"++ onClicked buttonStoreP (do oldState <- takeMVar st+ val <- listStoreToList dataP+ --putStrLn ("saving: " ++ (show val))+ putMVar st (oldState {confProcesses = val})+ widgetQueueDraw pic)++ onClicked buttonAllInP (do vals <- listStoreToList dataP+ let newVals = setAllIn True vals+ listStoreClear dataP+ sequence_ $ map (\x -> listStoreAppend dataP x) newVals)++ onClicked buttonAllOutP (do vals <- listStoreToList dataP+ let newVals = setAllOut True vals+ listStoreClear dataP+ sequence_ $ map (\x -> listStoreAppend dataP x) newVals)++ onClicked buttonNoneInP (do vals <- listStoreToList dataP+ let newVals = setAllIn False vals+ listStoreClear dataP+ sequence_ $ map (\x -> listStoreAppend dataP x) newVals)++ onClicked buttonNoneOutP (do vals <- listStoreToList dataP+ let newVals = setAllOut False vals+ listStoreClear dataP+ sequence_ $ map (\x -> listStoreAppend dataP x) newVals)++ return ()+++ where setAll :: (Bool, Bool) -> [(a,(Bool,Bool))] -> [(a,(Bool,Bool))]+ setAll to ((x,_):xs) = (x,to) : (setAll to xs)+ setAll _ [] = []+ setAllIn :: Bool -> [(a,(Bool,Bool))] -> [(a,(Bool,Bool))]+ setAllIn to ((x,(_,out)):xs) = (x,(to,out)) : (setAllIn to xs)+ setAllIn _ [] = []+ setAllOut :: Bool -> [(a,(Bool,Bool))] -> [(a,(Bool,Bool))]+ setAllOut to ((x,(i,_)):xs) = (x,(i,to)) : (setAllOut to xs)+ setAllOut _ [] = []+++++data MachineInfo = MachineInfo { machId :: String, runtime :: String, numProcesses :: String, numSent :: String, numRcvd :: String}+data ProcessInfo = ProcessInfo { machIdP :: String, procId :: String, runtimeP :: String, numThreads :: String, numSentP :: String, numRcvdP :: String}+data ThreadInfo = ThreadInfo { machIdT :: String, procIdT :: String, thrdId :: String, runtimeT :: String}++showTraceInfo :: Events -> String -> String -> GladeXML -> IO ()+showTraceInfo ((ms,ps,ts),mt,mxst,(msgs,_,heads,pt,_),(minT,maxT,_,_,_),_) filename statusString glade = do+ -- get access to the widgets:+ infoA <- xmlGetWidget glade castToLabel "infoA"+ infoM <- xmlGetWidget glade castToTreeView "infoM"+ infoP <- xmlGetWidget glade castToTreeView "infoP"+ infoT <- xmlGetWidget glade castToTreeView "infoT"+ -- Global information:+ labelSetText infoA ("Tracefile: " ++ filename ++ "\n" +++ map (commaToNewline) statusString ++ "\n\nProcesstree:\n" ++ drawTree pt)+ -- Machine information:+-- #if __GLASGOW_HASKELL__ < 606+ --skelM <- emptyListSkel+ mId <- treeViewColumnNew+ treeViewColumnSetTitle mId "machine id"+ treeViewAppendColumn infoM mId+ rendererMId <- cellRendererTextNew+ cellLayoutPackStart mId rendererMId True++ mTime <- treeViewColumnNew+ treeViewColumnSetTitle mTime "runtime (s)"+ treeViewAppendColumn infoM mTime+ rendererMTime <- cellRendererTextNew+ cellLayoutPackStart mTime rendererMTime True+ + mPrcs <- treeViewColumnNew+ treeViewColumnSetTitle mPrcs "processes"+ treeViewAppendColumn infoM mPrcs+ rendererMPrcs <- cellRendererTextNew+ cellLayoutPackStart mPrcs rendererMPrcs True++ --mTrds <- treeViewColumnNew+ --treeViewColumnSetTitle mTrds "threads"+ --treeViewAppendColumn infoM mTrds++ mSent <- treeViewColumnNew+ treeViewColumnSetTitle mSent "sent messages"+ treeViewAppendColumn infoM mSent+ rendererMSent <- cellRendererTextNew+ cellLayoutPackStart mSent rendererMSent True++ mRcvd <- treeViewColumnNew+ treeViewColumnSetTitle mRcvd "received messages"+ treeViewAppendColumn infoM mRcvd+ rendererMRcvd <- cellRendererTextNew+ cellLayoutPackStart mRcvd rendererMRcvd True++ dataM <- listStoreNew []+ -- newListStore skelM++ -- insert machine data+ inspectMachine ms dataM++ cellLayoutSetAttributes mId rendererMId dataM $ \row -> [ cellText := machId row ]+ cellLayoutSetAttributes mTime rendererMTime dataM $ \row -> [ cellText := runtime row ]+ cellLayoutSetAttributes mPrcs rendererMPrcs dataM $ \row -> [ cellText := numProcesses row ]+ cellLayoutSetAttributes mSent rendererMSent dataM $ \row -> [ cellText := numSent row ]+ cellLayoutSetAttributes mRcvd rendererMRcvd dataM $ \row -> [ cellText := numRcvd row ]++ treeViewSetModel infoM dataM+ treeViewColumnsAutosize infoM+++ -- Process information:+ --skelP <- emptyListSkel+ pMid <- treeViewColumnNew+ treeViewColumnSetTitle pMid "on machine"+ treeViewAppendColumn infoP pMid+ rendererPMid <- cellRendererTextNew+ cellLayoutPackStart pMid rendererPMid True++ pId <- treeViewColumnNew+ treeViewColumnSetTitle pId "process id"+ treeViewAppendColumn infoP pId+ rendererPId <- cellRendererTextNew+ cellLayoutPackStart pId rendererPId True++ pTime <- treeViewColumnNew+ treeViewColumnSetTitle pTime "runtime (s)"+ treeViewAppendColumn infoP pTime+ rendererPTime <- cellRendererTextNew+ cellLayoutPackStart pTime rendererPTime True++ pTrds <- treeViewColumnNew+ treeViewColumnSetTitle pTrds "threads"+ treeViewAppendColumn infoP pTrds+ rendererPTrds <- cellRendererTextNew+ cellLayoutPackStart pTrds rendererPTrds True++ pSent <- treeViewColumnNew+ treeViewColumnSetTitle pSent "sent messages"+ treeViewAppendColumn infoP pSent+ rendererPSent <- cellRendererTextNew+ cellLayoutPackStart pSent rendererPSent True++ pRcvd <- treeViewColumnNew+ treeViewColumnSetTitle pRcvd "received messages"+ treeViewAppendColumn infoP pRcvd+ rendererPRcvd <- cellRendererTextNew+ cellLayoutPackStart pRcvd rendererPRcvd True++ dataP <- listStoreNew []+ + inspectProcess (reverse ps) dataP +++++ cellLayoutSetAttributes pMid rendererPMid dataP $ \row -> [ cellText := machIdP row ]+ cellLayoutSetAttributes pId rendererPId dataP $ \row -> [ cellText := procId row ]+ cellLayoutSetAttributes pTime rendererPTime dataP $ \row -> [ cellText := runtimeP row ]+ cellLayoutSetAttributes pTrds rendererPTrds dataP $ \row -> [ cellText := numThreads row ]+ cellLayoutSetAttributes pSent rendererPSent dataP $ \row -> [ cellText := numSentP row ]+ cellLayoutSetAttributes pRcvd rendererPRcvd dataP $ \row -> [ cellText := numRcvdP row ]++ treeViewSetModel infoP dataP+ treeViewColumnsAutosize infoP++++ -- Thread information:+ --skelT <- emptyListSkel+ tMid <- treeViewColumnNew+ treeViewColumnSetTitle tMid "on machine"+ treeViewAppendColumn infoT tMid+ rendererTMid <- cellRendererTextNew+ cellLayoutPackStart tMid rendererTMid True++ tPid <- treeViewColumnNew+ treeViewColumnSetTitle tPid "in process"+ treeViewAppendColumn infoT tPid+ rendererTPid <- cellRendererTextNew+ cellLayoutPackStart tPid rendererTPid True++ tId <- treeViewColumnNew+ treeViewColumnSetTitle tId "thread id"+ treeViewAppendColumn infoT tId+ rendererTId <- cellRendererTextNew+ cellLayoutPackStart tId rendererTId True++ tTime <- treeViewColumnNew+ treeViewColumnSetTitle tTime "runtime (s)"+ treeViewAppendColumn infoT tTime+ rendererTTime <- cellRendererTextNew+ cellLayoutPackStart tTime rendererTTime True++ dataT <- listStoreNew []++ cellLayoutSetAttributes tMid rendererTMid dataT $ \row -> [ cellText := machIdT row ]+ cellLayoutSetAttributes tPid rendererTPid dataT $ \row -> [ cellText := procIdT row ]+ cellLayoutSetAttributes tId rendererTId dataT $ \row -> [ cellText := thrdId row ]+ cellLayoutSetAttributes tTime rendererTTime dataT $ \row -> [ cellText := runtimeT row ]++ inspectThread ts dataT+++ treeViewSetModel infoT dataT+ treeViewColumnsAutosize infoT++ where inspectMachine ((i,_,_,(p,s,r),evts):ms) store = do+ listStorePrepend store (MachineInfo {machId=("Machine " ++ show i), + runtime=(formatFloat (getEventTime (head evts) - (getStartTime i mt))), + numProcesses=(show p), + numSent=(show s), + numRcvd=(show r)})+ + inspectMachine ms store + inspectMachine _ _ = return ()+ inspectProcess (((m,i),_,_,stat,evts):ps) store = do+ -- because of the processIDs being reused, there may be more then one+ -- StartProcess-/KillProcess-Events in evts. One fkt. to find them all:+ filterProcesses evts stat (getEventTime (head evts)) 0 ""+ where filterProcesses :: [ProcessEvent] -> (Int,Int,Int) -> Seconds -> Int -> String -> IO ()+ filterProcesses (e:es) st@(t,s,r) killTime n l = case e of+ KillProcess time (t',s',r') -> filterProcesses es (t',s',r') time (n+1) l+ LabelProcess _ label -> filterProcesses es st killTime n label+ NewProcess time -> do++ listStoreAppend store (ProcessInfo {machIdP=(show m), + procId=("Process " ++ show i ++ "/" ++ show n), + runtimeP=(formatFloat (killTime - time)), + numThreads= (show t), + numSentP= (show s), + numRcvdP= (show r)})+ filterProcesses es st killTime n l+ _ -> filterProcesses es st killTime n l+ filterProcesses _ _ _ _ _ = inspectProcess ps store+ inspectProcess _ _ = return ()+ + inspectThread ((((m,p),i),evts):ts) store = do+ + listStorePrepend store (ThreadInfo{ machIdT=(show m),+ procIdT=(show p),+ thrdId=("Thread " ++ show i),+ runtimeT=(formatFloat (getEventTime (head evts) - (getEventTime (last evts))))})+ + inspectThread ts store+ inspectThread _ _ = return ()++ commaToNewline c+ | c == ',' = '\n'+ | otherwise = c+++++handleDragnDrop :: MVar ViewerState -> DrawingArea -> Events -> Double -> Double -> IO ()+handleDragnDrop st pic _ mx my = do+ state <- readMVar st+ + ((vx,vy,vw,vh),(ulx,uly,lrx,lry)) <- getCorners pic+ --widgetQueueDrawArea pic (floor mx - 100) vy 200 vh+ if mx > ulx && my > uly && mx < lrx && my < lry -- if my > uly && my < lry+ then do win <- widgetGetDrawWindow pic+ let oldpixbuf = oldView state :: Maybe Pixbuf+ gc <- G.gcNew win+ --redraw old portion of screen+ case oldpixbuf of+ Just pb -> drawPixbuf win gc pb 0 0 0 0 (-1) (-1) RgbDitherNormal 0 0+ Nothing -> return ()+ --drawWindowProcessUpdates win False+ renderWithDrawable win $ do+ --colorWhite+ --rectangle (fromIntegral vx) lry (50) (uly-lry)+ --fill+ colorRedA+ moveTo ((fromIntegral vx)+20) (my)+ lineTo ((fromIntegral vx)+30) (my)+ stroke+ + else return ()++performDragnDrop v st pic _ mx my = do+ state <- takeMVar st+ ((vx,vy,vw,vh),(ulx,uly,lrx,lry)) <- getCorners pic+ let matrix = case v of+ 2 -> matrixT state+ 1 -> matrixP state+ _ -> matrixM state+ ySkip = (lry - uly) / (fromIntegral (length matrix))+ index = fromIntegral (floor (1 + ((my - uly) / ySkip)))+ oldIndex = head $ sort $ selRow state+ if null (selRow state)+ then putMVar st state+ else do+ if index == oldIndex+ then do+ if deleteSel state + then do+ (w,h) <- widgetGetSize pic+ win <- widgetGetDrawWindow pic+ let pLines = selRow state+ skip' = round ySkip+ putMVar st (state { selRow = [], deleteSel = False, noDND = False })+ let pRects = map (\pLine -> Rectangle 0 (floor ((pLine-1)*ySkip + uly)-1) w (skip'+2)) pLines+ sequence_ (map (\r -> drawWindowInvalidateRect win r False) pRects)+ else putMVar st (state { deleteSel = False, noDND = False })+ else if noDND state+ then putMVar st (state { deleteSel = False, noDND = False })+ else do+ case v of+ 3 -> do+ let arr = matrixGP state+ ns = selRow state+ (m,a) = handleMove (floor index) ns arr+ putMVar st (state {selRow = m, matrixGP = a, deleteSel = False})+ 2 -> do+ let arr = matrixT state+ ns = selRow state+ (m,a) = handleMove (floor index) ns arr+ putMVar st (state {selRow = m, matrixT = a, deleteSel = False})+ + 1 -> do+ let arr = matrixP state+ ns = selRow state+ (m,a) = handleMove (floor index) ns arr+ putMVar st (state {selRow = m, matrixP = a, deleteSel = False})+ _ -> do+ let arr = matrixM state+ ns = selRow state+ (m,a) = handleMove (floor index) ns arr+ putMVar st (state {selRow = m, matrixM = a, deleteSel = False})+ return ()++handleMouseMove :: MVar ViewerState -> MVar EdenTvState -> Bool -> DrawingArea -> Events -> Double -> Double -> IO ()+handleMouseMove st edentvState hideStartupPhase pic (_,_,(maxStartupTimeInSeconds, _),_,(minT,maxT,maxST,_,_),_) mx my = do+ ((vx,vy,vw,vh),(ulx,uly,lrx,lry)) <- getCorners pic+ widgetQueueDrawArea pic (floor mx - 100) vy 200 vh+ if mx > (fromIntegral vx + ulx) && my > uly && my < lry+ then do + state <- readMVar st+ let useDiff = locTime state+ + globalState <- readMVar edentvState+ let colorsMap = colors globalState+ + -- if the startup-phase is not shown, adapt minT+ let minT'+ | hideStartupPhase = maxStartupTimeInSeconds+ | otherwise = minT+ + let time + | useDiff = posToTime minT' (maxT+maxST) ulx lrx mx+ | otherwise = posToTime minT' maxT ulx lrx mx+ text = formatFloat time+ + win <- widgetGetDrawWindow pic+ drawWindowProcessUpdates win False+ renderWithDrawable win $ do+ ext <- textExtents text+ let dx = (\ (TextExtents _ _ w _ _ _) -> w) ext+ lb = fromIntegral vx + ulx + 5+ rb = fromIntegral (vx + vw) - (border + 2) - dx+ x0 = mx - (dx/2) -- centered at mouse position+ x1 = max x0 lb -- not over left border+ xm = min x1 rb -- not over right border+ getColor markerLine colorsMap+ moveTo mx (fromIntegral vy + uly)+ lineTo mx (fromIntegral (vy + vh - 5))+ stroke+ moveTo xm (fromIntegral vy + 15)+ getColor markerLabel colorsMap+ showText text+ else return ()++removeElem :: (Eq a) => a -> [a] -> [a]+removeElem o (x:xs)+ | o == x = xs+ | otherwise = x : removeElem o xs+removeElem _ [] = [] ++handleButtonPress :: DrawingArea -> Int -> MVar ViewerState -> Event -> Events -> IO Bool+handleButtonPress pic v st e ((m,p,t),mt,(mxs,mxst),_,(minT,maxT,maxST,_,maxD),_) = do+ (_,(ulx,uly,lrx,lry)) <- getCorners pic+ oldState <- readMVar st++ let matrix = case v of+ 3 -> matrixGP oldState+ 2 -> matrixT oldState+ 1 -> matrixP oldState+ _ -> matrixM oldState+ ySkip = (lry - uly) / (fromIntegral (length matrix))+ (mx,my) = (eventX e, eventY e)+ line = if v /= 3+ then fromIntegral (floor (1 + ((my - uly) / ySkip)))+ else let y = my - uly+ in findRow 0 y machineOffsets+ where findRow i y ((numP,numSkip):xs) + | y < (numP*procSkip + numSkip*10) = i+ | otherwise = findRow (i+1) y xs+ findRow i _ [] = i++ numProcs :: [(MachineID, Int)]+ numProcs = map (\(mId,_,_,(numP,_,_),_) -> (mId, numP)) m++ numM = fromIntegral $ length m+ procSkip = (lry - uly - ((numM-1)*10) )/ (fromIntegral (length (matrixP oldState))) + sortedMachines = [(numM+1) - (posToMachine pos (matrixGP oldState)) | pos <- [1..numM]]+ where posToMachine :: Double -> [Double] -> Double+ posToMachine pos sort = posAcc 1 pos sort+ where posAcc i pos (s:ss)+ | pos == s = i+ | otherwise = posAcc (i+1) pos ss+ posAcc _ _ [] = 0++ machineOffsets = buildOffsets (0,0) sortedMachines+ where buildOffsets :: (Double, Double) -> [Double] -> [(Double,Double)] + buildOffsets (numP, numSkip) (mId:mIds) = (numP, numSkip) : (buildOffsets ((fromIntegral curP)+numP, numSkip+1) mIds)+ where Just curP = lookup (floor mId) numProcs+ buildOffsets _ [] = []++ line' = elemIndex line matrix -- get position of selLine in matrix+ elemIndex :: Eq a => a -> [a] -> Int+ elemIndex = ei 0 -- start search at index 0+ where ei :: Eq a => Int -> a -> [a] -> Int+ ei i e (c:cs)+ | e == c = i -- elem found at index i+ | otherwise = ei (i+1) e cs -- not found yet+ ei _ _ [] = -1 -- elem not found++ --putStrLn $ "sort: " ++ (show (matrixGP oldState)) + --putStrLn $ "sortedMachines: " ++ (show sortedMachines)+ --putStrLn $ "machineOffsets: " ++ (show machineOffsets)+ --putStrLn $ "line: " ++ (show line)++ case eventButton e of+ LeftButton -> if mx > ulx && my > uly && mx < lrx && my < lry+ then do+ state <- takeMVar st+ (w,h) <- widgetGetSize pic+ win <- widgetGetDrawWindow pic+ let pLines = selRow oldState+ skip' = round ySkip+ --pRects = map (\pLine -> (pLine, Rectangle 0 (floor ((pLine-1)*ySkip + uly)-1) w (skip'+2))) pLines+ --rect0 = Rectangle 0 (floor ((pLine-1)*ySkip + uly)-1) w (skip'+2)+ rect1 = Rectangle 0 (floor ((line-1)*ySkip + uly)-1) w (skip'+2)+ if line `elem` pLines+ then do if Shift `elem` (Graphics.UI.Gtk.Gdk.Events.eventModifier e)+ then putMVar st (state { selRow = removeElem line pLines, noDND = True })+ else do + putMVar st (state { deleteSel = True })+ --putMVar st (state { selRow = [] })+ --let pRects = map (\pLine -> Rectangle 0 (floor ((pLine-1)*ySkip + uly)-1) w (skip'+2)) pLines+ --sequence_ (map (\r -> drawWindowInvalidateRect win r False) pRects)+ drawWindowInvalidateRect win rect1 False+ else do if Shift `elem` (Graphics.UI.Gtk.Gdk.Events.eventModifier e)+ then putMVar st (state { selRow = (line:pLines), noDND = True })+ else do+ putMVar st (state { selRow = [line] })+ let pRects = map (\pLine -> Rectangle 0 (floor ((pLine-1)*ySkip + uly)-1) w (skip'+2)) pLines+ sequence_ (map (\r -> drawWindowInvalidateRect win r False) pRects)+ --drawWindowInvalidateRect win rect0 False+ drawWindowInvalidateRect win rect1 False+ return True+ else return True+ MiddleButton -> return True+ RightButton -> if mx > ulx && my > uly && my < lry+ then do+ let tData = (\ (_,evts) -> evts) (t!!line')+ pData = (\ (_,_,_,_,evts) -> evts) (p!!line')+ mData = (\ (_,_,_,_,evts) -> evts) (m!!line')+ (selMachine,selName) = case v of+ 2 -> case t!!line' of (((m,p),t),_) -> (m,'T': show m ++ ':': show p ++ ':': show t)+ 1 -> case p!!line' of ((m,p),_,_,_,_) -> (m,'P': show m ++ ':': show p)+ 0 -> case m!!line' of (m,_,_,_,_) -> (m,'M': show m)+ diffTime = (getStartTime selMachine mxst)+ scaledTime :: Double -> String+ scaledTime t = if locTime oldState+ then formatFloat (t + diffTime)+ else formatFloat (t - minT)+ selTime = if locTime oldState+ then (posToTime minT (maxT+maxST) ulx lrx mx) - diffTime+ else (posToTime minT maxT ulx lrx mx) + minT+ labelText = case v of+ 2 -> case take 1 (dropWhile (\e -> getEventTime e > selTime) tData) of+ [NewThread s o] -> "New thread " ++ selName +++ "\nTime: " ++ (scaledTime s) +++ "\noutport: " ++ show o+ [KillThread s] -> "Kill thread " ++ selName +++ "\nTime: " ++ (scaledTime s)+ [RunThread s] -> "Run thread " ++ selName +++ "\nTime: " ++ (scaledTime s)+ [SuspendThread s] -> "Suspend thread " ++ selName +++ "\nTime: " ++ (scaledTime s)+ [BlockThread s i r] -> "Block thread " ++ selName +++ "\nTime: " ++ (scaledTime s) +++ "\nInport: " ++ show i +++ "\nReason: " ++ show r+ [GCThread s g a c l]-> "Garbage collection " ++ selName +++ "\nTime: " ++ (scaledTime s) +++ "\nGeneration: " ++ show g +++ "\nAllocated: " ++ show a +++ "\nCollected: " ++ show c +++ "\nLive data: " ++ show l+ _ -> "No event to show"+ 1 -> case take 1 (dropWhile (\e -> getEventTime e > selTime) pData) of+ [NewProcess s] -> "New process " ++ selName +++ "\nTime: " ++ (scaledTime s)+ [KillProcess s _] -> "Kill process " ++ selName +++ "\nTime: " ++ (scaledTime s)+ [IdleProcess s] -> "Idle process " ++ selName +++ "\nTime: " ++ (scaledTime s)+ [RunningProcess s] -> "Running process " ++ selName +++ "\nTime: " ++ (scaledTime s)+ [SuspendedProcess s] -> "Suspended process " ++ selName +++ "\nTime: " ++ (scaledTime s)+ [BlockedProcess s] -> "Blocked process " ++ selName +++ "\nTime: " ++ (scaledTime s)+ [GCProcess s g a c l]-> "Garbage collection " ++ selName +++ "\nTime: " ++ (scaledTime s) +++ "\nGeneration: " ++ show g +++ "\nAllocated: " ++ show a +++ "\nCollected: " ++ show c +++ "\nLive data: " ++ show l+ _ -> "No event to show"+ 0 -> case take 1 (dropWhile (\e -> getEventTime e > selTime) mData) of+ [StartMachine s] -> "Start machine " ++ selName +++ "\nTime: " ++ (scaledTime s)+ [EndMachine s] -> "End machine " ++ selName +++ "\nTime: " ++ (scaledTime s)+ [GCMachine s g a c l]-> "Garbage collection " ++ selName +++ "\nTime: " ++ (scaledTime s) +++ "\nGeneration: " ++ show g +++ "\nAllocated: " ++ show a +++ "\nCollected: " ++ show c +++ "\nLive data: " ++ show l+ [IdleMachine s] -> "Idle machine " ++ selName +++ "\nTime: " ++ (scaledTime s)+ [RunningMachine s] -> "Running machine " ++ selName +++ "\nTime: " ++ (scaledTime s)+ [SuspendedMachine s] -> "Suspended machine " ++ selName +++ "\nTime: " ++ (scaledTime s)+ [BlockedMachine s] -> "Blocked machine " ++ selName +++ "\nTime: " ++ (scaledTime s)+ _ -> "No event to show"+ infoDlg <- dialogNew+ windowSetTitle infoDlg "Event-info"+ windowSetPosition infoDlg WinPosCenterOnParent+ dialogAddButton infoDlg stockOk ResponseOk+ upper <- dialogGetUpper infoDlg+ infoText <- labelNew (Just labelText)+ boxPackStartDefaults upper infoText+ widgetShowAll infoDlg+ dialogRun infoDlg+ widgetDestroy infoDlg+ return True+ else return True+++handleMove :: Int -> [Double] -> [Double] -> ([Double],[Double])+handleMove index moveRows allRows = result + where orderedMoveRows = map (\row -> 1 + (position (floor row) allRows) ) $ sort moveRows+ len = length allRows+ lenMoved = length moveRows+ lenOther = length orderedOtherRows+ orderedOtherRows = sortBy sortOther $ filterOther 1 allRows++ sortOther :: Double -> Double -> Ordering+ sortOther a b + | (allRows!!((floor a)-1)) < (allRows!!((floor b)-1)) = LT+ | otherwise = GT++ moveUp = head moveRows > (fromIntegral index)++ placesBefore = if (index `mod` len) == 0+ then 0+ else (index - 1) `mod` len+ placesAfter = if (index `mod` len) == 0 + then (len - 1) `mod` len+ else (len - placesBefore - lenMoved) `mod` len++ ++ filterOther i (x:xs)+ | i `elem` orderedMoveRows = filterOther (i+1) xs+ | otherwise = i : (filterOther (i+1) xs)+ filterOther _ [] = []+ + process :: Int -> [Double] -> [Double]+ process i (x:xs)+ | (fromIntegral i) `elem` orderedMoveRows = (fromIntegral movPos ) : (process (i+1) xs)+ | otherwise = (fromIntegral movPos') : (process (i+1) xs)+ where movedRowOffset = position i orderedMoveRows+ movPos = pos (index + movedRowOffset) + + alteredRowOffset = position i orderedOtherRows+ movPos' = if alteredRowOffset < placesBefore+ then pos (1+alteredRowOffset)+ else pos ( index + lenMoved + alteredRowOffset - placesBefore)+ process _ [] = []+ + pos :: Int -> Int+ pos x = ((x-1) `mod` len) + 1++ position i (x:xs)+ | (fromIntegral i) == x = 0+ | otherwise = 1 + (position i xs)+ position _ [] = 0++ selection = map (fromIntegral . pos) [index..(index+lenMoved-1)]++ result = (selection, process 1 allRows)+ +handleMoveUp :: DrawingArea -> Int -> MVar ViewerState -> IO ()+handleMoveUp pic i st = do+ state <- takeMVar st+ ((x,_,w,_),(ulx,uly,lrx,lry)) <- getCorners pic+ let ns = selRow state+ if not $ null ns+ then let n = head ns in case i of+ 3 -> do let arr = matrixGP state+ rows = fromIntegral (length (arr))+ ySkip = (lry - uly) / rows+ sortedRows = sort ns+ ind = (floor (head sortedRows))-1+ (m,a) = handleMove ind ns arr+ putMVar st (state {selRow = m, matrixGP = a})+ widgetQueueDraw pic+ 2 -> do let arr = matrixT state+ rows = fromIntegral (length (arr))+ ySkip = (lry - uly) / rows+ sortedRows = sort ns+ ind = (floor (head sortedRows))-1+ (m,a) = handleMove ind ns arr+ putMVar st (state {selRow = m, matrixT = a}) + widgetQueueDraw pic+ 1 -> do let arr = matrixP state+ rows = fromIntegral (length (arr))+ ySkip = (lry - uly) / rows+ sortedRows = sort ns+ ind = (floor (head sortedRows))-1+ (m,a) = handleMove ind ns arr+ putMVar st (state {selRow = m, matrixP = a})+ widgetQueueDraw pic+ _ -> do let arr = matrixM state+ rows = fromIntegral (length (arr))+ ySkip = (lry - uly) / rows+ sortedRows = sort ns+ ind = (floor (head sortedRows))-1+ (m,a) = handleMove ind ns arr+ putMVar st (state {selRow = m, matrixM = a})+ widgetQueueDraw pic+ else putMVar st state++shiftDown,shiftUp :: (Eq a, Num a) => a -> [a] -> [a]+shiftDown max (x:xs)+ | x == max = 1 : shiftDown max xs+ | otherwise = x + 1 : shiftDown max xs+shiftDown _ _ = []+shiftUp max (x:xs)+ | x == 1 = max : shiftUp max xs+ | otherwise = x - 1 : shiftUp max xs+shiftUp _ _ = []++handleMoveDown :: DrawingArea -> Int -> MVar ViewerState -> IO ()+handleMoveDown pic i st = do+ state <- takeMVar st+ (w,h) <- widgetGetSize pic+ ((x,_,w,_),(ulx,uly,lrx,lry)) <- getCorners pic+ let ns = selRow state -- TODO hack+ if not $ null ns+ then case i of+ 3 -> do let arr = (matrixGP state)+ rows = fromIntegral (length arr)+ ySkip = (lry - uly) / rows+ sortedRows = sort ns+ ind = (floor (head sortedRows))+1+ (m,a) = handleMove ind ns arr+ putMVar st (state {selRow = m, matrixGP = a})+ widgetQueueDraw pic+ 2 -> do let arr = (matrixT state)+ rows = fromIntegral (length arr)+ ySkip = (lry - uly) / rows+ sortedRows = sort ns+ ind = (floor (head sortedRows))+1+ (m,a) = handleMove ind ns arr+ putMVar st (state {selRow = m, matrixT = a})+ widgetQueueDraw pic+ 1 -> do let arr = (matrixP state)+ rows = fromIntegral (length arr)+ ySkip = (lry - uly) / rows+ sortedRows = sort ns+ ind = (floor (head sortedRows))+1+ (m,a) = handleMove ind ns arr+ putMVar st (state {selRow = m, matrixP = a})+ widgetQueueDraw pic+ _ -> do let arr = (matrixM state)+ rows = fromIntegral (length arr)+ ySkip = (lry - uly) / rows+ sortedRows = sort ns+ ind = (floor (head sortedRows))+1+ (m,a) = handleMove ind ns arr+ putMVar st (state {selRow = m, matrixM = a})+ widgetQueueDraw pic+ else putMVar st state
+ EdenTvType.hs view
@@ -0,0 +1,388 @@+{- The Eden Trace Viewer (or simply EdenTV) is a tool that can generate diagrams to visualize the behaviour of Eden programs.+ Copyright (C) 2005-2012 Phillips Universitaet Marburg++ This program is free software; you can redistribute it and/or modify+ it under the terms of the GNU General Public License as published by+ the Free Software Foundation; either version 3 of the License, or+ (at your option) any later version.+ This program is distributed in the hope that it will be useful,+ but WITHOUT ANY WARRANTY; without even the implied warranty of+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+ GNU General Public License for more details.+ You should have received a copy of the GNU General Public License+ along with this program; if not, write to the Free Software Foundation,+ Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA++-}++{-# LANGUAGE CPP #-}+-- JB: adapted instances (see end of file)+module EdenTvType where++import Data.Tree+import Data.Word+import qualified Data.Map as M+import qualified Data.Sequence as S+--import DeepSeq+import Graphics.UI.Gtk.Gdk.Pixbuf+import Graphics.UI.Gtk.Gdk.GC++++-- A State to carry around:+-- What has to be drawn and how?+data ViewerState = VS+ { selRow :: [Double] -- currently selected row, [] if none+ , selView :: Int -- machine- (0), process- (1) or threadView (2)+ , locTime :: Bool -- all machines starting simultaneously+ , showMsg :: Bool -- draw messages?+ , matrixM :: [Double] -- \ :-) + , matrixP :: [Double] -- these lists control sorting in diffrent views+ , matrixT :: [Double] -- / + , matrixGP :: [Double]+ , ommitRedraw :: Bool++ , clicked :: Bool+ , deleteSel :: Bool+ , noDND :: Bool+ , oldView :: Maybe Pixbuf++ , confMachines :: [(MachineID, (Bool,Bool))] -- show in/out Messages Machines+ , confProcesses :: [(ProcessID, (Bool,Bool))] -- show in/out Messages Procs++ , autoTicks :: Bool+ , tickSkip :: Seconds+ , tickMark :: Int+ + , filename :: String -- the trace file the data was read from+ , ignoreMessages :: Bool -- indicates if the trace file was parsed without messages+ } deriving Show++instance Show Pixbuf where+ show x = "pixbuf"++data EdenTvState = ES+ { lastPath :: String+ , colors :: Colors+ } deriving Show++data ColorRGBA = RGBA+ { rgbColor :: Color+ , alpha :: Word16+ } deriving Show++data Colors = Colors+ { statusRunning :: ColorRGBA+ , statusSuspended :: ColorRGBA+ , statusBlocked :: ColorRGBA+ , statusIdle :: ColorRGBA+ + , messagesSystem :: ColorRGBA+ , messagesHead :: ColorRGBA+ , messagesData :: ColorRGBA+ , messagesHeadLocal :: ColorRGBA+ , messagesDataLocal :: ColorRGBA+ , messagesBlock :: ColorRGBA+ , messagesReceive :: ColorRGBA+ + , markerLine :: ColorRGBA+ , markerLabel :: ColorRGBA+ , markerStartup :: ColorRGBA+ + , chartBackground :: ColorRGBA+ , chartAxes :: ColorRGBA+ , chartAxesLabel :: ColorRGBA+ } deriving Show++rgba :: Word16 -> Word16 -> Word16 -> Word16 -> ColorRGBA+rgba r g b a = RGBA {rgbColor = (Color r g b), alpha = a}++rgb :: Word16 -> Word16 -> Word16 -> ColorRGBA+rgb r g b = rgba r g b 65535++type Seconds = Double+type InportID = Int+type OutportID = Int+class EdenEvent e where+ getEventTime :: e -> Seconds+ setEventTime :: e -> Seconds -> e++-- A machine consists of an id and a list of related events+type MachineID = Int+type Machine = (MachineID,Int,Int,(Int,Int,Int),[MachineEvent])+-- (mID, allP,blkP,(#Proc,#sent,#rcv),events)+data MachineEvent+ = StartMachine !Seconds -- Event 137+ | EndMachine !Seconds -- Event 145+ | GCMachine !Seconds !Int !Int !Int !Int -- Event 849 (Garbage Collection)+ | IdleMachine !Seconds -- virtual event (no processes available)+ | RunningMachine !Seconds -- virtual event (process running)+ | SuspendedMachine !Seconds -- virtual event (no process running but runnable waiting)+ | BlockedMachine !Seconds -- virtual event (all processes blocked)+ | MNewProcess !Seconds -- other virtual events triggert by ProcessEvents+ | MKillRProcess !Seconds+ | MKillSProcess !Seconds+ | MKillBProcess !Seconds+ | MRunProcess !Seconds+ | MSuspendProcess !Seconds+ | MBlockProcess !Seconds+ | MIdleProcess !Seconds+ deriving (Show,Eq)+instance EdenEvent MachineEvent where+ getEventTime (StartMachine s) = s+ getEventTime (EndMachine s) = s+ getEventTime (GCMachine s _ _ _ _) = s+ getEventTime (IdleMachine s) = s+ getEventTime (RunningMachine s) = s+ getEventTime (SuspendedMachine s) = s+ getEventTime (BlockedMachine s) = s+ getEventTime (MNewProcess s) = s+ getEventTime (MKillBProcess s) = s+ getEventTime (MRunProcess s) = s+ getEventTime (MSuspendProcess s) = s+ getEventTime (MBlockProcess s) = s+ getEventTime (MIdleProcess s) = s+ getEventTime (MKillSProcess s) = s+ getEventTime (MKillRProcess s) = s+ --getEventTime e = error (show e)++ setEventTime (StartMachine _) s = StartMachine s+ setEventTime (EndMachine _) s = EndMachine s+ setEventTime (GCMachine _ g a c l) s = GCMachine s g a c l+ setEventTime (IdleMachine _) s = IdleMachine s+ setEventTime (RunningMachine _) s = RunningMachine s+ setEventTime (SuspendedMachine _) s = SuspendedMachine s+ setEventTime (BlockedMachine _) s = BlockedMachine s+ setEventTime (MNewProcess _) s = MNewProcess s+ setEventTime (MKillBProcess _) s = MKillBProcess s+ setEventTime (MRunProcess _) s = MRunProcess s+ setEventTime (MSuspendProcess _) s = MSuspendProcess s+ setEventTime (MBlockProcess _) s = MBlockProcess s+ setEventTime (MIdleProcess _) s = MIdleProcess s+{-instance DeepSeq MachineEvent where+ deepSeq (StartMachine sec) y = deepSeq sec y+ deepSeq (EndMachine sec) y = deepSeq sec y+-}++-- A process is identified by its own id and the machine's id+-- it is running on, completed with it's events+type ProcessID = (MachineID,Int) -- (MachineID,ProcessID)+type Process = (ProcessID,Int,Int,(Int,Int,Int),[ProcessEvent])+-- (pID,allT,blockedT,(#Threads,#sent,#rec),events)+data ProcessEvent+ = NewProcess !Seconds -- Event 153+ | LabelProcess !Seconds String+ | KillProcess !Seconds (Int,Int,Int) -- Event 161+ | GCProcess !Seconds !Int !Int !Int !Int+ | IdleProcess !Seconds -- virtual event (no threads available)+ | RunningProcess !Seconds -- virtual event (thread running)+ | SuspendedProcess !Seconds -- virtual event (no thread running but runnable waiting)+ | BlockedProcess !Seconds -- virtual event (all threads blocked)+ | PNewThread !Seconds+ | PKillRThread !Seconds+ | PKillSThread !Seconds+ | PKillBThread !Seconds+ | PRunThread !Seconds+ | PSuspendThread !Seconds+ | PBlockThread !Seconds+ | PDeblockThread !Seconds+ deriving (Show,Eq)+instance EdenEvent ProcessEvent where+ getEventTime (NewProcess s) = s+ getEventTime (LabelProcess s _) = s+ getEventTime (KillProcess s _) = s+ getEventTime (GCProcess s _ _ _ _) = s+ getEventTime (IdleProcess s) = s+ getEventTime (RunningProcess s) = s+ getEventTime (SuspendedProcess s) = s+ getEventTime (BlockedProcess s) = s+ getEventTime (PNewThread s) = s+ getEventTime (PKillRThread s) = s+ getEventTime (PKillSThread s) = s+ getEventTime (PKillBThread s) = s+ getEventTime (PRunThread s) = s+ getEventTime (PSuspendThread s) = s+ getEventTime (PBlockThread s) = s+ getEventTime (PDeblockThread s) = s++ setEventTime (NewProcess _) s = NewProcess s+ setEventTime (LabelProcess _ l) s = LabelProcess s l+ setEventTime (KillProcess _ i) s = KillProcess s i+ setEventTime (GCProcess _ g a c l) s = GCProcess s g a c l+ setEventTime (IdleProcess _) s = IdleProcess s+ setEventTime (RunningProcess _) s = RunningProcess s+ setEventTime (SuspendedProcess _) s = SuspendedProcess s+ setEventTime (BlockedProcess _) s = BlockedProcess s+ setEventTime (PNewThread _) s = PNewThread s+ setEventTime (PKillRThread _) s = PKillRThread s+ setEventTime (PKillSThread _) s = PKillSThread s+ setEventTime (PKillBThread _) s = PKillBThread s+ setEventTime (PRunThread _) s = PRunThread s+ setEventTime (PSuspendThread _) s = PSuspendThread s+ setEventTime (PBlockThread _) s = PBlockThread s+ setEventTime (PDeblockThread _) s = PDeblockThread s++-- Threads also have events and an identifier.+type ThreadID = (ProcessID,Int) -- (MachineID,ProcessID,ThreadID)+type Thread = (ThreadID,[ThreadEvent])+type OpenThread = (MachineID,(ThreadID,ThreadEvent),[Thread])+data ThreadEvent+ = NewThread !Seconds !OutportID -- Event 169+ | KillThread !Seconds -- Event 177+ | GCThread !Seconds !Int !Int !Int !Int+ | RunThread !Seconds -- Event 185+ | SuspendThread !Seconds -- Event 193+ | BlockThread !Seconds !InportID !Reason -- Event 201+ | DeblockThread !Seconds -- Event 209+ | DummyThread+ deriving (Show,Eq)+instance EdenEvent ThreadEvent where+ getEventTime (NewThread s _) = s+ getEventTime (KillThread s) = s+ getEventTime (GCThread s _ _ _ _) = s+ getEventTime (RunThread s) = s+ getEventTime (SuspendThread s) = s+ getEventTime (BlockThread s _ _) = s+ getEventTime (DeblockThread s) = s++ setEventTime (NewThread _ o) s = NewThread s o+ setEventTime (KillThread _) s = KillThread s+ setEventTime (GCThread _ g a c l) s = GCThread s g a c l+ setEventTime (RunThread _) s = RunThread s+ setEventTime (SuspendThread _) s = SuspendThread s+ setEventTime (BlockThread _ i r) s = BlockThread s i r+ setEventTime (DeblockThread _) s = DeblockThread s++{-instance DeepSeq ThreadEvent where+ deepSeq (NewThread sec outPort) y = deepSeq sec $ deepSeq outPort y+ deepSeq (KillThread sec) y = deepSeq sec y+ deepSeq (RunThread sec) y = deepSeq sec y+ deepSeq (SuspendThread sec) y = deepSeq sec y+ deepSeq (BlockThread sec inPort tag) y = deepSeq sec $ deepSeq inPort $ deepSeq tag y+ deepSeq (DeblockThread sec) y = deepSeq sec y+-}++-- Messages:+data ReasonType =+ RFork | -- legacy code: 85+ Connect | -- legacy code: 86 + DataMes | -- legacy code: 87 + Head | -- legacy code: 88+ Constr | -- legacy code: 89 + Part | -- legacy code: 90 + Terminate | -- legacy code: 91+ Default | -- legacy code: -1+ BlockReason | -- legacy code: 1+ LocalHead | -- new: optimized message on local machine+ LocalDataMes -- new: optimized message on local machine+ deriving (Show, Eq, Ord)++type Reason = ReasonType+type Size = Int++-- Map of open messages per process.+--+-- Key: sender process id+-- Value: all message events (send and receive) that were+-- triggered for messages sent by this process+--+type OpenMessagesPerProcess = M.Map ProcessID OpenMessages++-- Map of open messages for a process. The key used in this map (`OpenMessageKey`)+-- is not unique for a message event. It groups messages sent to the same process +-- through the same channel (inport/outport) and with the same type and reason. +-- These messages with the same key are organized in a sequence/queue, so that +-- the message events can be matched in the right order.+--+type OpenMessages = M.Map OpenMessageKey (S.Seq SmallOpenMessageEvent)++type OpenMessageKey = (OpenMessageType, ProcessID, OutportID, InportID, Reason)+data OpenMessageType = TORM | TOSM deriving (Show, Eq, Ord)++-- This type is used to store an open message as value in `OpenMessages`.+-- All other information of the message is already contained in the map key.+--+data SmallOpenMessageEvent+ = SmallORM !Seconds !Size+ | SmallOSM !Seconds+ deriving (Show,Eq)++-- Data type for open message events for messages sent from a process.+-- The process id for both ORM and OSM is always the the receiver process id.+data OpenMessageEvent+ = ORM !Seconds !ProcessID !OutportID !InportID !Reason !Size+ | OSM !Seconds !ProcessID !OutportID !InportID !Reason+ deriving (Show,Eq)+++{-instance DeepSeq OpenMessageEvent where+ deepSeq (ORM sec proc ports info) y = deepSeq sec $ deepSeq proc $ deepSeq ports $ deepSeq info y+ deepSeq (OSM sec proc ports info) y = deepSeq sec $ deepSeq proc $ deepSeq ports $ deepSeq info y+-}++-- Message: Complete message with send- and receive information+type ChannelID = (ProcessID,OutportID,ProcessID,InportID)+data Message = MSG !ChannelID !Seconds !Seconds !Reason !Size+-- channel stime rtime tag size+ deriving (Show,Eq)+{-instance DeepSeq Message where+ deepSeq (MSG times procs ports info) y = deepSeq times $ deepSeq procs $ deepSeq ports $ deepSeq info y+-}++-- the time it took to receive a message+type ReceiveLength = ((MachineID, [(Int,Seconds)]), Seconds, Seconds)++-- HeadMessage: Messages of type 100+type Count = Int+type DSize = Double+type OpenHeadMessage = (ChannelID,Size,Count,[Seconds],[Seconds])+-- channel, sum of sizes, quantity, sending/receiving times+type HeadMessage = (ChannelID,(Seconds,Seconds,Seconds,Seconds),DSize,Count)+-- channel stimeA,rtimeA stimeO,rtimeO size num+type OpenProcMessage = (MachineID,[(ProcessID,OpenMessageEvent)],[(ProcessID,OpenMessageEvent)],[ProcessID])+-- rcvMach sent Messages rcvd Messages NewProcess+type OpenMessageList = (OpenMessagesPerProcess,[Message],([OpenProcMessage],ProcessList,ProcessTree),([OpenHeadMessage],Double,[HeadMessage]))++type MessageList = (+ [Message], -- + [Message], -- additional messages: messages sent in a stream (bulk messages)+ [HeadMessage], -- msgs from+ ProcessTree, + [ReceiveLength] -- time to receive the messages+ )+ +type ProcessList = [(ProcessID,[ProcessID])]+type ProcessTree = (Tree ProcessID) -- Node ProcessID [ProcessTree])++-- (Trace-)Events:+type EventID = Int+type NewEvent = ((EventID,Seconds,[Int]),Maybe String)+-- datatype used within the calculation+type OpenEvents = (+ ([Machine], [Process], [OpenThread]), -- list of machines/processes/threads+ [(MachineID,Double)], -- machine starttimes+ OpenMessageList, -- o/c Msgs+ (Seconds,Seconds,Int,Int)) -- min_t max_t #P maxLD++-- The main datatype for the generated list of information+type Events = (+ ([Machine], [Process], [Thread]), -- list of machines/processes/threads+ [(MachineID, Double)], -- start-times per machine + (Seconds, [(MachineID, Seconds)]), -- maxStartup msgs/heads+ MessageList,+ ( Seconds, -- min_t+ Seconds, -- max_t+ Seconds, -- max_t_diff+ Double, -- maxMsgSize+ Double), -- MaxLD+ (Int, Int, Int) -- number of machines/processes/threads+ )++#if __GLASGOW_HASKELL__ < 606+#warning __GLASGOW_HASKELL__+instance (Show a,Show b,Show c,Show d,Show e,Show f) => Show (a,b,c,d,e,f)+instance (Show a,Show b,Show c,Show d,Show e,Show f,Show g) => Show (a,b,c,d,e,f,g)+instance (Show a,Show b,Show c,Show d,Show e,Show f,Show g,Show h) => Show (a,b,c,d,e,f,g,h)+instance (Show a,Show b,Show c,Show d,Show e,Show f,Show g,Show h,Show i) => Show (a,b,c,d,e,f,g,h,i)+instance (Show a,Show b,Show c,Show d,Show e,Show f,Show g,Show h,Show i,Show j) => Show (a,b,c,d,e,f,g,h,i,j)+#endif
+ EdenTvViewer.hs view
@@ -0,0 +1,974 @@+{- The Eden Trace Viewer (or simply EdenTV) is a tool that can generate diagrams to visualize the behaviour of Eden programs.+ Copyright (C) 2005-2010 Phillips Universitaet Marburg++ This program is free software; you can redistribute it and/or modify+ it under the terms of the GNU General Public License as published by+ the Free Software Foundation; either version 3 of the License, or+ (at your option) any later version.+ This program is distributed in the hope that it will be useful,+ but WITHOUT ANY WARRANTY; without even the implied warranty of+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+ GNU General Public License for more details.+ You should have received a copy of the GNU General Public License+ along with this program; if not, write to the Free Software Foundation,+ Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA++-}++module EdenTvViewer where++import EdenTvType+import EdenTvBasic+import EdenTvInteract+import Graphics.UI.Gtk hiding (get)+import Graphics.UI.Gtk.Gdk.Pixbuf+import Graphics.UI.Gtk.Glade+import Graphics.Rendering.Cairo+import Control.Monad.State+import Control.Concurrent.MVar+import Numeric+--import DeepSeq++import Debug.Trace++-- short terms:+type DrawColor = (Render (), Render (), Render (), Render ())+ -- idle running suspended blocked+type ColorButtons = (ColorButton,ColorButton,ColorButton,ColorButton)++-- at first the matrices are sorted and nothing is selected+initMatrix :: Int -> Int -> Int -> [MachineID] -> [ProcessID] -> String -> Bool -> ViewerState+initMatrix m p t lm lp filename ignoreMessages = VS {+ selRow = [],+ selView = 0, -- machines are the default view+ locTime = False, -- local Time off+ showMsg = False, -- messages off+ matrixM = [1..(fromIntegral m)],+ matrixP = [1..(fromIntegral p)],+ matrixT = [1..(fromIntegral t)],+ matrixGP = [1..(fromIntegral m)],++ ommitRedraw = False,+ clicked = False,+ deleteSel = False,+ noDND = False,+ oldView = Nothing,++ confMachines = [ (mId, (True,True)) | mId <- reverse lm],+ confProcesses = [ (pId, (True,True)) | pId <- reverse lp],+ autoTicks = True,+ tickSkip = 0,+ tickMark = 1,+ + filename = filename,+ ignoreMessages = ignoreMessages}++-- draw a piece of text right-justified+showTextR :: String -> Render ()+showTextR str = do+ info <- textExtents str+ let width = (\ (TextExtents _ _ w _ _ _) -> w) info+ relMoveTo (-width) 0+ showText str++drawAnyPic :: Bool -> Bool -> Bool -> Bool -> Bool -> Double -> Double -> (Render () -> IO ()) -> (Bool -> Double -> Double -> (Render () -> IO ()) -> Events -> Colors -> DrawingArea -> ViewerState -> (Int -> [(MachineID, Double)] -> Double -> Double) -> (Double -> Double) -> IO (Render ())) -> DrawingArea ->+ Events -> MVar ViewerState -> MVar EdenTvState -> Int -> IO ()+drawAnyPic drawBlkMsg drawStartup hideStartupPhase drawDataMsgs drawSystemMsgs transX transY target drawfunc pic traces st edentvState rows = do+ target $ do translate transX transY; save + + state <- readMVar st+ globalState <- readMVar edentvState+ let colorsMap = colors globalState+ + -- if the startup-phase should not be displayed, the mininum startup+ -- time is used as minTime+ let traces'@(_, _, _, _, (minTime, maxTime, maxSTime, _, _), _) + = if hideStartupPhase + then setMinTimeToStartUpTime traces+ else traces+ + let ommit = ommitRedraw state+ when (not ommit) $ do+ prepareBackground transX transY target pic colorsMap+ + -- Returns the time difference for a machine in relation to the+ -- local startup time. Only used if startup synchronisation is+ -- enabled+ --+ let getDiffTime :: Int -> [(MachineID, Double)] -> Double -> Double+ getDiffTime machineId startTimes minTime+ | hideStartupPhase = -((getStartTime machineId startTimes))+ | otherwise = -((getStartTime machineId startTimes) + minTime)+ + -- Returns the relative position in percent for a given point of time + -- in relation to the total duration. The value is used to calculate the + -- absolute position in pixels (which is done automatically by the drawing+ -- area).+ --+ let scaledTime :: Double -> Double+ scaledTime time + | not $ locTime state = (time - minTime) / (maxTime - minTime)+ | otherwise = (time - minTime) / ((maxTime+maxSTime) - minTime)+ + -- draw machines/processes/threads+ drawAxes <- drawfunc hideStartupPhase transX transY target traces' colorsMap pic state getDiffTime scaledTime+ pixelsPerSecond <- getPixelsPerSecond pic state minTime maxTime maxSTime+ + if selView state < 3 + then addSelection transX transY target (fromIntegral rows) pic state+ else addSelectionGroupedProcesses transX transY target (fromIntegral rows) pic state [] traces'+ + drawMessages drawBlkMsg drawDataMsgs drawSystemMsgs hideStartupPhase pixelsPerSecond transX transY target traces' pic state colorsMap+ when (drawStartup && (not hideStartupPhase)) $ drawStartupMarker pixelsPerSecond transX transY target traces' pic state colorsMap+ target showPage -- only for pdf export -- ortherwise useless+ + -- finally draw axes on top of everything+ target drawAxes+++setMinTimeToStartUpTime :: Events -> Events+setMinTimeToStartUpTime (lists, mTimes, maxStartups@(maxStartupTimeInSeconds, _), msgs, (_,maxTime,maxSTime,maxSize,maxLD), counts)+ = (lists, mTimes, maxStartups, msgs, (maxStartupTimeInSeconds,maxTime,maxSTime,maxSize,maxLD), counts)++getPixelsPerSecond :: DrawingArea -> ViewerState -> Double -> Double -> Double -> IO Double+getPixelsPerSecond pic state minTime maxTime maxSTime = do+ (_,(ulx,uly,lrx,lry)) <- getCorners pic+ + let pixelsPerSecond+ | locTime state = (lrx - ulx) / ((maxTime+maxSTime) - minTime)+ | otherwise = (lrx - ulx) / (maxTime - minTime)+ + return pixelsPerSecond++drawMessages :: Bool -> Bool -> Bool -> Bool -> Double -> Double -> Double -> (Render () -> IO ()) -> Events -> DrawingArea -> ViewerState -> Colors -> IO ()+drawMessages drawBlkMsg drawDataMsgs drawSystemMsgs hideStartupPhase pixelsPerSecond visX visY target ((ms,ps,_),mTimes,(mxs,mxst),(msgs,amsgs,hmsgs,_,rcvtimes),(minTime,maxTime,maxSTime,maxSize,maxLD),_) pic state colorsMap = do+ if ((v < 2) || (v == 3)) && showMsg state+ then do+ win <- widgetGetDrawWindow pic+ (_,(ulx,uly,lrx,lry)) <- getCorners pic+ let ySkip :: Double+ ySkip = case v of+ 1 -> (lry - uly) / (fromIntegral (length (matrixP state)))+ 0 -> (lry - uly) / (fromIntegral (length (matrixM state)))+ 3 -> (lry - uly - ((numM-1)*10) )/ (fromIntegral (length (matrixP state)))++ -- do not draw trapezoid if each message of a message bulk is+ -- drawn individually+ when (drawDataMsgs && (not drawBlkMsg)) $ drawHeads win pixelsPerSecond ySkip ulx uly+ + drawRcvLengths win pixelsPerSecond ySkip ulx uly+ drawMsgs win pixelsPerSecond ySkip ulx uly+ else return ()+ where v = selView state+ useDiff = locTime state+ sort = case v of+ 1 -> 0:(reverse (matrixP state))+ 0 -> reverse (matrixM state)+ 3 -> reverse (matrixGP state)+ iv = 0+ + -- Returns the pixel position on the drawing area for a given+ -- point of time.+ --+ getPositionInPx :: Int -> Double -> [(MachineID, Double)] -> Double -> Double+ getPositionInPx machineId time startTimes xScale+ | useDiff && hideStartupPhase = (time + (getStartTime machineId startTimes) - minTime) * xScale+ | useDiff = (time + (getStartTime machineId startTimes)) * xScale+ | otherwise = (time - minTime) * xScale+ + (rowPos,rowOff) = case v of+ 1 -> ((iv:(rowPosP 0 iv (reverse ps))), [iv..])+ 0 -> ((iv:(rowPosM iv (reverse ms))), (repeat iv))+ where rowPosP :: Num a => MachineID -> a -> [Process] -> [a]+ rowPosP _ _ [] = []+ rowPosP m' i (((m,p),_,_,_,_):pss)+ | m == m' = rowPosP m (i+1) pss+ | otherwise = i:(rowPosP m (i+1) pss)+ rowPosM :: Num a => a -> [Machine] -> [a]+ rowPosM _ [] = []+ rowPosM i (_:mss) = i:(rowPosM (i+1) mss)++ numProcs :: [(MachineID, Int)]+ numProcs = map (\(mId,_,_,(numP,_,_),_) -> (mId, numP)) ms++ numM = fromIntegral $ length ms+ + sortedMachines = [(numM+1) - (posToMachine pos (matrixGP state)) | pos <- [1..numM]]+ + posToMachine :: Double -> [Double] -> Double+ posToMachine pos sort = posAcc 1 pos sort+ where posAcc i pos (s:ss)+ | pos == s = i+ | otherwise = posAcc (i+1) pos ss+ posAcc _ _ [] = 0++ machineOffsets = buildOffsets (0,0) sortedMachines+ where buildOffsets :: (Double, Double) -> [Double] -> [(Double,Double)] + buildOffsets (numP, numSkip) (mId:mIds) = (numP, numSkip) : (buildOffsets ((fromIntegral curP)+numP, numSkip+1) mIds)+ where Just curP = lookup (floor mId) numProcs+ buildOffsets _ [] = []+++ messageActive :: ProcessID -> ProcessID -> Bool+ messageActive sender receiver = case v of+ 3 -> let activeProcs = confProcesses state+ Just (_,sout) = lookup sender activeProcs+ Just (rin,_) = lookup receiver activeProcs + in sout && rin+ 1 -> let activeProcs = confProcesses state+ Just (_,sout) = lookup sender activeProcs+ Just (rin,_) = lookup receiver activeProcs + in sout && rin+ 0 -> let activeMachs = confMachines state+ Just (_,sout) = lookup (fst sender) activeMachs+ Just (rin,_) = lookup (fst receiver) activeMachs + in sout && rin+ _ -> True+ drawRcvLengths :: DrawWindow -> Double -> Double -> Double -> Double -> IO ()+ drawRcvLengths win xScale yScale ulx uly =+ target $ do+ translate visX visY+ translate ulx (uly- 0.2*yScale)+ getColor messagesReceive colorsMap+ drawRcvLength rcvtimes+ where+ pidsOnMachine :: MachineID -> [Int]+ pidsOnMachine mId = map (\((_,pid),_,_,_,_) -> pid) $ filter (\((pmid,pid),_,_,_,_) -> pmid == mId) ps + row :: Int -> Int -> Double+ row m p + | v /= 3 = (((sort)!!(rowPos!!m + rowOff!!p)) * yScale)+ | otherwise = ( (numP + ((fromIntegral curP) +1- (fromIntegral p))) * yScale) + (numSkip*10)+ where machine = floor $ sort!!(m-1)+ (numP,numSkip) = machineOffsets!!(machine-1)+ Just curP = lookup m numProcs+ drawRcvLength [] = return ()+ drawRcvLength (((mID,ptimes),st,et):ts) =+ if and (map (0<=) [mID])+ then do+ drawRcvLength' mID ptimes st+ drawRcvLength ts+ else drawRcvLength ts+ drawRcvLength' mID ((pID,ptime):ptimes) oldSec = do+ rectangleLimited hideStartupPhase (getPositionInPx mID oldSec mxst xScale) (row mID pID) ((getPositionInPx mID ptime mxst xScale)-(getPositionInPx mID oldSec mxst xScale)) (yScale/10)+ drawRcvLength' mID ptimes ptime+ drawRcvLength' _ [] _ = fill+ arrow :: Double -> Double -> Double -> Double -> Render ()+ arrow fromX fromY toX toY = do+ moveTo fromX fromY+ lineTo toX toY+ arc toX toY 1.5 0 (2 * pi)+ stroke + drawMsgs :: DrawWindow -> Double -> Double -> Double -> Double -> IO ()+ drawMsgs win xScale yScale ulx uly =+ target $ do+ translate visX visY+ thickness <- getLineWidth+ translate ulx (uly - 0.3*yScale)+ drawMsg msgs thickness+ + -- if requested, draw additional messages+ if drawBlkMsg then drawMsg amsgs (thickness/2) else return ()+ where+ row :: Int -> Int -> Double+ row m p + | v /= 3 = (((sort)!!(rowPos!!m + rowOff!!p)) * yScale)+ | otherwise = ( (numP + ((fromIntegral curP) +1- (fromIntegral p))) * yScale) + (numSkip*10)+ where machine = floor $ sort!!(m-1)+ (numP,numSkip) = machineOffsets!!(machine-1)+ Just curP = lookup m numProcs+ drawMsg [] l = setLineWidth l+ drawMsg (m@(MSG ((sm,sp),o,(rm,rp),i) st rt t s):ms) thickness = do+ when ((and (map (0<=) [sm,sp,rm,rp])) && (messageActive (sm,sp) (rm,rp)))+ (do + if t == DataMes || t == Head || t == LocalDataMes || t == LocalHead-- not a system message (`DataMes` or `Head`)+ then+ when drawDataMsgs $ do+ let colorType = case t of + DataMes -> messagesData+ Head -> messagesHead+ LocalDataMes -> messagesDataLocal+ LocalHead -> messagesHeadLocal+ getColor colorType colorsMap+ drawMsgArrow thickness sm sp rm rp st rt+ +-- if t == DataMes+-- then do+-- -- draw data messages with half thickness+-- getColor messagesData colorsMap+-- drawMsgArrow (thickness / 2) sm sp rm rp st rt+-- else do +-- getColor messagesHead colorsMap+-- drawMsgArrow thickness sm sp rm rp st rt+ else + -- if requested, draw system msgs with a gray color+ -- otherwise skip the system msgs+ when drawSystemMsgs $ do+ getColor messagesSystem colorsMap+ drawMsgArrow thickness sm sp rm rp st rt+ )+ drawMsg ms thickness+ + drawMsgArrow width sm sp rm rp st rt+ = do+ setLineWidth width+ arrow (getPositionInPx sm st mxst xScale) ((row sm sp)-0.3*yScale) (getPositionInPx rm rt mxst xScale) (row rm rp)+ + arrow :: Double -> Double -> Double -> Double -> Render ()+ arrow fromX fromY toX toY = do+ moveTo fromX fromY+ lineTo toX toY+ arc toX toY 1.5 0 (2 * pi)+ stroke+ + -- draws a transparent, grey trapezoid for bulk messages + drawHeads :: DrawWindow -> Double -> Double -> Double -> Double -> IO ()+ drawHeads win xScale yScale ulx uly =+ target $ do+ translate visX visY+ lWidth <- getLineWidth+ setLineWidth (lWidth / 2)+ translate ulx (uly - 0.3*yScale)+ drawHead hmsgs+ setLineWidth lWidth+ where+ row :: Int -> Int -> Double+ row m p + | v /= 3 = (((sort)!!(rowPos!!m + rowOff!!p)) * yScale)+ | otherwise = ( (numP + ((fromIntegral curP) +1- (fromIntegral p))) * yScale) + (numSkip*10)+ where machine = floor $ sort!!(m-1)+ (numP,numSkip) = machineOffsets!!(machine-1)+ Just curP = lookup m numProcs+ compSize = 2 * maxSize+ relSize s = 0.15 + (s / compSize)+ drawHead ((((sm,sp),_,(rm,rp),_),(ts1,tr1,ts2,tr2),size,_):hs) =+ if ((min sp rp) < 0) || (not (messageActive (sm,sp) (rm,rp)))+ then drawHead hs -- can't draw this!+ else do getColorAlpha messagesBlock colorsMap (relSize size)+ trapezoid (getPositionInPx sm ts1 mxst xScale) (getPositionInPx sm ts2 mxst xScale) ((row sm sp)-0.3*yScale)+ (getPositionInPx rm tr1 mxst xScale) (getPositionInPx rm tr2 mxst xScale) (row rm rp)+ drawHead hs+ drawHead [] = return ()+ trapezoid :: Double -> Double -> Double -> Double -> Double -> Double -> Render ()+ trapezoid x11 x12 y1 x21 x22 y2 = do+ moveTo x11 y1+ lineTo x12 y1+ lineTo x22 y2+ lineTo x21 y2+ fill++++ ++-- Draws a transparent blue box on top of a selected row+--+addSelection ::Double -> Double -> (Render () -> IO ()) -> Double -> DrawingArea -> ViewerState -> IO ()+addSelection visX visY target nRows pic state = do+ win <- widgetGetDrawWindow pic+ (_,(ulx,uly,lrx,lry)) <- getCorners pic+ let xSkip = (lrx - ulx)+ ySkip = (lry - uly) / nRows+ rows = selRow state+ if (not $ null rows)+ then sequence_ $ map (\row -> target $ do+ translate visX visY+ translate ulx uly+ --scale xSkip ySkip+ translate 0 (ySkip * (row - 1))+ setSourceRGBA 0.0 0.0 1.0 0.3+ rectangle 0.0 0.0 xSkip ySkip+ fill) rows+ else return ()+ return ()++addSelectionGroupedProcesses :: Double -> Double -> (Render () -> IO ()) -> Double -> DrawingArea -> ViewerState -> [Double] -> Events -> IO ()+addSelectionGroupedProcesses visX visY target nRows pic state lineHeights ((ms,ps,_),mTimes,(mxs,mxst),(msgs,amsgs,hmsgs,_,rcvtimes),(minTime,maxTime,maxSTime,maxSize,maxLD),_)= do+ win <- widgetGetDrawWindow pic+ (_,(ulx,uly,lrx,lry)) <- getCorners pic+ let xSkip = (lrx - ulx)+ ySkip = (lry - uly) / nRows+ rows = selRow state+ numProcs :: [(MachineID, Int)]+ numProcs = map (\(mId,_,_,(numP,_,_),_) -> (mId, numP)) ms++ numM = fromIntegral $ length ms+ procSkip = (lry - uly - ((numM-1)*10) )/ (fromIntegral (length (matrixP state))) + sortedMachines = [(numM+1) - (posToMachine pos (matrixGP state)) | pos <- [1..numM]]+ + posToMachine :: Double -> [Double] -> Double+ posToMachine pos sort = posAcc 1 pos sort+ where posAcc i pos (s:ss)+ | pos == s = i+ | otherwise = posAcc (i+1) pos ss+ posAcc _ _ [] = 0++ machineOffsets = buildOffsets (0,0) sortedMachines+ where buildOffsets :: (Double, Double) -> [Double] -> [(Double,Double)] + buildOffsets (numP, numSkip) (mId:mIds) = (numP, numSkip) : (buildOffsets ((fromIntegral curP)+numP, numSkip+1) mIds)+ where Just curP = lookup (floor mId) numProcs+ buildOffsets _ [] = []+ if (not $ null rows)+ then sequence_ $ map (\row -> target $ do+ translate visX visY+ translate ulx uly+ --scale xSkip ySkip+ let mach = (floor numM + 1) - (floor (posToMachine row (matrixGP state)))+ (numP,numGap) = (machineOffsets!!((floor row) - 1))+ Just lenP = lookup mach numProcs+ translate 0 (numP*procSkip+numGap*10 - 5)+ setSourceRGBA 0.0 0.0 1.0 0.3+ rectangle 0.0 0.0 xSkip ((fromIntegral lenP)*procSkip + 5)+ fill) rows+ else return ()+ return ()++-- draws y-axis+--+drawNames :: Double -> Double -> [Double] -> [String] -> Colors -> Render ()+-- x-Offset lry y-Offsets names+drawNames x lry (s:ss) (n:ns) colorsMap = do+ moveTo x (s-3)+ getColor chartAxesLabel colorsMap+ showTextR (n)+ moveTo (x+2) s+ getColor chartAxes colorsMap+ lineTo (x+5) s+ drawNames x lry ss ns colorsMap+drawNames x lry _ _ colorsMap = do+ moveTo (x+5) (- 5)+ getColor chartAxes colorsMap+ lineTo (x+5) (lry + 5)++drawName x lry y name colorsMap = do+ moveTo x (y-3)+ getColor chartAxesLabel colorsMap+ showTextR name+ +drawNameTick x lry y colorsMap = do+ moveTo (x+2) y+ getColor chartAxes colorsMap+ lineTo (x+5) y++drawNameLine x lry colorsMap = do+ moveTo (x+5) (- 5)+ getColor chartAxes colorsMap+ lineTo (x+5) (lry + 5)++drawTimes :: Bool -- True, if ticks/labels should be placed automatically+ -> Seconds -- draw tick every `manualSkip` seconds+ -> Int -- draw time every `manualMarks` ticks+ -> (Seconds, Seconds, Seconds) + -> Bool -- startup sync. enabled+ -> DimV -- visible area+ -> Dim -- area to draw in+ -> Colors+ -> Render ()+drawTimes useAuto manualSkip manualMarks (minT,maxT,maxST) useDiff (vx,vy,vw,vh) (ulx,uly,lrx,lry) colors = do+ let y = fromIntegral (vy + vh - 20)+ xDelta = fromIntegral vw / 15+ tDelta+ | useDiff = xDelta * ((maxT+maxST) - minT) / (lrx - ulx)+ | otherwise = xDelta * (maxT - minT) / (lrx - ulx)+ tSkip = if not useAuto then manualSkip else smoothSkip tDelta+ xSkip+ | useDiff = tSkip * (lrx - ulx) / ((maxT+maxST) - minT)+ | otherwise = tSkip * (lrx - ulx) / (maxT - minT)+ + -- draw the x-axis+ moveTo (ulx-5) y+ getColor chartAxes colors+ lineTo lrx y+ stroke+ + -- draw axis labels and ticks+ drawTime 0 xSkip y+ + where+ drawTime :: Double -> Double -> Double -> Render ()+ drawTime i x y = if mx < lrx+ then do + -- draw tick+ moveTo mx y+ getColor chartAxes colors+ lineTo mx my+ stroke+ + -- draw label+ moveTo mx (y + 12)+ getColor chartAxesLabel colors+ if useAuto+ then showText timeString+ else if (floor i) `mod` manualMarks == 0+ then showText timeString+ else return ()+ drawTime (i+1) x y+ + else stroke+ where mx = ulx + (i * x)+ my = if useAuto + then y + 5+ else if ((floor i) `mod` manualMarks == 0) && manualMarks > 1+ then y + 6+ else y + 5+ + fullTime+ | useDiff = (showFFloat (Just 6) (posToTime minT (maxT+maxST) ulx lrx mx) "")+ | otherwise = (showFFloat (Just 6) (posToTime minT maxT ulx lrx mx) "")+ -- drop trailing zeros (1.600000 -> 1.6)+ (sndStr,fstStr) = splitAt 5 (reverse fullTime)+ timeString = (reverse fstStr) ++ (reverse (dropWhile (== '0') sndStr))+ + smoothSkip :: Seconds -> Double+ smoothSkip s+ | cmp > 7 = 10^^(exponent+1)+ | cmp > 5 = 7.5 * 10^^exponent+ | cmp > 2 = 5 * 10^^exponent+ | cmp > 1 = 2 * 10^^exponent+ | otherwise = 10^^exponent+ where exponent = floor (logBase 10 s)+ cmp = s * 10^^(-exponent)++drawThreads :: Bool -> Double -> Double -> (Render () -> IO ()) -> Events -> Colors -> DrawingArea -> ViewerState -> (Int -> [(MachineID, Double)] -> Double -> Double) -> (Double -> Double) -> IO (Render ())+drawThreads hideStartupPhase visX visY target ((_,_,threads),mTimes,(_,mxst),_,(minTime,maxTime,maxSTime,maxSize,maxLD),_) color pic state getDiffTime scaledTime = do+ win <- widgetGetDrawWindow pic+ (cv@(vx,vy,vw,vh),cr@(ulx,uly,lrx,lry)) <- getCorners pic+ let numT = (fromIntegral (length threads))::Double+ ySkip = (lry - uly) / numT+ xSkip = (lrx - ulx)+ sort = matrixT state+ names = map (\(((m,p),t),_) -> ('T':(show m) ++ ':':(show p) ++ ':': (show t))) threads+ target $ do+ translate visX visY+ save+ translate ulx uly+ scale xSkip ySkip+ if locTime state+ then drawLocalThreads threads sort+ else drawGlobalThreads threads sort+ restore++ let drawAxes = do+ drawTimes (autoTicks state) (tickSkip state) (tickMark state) (minTime,maxTime,maxSTime) (locTime state) cv cr color+ translate 0 (uly)+ drawNames (fromIntegral vx + ulx - 5) (lry-uly) (map (ySkip *) sort) names color+ stroke+ + return drawAxes+ where+ drawLocalThreads, drawGlobalThreads :: [Thread] -> [Double] -> Render ()+ drawLocalThreads ((((m,_),_),evts):ts) (s:ss) = do+ let diff = getDiffTime m mxst minTime+ drawEvents evts 1 s diff+ drawLocalThreads ts ss+ drawLocalThreads _ _ = return ()+ drawGlobalThreads ((_,evts):ts) (s:ss) = do+ drawEvents evts 1 s 0.0+ drawGlobalThreads ts ss+ drawGlobalThreads _ _ = return ()+ drawEvents :: [ThreadEvent] -> Double -> Double -> Double -> Render ()+ drawEvents (e:es) oldSec line diff = case e of+ (KillThread sec) -> drawEvents es (scaledTime (sec - diff)) line diff+ (GCThread sec _ _ _ l) -> do+ let (newSec,evtColor) = getTimeAndColor+ evtColor+ rectangleLimited hideStartupPhase newSec barG (oldSec - newSec) (fromIntegral l * ldScale)+ fill+ drawEvents es newSec line diff+ evt -> do+ let (newSec,evtColor) = getTimeAndColor+ evtColor -- set the right color+ rectangleLimited hideStartupPhase newSec barO (oldSec - newSec) barH+ fill+ drawEvents es newSec line diff+ where getTimeAndColor = case e of+ RunThread sec -> (scaledTime (sec - diff), getColor statusRunning color)+ SuspendThread sec -> (scaledTime (sec - diff), getColor statusSuspended color)+ BlockThread sec _ _ -> (scaledTime (sec - diff), getColor statusBlocked color)+ DeblockThread sec -> (scaledTime (sec - diff), getColor statusSuspended color)+ GCThread sec _ _ _ _-> (scaledTime (sec - diff), getColor statusIdle color)+ NewThread sec _ -> (scaledTime (sec - diff), getColor statusSuspended color)+ barO = line - 0.8+ barG = line - 0.1+ drawEvents _ _ _ _ = return ()+ barH = 0.7+ ldScale = (-barH) / maxLD++drawProcesses :: Bool -> Double -> Double -> (Render () -> IO ()) -> Events -> Colors -> DrawingArea -> ViewerState -> (Int -> [(MachineID, Double)] -> Double -> Double) -> (Double -> Double) -> IO (Render ())+drawProcesses hideStartupPhase visX visY target ((_,processes,_),mTimes,(_,mxst),_,(minTime,maxTime,maxSTime,maxSize,maxLD),_) color pic state getDiffTime scaledTime = do+ win <- widgetGetDrawWindow pic+ (cv@(vx,vy,vw,vh),cr@(ulx,uly,lrx,lry)) <- getCorners pic+ let numP = (fromIntegral (length processes))::Double+ ySkip = (lry - uly) / numP+ xSkip = (lrx - ulx)+ sort = matrixP state+ names = map (\((m,p),_,_,_,_) -> ('P':(show m) ++ ':':(show p))) processes+ target $ do+ translate visX visY + save+ translate ulx uly+ scale xSkip ySkip+ if locTime state+ then drawLocalProcesses processes sort+ else drawGlobalProcesses processes sort+ restore+ + let drawAxes = do+ drawTimes (autoTicks state) (tickSkip state) (tickMark state) (minTime,maxTime,maxSTime) (locTime state) cv cr color+ translate 0 (uly)+ drawNames (fromIntegral vx + ulx - 5) (lry-uly) (map (ySkip *) sort) names color+ stroke+ + return drawAxes+ where+ drawLocalProcesses, drawGlobalProcesses :: [Process] -> [Double] -> Render ()+ drawLocalProcesses (((m,_),_,_,_,evts):ps) (s:ss) = do+ let diff = getDiffTime m mxst minTime+ + drawEvents evts 1 s diff+ drawLocalProcesses ps ss+ drawLocalProcesses _ _ = return ()+ drawGlobalProcesses ((_,_,_,_,evts):ps) (s:ss) = do+ drawEvents evts 1 s 0.0+ drawGlobalProcesses ps ss+ drawGlobalProcesses _ _ = return ()+ drawEvents :: [ProcessEvent] -> Double -> Double -> Double -> Render ()+ drawEvents [] _ _ _ = return ()+ drawEvents (e:es) oldSec line diff = case e of+ KillProcess sec _ -> drawEvents es (scaledTime (sec - diff)) line diff+ LabelProcess _ _ -> drawEvents es oldSec line diff -- don't care+ GCProcess sec _ _ _ l -> do+ let (newSec,evtColor,_,_) = getTimeAndColor+ evtColor+ rectangleLimited hideStartupPhase newSec barG (oldSec - newSec) (fromIntegral l * ldScale)+ fill+ drawEvents es newSec line diff+ _ -> do+ let (newSec,evtColor,u,d) = getTimeAndColor+ evtColor -- set the right color+ rectangleLimited hideStartupPhase newSec u (oldSec - newSec) d+ fill+ drawEvents es newSec line diff+ where getTimeAndColor = case e of+ RunningProcess sec -> (scaledTime (sec - diff), getColor statusRunning color,barO,barH)+ SuspendedProcess sec -> (scaledTime (sec - diff), getColor statusSuspended color,barO,barH)+ BlockedProcess sec -> (scaledTime (sec - diff), getColor statusBlocked color,barO,barH)+ GCProcess sec _ _ _ _-> (scaledTime (sec - diff), getColor statusIdle color,barO,barH)+ NewProcess sec -> (scaledTime (sec - diff), getColor statusIdle color,barP,barI)+ IdleProcess sec -> (scaledTime (sec - diff), getColor statusIdle color,barP,barI)+ barO = line - 0.8+ barG = line - 0.1+ barP = line - 0.5+ barH = 0.7+ barI = 0.4+ ldScale = (-barH) / maxLD+++drawGroupProcesses :: Bool -> Double -> Double -> (Render () -> IO ()) -> Events -> Colors -> DrawingArea -> ViewerState -> (Int -> [(MachineID, Double)] -> Double -> Double) -> (Double -> Double) -> IO (Render ())+drawGroupProcesses hideStartupPhase visX visY target ((machines,processes,_),mTimes,(_,mxst),_,(minTime,maxTime,maxSTime,maxSize,maxLD),_) color pic state getDiffTime scaledTime = do+ win <- widgetGetDrawWindow pic+ let groupedProcesses = map (\(mid,_,_,_,_) -> filter (\((pmid,pid),_,_,_,_) -> pmid == mid) processes) machines+ --let sortOrder :: [(Double, + (cv@(vx,vy,vw,vh),cr@(ulx,uly,lrx,lry)) <- getCorners pic+ let numP = (fromIntegral (length processes))::Double+ numM = (fromIntegral (length machines))::Double+ machGap = 10+ ySkip = ((lry - uly - ((numM-1)*machGap) ) / numP)+ xSkip = (lrx - ulx)+ sort = matrixGP state+ names = map (\((m,p),_,_,_,_) -> ('P':(show m) ++ ':':(show p))) processes+ sortGroup = map (pos 1 sort) [1..numM]+ where pos :: Double -> [Double] -> Double -> Double+ pos i (y:ys) x + | x == y = i+ | otherwise = pos (i+1) ys x+ pos _ [] _ = undefined+ + + sortedGroupedProcess = map (\i -> groupedProcesses !! ((floor i)-1)) sortGroup+ drawLocalGroupedProcesses :: [[Process]] -> Double -> Render ()+ drawLocalGroupedProcesses (p:ps) i = do+ let skip = (machGap / ySkip)+ drawLocalProcesses p [1..] i+ drawLocalGroupedProcesses ps (i + (fromIntegral $ length p) + skip)+ drawLocalGroupedProcesses [] _ = return ()+ drawGlobalGroupedProcesses :: [[Process]] -> Double -> Render ()+ drawGlobalGroupedProcesses (p:ps) i = do+ let skip = (machGap / ySkip)+ drawGlobalProcesses p [1..] i+ drawGlobalGroupedProcesses ps (i + (fromIntegral $ length p) + skip)+ drawGlobalGroupedProcesses [] _ = return ()++ drawGroupNames :: [[Process]] -> Double -> Render ()+ drawGroupNames (p:ps) i = do+ let skip = (machGap)+ drawPNames p [1..] i color+ stroke+ drawGroupNames ps (i+ (((fromIntegral $ length p))*ySkip) + skip)+ drawGroupNames [] _ = do+ drawNameLine (fromIntegral vx + ulx - 5) (lry-uly) color+ stroke++ drawPNames [((m,pid),_,_,_,evts)] (s:ss) skip = do+ drawName (fromIntegral vx + ulx - 5) (lry-uly) ((s*ySkip)+skip) ("P" ++ (show m) ++ ":" ++ (show pid))+ drawNameTick (fromIntegral vx + ulx -5) (lry-uly) ((s*ySkip)+skip+5)+ drawPNames (((m,pid),_,_,_,evts):ps) (s:ss) skip = do+ drawName (fromIntegral vx + ulx - 5) (lry-uly) ((s*ySkip)+skip) ("P" ++ (show m) ++ ":" ++ (show pid))+ drawPNames ps ss skip+ ++ target $ do+ translate visX visY + save+ translate ulx uly+ scale xSkip ySkip+ --liftIO $ putStrLn $ "sort" ++ (show sort)+ --liftIO $ putStrLn $ "sortGroup" ++ (show sort)+ if locTime state+ then drawLocalGroupedProcesses sortedGroupedProcess 0+ else drawGlobalGroupedProcesses sortedGroupedProcess 0+ restore+ + let drawAxes = do+ drawTimes (autoTicks state) (tickSkip state) (tickMark state) (minTime,maxTime,maxSTime) (locTime state) cv cr color+ translate 0 (uly)+ drawGroupNames sortedGroupedProcess 0+ stroke+ + return drawAxes+ where+ drawLocalProcesses :: [Process] -> [Double] -> Double -> Render ()+ drawLocalProcesses (((m,_),_,_,_,evts):ps) (s:ss) skip = do+ let diff = getDiffTime m mxst minTime+ + drawEvents evts 1 s diff skip+ drawLocalProcesses ps ss skip+ drawLocalProcesses _ _ _ = return ()+ drawGlobalProcesses ((_,_,_,_,evts):ps) (s:ss) skip = do+ drawEvents evts 1 s 0.0 skip+ drawGlobalProcesses ps ss skip+ drawGlobalProcesses _ _ _ = return ()+ drawEvents :: [ProcessEvent] -> Double -> Double -> Double -> Double -> Render ()+ drawEvents [] _ _ _ _ = return ()+ drawEvents (e:es) oldSec line diff skip = case e of+ KillProcess sec _ -> drawEvents es (scaledTime (sec - diff)) line diff skip+ LabelProcess _ _ -> drawEvents es oldSec line diff skip -- don't care+ GCProcess sec _ _ _ l -> do+ let (newSec,evtColor,_,_) = getTimeAndColor+ evtColor+ rectangleLimited hideStartupPhase newSec barG (oldSec - newSec) (fromIntegral l * ldScale)+ fill+ drawEvents es newSec line diff skip+ _ -> do+ let (newSec,evtColor,u,d) = getTimeAndColor+ evtColor -- set the right color+ rectangleLimited hideStartupPhase newSec (skip+u) (oldSec - newSec) d+ fill+ drawEvents es newSec line diff skip+ where getTimeAndColor = case e of+ RunningProcess sec -> (scaledTime (sec - diff), getColor statusRunning color,barO,barH)+ SuspendedProcess sec -> (scaledTime (sec - diff), getColor statusSuspended color,barO,barH)+ BlockedProcess sec -> (scaledTime (sec - diff), getColor statusBlocked color,barO,barH)+ GCProcess sec _ _ _ _-> (scaledTime (sec - diff), getColor statusIdle color,barO,barH)+ NewProcess sec -> (scaledTime (sec - diff), getColor statusIdle color,barP,barI)+ IdleProcess sec -> (scaledTime (sec - diff), getColor statusIdle color,barP,barI)+ barO = line - 1 -- - 0.7+ barG = line - 0.1+ barP = line - 0.5+ barH = 1+ barI = 0.4+ ldScale = (-barH) / maxLD++++drawMachines :: Bool -> Double -> Double -> (Render () -> IO ()) -> Events -> Colors -> DrawingArea -> ViewerState -> (Int -> [(MachineID, Double)] -> Double -> Double) -> (Double -> Double) -> IO (Render ())+drawMachines hideStartupPhase visX visY target ((machines,_,_),mTimes,(mxs,mxst),_,(minTime,maxTime,maxSTime,maxSize,maxLD),_) color pic state getDiffTime scaledTime = do+ win <- widgetGetDrawWindow pic+ (cv@(vx,vy,vw,vh),cr@(ulx,uly,lrx,lry)) <- getCorners pic+ let numM = (fromIntegral (length machines))::Double+ ySkip = (lry - uly) / numM+ xSkip = (lrx - ulx)+ sort = matrixM state+ names = map (\(m,_,_,_,_) -> ('M':(show m))) machines+ + target $ do+ translate visX visY+ translate ulx (uly - ySkip)+ scale xSkip ySkip+ if locTime state+ then drawLocalMachines machines sort+ else drawGlobalMachines machines sort++ let drawAxes = do+ translate visX visY+ drawTimes (autoTicks state) (tickSkip state) (tickMark state) (minTime,maxTime,maxSTime) (locTime state) cv cr color+ translate 0 (uly)+ drawNames (fromIntegral vx + ulx - 5) (lry-uly) (map (ySkip *) sort) names color+ stroke+ + return drawAxes+ where+ -- startup sync activated + drawLocalMachines, drawGlobalMachines :: [Machine] -> [Double] -> Render ()+ drawLocalMachines ((i,_,_,_,evts):ms) (s:ss) = do+ let diffTime = getDiffTime i mxst minTime+ + drawEvents evts 1 s diffTime+ drawLocalMachines ms ss+ drawLocalMachines _ _ = return ()+ + -- startup sync deactivated+ drawGlobalMachines ((i,_,_,_,evts):ms) (s:ss) = do+ drawEvents evts 1 s 0.0+ drawGlobalMachines ms ss+ drawGlobalMachines _ _ = return ()+ + drawEvents :: [MachineEvent] -> Double -> Double -> Double -> Render ()+ drawEvents (e:es) oldSec line diff = case e of+ (EndMachine sec) ->+ drawEvents es (scaledTime (sec - diff)) line diff+ (GCMachine sec _ _ _ l) -> do+ let (newSec,evtColor,_,_) = getTimeAndColor+ evtColor+ rectangleLimited hideStartupPhase newSec barG (oldSec - newSec) (fromIntegral l * ldScale)+ fill+ drawEvents es newSec line diff+ _ -> do+ let (newSec,evtColor,u,d) = getTimeAndColor+ evtColor -- set the right color+ rectangleLimited hideStartupPhase newSec u (oldSec - newSec) d+ fill+ drawEvents es newSec line diff+ where getTimeAndColor = case e of+ RunningMachine sec -> (scaledTime (sec - diff), getColor statusRunning color,barO,barH)+ SuspendedMachine sec -> (scaledTime (sec - diff), getColor statusSuspended color,barO,barH)+ BlockedMachine sec -> (scaledTime (sec - diff), getColor statusBlocked color,barO,barH)+ GCMachine sec _ _ _ _-> (scaledTime (sec - diff), getColor statusIdle color,barO,barH)+ StartMachine sec -> (scaledTime (sec - diff), getColor statusIdle color,barP,barI)+ IdleMachine sec -> (scaledTime (sec - diff), getColor statusIdle color,barP,barI)+ barO = line + 0.2+ barG = line + 0.9+ barP = line + 0.5+ drawEvents _ _ _ _ = return ()+ barH = 0.7+ barI = 0.4+ ldScale = (-barH) / maxLD++prepareBackground :: Double -> Double -> (Render () -> IO ()) -> DrawingArea -> Colors -> IO ()+prepareBackground visX visY target area colors = do+ win <- widgetGetDrawWindow area+ (w,h) <- widgetGetSize area+ (_,(ulx,uly,lrx,lry)) <- getCorners area+ let width = realToFrac w+ height = realToFrac h+ width' = width - 2 * border+ height' = height - 2 * border+ target $ do+ translate visX visY+ -- setLineWidth 1+ -- Background+ colorGray+ rectangle 0 0 width height+ fill+ colorBlack++ -- Shadow of paper+ save+ translate shadow shadow+ rectangle border border width' height'+ fill+ restore++ -- Paper+ rectangle border border width' height'+ stroke+ getColor chartBackground colors+ rectangle border border width' height'+ fill++ {-- Axis+ colorBlack+ moveTo (ulx - 10) lry+ lineTo (lrx + 5) lry+ stroke-}+ return ()+ where++-- create a dialog with a message (for errors and questions)+genericDialog :: String -> Bool -> IO Dialog+genericDialog msg err = do+ dlg <- dialogNew+ dialogSetHasSeparator dlg False+ windowSetIconName dlg $ if err+ then "gtk-dialog-error"+ else "gtk-dialog-question"+ upper <- dialogGetUpper dlg+ label <- labelNew (Just msg)+ labelSetJustify label JustifyCenter+ miscSetPadding label 20 20+ containerAdd upper label+ return dlg++-- errorMessage:+-- opens a window and displays the given string as errormessage+errorMessage :: String -> IO ()+errorMessage e = do+ dlg <- genericDialog e True+ dialogAddButton dlg stockOk ResponseOk+ afterResponse dlg (\_ -> widgetDestroy dlg)+ widgetShowAll dlg++yesNoMessage :: String -> IO Bool+yesNoMessage e = do+ dlg <- genericDialog e False+ dialogAddButton dlg stockYes ResponseYes+ dialogAddButton dlg stockNo ResponseNo+ afterResponse dlg (\_ -> widgetDestroy dlg)+ widgetShowAll dlg+ response <- dialogRun dlg+ case response of+ ResponseYes -> return True+ _ -> return False+++drawStartupMarker :: Double -> Double -> Double -> (Render () -> IO ()) -> Events -> DrawingArea -> ViewerState -> Colors -> IO ()+drawStartupMarker pixelsPerSecond visX visY target (_, _, (maxStartupTimeInSeconds,_),_ , (minTime, maxTime, maxSTime,_ ,_ ), _) pic state colorsMap+ = do+ win <- widgetGetDrawWindow pic+ (_,(ulx,uly,lrx,lry)) <- getCorners pic+ + drawMarker win pixelsPerSecond ulx uly (lry - uly)+ where+ drawMarker :: DrawWindow -> Double -> Double -> Double -> Double -> IO ()+ drawMarker win pixelsPerSecond ulx uly height = target $ do+ translate visX visY+ thickness <- getLineWidth+ setLineWidth (thickness / 2)+ translate ulx uly+ getColor markerStartup colorsMap+ + let startupPositionInPx = getPosition maxStartupTimeInSeconds+ + arrow startupPositionInPx (0) startupPositionInPx (height)+ setLineWidth thickness+ + where+ getPosition :: Double -> Double+ getPosition seconds = seconds * pixelsPerSecond+ + arrow :: Double -> Double -> Double -> Double -> Render ()+ arrow fromX fromY toX toY = do+ moveTo fromX fromY+ lineTo toX toY+ arc toX toY 1.5 0 (2 * pi)+ stroke+ +-- When hiding the startup-phase, the blue box of a machine might start before+-- the y-axis. This function makes sure that only the part right of the+-- y-axis is drawn.+rectangleLimited :: Bool -> Double -> Double -> Double -> Double -> Render()+rectangleLimited checkOverflow x y width height+ | checkOverflow && (x < 0) = do+ let newWidth = width + x+ when (newWidth > 0) $ rectangle 0 y newWidth height+ | otherwise = rectangle x y width height+
+ RTSEventsParser.hs view
@@ -0,0 +1,1177 @@+{- The Eden Trace Viewer (or simply EdenTV) is a tool that can generate diagrams+ to visualize the behaviour of Eden programs.+ Copyright (C) 2005-2010 Phillips Universitaet Marburg++ This program is free software; you can redistribute it and/or modify+ it under the terms of the GNU General Public License as published by+ the Free Software Foundation; either version 3 of the License, or+ (at your option) any later version.+ This program is distributed in the hope that it will be useful,+ but WITHOUT ANY WARRANTY; without even the implied warranty of+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+ GNU General Public License for more details.+ You should have received a copy of the GNU General Public License+ along with this program; if not, write to the Free Software Foundation,+ Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA++-}+{-# OPTIONS -XNamedFieldPuns #-}+{-# LANGUAGE BangPatterns #-}+module RTSEventsParser (+ traceRTSFile,+ Err(..)+) where++import TinyZipper+import qualified EdenTvType as E+import GHC.RTS.Events++import qualified Control.Exception as C+import Control.Monad.Error+import Data.Binary.Get+import Data.ByteString.Lazy (ByteString)+import Data.Either+import Data.Maybe+import Data.Tree+import qualified Data.Map as M+import qualified Data.Sequence as S++import Debug.Trace++type RTSEvents = (E.MachineID, [Event])+data Err a = Ok !a | Failed String+type Lookuptable = [(E.MachineID, [(Int, Int)])]++----------------------------------+--+-- Reader function: parseRawFile+-- Reads a zip File containing binary eventlog files+-- to a List of RTSEvents+-- +----------------------------------++-- We need to catch Exceptions here, because getEventLog (GHC.RTS.Events) uses Lazy Bytestrings and+-- non-strict Get!+parseRawFile :: FilePath -> IO (Either String [RTSEvents])+parseRawFile zipfile = C.catch (readAll zipfile) catchBadFile+ where catchBadFile :: C.SomeException -> IO (Either String [RTSEvents]) + catchBadFile e = return (Left ("ParseRawFile: Bad File (due to: "++(show e)++")"))+++-- similar to readEventLogFromFile, but uses a ByteString+-- parses a binary *.eventlog file+readGhcEventsSingle :: ByteString -> IO (Either String EventLog)+readGhcEventsSingle s = return $ runGet (do v <- runErrorT $ getEventLog+ m <- isEmpty+ m `seq` return v) $ s++-- convert an EventLog to a List of its Events, paired with+-- the machine number+eventLogToEvents :: EventLog -> Either String RTSEvents+eventLogToEvents evtlog = + let ghcevents = map ce_event $ sortEvents (events $ dat evtlog) + mID = getMachineID ghcevents + in either (\err -> Left err) (\id -> Right (id, ghcevents)) mID+ where getMachineID :: [Event] -> Either String E.MachineID+ getMachineID ((Event{time, spec=CreateMachine{machine}}):_) = + Right $ fromIntegral machine+ getMachineID (_:xs) = getMachineID xs+ getMachineID [] = Left "eventLogToEvents: No CreateMachine Event!"++-- now we can read all files contained in a zip archive+readAll :: FilePath -> IO (Either String [RTSEvents])+readAll zippath = do+ files' <- readZip zippath + either (\err -> return $ Left err)+ (\files -> do+ eventlogs <- sequence $ map readGhcEventsSingle files+ let (errparse, logs) = partitionEithers eventlogs+ case null errparse of+ True -> do + let (errevts, events) = + partitionEithers $ map eventLogToEvents logs+ case null errevts of+ False -> return $ Left ("readAll: Events error "++(show errevts))+ True -> return $ Right events+ False -> return $ Left "readAll: Parse error")+ files' ++++---------------------------------------------------------------+-- parseAdditional+-- parses Additional information (needed for, or not covered by+-- the old legacy parser) from RTSEvents+---------------------------------------------------------------++data AddInfo = AddInfo {+ ai_threadTable :: !ThreadTable, -- get Proc# from Thread#+ ai_mainTime :: !E.Seconds, -- realtime of 1st machine+ ai_syncTable :: ![(E.MachineID, E.Seconds)], -- offsets to mainTime+ ai_startupDiff :: !(E.Seconds, [(E.MachineID, E.Seconds)]), -- offsets to Startup+ ai_endTable :: ![(E.MachineID, E.Seconds)], -- end Times of Machines+ ai_maxEndTime :: !E.Seconds, -- max End Time+ ai_minCMTime :: !E.Seconds, -- earliest CreateMachine Time+ ai_maxSUDiff :: !E.Seconds, -- max startup offset+ ai_rcvLengths :: ![((E.MachineID,[(Int,E.Seconds)]), E.Seconds, E.Seconds)], -- used for rect Blocks in Grouped Messages+ ai_leftMsgs :: ![E.Message] -- Messages which are left out by old ETV+}+type ThreadTable = [(E.MachineID, [(Int, Int)])]++parseAdditional :: Bool -> [RTSEvents] -> AddInfo+parseAdditional ignoreMessages = mergeInfo . + map (\(mID, evts) -> (parseAdditionalSingle evts (emptyInfo mID)) ignoreMessages)+++mergeInfo :: [AddInfoSingle] -> AddInfo+mergeInfo aiss = + let threadTable = map (\ais -> let mID = ais_machineID ais+ tTable = ais_threadTable ais+ in mID `seq` (length tTable) `seq` (mID, tTable)) aiss++ mainTime = ais_realtime $ head $ filter (\ais -> ais_machineID ais == 1) aiss+ syncTable = map (\ais -> let mID = ais_machineID ais+ realT = ais_realtime ais+ in mID `seq` realT `seq` (mID, realT - mainTime)) aiss+ + + cmTimes = map (\ais -> let mID = ais_machineID ais+ cmT = convertTimestampWithTable syncTable mID (ais_CMTimestamp ais)+ in mID `seq` cmT `seq` (mID, cmT)+ ) aiss+ minCMTime = minimum $ map snd cmTimes++ startupTimes = map (\ais -> let mID = ais_machineID ais+ suT = convertTimestampWithTable syncTable mID (ais_SUTimestamp ais)+ in mID `seq` suT `seq` (mID, suT)+ ) aiss+ maxStartupTime = maximum $ map snd startupTimes++ startupDiff = (maxStartupTime, map (\(mID, s) -> (mID, maxStartupTime - s)) startupTimes)+ maxStartupDiff = maximum $ zipWith (\(_, diffs) (_,end) -> if diffs + end > maxEndTime then (diffs+end)-maxEndTime else 0) (snd startupDiff) endTimes++ endTimes = map (\ais -> let mID = ais_machineID ais+ leT = convertTimestampWithTable syncTable mID (ais_LETimestamp ais)+ in mID `seq` leT `seq` (mID, leT)+ ) aiss+ maxEndTime = maximum $ map snd endTimes++ rcvLengths = concatMap (\ais -> let mID = ais_machineID ais+ convert = convertTimestampWithTable syncTable mID+ in map (\(pids, ts, te) -> let pidM = reverse $ map (\(pid, t) -> (pid, convert t)) pids+ cts = convert ts+ cte = convert te+ in mID `seq` (length pidM) `seq` cts `seq` cte `seq` ((mID, pidM), cts, cte)+ ) (ais_receiveLengths ais)) aiss++ leftMsgEvents :: [(E.MachineID, Event)]+ leftMsgEvents = concatMap (\ais -> map (\e -> (ais_machineID ais, e)) (ais_leftMessages ais)) aiss+ + leftMsgs :: (E.OpenMessagesPerProcess, [E.Message])+ leftMsgs = foldr processLeftMsgs (M.empty, []) leftMsgEvents+ + left :: [E.Message]+ left = snd leftMsgs+ + processLeftMsgs :: (E.MachineID, Event) -> (E.OpenMessagesPerProcess, [E.Message]) + -> (E.OpenMessagesPerProcess, [E.Message])+ processLeftMsgs (mID, Event{time, spec}) oe+ = let convertTimestamp = convertTimestampWithSync (toSyncTime syncTable mID)+ in case spec of+ SendMessage{+ mesTag, + senderProcess, + senderThread, + receiverMachine, + receiverProcess,+ receiverInport} + -> insertLeftOutMessages (mID, (fromIntegral senderProcess))+ (E.OSM (convertTimestamp time) + (fromIntegral receiverMachine, fromIntegral receiverProcess) + (fromIntegral senderThread) + (fromIntegral receiverInport) + (readTag mesTag)) oe+ ReceiveMessage{+ mesTag,+ receiverProcess,+ receiverInport,+ senderMachine,+ senderProcess,+ senderThread,+ messageSize} + -> insertLeftOutMessages ((fromIntegral senderMachine), (fromIntegral senderProcess))+ (E.ORM (convertTimestamp time) + (mID, fromIntegral receiverProcess) + (fromIntegral senderThread) + (fromIntegral receiverInport) + (readTag mesTag) + (fromIntegral messageSize)) oe+ SendReceiveLocalMessage{+ mesTag,+ senderProcess,+ senderThread,+ receiverProcess,+ receiverInport}+ -> insertLeftOutLocalMessage (E.MSG ((mID, fromIntegral senderProcess),+ fromIntegral senderThread,+ (mID, fromIntegral receiverProcess),+ fromIntegral receiverInport)+ (convertTimestamp time)+ (convertTimestamp time)+ (readLocalTag mesTag)+ 0+ ) oe+ _ -> oe+++ evaluateMessages [] = []+ evaluateMessages ((E.MSG _ _ _ _ _):msgs) = evaluateMessages msgs++ in (length threadTable) `seq` + (length rcvLengths) `seq`+ (evaluateMessages left) `seq`+ AddInfo { ai_threadTable = threadTable,+ ai_mainTime = mainTime,+ ai_syncTable = syncTable,+ ai_startupDiff = startupDiff,+ ai_endTable = endTimes,+ ai_maxEndTime = maxEndTime,+ ai_rcvLengths = rcvLengths,+ ai_minCMTime = minCMTime,+ ai_maxSUDiff = maxStartupDiff,+ ai_leftMsgs = left+ }++emptyInfo :: E.MachineID -> AddInfoSingle+emptyInfo mID = AddInfoSingle { ais_machineID = mID,+ ais_threadTable = [],+ ais_CMTimestamp = 0,+ ais_SUTimestamp = 0,+ ais_LETimestamp = 0,+ ais_realtime = 0,+ ais_receiveLengths = [],+ ais_leftMessages = [],++ ais_tCollect = False,+ ais_tStart = 0,+ ais_tPIDS = []+ }++data AddInfoSingle = AddInfoSingle {+ ais_machineID :: !E.MachineID,+ ais_threadTable :: ![(Int,Int)], -- (Thread#, Proc#)+ ais_CMTimestamp :: !Timestamp, -- Timestamp of CreateMachine+ ais_SUTimestamp :: !Timestamp, -- Timestamp of Startup+ ais_LETimestamp :: !Timestamp, --- Timestamp of last Event+ ais_realtime :: !E.Seconds,+ ais_receiveLengths :: ![([(Int, Timestamp)], Timestamp, Timestamp)],+ ais_leftMessages :: ![Event],++ ais_tCollect :: !Bool,+ ais_tStart :: !Timestamp,+ ais_tPIDS :: ![(Int,Timestamp)]+}+parseAdditionalSingle :: [Event] -> AddInfoSingle -> Bool -> AddInfoSingle+parseAdditionalSingle [] aux _ = aux+parseAdditionalSingle ((Event{time,+ spec=AssignThreadToProcess{thread,process}}):evts) aux ignoreMessages = + let oldTT = ais_threadTable aux+ newTT@((!t, !p): (!oldTT')) = (fromIntegral thread, fromIntegral process):oldTT+ in parseAdditionalSingle evts (aux{ais_threadTable = newTT,ais_LETimestamp= time}) ignoreMessages++parseAdditionalSingle ((Event{time,+ spec=CreateMachine{realtime}}):evts) aux ignoreMessages = + let newRealtime = ((fromIntegral realtime)/10e7)-((fromIntegral time) / 10e8)+ in parseAdditionalSingle evts (aux{ais_CMTimestamp = time, ais_realtime = newRealtime,ais_LETimestamp= time}) ignoreMessages++parseAdditionalSingle ((Event{time,+ spec=Startup{}}):evts) aux ignoreMessages = parseAdditionalSingle evts (aux{ais_SUTimestamp = time, ais_LETimestamp= time}) ignoreMessages++parseAdditionalSingle (e@(Event{time, spec=SendMessage{}}):evts) aux@(AddInfoSingle{ais_leftMessages=oldMsg}) ignoreMessages+ | ignoreMessages = parseAdditionalSingle evts aux ignoreMessages+ | otherwise = parseAdditionalSingle evts (aux{ais_leftMessages = (e:oldMsg), ais_LETimestamp= time}) ignoreMessages+ +parseAdditionalSingle ((Event{time,+ spec=EdenStartReceive}):evts) aux ignoreMessages = + parseAdditionalSingle evts (aux{ais_tCollect = True,ais_tStart=time,ais_LETimestamp= time }) ignoreMessages++parseAdditionalSingle ((Event{time,+ spec=EdenEndReceive}):evts) aux@(AddInfoSingle{ais_receiveLengths=oldRL, ais_tStart, ais_tPIDS}) ignoreMessages = + ais_tStart `seq` ais_tPIDS `seq` oldRL `seq` parseAdditionalSingle evts (aux{ais_tCollect = False,ais_receiveLengths=((ais_tPIDS, ais_tStart, time):oldRL), ais_tPIDS=[], ais_LETimestamp= time}) ignoreMessages++parseAdditionalSingle ((Event{time,+ spec=CreateProcess{process}}):evts) aux@(AddInfoSingle{ais_tCollect=True, ais_tPIDS=oldPIDs}) ignoreMessages = + let p = fromIntegral process+ in p `seq` oldPIDs `seq` parseAdditionalSingle evts (aux{ais_tPIDS=((p,time):oldPIDs),ais_LETimestamp= time}) ignoreMessages++parseAdditionalSingle (e@(Event{time, spec=ReceiveMessage{receiverProcess,mesTag}}):evts) aux@(AddInfoSingle{ais_tCollect=b, ais_tPIDS=oldPIDs,ais_leftMessages=oldMsg}) ignoreMessages+ | ignoreMessages = parseAdditionalSingle evts aux ignoreMessages+ | b = case mesTag of RFork -> parseAdditionalSingle evts (aux{ais_leftMessages = (e:oldMsg),ais_LETimestamp=time}) ignoreMessages+ _ -> let rp = fromIntegral receiverProcess + in rp ` seq` parseAdditionalSingle evts (aux{ais_leftMessages = (e:oldMsg),ais_tPIDS=((fromIntegral receiverProcess,time):oldPIDs),ais_LETimestamp=time}) ignoreMessages+ | otherwise = parseAdditionalSingle evts (aux{ais_leftMessages = (e:oldMsg),ais_LETimestamp=time}) ignoreMessages++parseAdditionalSingle (e@(Event{time, spec=SendReceiveLocalMessage{}}):evts) aux@(AddInfoSingle{ais_leftMessages=oldMsg}) ignoreMessages+ | ignoreMessages = parseAdditionalSingle evts aux ignoreMessages+ | otherwise = parseAdditionalSingle evts (aux{ais_leftMessages = (e:oldMsg), ais_LETimestamp= time}) ignoreMessages++parseAdditionalSingle (e:evts) aux ignoreMessages = parseAdditionalSingle evts (aux{ais_LETimestamp= time e}) ignoreMessages+++-- This function is called for every SendMessage or ReceiveMessage that+-- was found in the additional events. It takes care of grouping corresponding+-- send and receive message events into a single message.+--+-- copy of legacy Code, used to just extract Head Messages+insertLeftOutMessages :: E.ProcessID -- sender process id+ -> E.OpenMessageEvent -- the message event to process+ -> (E.OpenMessagesPerProcess, -- messages that could not yet be matched with their+ -- corresponding close/open message grouped per process+ [E.Message]) -- complete messages for which the send and+ -- and receive event could be matched+ -> (E.OpenMessagesPerProcess, [E.Message])+insertLeftOutMessages senderProcessId newMessage ocMsgs@(openMessages, closedMessages)+ | or [(tag == E.Head), (tag == E.DataMes)] + = let ((_, senderProcess'), (_, receiveProcess')) = (senderProcessId, receiveProcessId)+ in if (min senderProcess' receiveProcess') >= 0+ then openMessages' `seq` closedMessages' `seq` (openMessages', closedMessages')+ else ocMsgs+ | otherwise = ocMsgs+ where (receiveProcessId, tag) = case newMessage of+ E.ORM _ p _ _ r _ -> (p, r)+ E.OSM _ p _ _ r -> (p, r)+ + (openMessages', closedMessages') = searchID senderProcessId newMessage openMessages closedMessages+++insertLeftOutLocalMessage :: E.Message -> (E.OpenMessagesPerProcess, [E.Message]) -> (E.OpenMessagesPerProcess, [E.Message])+insertLeftOutLocalMessage m (oms, msgs) = let msgs' = m : msgs+ in msgs' ` seq` (oms, msgs')+++-- This function receives a process id, a message event (send or receive) for a message +-- that was sent from this process, a map of open messages for all processes +-- and a list of closed messages. +-- +-- If there already are message events for the given process, the corresponding +-- send/receive message is searched in the open messages of the process.+-- If a message can be 'closed' (a SendMessage can be found for a ReceiveMessage,+-- or a ReceiveMessage can be found for a SendMessage), the merged message is +-- added to the list of closed messages.+--+searchID :: E.ProcessID -> E.OpenMessageEvent -> E.OpenMessagesPerProcess -> [E.Message] + -> (E.OpenMessagesPerProcess, [E.Message])+searchID senderProcess newOpenMessage openMessagesPerProcess closedMessages+ = trySearchProcess (M.lookup senderProcess openMessagesPerProcess)+ where+ -- the key to store the message event in a map+ messageKey = getKeyForOpenMessage newOpenMessage+ -- the key a corresponding 'closing' message event would have+ closingMessageKey = getClosingMessageKey newOpenMessage+ + -- a compressed representation of the message which is used as+ -- value to store the message in a map (all other information+ -- about the message is already contained in the key)+ smallNewOpenMessage = getSmallOpenMessage newOpenMessage+ + + trySearchProcess :: Maybe E.OpenMessages -> (E.OpenMessagesPerProcess, [E.Message])+ -- this is the first message of the process, create a new entry in the map+ trySearchProcess (Nothing) = (openMessagesPerProcess', closedMessages)+ where + openMessagesPerProcess' = M.insert senderProcess processEntry openMessagesPerProcess+ processEntry = M.singleton messageKey (S.singleton smallNewOpenMessage)+ -- there is already an entry for the process, look for an closing message event+ trySearchProcess (Just openMessages) + = trySearchClosingMessage (M.lookup closingMessageKey openMessages) openMessages+ + + trySearchClosingMessage :: Maybe (S.Seq E.SmallOpenMessageEvent) -> E.OpenMessages + -> (E.OpenMessagesPerProcess, [E.Message])+ -- there is no matching closing message event yet, so store the event+ trySearchClosingMessage (Nothing) openMessages + = (openMessagesPerProcess', closedMessages)+ where+ -- update the process entry in the map+ openMessagesPerProcess' :: E.OpenMessagesPerProcess+ openMessagesPerProcess' = M.insert senderProcess openMessages' openMessagesPerProcess+ + -- add the event to the map of open events for this process:+ -- if there already are open events for this process that use the same+ -- channel (same type/rcvProcess/inport/outport/type), thus use the same+ -- map key, then enqueue the new message to the sequence of these messages.+ openMessages' :: E.OpenMessages+ openMessages' = M.insertWith enqueueEvent messageKey (S.singleton smallNewOpenMessage) openMessages+ + -- this functions takes care of appending the new event to the sequence+ -- of already existing events with the same map key+ enqueueEvent :: S.Seq E.SmallOpenMessageEvent -- sequence which contains only the new event+ -> S.Seq E.SmallOpenMessageEvent -- old events with the same key+ -> S.Seq E.SmallOpenMessageEvent+ enqueueEvent newOpenMessageSeq oldOpenMessages = enqueue oldOpenMessages newOpenMessage+ where + newOpenMessage = S.index newOpenMessageSeq 0+ enqueue = (S.|>)+ -- if there is a corresponding event, 'close' the message+ trySearchClosingMessage (Just oldMessages) openMessages+ = (openMessagesPerProcess', closedMessages')+ where + openMessagesPerProcess' :: E.OpenMessagesPerProcess+ openMessagesPerProcess' = + -- if this was the last message event of the process, + -- remove the process' map entry+ if (M.null openMessages')+ then M.delete senderProcess openMessagesPerProcess+ else M.insert senderProcess openMessages' openMessagesPerProcess+ + openMessages' :: E.OpenMessages+ openMessages' = + -- if there are no more events with the same key as the+ -- closing event, remove the key from the map+ if ((S.length oldMessages) == 1)+ then M.delete closingMessageKey openMessages+ else M.insert closingMessageKey (S.drop 1 oldMessages) openMessages+ + closedMessages' :: [E.Message]+ closedMessages' = closedMessage : closedMessages+ closedMessage :: E.Message+ closedMessage = closeMessage newOpenMessage oldMessage+ + oldMessage :: E.SmallOpenMessageEvent+ oldMessage = S.index oldMessages 0+ + -- Merges matching send- and receive-message events into a single message+ closeMessage :: E.OpenMessageEvent -> E.SmallOpenMessageEvent -> E.Message+ closeMessage (E.OSM sendTime rcvProcess outport inport reason) (E.SmallORM rcvTime size)+ = E.MSG (senderProcess, outport, rcvProcess, inport) sendTime rcvTime reason size+ closeMessage (E.ORM rcvTime rcvProcess outport inport reason size) (E.SmallOSM sendTime)+ = E.MSG (senderProcess, outport, rcvProcess, inport) sendTime rcvTime reason size+ + -- Creates a 'small' representation of a message event, which is+ -- used to store the message in a map.+ getSmallOpenMessage :: E.OpenMessageEvent -> E.SmallOpenMessageEvent+ getSmallOpenMessage (E.OSM sendTime rcvProcess outport inport reason)+ = E.SmallOSM sendTime+ getSmallOpenMessage (E.ORM sendTime rcvProcess outport inport reason size)+ = E.SmallORM sendTime size+ + -- Returns a map key to retrieve a message event which would close+ -- the given message event.+ getClosingMessageKey :: E.OpenMessageEvent -> E.OpenMessageKey+ getClosingMessageKey (E.ORM _ rcvProcess outport inport reason _)+ = getKeyForOpenMessage (E.OSM __ rcvProcess outport inport reason)+ getClosingMessageKey (E.OSM _ rcvProcess outport inport reason)+ = getKeyForOpenMessage (E.ORM __ rcvProcess outport inport reason ___)+ __ = 0 / 0+ ___ = 0+ + -- Returns a key which is used store a message event in a map.+ getKeyForOpenMessage :: E.OpenMessageEvent -> E.OpenMessageKey+ getKeyForOpenMessage (E.ORM _ rcvProcess outport inport reason _)+ = (E.TORM, rcvProcess, outport, inport, reason)+ getKeyForOpenMessage (E.OSM _ rcvProcess outport inport reason)+ = (E.TOSM, rcvProcess, outport, inport, reason)++--------------------------------------------------------------------------------+-- Main Function+--------------------------------------------------------------------------------+traceRTSFile :: FilePath -> Bool -> IO (Err E.Events)+traceRTSFile file ignoreMessages = + do ghcevents' <- parseRawFile file+ case ghcevents' of+ Left err -> return (Failed err)+ Right ghcevents ->+ do return (Ok finishedEvents)+ where processedEvents = closeOpenLists $ process ghcevents emptyoe+ additionalInfo = parseAdditional ignoreMessages ghcevents + finishedEvents = if ignoreMessages+ then finish processedEvents+ else injectProcMessages $ finish processedEvents++ finish ((lom,lop,lot),mst, sudiff, (ml,aml,hml,pt, rcvl ), (min_t, m_t,msudiff,mmsg,mld),nums) =+ ((lom,lop,lot),mst, ai_startupDiff additionalInfo, (ml,ai_leftMsgs additionalInfo,hml,pt, ai_rcvLengths additionalInfo), (min_t, m_t,ai_maxSUDiff additionalInfo,mmsg,mld),nums)++ + {-+ -- START HACK+ -- TODO needs rewrite + -}+ -- Manually build Process Table+ -- and ProcMessages (needed because wrong results + -- when those messages are processed in a 'wrong' order, and+ -- finding the right order is just as complex as this)+ + sendRForks = map (\(mID, evts) -> (mID, filter (isSendRFork) evts)) ghcevents++ isSendRFork :: Event -> Bool+ isSendRFork evt = case spec evt of+ SendMessage{mesTag=RFork} -> True+ _ -> False++ rcv_crtRForks = map (\(mID, evts) -> (mID, filter (\evt -> case spec evt of ReceiveMessage{mesTag=RFork} -> True; CreateProcess{} -> True; _ -> False) evts)) ghcevents++ injectProcMessages :: E.Events -> E.Events+ injectProcMessages ((lom,lop,lot),mst, inj ,(ml,aml,hml,pt, rcvl ),stats,nums) = ((lom,lop,lot),mst, inj,(ml++procMessages,aml,hml,processTree, rcvl ),stats,nums)+++ childTable :: [(E.ProcessID, [E.ProcessID])]+ procMessages :: [E.Message]+ (childTable,procMessages) = createChildTable sendRForks rcv_crtRForks [] []++ processTree :: E.ProcessTree+ processTree = unfoldTree buildTree ((1,1), fromJust (lookup (1,1) childTable))++ buildTree :: (E.ProcessID, [E.ProcessID]) -> (E.ProcessID, [(E.ProcessID, [E.ProcessID])])+ buildTree (pid, pids) = (pid, map (\p -> let mps = lookup p childTable+ in case mps of+ Nothing -> (p, [])+ Just ps -> (p, ps)) pids)++ createChildTable :: [(E.MachineID, [Event])] -> [(E.MachineID, [Event])] -> [(E.ProcessID, [E.ProcessID])] -> [E.Message] -> ([(E.ProcessID, [E.ProcessID])], [E.Message])+ createChildTable ((mID, evt:evts):machines) rcvers table procMsgs= + let SendMessage{senderProcess,receiverMachine} = spec evt + senderProc = (mID, fromIntegral sProc)+ receiverMach = fromIntegral receiverMachine+ sMach = fromIntegral mID+ sProc = senderProcess+ sTime = convertTimestampWithSync (toSyncTime (ai_syncTable additionalInfo) mID) (time evt) ++ Just rcvEvents = lookup receiverMach rcvers+ + + + (childId, remainingEvents, child) = nextChildId rcvEvents+ childProcess = (receiverMach, childId)++ newRcvers = updateReceivers receiverMach rcvers remainingEvents+ newTable = addChild table senderProc childProcess+ newProcMsgs = child:procMsgs++ addChild :: [(E.ProcessID, [E.ProcessID])] -> E.ProcessID -> E.ProcessID -> [(E.ProcessID, [E.ProcessID])]+ addChild (cur@(pid, childs):pids) father child+ | pid == father = ((pid, (child:childs)):pids)+ | otherwise = cur : (addChild pids father child)+ addChild [] father child = [(father, [child])]++ updateReceivers :: E.MachineID -> [(E.MachineID, [Event])] -> [Event] -> [(E.MachineID, [Event])]+ updateReceivers i (mach@(mID, evts):machines) update+ | mID == i = ((mID, update):machines)+ | otherwise = mach : (updateReceivers i machines update)+ updateReceivers _ [] _ = error "not updated"++ nextChildId (e:es) = case spec e of+ ReceiveMessage{senderMachine,senderProcess,+ messageSize} -> if senderMachine == sMach && senderProcess == sProc + then let (Event{spec=CreateProcess{process}}, rest) = getNextAndRemove (\evt -> case spec evt of CreateProcess{} -> True; _ -> False) es+ childId = fromIntegral process+ channelID = (senderProc, 0, (receiverMach, childId),0)+ rTime = convertTimestampWithSync (toSyncTime (ai_syncTable additionalInfo) receiverMach) (time e) + child = E.MSG channelID sTime rTime E.RFork (fromIntegral messageSize)+ in (childId, rest, child)+ else let (id, rest, child) = nextChildId es+ in (id, e:rest, child)+ _ -> let (id, rest, child) = nextChildId es+ in (id, e:rest, child)+ nextChildId [] = error "next child not found"++ getNextAndRemove :: (a -> Bool) -> [a] -> (a, [a])+ getNextAndRemove p (x:xs)+ | p x = (x,xs)+ | otherwise = let (y,ys) = getNextAndRemove p xs+ in (y,x:ys)+ getNextAndRemove _ [] = (error "next not found", [])+ in createChildTable ((mID, evts):machines) newRcvers newTable newProcMsgs+ createChildTable ((mID, []):machines) rcvers table procMsgs = createChildTable machines rcvers table procMsgs+ createChildTable [] ecv table procMsgs = (table,procMsgs)++ {-+ -- END HACK+ -}++ -- from old haskell EdenTV+ -- initial events structure+ emptyoe = (([],[],[]),[(0,firstTime)], fml firstTime, (firstTime, firstTime, 0, -1))+ where firstTime = ai_minCMTime additionalInfo+++ -- from old haskell EdenTV+ -- creates initial MessageList+ fml :: E.Seconds -> E.OpenMessageList+ fml t = (M.empty,[],([(1,[((1,1),E.OSM t (0,0) (-1) (-1) E.RFork)],[((0,0),E.ORM t (1,1) (-1) (-1) E.RFork 4)],[])],[((0,0),[])],Node (0,0) []),([],0,[]))++ -- walks over the list of machines (which contains all events for this machine) and inserts all events+ -- in an accumulated OpenEvents structure+ -- when no events are left, we are finished and just need to close open lists in the generated structure + process :: [(E.MachineID, [Event])] -> E.OpenEvents -> E.OpenEvents+ process ((mID, (evt:evts)):machines) oe = let convertTimestamp = convertTimestampWithSync (toSyncTime (ai_syncTable additionalInfo) mID) + newOE = insertEvent convertTimestamp (ai_threadTable additionalInfo) (mID,evt) oe ignoreMessages+ in seq newOE $ process ((mID,evts):machines) newOE+ process ((_,[]):machines) oe = process machines oe+ process [] oe = oe +++--------------------------------------------------------------------------------+-- Helpers+--------------------------------------------------------------------------------++-- converts a timestamp in TICKS to Seconds with respect +-- to a realtime offset 'sync'+convertTimestampWithSync :: E.Seconds -> Timestamp -> E.Seconds+convertTimestampWithSync sync x = sync + (fromIntegral x / 10e8)++convertTimestampWithTable :: [(E.MachineID, Double)] -> E.MachineID -> Timestamp -> E.Seconds+convertTimestampWithTable syncTable mID timestamp =+ let offset = toSyncTime syncTable mID+ in convertTimestampWithSync offset timestamp++toSyncTime :: [(E.MachineID, Double)] -> E.MachineID -> E.Seconds+toSyncTime ((mId, t):machines) i+ | mId == i = t+ | otherwise = toSyncTime machines i+toSyncTime [] _ = 0++-- converts a MessageTag to the ReasonType specified in old legacy format+readTag :: MessageTag -> E.ReasonType+readTag tag = case tag of + RFork -> E.RFork + Connect -> E.Connect + DataMes -> E.DataMes + Head -> E.Head+ Constr -> E.Constr + Part -> E.Part + Terminate -> E.Terminate+ _ -> E.Default++readLocalTag :: MessageTag -> E.ReasonType+readLocalTag tag = case tag of+ Head -> E.LocalHead+ DataMes -> E.LocalDataMes+ _ -> error "readLocalTag was given a non-local tag"++-- finds the matching Process# to a given MachineId and Thread#+-- inside the ThreadTable+lookupProcess :: ThreadTable -> E.MachineID -> Int -> Int+lookupProcess ((machine, es):ts) sMachine sThread = + if machine == sMachine + then lookupProcess' es sThread + else lookupProcess ts sMachine sThread+ where lookupProcess' lst@((tnum,pnum):xs) stnum = if tnum == stnum+ then pnum + else lookupProcess' xs stnum + lookupProcess' [] stnum = Debug.Trace.trace ("Warning Thread #" ++ (show stnum) ++ + " on Machine #" ++ (show sMachine) ++ "is not assigned to a Process: Defaulting to 1") 1+lookupProcess [] sMachine sThread = Debug.Trace.trace ("Warning Thread #" ++ (show sThread) ++ + " on Machine #" ++ (show sMachine) ++ "is not assigned to a Process: Defaulting to 1") 1++--------------------------------------------------------------------------------+-- Legacy Code+--------------------------------------------------------------------------------+++-- legacy code of old haskell EdenTV+-- modified to work with new Tracefile Format+insertEvent :: (Timestamp -> E.Seconds) -> Lookuptable -> (E.MachineID, Event) -> E.OpenEvents -> Bool -> E.OpenEvents+insertEvent convertTimestamp lutable (mId, Event{time, spec}) + oldEvents@(oEvts@(ms,ps,ts),mts,ocMsgs,(minTime,maxTime,nP,maxLD)) ignoreMessages+ | isMsgEvent && ignoreMessages = oldEvents+ | isMsgEvent = newMsgEvents `seq` ((newMs, newPs,ts),mts,newMsgEvents,(minTime,newMax,nP,maxLD)) -- process the event+ | isTrdEvent = let (newTData, mPE) = newTrdEvents+ (newPData, mME) = case mPE of+ [] -> (ps, []) -- no virtual process event+ pe -> insPEventList pe ps -- insert generated process event+ newMData = case mME of+ [] -> ms -- no virtual machine event+ me -> insMEventList mId me ms -- insert generated machine event+ in seq newMData ((newMData, newPData, newTData),mts,ocMsgs,(minTime,newMax,nP,maxLD))+ | isPrcEvent = let (newPData,mME) = newPrcEvents+ newMData = case mME of+ Nothing -> ms -- no virtual machine event+ Just me -> insMEvent mId me ms -- virtual machine event generated+ in seq newMData ((newMData,newPData,ts),mts,newOcMsgs,(minTime,newMax,newNP,maxLD))+ | isMchEvent = let newData = case gcEvents of+ Nothing -> (newMchEvents, ps, ts)+ Just (p,t) -> let newPE = insPeByMID mId p ps+ newTE = insTeByMID mId t ts+ in (newMchEvents, newPE, newTE)+ in seq newData (newData,newMchTimes,ocMsgs,(min',max',nP,maxLD'))+ | otherwise = oldEvents -- ignore unknown events+ where+ (isMsgEvent, newMsgEvents, newMs, newPs) = case spec of+ SendMessage{mesTag=Connect} -> (False, undefined, undefined, undefined) -- ignore+ SendMessage{+ mesTag, + senderProcess, + senderThread, + receiverMachine, + receiverProcess,+ receiverInport} -> (True, createNewMsgEvents + (mId, fromIntegral senderProcess) + (E.OSM (convertTimestamp time) + (fromIntegral receiverMachine, fromIntegral receiverProcess) + (fromIntegral senderThread) + (fromIntegral receiverInport) + (readTag mesTag)),+ nms, nps)+ + ReceiveMessage{+ mesTag,+ receiverProcess,+ receiverInport,+ senderMachine,+ senderProcess,+ senderThread,+ messageSize} -> (True, createNewMsgEvents + (fromIntegral senderMachine, fromIntegral senderProcess)+ (E.ORM (convertTimestamp time) + (mId, fromIntegral receiverProcess)+ (fromIntegral senderThread) + (fromIntegral receiverInport) + (readTag mesTag) + (fromIntegral messageSize)), + nms, nps) + +{- SendReceiveLocalMessage{+ mesTag,+ senderProcess,+ senderThread, + receiverProcess,+ receiverInport} -> trace "insertEvent SRLM (unhandled)" (False, undefined, undefined, undefined) --will be something like (True, newOPenMEssageList, nms, nps)+ --unfinished ... #todo+ -} + _ -> (False, undefined, undefined, undefined)+ + where createNewMsgEvents i event = insertMessage i event ocMsgs+ proc = case spec of SendMessage _ p _ _ _ _ -> fromIntegral p; ReceiveMessage _ p _ _ _ _ _ -> fromIntegral p + (nms, nps) = increaseMsgCount (mId, proc) ms ps spec+ (isTrdEvent,newTrdEvents) = case spec of+ RunThread { + thread } -> (True, newEvents (E.RunThread (convertTimestamp time)))+ AssignThreadToProcess {+ thread, + process} -> (True, newEvents (E.NewThread (convertTimestamp time) (0))) -- #####hack outport? always zero in toSDDF+ StopThread {+ thread,+ status} -> res where + res | status == ThreadFinished = (True, newEvents (E.KillThread (convertTimestamp time))) + | status `elem` blockList = trace (show status) (True, newEvents (E.BlockThread (convertTimestamp time) (0) (E.BlockReason))) -- ####hack inport? reason?+ | otherwise = (True, newEvents (E.SuspendThread (convertTimestamp time)))+ blockList = [ThreadBlocked,BlockedOnMVar,BlockedOnBlackHole,BlockedOnDelay,BlockedOnSTM,+ BlockedOnDoProc,BlockedOnMsgThrowTo,ThreadMigrating,BlockedOnMsgGlobalise,BlockedOnBlackHoleOwnedBy 0]+ WakeupThread {+ thread,+ otherCap} -> (True, newEvents (E.DeblockThread (convertTimestamp time)))+ _ -> (False, undefined)+ where proc = lookupProcess lutable mId thre -- hack+ thre = fromIntegral (thread spec) -- hack+ newEvents evt = insertThreadEvent ((mId, proc), thre) evt ts+ (isPrcEvent,newPrcEvents,newOcMsgs,newNP) = case spec of+ CreateProcess {+ process} -> (True, newEvents (E.NewProcess (convertTimestamp time)), ocMsgs, nP + 1)+ KillProcess {+ process} -> (True, newEvents (E.KillProcess (convertTimestamp time) (0,0,0)), delFromProcList (mId,fromIntegral process) ocMsgs, nP)+ _ -> (False, undefined, undefined, undefined)+ where newEvents evt = insPEvent (mId, fromIntegral (process spec)) evt ps+ + (isMchEvent,newMchEvents,newMchTimes,maxLD',gcEvents) = case spec of+ CreateMachine{} -> (True, newEvents (E.StartMachine (convertTimestamp time)), (mId, convertTimestamp time):mts, maxLD, Nothing)+ Startup{n_caps} -> (True, ms, mts, maxLD, Nothing)+ KillMachine _ -> (True, newEvents (E.EndMachine (convertTimestamp time)), mts, maxLD, Nothing)+ -- JB, WAS: 849 -> + --233 -> (True, newEvents (GCMachine getGCTime v2 v3 v4 v5), mts, max maxLD v5, -- hack todo GC+ -- Just (GCProcess getGCTime v2 v3 v4 v5, GCThread getGCTime v2 v3 v4 v5))+ _ -> (False, undefined, undefined, undefined, undefined)+ where newEvents evt = insMEvent mId evt ms++ -- compute new min/max times:+ newMax = max (convertTimestamp time) maxTime+ (min', max') = if (convertTimestamp time) > maxTime+ then (minTime, (convertTimestamp time))+ else (newMin, maxTime)+ newMin :: E.Seconds+ newMin = min (convertTimestamp time) minTime+ + insMEventList :: E.MachineID -> [E.MachineEvent] -> [E.Machine] -> [E.Machine]+ insMEventList i (m:ms) lst = insMEvent i m (insMEventList i ms lst)+ insMEventList _ _ lst = lst+ + insMEvent :: E.MachineID -> E.MachineEvent -> [E.Machine] -> [E.Machine]+ insMEvent i1 evt lst@(e@(i2,allP,blkP,stat@(p,s,r),evts):es) -- insert in existing list of machines+ | i2 > i1 = let es' = (insMEvent i1 evt es) in seq es' (e : es') -- go on+ | i2 == i1 = let e' = insertHere in seq e' (e' : es) -- existing machine+ | otherwise = (i1,0,0,(0,0,0),[evt]) : lst -- new machine => no processes+ where insertHere = case evt of+ E.MSuspendProcess sec -> let newEvts = case head evts of+ E.SuspendedMachine _ -> evts+ _ -> (E.SuspendedMachine sec):evts+ in (i2,allP,blkP,stat,newEvts)+ E.MRunProcess sec -> (i2,allP,blkP,stat,(E.RunningMachine sec):evts)+ E.MBlockProcess sec -> let newBlkP = blkP + 1+ newEvts = if newBlkP < allP+ then (E.SuspendedMachine sec):evts+ else (E.BlockedMachine sec):evts+ in (i2,allP,newBlkP,stat,newEvts)+ E.GCMachine _ _ _ _ _ -> (i2,allP,blkP,stat,evt:evts)+ E.MNewProcess sec -> let newAllP = allP + 1+ newEvts = if blkP == allP -- test if evt may be skipped:+ then (E.SuspendedMachine sec):evts+ else evts+ in (i2,allP + 1,blkP,(p+1,s,r),newEvts)+ E.MKillRProcess sec -> let newAllP = allP - 1+ newEvts = if newAllP > 0+ then (E.SuspendedMachine sec):evts+ else (E.IdleMachine sec):evts+ in (i2,newAllP,blkP,stat,newEvts)+ E.MKillSProcess sec -> let newAllP = allP - 1+ newEvts = if newAllP > 0+ then evts+ else (E.IdleMachine sec):evts+ in (i2,newAllP,blkP,stat,newEvts)+ E.MKillBProcess sec -> let newAllP = allP - 1+ newBlkP = blkP - 1+ newEvts = if newAllP > 0 + then evts + else (E.IdleMachine sec):evts+ in (i2,newAllP,newBlkP,stat,newEvts)+ E.MIdleProcess sec -> let newEvts = case head evts of+ E.SuspendedMachine _ -> evts+ _ -> (E.SuspendedMachine sec):evts+ in (i2,allP,blkP,stat,newEvts)+ E.EndMachine _ -> (i2,0,0,stat,evt:evts)+ _ -> error ("insMEvent: unknown event: " ++ show evt)+ insMEvent i1 evt [] = [(i1,0,0,(0,0,0),[evt])] -- brand new machine => no processes+ + insPEventList :: [(E.ProcessID,E.ProcessEvent)] -> [E.Process] -> ([E.Process],[E.MachineEvent])+ insPEventList ((i,p):ps) lst = let (ps',mes) = insPEventList ps lst+ (lst',me) = insPEvent i p ps'+ in case me of+ Nothing -> (lst',mes)+ Just me -> (lst',me:mes)+ insPEventList _ lst = (lst,[])+ + insPeByMID :: E.MachineID -> E.ProcessEvent -> [E.Process] -> [E.Process]+ insPeByMID i evt lst@(e@((m,_),_,_,_,_):es)+ | i == m = insertHere lst -- first process on machine i found, insert event+ | otherwise = let es' = insPeByMID i evt es in seq es' (e:es') -- search on+ where insertHere lst@(e@(i'@(m,_),a,b,s,evts):es)+ | i == m = let es' = insertHere es in case take 1 evts of+ [E.KillProcess _ _] -> seq es' ( e : es') -- process not alive+ [E.BlockedProcess _] -> seq es' ((i',a,b,s,(E.BlockedProcess (convertTimestamp time):evt:evts)):es')+ [E.SuspendedProcess _] -> seq es' ((i',a,b,s,(E.SuspendedProcess (convertTimestamp time):evt:evts)):es')+ _ -> seq es' ((i',a,b,s,evt:evts) : es') -- not possible?+ | otherwise = lst -- all processes on machine i worked up+ insertHere [] = []+ + insPEvent :: E.ProcessID -> E.ProcessEvent -> [E.Process] -> ([E.Process],Maybe E.MachineEvent)+ insPEvent i1 evt lst@(e@(i2,allT,blkT,stat@(t,s,r),evts):es)+ | i1 < i2 = let (es',mEvt) = insPEvent i1 evt es in seq es' (seq mEvt (e : es', mEvt))+ | i1 == i2 = (insertHere : es, vMachineEvent) {- case evt of -- a new entry for every new process+ NewProcess sec -> ((i1,0,0,(0,0,0),[evt]):lst, Just (MNewProcess time))+ _ -> (insertHere : es, vMachineEvent) -}+ | otherwise = ((i1,0,0,(0,0,0),[evt]):lst,Just (E.MNewProcess (convertTimestamp time))) -- new Process => evt == NewProcess+ where (insertHere,vMachineEvent) = case evt of+ E.PNewThread sec -> let newAllT = allT + 1+ in if blkT == allT -- was Process blocked?+ then ((i1,newAllT,blkT,(t+1,s,r),(E.SuspendedProcess sec):evts), Just (E.MSuspendProcess sec))+ else ((i1,newAllT,blkT,(t+1,s,r),evts),Nothing)+ E.PKillRThread sec -> let newAllT = allT - 1+ (newEvts,newMEvt) = if newAllT > 0+ then if blkT < newAllT+ then ((E.SuspendedProcess sec):evts, Just (E.MSuspendProcess sec))+ else ((E.BlockedProcess sec):evts, Just (E.MBlockProcess sec))+ else case evts of+ (E.KillProcess _ _:_) -> (evts, Nothing)+ _ -> ((E.IdleProcess sec):evts, Just (E.MIdleProcess sec))+ in ((i1,newAllT,blkT,stat,newEvts),newMEvt)+ E.PKillSThread sec -> let newAllT = allT - 1+ (newEvts,newMEvt) = if newAllT > 0+ then if blkT < newAllT+ then (evts, Nothing)+ else ((E.BlockedProcess sec):evts, Just (E.MBlockProcess sec))+ else case evts of+ (E.KillProcess _ _:_) -> (evts, Nothing)+ _ -> ((E.IdleProcess sec):evts, Just (E.MIdleProcess sec))+ in ((i1,newAllT,blkT,stat,newEvts), newMEvt)+ E.PKillBThread sec -> let newAllT = allT - 1+ newBlkT = blkT - 1+ (newEvts,newMEvt) = if newAllT > 0+ then (evts, Nothing)+ else case evts of+ (E.KillProcess _ _:_) -> (evts, Nothing)+ _ -> ((E.IdleProcess sec):evts, Just (E.MIdleProcess sec))+ in ((i1,newAllT,newBlkT,stat,newEvts), newMEvt)+ E.PRunThread sec -> ((i1,allT,blkT,stat,(E.RunningProcess sec):evts),Just (E.MRunProcess sec))+ E.PSuspendThread sec -> ((i1,allT,blkT,stat,(E.SuspendedProcess sec):evts), Just (E.MSuspendProcess sec))+ E.PBlockThread sec -> let newBlkT = blkT + 1+ (newEvts,newMEvt) = if newBlkT < allT+ then ((E.SuspendedProcess sec):evts,Just (E.MSuspendProcess sec))+ else ((E.BlockedProcess sec):evts,Just (E.MBlockProcess sec))+ in ((i1,allT,newBlkT,stat,newEvts),newMEvt)+ E.PDeblockThread sec -> let newBlkT = blkT - 1+ (newEvts,newMEvt) = if newBlkT < allT -- was process blocked?+ then ((E.SuspendedProcess sec):evts,Just (E.MSuspendProcess sec))+ else (evts,Nothing)+ in ((i1,allT,newBlkT,stat,newEvts),newMEvt)+ E.NewProcess sec -> ((i1,0,0,(t,s,r),(evt:evts)),Just (E.MNewProcess sec))+ E.LabelProcess sec _ -> ((i1,allT,blkT,stat,evt:evts),Nothing)+ -- KillProcess holds the statistic information for the ending process+ E.KillProcess sec _ -> let evt' = E.KillProcess sec (t,s,r) + in case evts of+ (E.RunningProcess _:_) -> ((i1,0,0,(0,0,0),(evt':evts)),Just (E.MKillRProcess sec))+ (E.BlockedProcess _:_) -> ((i1,0,0,(0,0,0),(evt':evts)),Just (E.MKillBProcess sec))+ _ -> ((i1,0,0,(0,0,0),(evt':evts)),Just (E.MKillSProcess sec))+ _ -> error ("unknown event: " ++ show evt)+ insPEvent i1 evt [] = ([(i1,0,0,(0,0,0),[evt])],Just (E.MNewProcess (convertTimestamp time))) -- new Process => evt == NewProcess++ insTeByMID :: E.MachineID -> E.ThreadEvent -> [E.OpenThread] -> [E.OpenThread]+ insTeByMID i evt lst@(e@(m,(lti,lte),ts):es)+ | i == m = (m,(((m,-1),-1),evt),insertHere ts):es -- machine i found, insert event into threads; the ((m,-1),-1)+ -- inserts 'evt' the next time insTEvent is run.+ | otherwise = let es' = insTeByMID i evt es in seq es' (e:es') -- search on+ where insertHere (l@(i,evts):ls) = let ls' = insertHere ls+ in case take 1 evts of+ -- skip already killed threads:+ [E.KillThread _] -> seq ls' (l:ls') -- Thread already dead+ -- The following entry describes the last suspended thread. The SuspendThread-event hasn't yet+ -- been inserted, it resides in 'lte':+ [E.RunThread _] -> seq ls' ((i,E.setEventTime lte (convertTimestamp time):evt:lte:evts):ls')+ -- other threads are blocked or suspended:+ [lastEvent] -> seq ls' ((i,E.setEventTime lastEvent (convertTimestamp time):evt:evts):ls')+ insertHere [] = []++ insertThreadEvent :: E.ThreadID -> E.ThreadEvent -> [E.OpenThread] -> ([E.OpenThread], [(E.ProcessID,E.ProcessEvent)])+ insertThreadEvent i@((m,_),_) evt tl@(t@(im,(lti,lte),ts):tls)+ | m < im = let (tls', pEvt') = insertThreadEvent i evt tls -- look for corresponding machine+ in seq tls' (seq pEvt' (t:tls',pEvt')) -- recurse+ | m == im = case lte of+ E.SuspendThread _ -> case evt of+ E.RunThread _ -> if i == lti+ then ((im,(i,E.DummyThread),ts):tls,[]) -- suppress flattering+ else bothEvents+ _ -> bothEvents+ E.DummyThread -> case evt of+ E.SuspendThread _ -> ((im,(i,evt),ts):tls, []) -- deter SuspendThread-Event+ _ -> let (ts',pEvt') = insTEvent' i evt ts in ((im,(i,E.DummyThread),ts'):tls,[(t2pID i,pEvt')])+ otherwise -> insertThreadEvent i evt tls + | otherwise = ((m,(i,E.DummyThread),[(i,[evt])]):tl,[(t2pID i,vProcessEvent evt [])]) -- new machine+ where bothEvents = let (ts2,pEvt2) = insTEvent' lti lte ts+ (ts3,pEvt3) = insTEvent' i evt ts2+ in ((im,(i,E.DummyThread),ts3):tls,[(t2pID i,pEvt3),(t2pID lti,pEvt2)])+ insertThreadEvent i@((m,_),_) evt [] = ([(m,(i,E.DummyThread),[(i,[evt])])],[(t2pID i,vProcessEvent evt [])])++ insTEvent' :: E.ThreadID -> E.ThreadEvent -> [E.Thread] -> ([E.Thread],E.ProcessEvent)+ insTEvent' i@((m,_),t) ne lst@(e@(ib@((im,_),it),evts):es)+ | i' < ib' = let (es', mEvt') = (insTEvent' i ne es) in seq es' (seq mEvt' (e:es',mEvt'))+ | i' == ib' = ((i,(ne:evts)):es, vProcessEvent ne evts)+ | otherwise = ((i,[ne]):lst,vProcessEvent ne evts)+ where+ i' = (m,t)+ ib' = (im,it)+ insTEvent' i evt _ = ([(i,[evt])],vProcessEvent evt [])+ + vProcessEvent :: E.ThreadEvent -> [E.ThreadEvent] -> E.ProcessEvent+ vProcessEvent evt evts = case evt of+ E.KillThread sec -> case evts of+ (E.BlockThread _ _ _:_) -> E.PKillBThread sec+ (E.RunThread _ :_) -> E.PKillRThread sec+ _ -> E.PKillSThread sec+ E.RunThread sec -> E.PRunThread sec+ E.SuspendThread sec -> E.PSuspendThread sec+ E.BlockThread sec _ _ -> E.PBlockThread sec+ E.DeblockThread sec -> E.PDeblockThread sec+ E.NewThread _ _ -> E.PNewThread (convertTimestamp time)++ + +++increaseMsgCount :: E.ProcessID -> [E.Machine] -> [E.Process] -> + EventInfo -> ([E.Machine], [E.Process])+increaseMsgCount pID@(mID,_) ml pl spec = (incM ml, incP pl)+ where incM :: [E.Machine] -> [E.Machine]+ incM (m@(i, aP, bP, (p,s,r), es):ms)+ | i > mID = m : incM ms -- go on+ | i == mID = case spec of+ SendMessage _ _ _ _ _ _ -> ((i, aP, bP, (p, s+1, r), es):ms)+ ReceiveMessage _ _ _ _ _ _ _ -> ((i, aP, bP, (p, s, r+1), es):ms)+ SendReceiveLocalMessage {} -> ((i, aP, bP, (p, s+1, r+1), es):ms)+ otherwise -> m:ms -- should not occur+ | otherwise = m:ms -- not found? nevermind...+ incM _ = []+ incP :: [E.Process] -> [E.Process]+ incP (p@(i,aT,bT,(t,s,r),es):ps)+ | i > pID = p : incP ps+ | i == pID = case spec of+ SendMessage _ _ _ _ _ _ -> ((i, aT, bT, (t, s+1, r), es):ps)+ ReceiveMessage _ _ _ _ _ _ _ -> ((i, aT, bT, (t, s, r+1), es):ps)+ SendReceiveLocalMessage {} -> ((i, aT, bT, (t, s+1, r+1), es):ps)+ otherwise -> p:ps -- should not occur+ | otherwise = p:ps -- not found? nevermind...+ incP _ = [] +++newProc :: E.ProcessID -> E.ProcessID -> E.ProcessList -> E.ProcessTree -> (E.ProcessList, E.ProcessTree)+newProc dad son pls pt = (addProcPath son (dadPath) pls, addChildPrc son dadPath pt)+ where dadPath = []--TODO getPath dad pls ++ [dad]+ getPath :: E.ProcessID -> E.ProcessList -> [E.ProcessID]+ getPath pId (p@(i,path):ps)+ | i < pId = getPath pId ps+ | i == pId = path+ | otherwise = error ("not impl: getPath, otherwise " ++ (show son) ++ " " ++ show (pId,pls))+ getPath _ _ = []++addProcPath :: E.ProcessID -> [E.ProcessID] -> E.ProcessList -> E.ProcessList+addProcPath pId path pls@(p@(i,lst):ps)+ | i < pId = let ps' = addProcPath pId path ps in seq ps' (p:ps')+ | i == pId = (pId,path) : ps+ | otherwise = (pId,path) : pls+addProcPath pId path _ = [(pId, path)]++addChildPrc :: E.ProcessID -> [E.ProcessID] -> E.ProcessTree -> E.ProcessTree+addChildPrc pId [p] (Node i pts) = Node i ((Node pId []):pts)+addChildPrc pId path@(p:ps) pt@(Node i pts)+ | p == i = let pts' = stepDown ps pts in seq pts' (Node i pts')+ | otherwise = error ("addChildPrc: wrong ProcessTree found (" ++ show p ++ "!=" ++ show i ++ ")")+ where stepDown :: [E.ProcessID] -> [E.ProcessTree] -> [E.ProcessTree]+ stepDown path@(p:ps) pts@(t@(Node i _):ts)+ | i == p = let t' = addChildPrc pId path t in seq t' (t':ts)+ | otherwise = let ts' = stepDown path ts in seq ts' (t:ts')+ stepDown path [] = seq (putStrLn ("stepDown: path " ++ show path ++ " not found in Process Tree:" ++ show pt)) []+addChildPrc pId [] pt = pt ++delFromProcList :: E.ProcessID -> E.OpenMessageList -> E.OpenMessageList+delFromProcList pId oml = oml+++++++insertMessage :: E.ProcessID -> E.OpenMessageEvent -> E.OpenMessageList -> E.OpenMessageList+insertMessage sp newMessage ocMsgs@(openMsgList,closedMessages,partMsgs@(openPrcMsgs,prcTbl,prcTree),(headMessages,hSize,closedHeads))+ | tag == E.Head = let ohl' = addHeadMsg (sp, out, rp, inp) headMessages+ in seq ohl' (openMsgList, closedMessages, partMsgs,(ohl', hSize, closedHeads))+ | tag == E.DataMes = let (ohl,chl,hs') = searchHeadMsg (sp,out,rp,inp) headMessages+ in cml `seq` chl `seq` (oml,cml,partMsgs,(ohl,max hs' hSize,chl))+ | tag == E.RFork = ocMsgs+ | otherwise = let ((_,sp'),(_,rp')) = (sp,rp)+ in if (min sp' rp') >= 0+ then seq oml (seq cml (oml,cml,partMsgs,(headMessages,hSize,closedHeads)))+ else ocMsgs+ where (time, rp@(rm,_),out,inp,tag,size) = case newMessage of+ E.ORM t p o i r s -> (t,p,o,i,r,s)+ E.OSM t p o i r -> (t,p,o,i,r,0)+ (oml,cml) = searchID sp newMessage openMsgList closedMessages+ + addHeadMsg :: E.ChannelID -> [E.OpenHeadMessage] -> [E.OpenHeadMessage]+ addHeadMsg cId hml@(h@(idB,s,i,hsm,hrm):hs)+ | cId > idB = let hs' = addHeadMsg cId hs in seq hs' (h:hs') -- not found yet: search on+ | cId == idB = case newMessage of+ E.ORM _ _ _ _ _ _ -> case hrm of -- entry found, increase quantity and size+ [firstMsg] -> (idB,(s+size),(i+1),hsm,time:hrm):hs -- second received Message+ (lastMsg:fm) -> (idB,(s+size),(i+1),hsm, time:fm):hs -- replace last received Message+ [] -> (idB,(s+size),(i+1),hsm, [time] ):hs -- first received Message+ E.OSM _ _ _ _ _ -> case hsm of -- entry found, don't touch values+ [firstMsg] -> (idB,s,i,time:hsm,hrm):hs+ (lastMsg:fm) -> (idB,s,i,time:fm ,hrm):hs+ [] -> (idB,s,i, [time] ,hrm):hs+ | otherwise = case newMessage of+ E.ORM _ _ _ _ _ _ -> (cId,size,1,[],[time]):hml -- insert new entry before h+ E.OSM _ _ _ _ _ -> (cId,size,0,[time],[]):hml+ addHeadMsg cId [] = case newMessage of+ E.ORM _ _ _ _ _ _ -> [(cId,size,1,[],[time])]+ E.OSM _ _ _ _ _ -> [(cId,size,0,[time],[])]+ + searchHeadMsg :: E.ChannelID -> [E.OpenHeadMessage] -> ([E.OpenHeadMessage],[E.HeadMessage],Double)+ searchHeadMsg cId hml@(h@(idB,s,i,hsm,hrm):hs)+ | cId > idB = let (hs',ch',ms') = searchHeadMsg cId hs+ in seq hs' (seq ch' (h:hs',ch',ms'))+ | cId == idB = let sInt = s + size+ sDouble = fromIntegral sInt+ in case newMessage of+ E.ORM _ _ _ _ _ _ ->+ if length hsm == 3+ then (hs, (cId,(ts1,tr1,ts2,time),sDouble,(i+1)):closedHeads, sDouble)+ else ((idB,sInt,(i+1),hsm,time:hrm):hs,closedHeads,sDouble)+ E.OSM _ _ _ _ _ ->+ if length hrm == 3+ then (hs, (cId,(ts1,tr1,time,tr2),sDouble,i):closedHeads,sDouble)+ else ((idB,s,i,time:hsm,hrm):hs,closedHeads,sDouble)+ | otherwise = (hml,closedHeads,0)+ where ts2 = head hsm+ ts1 = last hsm+ tr2 = head hrm+ tr1 = last hrm+ searchHeadMsg cId [] = ([], closedHeads,0)+++-- insertClosedMessage :: Message -> OpenMessage -> OpenMessageList+-- insertClosedMessage m@(SendReceiveLocalMessage {}) (openMsgList,closedMessages,partMsgs,(headMessages,hSize,closedHeads)) = todo+++closeOpenLists :: E.OpenEvents -> E.Events+closeOpenLists (events@(mEvents,pEvents,tEvents),mTimes,(_,closedMessages,(_,_,Node _ pTrees),(openHeadMessages,hSize,headMessages)),(minTime,maxTime,numP,maxLD)) =+ seq mEvents (seq minTime (seq allHeadMessages+ ((mEvents,pEvents,newThreadEvents),mTimes,undefined,(closedMessages,[],allHeadMessages,reversedProcTree, []),+ (minTime,maxTime,0,hSize,(fromIntegral maxLD)),(length mEvents,numP,length newThreadEvents))))+ where allHeadMessages = handleOpenHeadMsgs openHeadMessages headMessages+ newThreadEvents = concat (map (\(_,_,ts) -> ts) tEvents)+ reversedProcTree :: E.ProcessTree+ reversedProcTree = if null pTrees+ then Node (0,0) []+ else reverseSubForests (head pTrees)+ reverseSubForests :: E.ProcessTree -> E.ProcessTree+ reverseSubForests (Node i f) = Node i (map reverseSubForests (reverse f))+ handleOpenHeadMsgs :: [E.OpenHeadMessage] -> [E.HeadMessage] -> [E.HeadMessage]+ handleOpenHeadMsgs [] hm = hm+ handleOpenHeadMsgs ((ch,s,i,sml,rml):os) hm = case zip sml rml of+ ((lst',lrt'):(fst',frt'):_) -> handleOpenHeadMsgs os ((newHeadMsg fst' frt' lst' lrt'):hm)+ _ -> handleOpenHeadMsgs os hm+ where newHeadMsg :: E.Seconds -> E.Seconds -> E.Seconds -> E.Seconds -> E.HeadMessage+ newHeadMsg tS1 tR1 tS2 tR2 = (ch,(tS1,tR1,tS2,tR2),fromIntegral s,i)++ +t2pID :: E.ThreadID -> E.ProcessID+t2pID tid = fst tid+++instance Eq ThreadStopStatus where+ NoStatus == NoStatus = True+ NoStatus == _ = False+ HeapOverflow == HeapOverflow = True+ HeapOverflow == _ = False+ StackOverflow == StackOverflow = True+ StackOverflow == _ = False+ ThreadYielding == ThreadYielding = True+ ThreadYielding == _ = False+ ThreadBlocked == ThreadBlocked = True+ ThreadBlocked == _ = False+ ThreadFinished == ThreadFinished = True+ ThreadFinished == _ = False+ ForeignCall == ForeignCall = True+ ForeignCall == _ = False+ BlockedOnMVar == BlockedOnMVar = True+ BlockedOnMVar == _ = False+ BlockedOnBlackHole == BlockedOnBlackHole = True+ BlockedOnBlackHole == _ = False+ BlockedOnRead == BlockedOnRead = True+ BlockedOnRead == _ = False+ BlockedOnWrite == BlockedOnWrite = True+ BlockedOnWrite == _ = False+ BlockedOnDelay == BlockedOnDelay = True+ BlockedOnDelay == _ = False+ BlockedOnSTM == BlockedOnSTM = True+ BlockedOnSTM == _ = False+ BlockedOnDoProc == BlockedOnDoProc = True+ BlockedOnDoProc == _ = False+ BlockedOnCCall == BlockedOnCCall = True+ BlockedOnCCall == _ = False+ BlockedOnCCall_NoUnblockExc == BlockedOnCCall_NoUnblockExc = True+ BlockedOnCCall_NoUnblockExc == _ = False+ BlockedOnMsgThrowTo == BlockedOnMsgThrowTo = True+ BlockedOnMsgThrowTo == _ = False+ ThreadMigrating == ThreadMigrating = True+ ThreadMigrating == _ = False+ BlockedOnMsgGlobalise == BlockedOnMsgGlobalise = True+ BlockedOnMsgGlobalise == _ = False+ (BlockedOnBlackHoleOwnedBy _) == (BlockedOnBlackHoleOwnedBy _) = True+ (BlockedOnBlackHoleOwnedBy _) == _ = False
+ RTSEventsParserOld.lhs view
@@ -0,0 +1,1009 @@+EdenTV Project.++The Haskell-based viewer. Port to new GHC events.++\begin{code}+{-# OPTIONS -XNamedFieldPuns #-}+module RTSEventsParserOLD where+import Text.Printf+import qualified EdenTvType as E+import GHC.RTS.Events++import TinyZipper++import Data.Binary.Get+import Control.Monad+import Control.Monad.Error+import Data.ByteString.Lazy (ByteString)+import System.IO.Unsafe (unsafePerformIO)++import Control.Monad+import Control.Monad.State++import Data.Maybe+--import Data.IntMap (IntMap)+--import qualified Data.IntMap as M++import Data.Either+import Data.Tree+import List+import qualified Data.HashMap as Hash++import qualified Control.Exception as C++import Debug.Trace++data Err a = Ok !a | Failed String++\end{code}++----------------------------------+--+-- Reader function+--+----------------------------------++We mimic the behaviour of the original reader function @toEvents@.++-- TraceParser.hs+data Err a = Ok !a | Failed String+toEvents :: [Char] -> Err Events+toEvents [] = Failed "File empty"+toEvents ts = Ok ...++-- EdenTvTypes.hs+type Events = (([Machine],[Process],[Thread]),[(MachineID,Double)],MessageList,(Seconds,Seconds,Double,Double),(Int,Int,Int))+-- loM loP loT machine starttimes msgs/heads min_t max_t maxMsgSize MaxLD #M #P #T++oh my...++------------------------------------++We need to read events from a bytestring!++-- GHC.RTS.Events says:+readEventLogFromFile :: FilePath -> IO (Either String EventLog)+readEventLogFromFile f = do+ s <- L.readFile f+ return $ runGet (do v <- runErrorT $ getEventLog+ m <- isEmpty+ m `seq` return v) s+\begin{code}+readGhcEventsSingle :: ByteString -> IO (Either String EventLog)+readGhcEventsSingle s = return $ runGet (do v <- runErrorT $ getEventLog+ m <- isEmpty+ m `seq` return v) $ s+\end{code}++Now we can read events from a bytestring!++\begin{code}+type RTSEvents = (E.MachineID, [Event])++readOne :: EventLog -> Either String RTSEvents+readOne evtlog = let ghcevents = map ce_event $ sortEvents (events $ dat evtlog)+ mID = getMachineID ghcevents+ in either (\err -> Left err) (\id -> Right (id, ghcevents)) mID+ where getMachineID :: [Event] -> Either String E.MachineID+ getMachineID ((Event{time, spec=CreateMachine{machine}}):_) = + Right $ fromIntegral machine+ getMachineID (_:xs) = getMachineID xs+ getMachineID [] = Left "readSingle: No Create Machine Event found"+\end{code}++As we can read events from a single stream, we can also read multiple event +files from a zip archive+\begin{code}+readAll :: FilePath -> IO (Either String [RTSEvents])+readAll zippath = do+ files' <- readZip zippath + either (\err -> return $ Left err)+ (\files -> do+ eventlogs <- sequence $ map readGhcEventsSingle files+ let (errparse, logs) = partitionEithers eventlogs+ case null errparse of+ True -> do + let (errevts, events) = partitionEithers $ map readOne logs+ case null errevts of+ False -> return $ Left "readAll: Events error"+ True -> return $ Right events+ False -> return $ Left "readAll: Parse error")+ files' +++{-+We need to catch Exceptions here, because getEventLog (GHC.RTS.Events) uses Lazy Bytestrings and+non-strict Get!+-}+parseRawFile :: FilePath -> IO (Either String [RTSEvents])+parseRawFile zipfile = C.catch (readAll zipfile) catchBadFile+ where catchBadFile :: C.SomeException -> IO (Either String [RTSEvents]) + catchBadFile e = return (Left "Parse: Bad File") ++\end{code}++we want to know how long a message was processed+- when an EdenStartReceive Event is found we store the startTime and go on searching+ for received Messages in this block, until the matching EdenEndReceive Event is found.+- for each process found in this block we store the process id and receive time, so that we can+ seperate the blocks in Process view+\begin{code}+getReceiveLengths :: [(E.MachineID, Double)] -> [(E.MachineID, [Event])] -> [E.ReceiveLength]+getReceiveLengths syncTimes ((mID, events):otherMachines) = (process mID events) ++ (getReceiveLengths syncTimes otherMachines)+ where process :: E.MachineID -> [Event] -> [((E.MachineID,[(Int,E.Seconds)]), E.Seconds, E.Seconds)]+ process mID (event:events) = case (spec event) of+ EdenStartReceive -> case endT of+ (-1) -> process mID events -- skip faulty (no EdenEndReceive Event found)+ _ -> ((mID, pID), startT, endT) : (process mID events) -- block ok, store and do next+ where pID = getProcessID events -- scan for receiving processes and their receive times+ startT = convertTimestampWithSync (toSyncTime syncTimes mID) (time event)+ endT = getEndTime events+ getEndTime :: [Event] -> E.Seconds+ getEndTime (event:events) = case (spec event) of+ EdenEndReceive -> convertTimestampWithSync (toSyncTime syncTimes mID) (time event)+ _ -> getEndTime events+ getEndTime [] = (-1)+ eventTime e = convertTimestampWithSync (toSyncTime syncTimes mID) (time e)+ getProcessID :: [Event] -> [(Int,E.Seconds)]+ getProcessID (event:events) = case (spec event) of+ ReceiveMessage RFork _ _ _ _ _ _ -> getProcessID events+ CreateProcess p -> (fromIntegral p, eventTime event) : (getProcessID events)+ ReceiveMessage _ _ _ _ _ _ _ -> (fromIntegral $ receiverProcess (spec event), eventTime event) : (getProcessID events)+ EdenEndReceive -> []+ _ -> getProcessID events+ getProcessID [] = []+ _ -> process mID events+ process _ [] = []+getReceiveLengths _ [] = []++\end{code}+time in the tracefile is stored in ticks, which are not comparable between machines.+to match times between traces we calculate a realtime offset for each machine,+stored in a (ID,Seconds) List++This helper function retrieves the realtime offset for a given machine id.+\begin{code}+toSyncTime :: [(E.MachineID, Double)] -> E.MachineID -> Double+toSyncTime ((mId, t):machines) i+ | mId == i = t+ | otherwise = toSyncTime machines i+toSyncTime [] _ = 0+++\end{code}++Now we need to create the Eden Events structure.+For this we insert the events one by one into the Structure,+until all Events are processed.++\begin{code}++traceRTSFile :: FilePath -> IO (Err E.Events)+traceRTSFile file = do+ ghcevents' <- parseRawFile file+ case ghcevents' of+ Left err -> return (Failed err)+ Right ghcevents -> do+ return (Ok injectedEvents)+ where + -- insert events in final structure and close open messages+ processedEvents = closeOpenLists $ process ghcevents emptyoe + -- inject additional information+ injectedEvents = injectLOMessages leftMessages $ injectProcMessages $ injectMaxStartupDifference (maxStartupDifference maxEnd) $ injectStartupDifferences diffStartups $ injectReceiveTimes rcvTimes processedEvents + ------------------------------+ -- 'additional information' --+ ------------------------------++ leftMessages = snd (processLeftOvers ghcevents ([],[]))++ -- startup differences -- used for 'better aligning' machines+ diffStartups = startupDifferences ghcevents (maxStartupTimeOfTrace ghcevents)+ + -- receive length -- used to draw small rectangles to show how long it took to receive a message + rcvTimes = getReceiveLengths syncTimes ghcevents+ + -- used for rescaling of x-axis when we align to startup times+ endTimes = endTimesOfTrace ghcevents + maxEnd = getMaxEndTime processedEvents++ -- tracefile only contains timestamp with 'TICKS' of local machine+ -- we use this table to convert TICKS to global time+ syncTimes = getSyncTimes (mainTimeOfTrace ghcevents) ghcevents+ + -- we need to store to which process a thread belongs+ luptable = createThreadLookupTable ghcevents++ -- from old haskell EdenTV+ -- initial events structure+ emptyoe = (([],[],[]),[(0,firstTime)], fml firstTime, (firstTime, firstTime, 0, -1))+ where firstTime = minCreateMachineTimeOfTrace ghcevents++ getMaxEndTime ((lom,lop,lot),mst, maxSt, rcv,(min_t, m_t,_,mmsg,mld),nums) = m_t+++ -- mainTime is the realtime of the first machine+ mainTimeOfTrace :: [(E.MachineID, [Event])] -> Double+ mainTimeOfTrace ((1,machine):machines) = realtimeOfMachine machine+ mainTimeOfTrace (_:machines) = mainTimeOfTrace machines+ mainTimeOfTrace [] = 0+ + -- syncTimes are the offset of machine-realtimes to the 'mainTime'+ getSyncTimes :: Double -> [(E.MachineID, [Event])] -> [(E.MachineID, Double)]+ getSyncTimes mainTime ((mID,evts):machines) = ((mID,t): (getSyncTimes mainTime machines))+ where t = (realtimeOfMachine evts) - mainTime+ getSyncTimes _ [] = []+ + -- injects the max startup difference time into the final Events structure+ -- needed because insertEvent doesn't cover startup difference times+ injectMaxStartupDifference :: E.Seconds -> E.Events -> E.Events+ injectMaxStartupDifference time ((lom,lop,lot),mst, maxSt, rcv,(min_t, m_t,_,mmsg,mld),nums) = ((lom,lop,lot),mst,maxSt,rcv,(min_t,m_t,time,mmsg,mld),nums) ++ -- the maximal difference of startup times+ -- used to re-calculate the latest time of all events+ maxStartupDifference :: E.Seconds -> E.Seconds+ maxStartupDifference maxE = let difftimes = zipWith (\(_, diffs) (_,end) -> if diffs + end > maxE then (diffs+end)-maxE else 0) (snd diffStartups) endTimes+ in seq difftimes $ maximum difftimes++ -- times of last event of all machines+ endTimesOfTrace :: [(E.MachineID, [Event])] -> [(E.MachineID, E.Seconds)]+ endTimesOfTrace evts = map endTime evts+ where endTime (mID, evt) = (mID, convertTimestampWithSync (toSyncTime syncTimes mID) $ time $ last evt)++ + -- injects the receive times into the final Events structure+ -- needed because insertEvent doesn't cover receive times+ injectReceiveTimes :: [E.ReceiveLength] -> E.Events -> E.Events+ injectReceiveTimes inj ((lom,lop,lot),mst, maxSt, (ml,aml,hml,pt, _ ),stats,nums) = ((lom,lop,lot),mst,maxSt,(ml,aml,hml,pt, inj ),stats,nums)++ -- injects the left out Head Messages+ -- needed because insertEvent throws them away+ injectLOMessages :: [E.Message] -> E.Events -> E.Events+ injectLOMessages inj ((lom,lop,lot),mst, maxSt, (ml,_,hml,pt, rcvl ),stats,nums) = ((lom,lop,lot),mst,maxSt,(ml,inj,hml,pt, rcvl ),stats,nums)+ + -- injects the startup differences into the final Events structure+ -- needed because insertEvent doesn't cover startup differences+ injectStartupDifferences :: (E.Seconds,[(Int,E.Seconds)]) -> E.Events -> E.Events+ injectStartupDifferences inj ((lom,lop,lot),mst, _ ,(ml,aml,hml,pt, rcvl ),stats,nums) = ((lom,lop,lot),mst, inj,(ml,aml,hml,pt, rcvl ),stats,nums)+ ++ -- builds startup differences table of a trace+ -- trace -> maxStartupTime of Trace -> (maxStartupTime, diffTable)+ startupDifferences :: [(E.MachineID, [Event])] -> E.Seconds -> (E.Seconds, [(Int,E.Seconds)])+ startupDifferences ((mId,evts):machines) maxS = let s = convertTimestampWithSync (toSyncTime syncTimes mId) (startupTimestampOfMachine evts)+ in seq s (maxS,((mId,(maxS-s)): (startupDifferences' machines maxS)))+ where startupDifferences' ((mId,evts):machines) maxS = let s = convertTimestampWithSync (toSyncTime syncTimes mId) (startupTimestampOfMachine evts)+ in seq s ((mId,(maxS-s)): (startupDifferences' machines maxS))+ startupDifferences' [] _ = []+ startupDifferences [] _ = (0,[])+ + + -- from old haskell EdenTV+ -- creates initial MessageList+ fml :: E.Seconds -> E.OpenMessageList+ fml t = ([],[],([(1,[((1,1),E.OSM t (0,0) (-1) (-1) 85)],[((0,0),E.ORM t (1,1) (-1) (-1) 85 4)],[])],[((0,0),[])],Node (0,0) []),([],0,[]))+ + -- determines the earliest CreateMachine time from all Machines -- which is equivalent with the earliest event time+ minCreateMachineTimeOfTrace :: [(E.MachineID, [Event])] -> E.Seconds+ minCreateMachineTimeOfTrace = minimum . map (\(mID, machine) -> convertTimestampWithSync (fromMaybe 0 $ lookup mID syncTimes) (createmachineTimestampOfMachine machine))+ + -- determines the latest Startup time from all Machies+ maxStartupTimeOfTrace :: [(E.MachineID, [Event])] -> E.Seconds+ maxStartupTimeOfTrace = maximum . map (\(mID, machine) -> convertTimestampWithSync (fromMaybe 0 $ lookup mID syncTimes) (startupTimestampOfMachine machine))+ + -- extracts the CreateMachine Timestamp of a list of all Machine Events+ createmachineTimestampOfMachine :: [Event] -> Timestamp+ createmachineTimestampOfMachine ((Event {time, spec=CreateMachine{}}):xs) = time+ createmachineTimestampOfMachine (_:xs) = createmachineTimestampOfMachine xs+ createmachineTimestampOfMachine _ = error "No Machine created"++ -- extracts the realtime of a list of all Machine Events+ realtimeOfMachine :: [Event] -> Double+ realtimeOfMachine ((Event {time, spec=CreateMachine{realtime}}):xs) = ((fromIntegral realtime)/10e7)-((fromIntegral time) / 10e8)+ realtimeOfMachine (_:xs) = realtimeOfMachine xs+ realtimeOfMachine _ = error "No realtime found"+ + -- extracts the Startup Timestamp of a list of all Machine Events+ startupTimestampOfMachine :: [Event] -> Timestamp+ startupTimestampOfMachine ((Event { time, spec=Startup { n_caps } }) :xs) = time+ startupTimestampOfMachine (_:xs) = startupTimestampOfMachine xs+ startupTimestampOfMachine _ = error "No Machine started"+ + + -- walks over the list of machines (which contains all events for this machine) and inserts all events+ -- in an accumulated OpenEvents structure+ -- when no events are left, we are finished and just need to close open lists in the generated structure + process :: [(E.MachineID, [Event])] -> E.OpenEvents -> E.OpenEvents+ process ((mID, (evt:evts)):machines) oe = let convertTimestamp = convertTimestampWithSync (toSyncTime syncTimes mID) + newOE = insertEvent convertTimestamp luptable (mID,evt) oe+ in seq newOE $ process ((mID,evts):machines) newOE+ process ((_,[]):machines) oe = process machines oe+ process [] oe = oe + ++ -- insertLeftOutMessages :: E.ProcessID -> E.OpenMessageEvent -> ([OpenMessage],[Message]) -> ([OpenMessage],[Message])++ processLeftOvers :: [(E.MachineID, [Event])] -> ([E.OpenMessage],[E.Message]) -> ([E.OpenMessage],[E.Message])+ processLeftOvers ((mID, (evt:evts)):machines) oe = let convertTimestamp = convertTimestampWithSync (toSyncTime syncTimes mID)+ in case spec evt of+ + SendMessage{+ mesTag, + senderProcess, + senderThread, + receiverMachine, + receiverProcess,+ receiverInport} -> let newOE = insertLeftOutMessages (mID, (fromIntegral senderProcess))+ (E.OSM (convertTimestamp (time evt)) (fromIntegral receiverMachine, fromIntegral receiverProcess) (fromIntegral senderThread) (fromIntegral receiverInport) (readTag mesTag))+ oe+ in processLeftOvers ((mID,evts):machines) newOE+ ReceiveMessage{+ mesTag,+ receiverProcess,+ receiverInport,+ senderMachine,+ senderProcess,+ senderThread,+ messageSize} -> let newOE = insertLeftOutMessages ((fromIntegral senderMachine), (fromIntegral senderProcess))+ (E.ORM (convertTimestamp (time evt)) (mID, fromIntegral receiverProcess) (fromIntegral senderThread) (fromIntegral receiverInport) (readTag mesTag) (fromIntegral messageSize))+ oe+ in processLeftOvers ((mID,evts):machines) newOE+ _ -> processLeftOvers ((mID,evts):machines) oe+ processLeftOvers ((_,[]):machines) oe = processLeftOvers machines oe+ processLeftOvers [] oe = oe +++ -- Manually build Process Table+ -- and ProcMessages (needed because wrong results + -- when those messages are processed in a 'wrong' order, and+ -- finding the right order is just as complex as this)+ + sendRForks = map (\(mID, evts) -> (mID, filter (isSendRFork) evts)) ghcevents++ isSendRFork :: Event -> Bool+ isSendRFork evt = case spec evt of+ SendMessage{mesTag=RFork} -> True+ _ -> False++ rcv_crtRForks = map (\(mID, evts) -> (mID, filter (\evt -> case spec evt of ReceiveMessage{mesTag=RFork} -> True; CreateProcess{} -> True; _ -> False) evts)) ghcevents++ injectProcMessages :: E.Events -> E.Events+ injectProcMessages ((lom,lop,lot),mst, inj ,(ml,aml,hml,pt, rcvl ),stats,nums) = ((lom,lop,lot),mst, inj,(ml++procMessages,aml,hml,processTree, rcvl ),stats,nums)+++ childTable :: [(E.ProcessID, [E.ProcessID])]+ procMessages :: [E.Message]+ (childTable,procMessages) = createChildTable sendRForks rcv_crtRForks [] []++ processTree :: E.ProcessTree+ processTree = unfoldTree buildTree ((1,1), fromJust (lookup (1,1) childTable))++ buildTree :: (E.ProcessID, [E.ProcessID]) -> (E.ProcessID, [(E.ProcessID, [E.ProcessID])])+ buildTree (pid, pids) = (pid, map (\p -> let mps = lookup p childTable+ in case mps of+ Nothing -> (p, [])+ Just ps -> (p, ps)) pids)++ createChildTable :: [(E.MachineID, [Event])] -> [(E.MachineID, [Event])] -> [(E.ProcessID, [E.ProcessID])] -> [E.Message] -> ([(E.ProcessID, [E.ProcessID])], [E.Message])+ createChildTable ((mID, evt:evts):machines) rcvers table procMsgs= + let SendMessage{senderProcess,receiverMachine} = spec evt + senderProc = (mID, fromIntegral sProc)+ receiverMach = fromIntegral receiverMachine+ sMach = fromIntegral mID+ sProc = senderProcess+ sTime = convertTimestampWithSync (toSyncTime syncTimes mID) (time evt) ++ Just rcvEvents = lookup receiverMach rcvers+ + + + (childId, remainingEvents, child) = nextChildId rcvEvents+ childProcess = (receiverMach, childId)++ newRcvers = updateReceivers receiverMach rcvers remainingEvents+ newTable = addChild table senderProc childProcess+ newProcMsgs = child:procMsgs++ addChild :: [(E.ProcessID, [E.ProcessID])] -> E.ProcessID -> E.ProcessID -> [(E.ProcessID, [E.ProcessID])]+ addChild (cur@(pid, childs):pids) father child+ | pid == father = ((pid, (child:childs)):pids)+ | otherwise = cur : (addChild pids father child)+ addChild [] father child = [(father, [child])]++ updateReceivers :: E.MachineID -> [(E.MachineID, [Event])] -> [Event] -> [(E.MachineID, [Event])]+ updateReceivers i (mach@(mID, evts):machines) update+ | mID == i = ((mID, update):machines)+ | otherwise = mach : (updateReceivers i machines update)+ updateReceivers _ [] _ = error "not updated"++ nextChildId (e:es) = case spec e of+ ReceiveMessage{senderMachine,senderProcess,+ messageSize} -> if senderMachine == sMach && senderProcess == sProc + then let (Event{spec=CreateProcess{process}}, rest) = getNextAndRemove (\evt -> case spec evt of CreateProcess{} -> True; _ -> False) es+ childId = fromIntegral process+ channelID = (senderProc, 0, (receiverMach, childId),0)+ rTime = convertTimestampWithSync (toSyncTime syncTimes receiverMach) (time e) + child = E.MSG channelID sTime rTime 85 (fromIntegral messageSize)+ in (childId, rest, child)+ else let (id, rest, child) = nextChildId es+ in (id, e:rest, child)+ _ -> let (id, rest, child) = nextChildId es+ in (id, e:rest, child)+ nextChildId [] = error "next child not found"++ getNextAndRemove :: (a -> Bool) -> [a] -> (a, [a])+ getNextAndRemove p (x:xs)+ | p x = (x,xs)+ | otherwise = let (y,ys) = getNextAndRemove p xs+ in (y,x:ys)+ getNextAndRemove _ [] = (error "next not found", [])+ in createChildTable ((mID, evts):machines) newRcvers newTable newProcMsgs++ + createChildTable ((mID, []):machines) rcvers table procMsgs = createChildTable machines rcvers table procMsgs+ createChildTable [] ecv table procMsgs = (table,procMsgs)++ ++-- converts a timestamp in TICKS to Seconds with respect to a realtime offset 'sync'+convertTimestampWithSync :: E.Seconds -> Timestamp -> E.Seconds+convertTimestampWithSync sync x = sync + (fromIntegral x / 10e8)++readTag :: MessageTag -> Int +readTag tag = case tag of +-- Log.Ready -> 80+-- Log.NewPE -> 81 +-- Log.PETIDS -> 82 +-- Log.Finish -> 83 +-- Log.Fail -> 84+ RFork -> 85 + Connect -> 86 + DataMes -> 87 + Head -> 88+ Constr -> 89 + Part -> 90 +-- Log.Packet -> 92+ Terminate -> 91+ _ -> -1+++type ThreadLookupMap = Hash.HashMap E.MachineID (Hash.HashMap Int Int)++createThreadLookupMap :: [(E.MachineID, [Event])] -> ThreadLookupMap+createThreadLookupMap list = let table = createThreadLookupTable list+ hashv1 = map (\(mID, x) -> (mID, Hash.fromList x)) table+ in Hash.fromList hashv1++createThreadLookupTable :: [(E.MachineID, [Event])] -> [(E.MachineID, [(Int, Int)])]+createThreadLookupTable ((mId, es):xs) = (mId, createTable es) : createThreadLookupTable xs+ where createTable :: [Event] -> [(Int, Int)]+ createTable ((Event{time,spec=AssignThreadToProcess{thread,process}}):es) = ((fromIntegral thread, fromIntegral process): createTable es)+ createTable (_:es) = createTable es+ createTable [] = []+createThreadLookupTable [] = []++type Lookuptable = [(E.MachineID, [(Int, Int)])]+lookupProcess :: Lookuptable -> E.MachineID -> Int -> Int+lookupProcess ((machine, es):ts) sMachine sThread = if machine == sMachine then lookupProcess' es sThread else lookupProcess ts sMachine sThread+ where lookupProcess' lst@((x,y):xs) z = if x == z then y else lookupProcess' xs z + lookupProcess' [] z = error ("Thread not found" ++ (show sMachine) ++ " " ++ (show z))+lookupProcess [] sMachine sThread = error ("--Thread not found" ++ (show sMachine) ++ " " ++ (show sThread))++++++insertLeftOutMessages :: E.ProcessID -> E.OpenMessageEvent -> ([E.OpenMessage],[E.Message]) -> ([E.OpenMessage],[E.Message])+insertLeftOutMessages sp newMessage ocMsgs@(openMsgList, closedMessages)+ | or [(tag == 88),(tag == 87)] = let ((_,sp'),(_,rp')) = (sp, rp)+ in if (min sp' rp') >= 0+ then seq oml (seq cml (oml,cml))+ else ocMsgs+ | otherwise = ocMsgs+ where (time, rp@(rm,_),out,inp,tag,size) = case newMessage of+ E.ORM t p o i r s -> (t,p,o,i,r,s)+ E.OSM t p o i r -> (t,p,o,i,r,0)+ (oml,cml) = searchID openMsgList+ searchID :: [E.OpenMessage] -> ([E.OpenMessage], [E.Message])+ searchID oml@(om@(iB,msgs):oms)+ | sp > iB = seq cms' (seq oms' (om:oms',cms')) -- go on+ | sp == iB = if null newOms -- OMList found => look for matching message+ then (oms,newCms)+ else ((iB, newOms):oms,newCms)+ | otherwise = ((sp,[newMessage]):oml,closedMessages) -- no OMList for threadId found+ where (oms',cms') = searchID oms -- recurse+ (newOms,newCms) = insertOrReplace msgs -- try to find matching OpenMessage+ insertOrReplace :: [E.OpenMessageEvent] -> ([E.OpenMessageEvent], [E.Message])+ insertOrReplace (o:os) = case closeMessage o newMessage of+ Nothing -> seq os' (o:os', cls')+ Just c -> (os, c:closedMessages)+ where (os',cls') = insertOrReplace os+ insertOrReplace [] = ([newMessage],closedMessages)+ closeMessage :: E.OpenMessageEvent -> E.OpenMessageEvent -> Maybe E.Message+ closeMessage (E.OSM t1 p1 o1 i1 r1) (E.ORM t2 p2 o2 i2 r2 s2)+ | and [p1==p2, o1==o2, i1==i2, r1==r2] = Just (E.MSG (sp,o1,p1,i1) t1 t2 r1 s2)+ | otherwise = Nothing+ closeMessage (E.ORM t2 p2 o2 i2 r2 s2) (E.OSM t1 p1 o1 i1 r1)+ | and [p1==p2, o1==o2, i1==i2, r1==r2] = Just (E.MSG (sp,o1,p1,i1) t1 t2 r1 s2)+ | otherwise = Nothing+ closeMessage _ _ = Nothing+ searchID [] = ([(sp, [newMessage])], closedMessages)+++++-- legacy code of old haskell EdenTV+-- modified to work with new Tracefile Format+insertEvent :: (Timestamp -> E.Seconds) -> Lookuptable -> (E.MachineID, Event) -> E.OpenEvents -> E.OpenEvents+insertEvent convertTimestamp lutable (mId, Event{time, spec}) oldEvents@(oEvts@(ms,ps,ts),mts,ocMsgs,(minTime,maxTime,nP,maxLD))+ | isMsgEvent = seq newMsgEvents ((newMs, newPs,ts),mts,newMsgEvents,(minTime,newMax,nP,maxLD)) -- process the event+ | isTrdEvent = let (newTData, mPE) = newTrdEvents+ (newPData, mME) = case mPE of+ [] -> (ps, []) -- no virtual process event+ pe -> insPEventList pe ps -- insert generated process event+ newMData = case mME of+ [] -> ms -- no virtual machine event+ me -> insMEventList mId me ms -- insert generated machine event+ in seq newMData ((newMData, newPData, newTData),mts,ocMsgs,(minTime,newMax,nP,maxLD))+ | isPrcEvent = let (newPData,mME) = newPrcEvents+ newMData = case mME of+ Nothing -> ms -- no virtual machine event+ Just me -> insMEvent mId me ms -- virtual machine event generated+ in seq newMData ((newMData,newPData,ts),mts,newOcMsgs,(minTime,newMax,newNP,maxLD))+ | isMchEvent = let newData = case gcEvents of+ Nothing -> (newMchEvents, ps, ts)+ Just (p,t) -> let newPE = insPeByMID mId p ps+ newTE = insTeByMID mId t ts+ in (newMchEvents, newPE, newTE)+ in seq newData (newData,newMchTimes,ocMsgs,(min',max',nP,maxLD'))+ | otherwise = oldEvents -- ignore unknown events+ where+ (isMsgEvent, newMsgEvents, newMs, newPs) = case spec of+ SendMessage{mesTag=Connect} -> (False, undefined, undefined, undefined) -- ignore+ SendMessage{+ mesTag, + senderProcess, + senderThread, + receiverMachine, + receiverProcess,+ receiverInport} -> (True, createNewMsgEvents (mId, fromIntegral senderProcess) + (E.OSM (convertTimestamp time) (fromIntegral receiverMachine, fromIntegral receiverProcess) + (fromIntegral senderThread) (fromIntegral receiverInport) (readTag mesTag)), nms, nps)+ ReceiveMessage{+ mesTag,+ receiverProcess,+ receiverInport,+ senderMachine,+ senderProcess,+ senderThread,+ messageSize} -> (True, createNewMsgEvents (fromIntegral senderMachine, fromIntegral senderProcess)+ (E.ORM (convertTimestamp time) (mId, fromIntegral receiverProcess) + (fromIntegral senderThread) (fromIntegral receiverInport) (readTag mesTag) (fromIntegral messageSize)), nms, nps) + _ -> (False, undefined, undefined, undefined)+ where createNewMsgEvents i event = insertMessage i event ocMsgs+ proc = case spec of SendMessage _ p _ _ _ _ -> fromIntegral p; ReceiveMessage _ p _ _ _ _ _ -> fromIntegral p + (nms, nps) = increaseMsgCount (mId, proc) ms ps spec+ (isTrdEvent,newTrdEvents) = case spec of+ RunThread { + thread } -> (True, newEvents (E.RunThread (convertTimestamp time)))+ AssignThreadToProcess {+ thread, + process} -> (True, newEvents (E.NewThread (convertTimestamp time) (0))) -- #####hack outport? always zero in toSDDF+ StopThread {+ thread,+ status} -> case status of+ ThreadFinished -> (True, newEvents (E.KillThread (convertTimestamp time))) + ThreadBlocked -> (True, newEvents (E.BlockThread (convertTimestamp time) (0) (1))) -- ####hack inport? reason?+ _ -> (True, newEvents (E.SuspendThread (convertTimestamp time)))+ WakeupThread {+ thread,+ otherCap} -> (True, newEvents (E.DeblockThread (convertTimestamp time)))+ _ -> (False, undefined)+ where proc = lookupProcess lutable mId thre -- hack+ thre = fromIntegral (thread spec) -- hack+ newEvents evt = insertThreadEvent ((mId, proc), thre) evt ts+ (isPrcEvent,newPrcEvents,newOcMsgs,newNP) = case spec of+ CreateProcess {+ process} -> (True, newEvents (E.NewProcess (convertTimestamp time)), ocMsgs, nP + 1)+ KillProcess {+ process} -> (True, newEvents (E.KillProcess (convertTimestamp time) (0,0,0)), delFromProcList (mId,fromIntegral process) ocMsgs, nP)+ _ -> (False, undefined, undefined, undefined)+ where newEvents evt = insPEvent (mId, fromIntegral (process spec)) evt ps+ + (isMchEvent,newMchEvents,newMchTimes,maxLD',gcEvents) = case spec of+ CreateMachine{} -> (True, newEvents (E.StartMachine (convertTimestamp time)), (mId, convertTimestamp time):mts, maxLD, Nothing)+ Startup{n_caps} -> (True, ms, mts, maxLD, Nothing)+ KillMachine _ -> (True, newEvents (E.EndMachine (convertTimestamp time)), mts, maxLD, Nothing)+ -- JB, WAS: 849 -> + --233 -> (True, newEvents (GCMachine getGCTime v2 v3 v4 v5), mts, max maxLD v5, -- hack todo GC+ -- Just (GCProcess getGCTime v2 v3 v4 v5, GCThread getGCTime v2 v3 v4 v5))+ _ -> (False, undefined, undefined, undefined, undefined)+ where newEvents evt = insMEvent mId evt ms++ -- compute new min/max times:+ newMax = max (convertTimestamp time) maxTime+ (min', max') = if (convertTimestamp time) > maxTime+ then (minTime, (convertTimestamp time))+ else (newMin, maxTime)+ newMin :: E.Seconds+ newMin = min (convertTimestamp time) minTime+ + insMEventList :: E.MachineID -> [E.MachineEvent] -> [E.Machine] -> [E.Machine]+ insMEventList i (m:ms) lst = insMEvent i m (insMEventList i ms lst)+ insMEventList _ _ lst = lst+ + insMEvent :: E.MachineID -> E.MachineEvent -> [E.Machine] -> [E.Machine]+ insMEvent i1 evt lst@(e@(i2,allP,blkP,stat@(p,s,r),evts):es) -- insert in existing list of machines+ | i2 > i1 = let es' = (insMEvent i1 evt es) in seq es' (e : es') -- go on+ | i2 == i1 = let e' = insertHere in seq e' (e' : es) -- existing machine+ | otherwise = (i1,0,0,(0,0,0),[evt]) : lst -- new machine => no processes+ where insertHere = case evt of+ E.MSuspendProcess sec -> let newEvts = case head evts of+ E.SuspendedMachine _ -> evts+ _ -> (E.SuspendedMachine sec):evts+ in (i2,allP,blkP,stat,newEvts)+ E.MRunProcess sec -> (i2,allP,blkP,stat,(E.RunningMachine sec):evts)+ E.MBlockProcess sec -> let newBlkP = blkP + 1+ newEvts = if newBlkP < allP+ then (E.SuspendedMachine sec):evts+ else (E.BlockedMachine sec):evts+ in (i2,allP,newBlkP,stat,newEvts)+ E.GCMachine _ _ _ _ _ -> (i2,allP,blkP,stat,evt:evts)+ E.MNewProcess sec -> let newAllP = allP + 1+ newEvts = if blkP == allP -- test if evt may be skipped:+ then (E.SuspendedMachine sec):evts+ else evts+ in (i2,allP + 1,blkP,(p+1,s,r),newEvts)+ E.MKillRProcess sec -> let newAllP = allP - 1+ newEvts = if newAllP > 0+ then (E.SuspendedMachine sec):evts+ else (E.IdleMachine sec):evts+ in (i2,newAllP,blkP,stat,newEvts)+ E.MKillSProcess sec -> let newAllP = allP - 1+ newEvts = if newAllP > 0+ then evts+ else (E.IdleMachine sec):evts+ in (i2,newAllP,blkP,stat,newEvts)+ E.MKillBProcess sec -> let newAllP = allP - 1+ newBlkP = blkP - 1+ newEvts = if newAllP > 0 + then evts + else (E.IdleMachine sec):evts+ in (i2,newAllP,newBlkP,stat,newEvts)+ E.MIdleProcess sec -> let newEvts = case head evts of+ E.SuspendedMachine _ -> evts+ _ -> (E.SuspendedMachine sec):evts+ in (i2,allP,blkP,stat,newEvts)+ E.EndMachine _ -> (i2,0,0,stat,evt:evts)+ _ -> error ("insMEvent: unknown event: " ++ show evt)+ insMEvent i1 evt [] = [(i1,0,0,(0,0,0),[evt])] -- brand new machine => no processes+ + insPEventList :: [(E.ProcessID,E.ProcessEvent)] -> [E.Process] -> ([E.Process],[E.MachineEvent])+ insPEventList ((i,p):ps) lst = let (ps',mes) = insPEventList ps lst+ (lst',me) = insPEvent i p ps'+ in case me of+ Nothing -> (lst',mes)+ Just me -> (lst',me:mes)+ insPEventList _ lst = (lst,[])+ + insPeByMID :: E.MachineID -> E.ProcessEvent -> [E.Process] -> [E.Process]+ insPeByMID i evt lst@(e@((m,_),_,_,_,_):es)+ | i == m = insertHere lst -- first process on machine i found, insert event+ | otherwise = let es' = insPeByMID i evt es in seq es' (e:es') -- search on+ where insertHere lst@(e@(i'@(m,_),a,b,s,evts):es)+ | i == m = let es' = insertHere es in case take 1 evts of+ [E.KillProcess _ _] -> seq es' ( e : es') -- process not alive+ [E.BlockedProcess _] -> seq es' ((i',a,b,s,(E.BlockedProcess (convertTimestamp time):evt:evts)):es')+ [E.SuspendedProcess _] -> seq es' ((i',a,b,s,(E.SuspendedProcess (convertTimestamp time):evt:evts)):es')+ _ -> seq es' ((i',a,b,s,evt:evts) : es') -- not possible?+ | otherwise = lst -- all processes on machine i worked up+ insertHere [] = []+ + insPEvent :: E.ProcessID -> E.ProcessEvent -> [E.Process] -> ([E.Process],Maybe E.MachineEvent)+ insPEvent i1 evt lst@(e@(i2,allT,blkT,stat@(t,s,r),evts):es)+ | i1 < i2 = let (es',mEvt) = insPEvent i1 evt es in seq es' (seq mEvt (e : es', mEvt))+ | i1 == i2 = (insertHere : es, vMachineEvent) {- case evt of -- a new entry for every new process+ NewProcess sec -> ((i1,0,0,(0,0,0),[evt]):lst, Just (MNewProcess time))+ _ -> (insertHere : es, vMachineEvent) -}+ | otherwise = ((i1,0,0,(0,0,0),[evt]):lst,Just (E.MNewProcess (convertTimestamp time))) -- new Process => evt == NewProcess+ where (insertHere,vMachineEvent) = case evt of+ E.PNewThread sec -> let newAllT = allT + 1+ in if blkT == allT -- was Process blocked?+ then ((i1,newAllT,blkT,(t+1,s,r),(E.SuspendedProcess sec):evts), Just (E.MSuspendProcess sec))+ else ((i1,newAllT,blkT,(t+1,s,r),evts),Nothing)+ E.PKillRThread sec -> let newAllT = allT - 1+ (newEvts,newMEvt) = if newAllT > 0+ then if blkT < newAllT+ then ((E.SuspendedProcess sec):evts, Just (E.MSuspendProcess sec))+ else ((E.BlockedProcess sec):evts, Just (E.MBlockProcess sec))+ else case evts of+ (E.KillProcess _ _:_) -> (evts, Nothing)+ _ -> ((E.IdleProcess sec):evts, Just (E.MIdleProcess sec))+ in ((i1,newAllT,blkT,stat,newEvts),newMEvt)+ E.PKillSThread sec -> let newAllT = allT - 1+ (newEvts,newMEvt) = if newAllT > 0+ then if blkT < newAllT+ then (evts, Nothing)+ else ((E.BlockedProcess sec):evts, Just (E.MBlockProcess sec))+ else case evts of+ (E.KillProcess _ _:_) -> (evts, Nothing)+ _ -> ((E.IdleProcess sec):evts, Just (E.MIdleProcess sec))+ in ((i1,newAllT,blkT,stat,newEvts), newMEvt)+ E.PKillBThread sec -> let newAllT = allT - 1+ newBlkT = blkT - 1+ (newEvts,newMEvt) = if newAllT > 0+ then (evts, Nothing)+ else case evts of+ (E.KillProcess _ _:_) -> (evts, Nothing)+ _ -> ((E.IdleProcess sec):evts, Just (E.MIdleProcess sec))+ in ((i1,newAllT,newBlkT,stat,newEvts), newMEvt)+ E.PRunThread sec -> ((i1,allT,blkT,stat,(E.RunningProcess sec):evts),Just (E.MRunProcess sec))+ E.PSuspendThread sec -> ((i1,allT,blkT,stat,(E.SuspendedProcess sec):evts), Just (E.MSuspendProcess sec))+ E.PBlockThread sec -> let newBlkT = blkT + 1+ (newEvts,newMEvt) = if newBlkT < allT+ then ((E.SuspendedProcess sec):evts,Just (E.MSuspendProcess sec))+ else ((E.BlockedProcess sec):evts,Just (E.MBlockProcess sec))+ in ((i1,allT,newBlkT,stat,newEvts),newMEvt)+ E.PDeblockThread sec -> let newBlkT = blkT - 1+ (newEvts,newMEvt) = if newBlkT < allT -- was process blocked?+ then ((E.SuspendedProcess sec):evts,Just (E.MSuspendProcess sec))+ else (evts,Nothing)+ in ((i1,allT,newBlkT,stat,newEvts),newMEvt)+ E.NewProcess sec -> ((i1,0,0,(t,s,r),(evt:evts)),Just (E.MNewProcess sec))+ E.LabelProcess sec _ -> ((i1,allT,blkT,stat,evt:evts),Nothing)+ -- KillProcess holds the statistic information for the ending process+ E.KillProcess sec _ -> let evt' = E.KillProcess sec (t,s,r) + in case evts of+ (E.RunningProcess _:_) -> ((i1,0,0,(0,0,0),(evt':evts)),Just (E.MKillRProcess sec))+ (E.BlockedProcess _:_) -> ((i1,0,0,(0,0,0),(evt':evts)),Just (E.MKillBProcess sec))+ _ -> ((i1,0,0,(0,0,0),(evt':evts)),Just (E.MKillSProcess sec))+ _ -> error ("unknown event: " ++ show evt)+ insPEvent i1 evt [] = ([(i1,0,0,(0,0,0),[evt])],Just (E.MNewProcess (convertTimestamp time))) -- new Process => evt == NewProcess++ insTeByMID :: E.MachineID -> E.ThreadEvent -> [E.OpenThread] -> [E.OpenThread]+ insTeByMID i evt lst@(e@(m,(lti,lte),ts):es)+ | i == m = (m,(((m,-1),-1),evt),insertHere ts):es -- machine i found, insert event into threads; the ((m,-1),-1)+ -- inserts 'evt' the next time insTEvent is run.+ | otherwise = let es' = insTeByMID i evt es in seq es' (e:es') -- search on+ where insertHere (l@(i,evts):ls) = let ls' = insertHere ls+ in case take 1 evts of+ -- skip already killed threads:+ [E.KillThread _] -> seq ls' (l:ls') -- Thread already dead+ -- The following entry describes the last suspended thread. The SuspendThread-event hasn't yet+ -- been inserted, it resides in 'lte':+ [E.RunThread _] -> seq ls' ((i,E.setEventTime lte (convertTimestamp time):evt:lte:evts):ls')+ -- other threads are blocked or suspended:+ [lastEvent] -> seq ls' ((i,E.setEventTime lastEvent (convertTimestamp time):evt:evts):ls')+ insertHere [] = []++ insertThreadEvent :: E.ThreadID -> E.ThreadEvent -> [E.OpenThread] -> ([E.OpenThread], [(E.ProcessID,E.ProcessEvent)])+ insertThreadEvent i@((m,_),_) evt tl@(t@(im,(lti,lte),ts):tls)+ | m < im = let (tls', pEvt') = insertThreadEvent i evt tls -- look for corresponding machine+ in seq tls' (seq pEvt' (t:tls',pEvt')) -- recurse+ | m == im = case lte of+ E.SuspendThread _ -> case evt of+ E.RunThread _ -> if i == lti+ then ((im,(i,E.DummyThread),ts):tls,[]) -- suppress flattering+ else bothEvents+ _ -> bothEvents+ E.DummyThread -> case evt of+ E.SuspendThread _ -> ((im,(i,evt),ts):tls, []) -- deter SuspendThread-Event+ _ -> let (ts',pEvt') = insTEvent' i evt ts in ((im,(i,E.DummyThread),ts'):tls,[(t2pID i,pEvt')])+ otherwise -> insertThreadEvent i evt tls + | otherwise = ((m,(i,E.DummyThread),[(i,[evt])]):tl,[(t2pID i,vProcessEvent evt [])]) -- new machine+ where bothEvents = let (ts2,pEvt2) = insTEvent' lti lte ts+ (ts3,pEvt3) = insTEvent' i evt ts2+ in ((im,(i,E.DummyThread),ts3):tls,[(t2pID i,pEvt3),(t2pID lti,pEvt2)])+ insertThreadEvent i@((m,_),_) evt [] = ([(m,(i,E.DummyThread),[(i,[evt])])],[(t2pID i,vProcessEvent evt [])])++ insTEvent' :: E.ThreadID -> E.ThreadEvent -> [E.Thread] -> ([E.Thread],E.ProcessEvent)+ insTEvent' i@((m,_),t) ne lst@(e@(ib@((im,_),it),evts):es)+ | i' < ib' = let (es', mEvt') = (insTEvent' i ne es) in seq es' (seq mEvt' (e:es',mEvt'))+ | i' == ib' = ((i,(ne:evts)):es, vProcessEvent ne evts)+ | otherwise = ((i,[ne]):lst,vProcessEvent ne evts)+ where+ i' = (m,t)+ ib' = (im,it)+ insTEvent' i evt _ = ([(i,[evt])],vProcessEvent evt [])+ + vProcessEvent :: E.ThreadEvent -> [E.ThreadEvent] -> E.ProcessEvent+ vProcessEvent evt evts = case evt of+ E.KillThread sec -> case evts of+ (E.BlockThread _ _ _:_) -> E.PKillBThread sec+ (E.RunThread _ :_) -> E.PKillRThread sec+ _ -> E.PKillSThread sec+ E.RunThread sec -> E.PRunThread sec+ E.SuspendThread sec -> E.PSuspendThread sec+ E.BlockThread sec _ _ -> E.PBlockThread sec+ E.DeblockThread sec -> E.PDeblockThread sec+ E.NewThread _ _ -> E.PNewThread (convertTimestamp time)++ + +++increaseMsgCount :: E.ProcessID -> [E.Machine] -> [E.Process] -> + EventTypeSpecificInfo -> ([E.Machine], [E.Process])+increaseMsgCount pID@(mID,_) ml pl spec = (incM ml, incP pl)+ where incM :: [E.Machine] -> [E.Machine]+ incM (m@(i, aP, bP, (p,s,r), es):ms)+ | i > mID = m : incM ms -- go on+ | i == mID = case spec of+ SendMessage _ _ _ _ _ _ -> ((i, aP, bP, (p, s+1, r), es):ms)+ ReceiveMessage _ _ _ _ _ _ _ -> ((i, aP, bP, (p, s, r+1), es):ms)+ otherwise -> m:ms -- should not occur+ | otherwise = m:ms -- not found? nevermind...+ incM _ = []+ incP :: [E.Process] -> [E.Process]+ incP (p@(i,aT,bT,(t,s,r),es):ps)+ | i > pID = p : incP ps+ | i == pID = case spec of+ SendMessage _ _ _ _ _ _ -> ((i, aT, bT, (t, s+1, r), es):ps)+ ReceiveMessage _ _ _ _ _ _ _ -> ((i, aT, bT, (t, s, r+1), es):ps)+ otherwise -> p:ps -- should not occur+ | otherwise = p:ps -- not found? nevermind...+ incP _ = [] +++newProc :: E.ProcessID -> E.ProcessID -> E.ProcessList -> E.ProcessTree -> (E.ProcessList, E.ProcessTree)+newProc dad son pls pt = (addProcPath son (dadPath) pls, addChildPrc son dadPath pt)+ where dadPath = []--TODO getPath dad pls ++ [dad]+ getPath :: E.ProcessID -> E.ProcessList -> [E.ProcessID]+ getPath pId (p@(i,path):ps)+ | i < pId = getPath pId ps+ | i == pId = path+ | otherwise = error ("not impl: getPath, otherwise " ++ (show son) ++ " " ++ show (pId,pls))+ getPath _ _ = []++addProcPath :: E.ProcessID -> [E.ProcessID] -> E.ProcessList -> E.ProcessList+addProcPath pId path pls@(p@(i,lst):ps)+ | i < pId = let ps' = addProcPath pId path ps in seq ps' (p:ps')+ | i == pId = (pId,path) : ps+ | otherwise = (pId,path) : pls+addProcPath pId path _ = [(pId, path)]++addChildPrc :: E.ProcessID -> [E.ProcessID] -> E.ProcessTree -> E.ProcessTree+addChildPrc pId [p] (Node i pts) = Node i ((Node pId []):pts)+addChildPrc pId path@(p:ps) pt@(Node i pts)+ | p == i = let pts' = stepDown ps pts in seq pts' (Node i pts')+ | otherwise = error ("addChildPrc: wrong ProcessTree found (" ++ show p ++ "!=" ++ show i ++ ")")+ where stepDown :: [E.ProcessID] -> [E.ProcessTree] -> [E.ProcessTree]+ stepDown path@(p:ps) pts@(t@(Node i _):ts)+ | i == p = let t' = addChildPrc pId path t in seq t' (t':ts)+ | otherwise = let ts' = stepDown path ts in seq ts' (t:ts')+ stepDown path [] = seq (putStrLn ("stepDown: path " ++ show path ++ " not found in Process Tree:" ++ show pt)) []+addChildPrc pId [] pt = pt ++delFromProcList :: E.ProcessID -> E.OpenMessageList -> E.OpenMessageList+delFromProcList pId oml = oml+++++++insertMessage :: E.ProcessID -> E.OpenMessageEvent -> E.OpenMessageList -> E.OpenMessageList+insertMessage sp newMessage ocMsgs@(openMsgList,closedMessages,partMsgs@(openPrcMsgs,prcTbl,prcTree),(headMessages,hSize,closedHeads))+ | tag == 88 = let ohl' = addHeadMsg (sp, out, rp, inp) headMessages+ in seq ohl' (openMsgList, closedMessages, partMsgs,(ohl', hSize, closedHeads))+ | tag == 87 = let (ohl,chl,hs') = searchHeadMsg (sp,out,rp,inp) headMessages+ in seq cml (seq chl (oml,cml,partMsgs,(ohl,max hs' hSize,chl)))+ | tag == 85 = ocMsgs+ | otherwise = let ((_,sp'),(_,rp')) = (sp,rp)+ in if (min sp' rp') >= 0+ then seq oml (seq cml (oml,cml,partMsgs,(headMessages,hSize,closedHeads)))+ else ocMsgs+ where (time, rp@(rm,_),out,inp,tag,size) = case newMessage of+ E.ORM t p o i r s -> (t,p,o,i,r,s)+ E.OSM t p o i r -> (t,p,o,i,r,0)+ (oml,cml) = searchID openMsgList+ + addHeadMsg :: E.ChannelID -> [E.OpenHeadMessage] -> [E.OpenHeadMessage]+ addHeadMsg cId hml@(h@(idB,s,i,hsm,hrm):hs)+ | cId > idB = let hs' = addHeadMsg cId hs in seq hs' (h:hs') -- not found yet: search on+ | cId == idB = case newMessage of+ E.ORM _ _ _ _ _ _ -> case hrm of -- entry found, increase quantity and size+ [firstMsg] -> (idB,(s+size),(i+1),hsm,time:hrm):hs -- second received Message+ (lastMsg:fm) -> (idB,(s+size),(i+1),hsm, time:fm):hs -- replace last received Message+ [] -> (idB,(s+size),(i+1),hsm, [time] ):hs -- first received Message+ E.OSM _ _ _ _ _ -> case hsm of -- entry found, don't touch values+ [firstMsg] -> (idB,s,i,time:hsm,hrm):hs+ (lastMsg:fm) -> (idB,s,i,time:fm ,hrm):hs+ [] -> (idB,s,i, [time] ,hrm):hs+ | otherwise = case newMessage of+ E.ORM _ _ _ _ _ _ -> (cId,size,1,[],[time]):hml -- insert new entry before h+ E.OSM _ _ _ _ _ -> (cId,size,0,[time],[]):hml+ addHeadMsg cId [] = case newMessage of+ E.ORM _ _ _ _ _ _ -> [(cId,size,1,[],[time])]+ E.OSM _ _ _ _ _ -> [(cId,size,0,[time],[])]+ + searchHeadMsg :: E.ChannelID -> [E.OpenHeadMessage] -> ([E.OpenHeadMessage],[E.HeadMessage],Double)+ searchHeadMsg cId hml@(h@(idB,s,i,hsm,hrm):hs)+ | cId > idB = let (hs',ch',ms') = searchHeadMsg cId hs+ in seq hs' (seq ch' (h:hs',ch',ms'))+ | cId == idB = let sInt = s + size+ sDouble = fromIntegral sInt+ in case newMessage of+ E.ORM _ _ _ _ _ _ ->+ if length hsm == 3+ then (hs, (cId,(ts1,tr1,ts2,time),sDouble,(i+1)):closedHeads, sDouble)+ else ((idB,sInt,(i+1),hsm,time:hrm):hs,closedHeads,sDouble)+ E.OSM _ _ _ _ _ ->+ if length hrm == 3+ then (hs, (cId,(ts1,tr1,time,tr2),sDouble,i):closedHeads,sDouble)+ else ((idB,s,i,time:hsm,hrm):hs,closedHeads,sDouble)+ | otherwise = (hml,closedHeads,0)+ where ts2 = head hsm+ ts1 = last hsm+ tr2 = head hrm+ tr1 = last hrm+ searchHeadMsg cId [] = ([], closedHeads,0)+ + searchID :: [E.OpenMessage] -> ([E.OpenMessage], [E.Message])+ searchID oml@(om@(iB,msgs):oms)+ | sp > iB = seq cms' (seq oms' (om:oms',cms')) -- go on+ | sp == iB = if null newOms -- OMList found => look for matching message+ then (oms,newCms)+ else ((iB, newOms):oms,newCms)+ | otherwise = ((sp,[newMessage]):oml,closedMessages) -- no OMList for threadId found+ where (oms',cms') = searchID oms -- recurse+ (newOms,newCms) = insertOrReplace msgs -- try to find matching OpenMessage+ insertOrReplace :: [E.OpenMessageEvent] -> ([E.OpenMessageEvent], [E.Message])+ insertOrReplace (o:os) = case closeMessage o newMessage of+ Nothing -> seq os' (o:os', cls')+ Just c -> (os, c:closedMessages)+ where (os',cls') = insertOrReplace os+ insertOrReplace [] = ([newMessage],closedMessages)+ closeMessage :: E.OpenMessageEvent -> E.OpenMessageEvent -> Maybe E.Message+ closeMessage (E.OSM t1 p1 o1 i1 r1) (E.ORM t2 p2 o2 i2 r2 s2)+ | and [p1==p2, o1==o2, i1==i2, r1==r2] = Just (E.MSG (sp,o1,p1,i1) t1 t2 r1 s2)+ | otherwise = Nothing+ closeMessage (E.ORM t2 p2 o2 i2 r2 s2) (E.OSM t1 p1 o1 i1 r1)+ | and [p1==p2, o1==o2, i1==i2, r1==r2] = Just (E.MSG (sp,o1,p1,i1) t1 t2 r1 s2)+ | otherwise = Nothing+ closeMessage _ _ = Nothing+ searchID [] = ([(sp, [newMessage])], closedMessages)+ +++closeOpenLists :: E.OpenEvents -> E.Events+closeOpenLists (events@(mEvents,pEvents,tEvents),mTimes,(_,closedMessages,(_,_,Node _ pTrees),(openHeadMessages,hSize,headMessages)),(minTime,maxTime,numP,maxLD)) =+ seq mEvents (seq minTime (seq allHeadMessages+ ((mEvents,pEvents,newThreadEvents),mTimes,undefined,(closedMessages,[],allHeadMessages,reversedProcTree, []),+ (minTime,maxTime,0,hSize,(fromIntegral maxLD)),(length mEvents,numP,length newThreadEvents))))+ where allHeadMessages = handleOpenHeadMsgs openHeadMessages headMessages+ newThreadEvents = concat (map (\(_,_,ts) -> ts) tEvents)+ reversedProcTree :: E.ProcessTree+ reversedProcTree = if null pTrees+ then Node (0,0) []+ else reverseSubForests (head pTrees)+ reverseSubForests :: E.ProcessTree -> E.ProcessTree+ reverseSubForests (Node i f) = Node i (map reverseSubForests (reverse f))+ handleOpenHeadMsgs :: [E.OpenHeadMessage] -> [E.HeadMessage] -> [E.HeadMessage]+ handleOpenHeadMsgs [] hm = hm+ handleOpenHeadMsgs ((ch,s,i,sml,rml):os) hm = case zip sml rml of+ ((lst',lrt'):(fst',frt'):_) -> handleOpenHeadMsgs os ((newHeadMsg fst' frt' lst' lrt'):hm)+ _ -> handleOpenHeadMsgs os hm+ where newHeadMsg :: E.Seconds -> E.Seconds -> E.Seconds -> E.Seconds -> E.HeadMessage+ newHeadMsg tS1 tR1 tS2 tR2 = (ch,(tS1,tR1,tS2,tR2),fromIntegral s,i)++ +t2pID :: E.ThreadID -> E.ProcessID+t2pID tid = fst tid+++instance Eq ThreadStopStatus where+ NoStatus == NoStatus = True+ NoStatus == _ = False+ HeapOverflow == HeapOverflow = True+ HeapOverflow == _ = False+ StackOverflow == StackOverflow = True+ StackOverflow == _ = False+ ThreadYielding == ThreadYielding = True+ ThreadYielding == _ = False+ ThreadBlocked == ThreadBlocked = True+ ThreadBlocked == _ = False+ ThreadFinished == ThreadFinished = True+ ThreadFinished == _ = False+ ForeignCall == ForeignCall = True+ ForeignCall == _ = False+\end{code}
+ Setup.lhs view
@@ -0,0 +1,4 @@+#!/usr/bin/env runhaskell++> import Distribution.Simple+> main = defaultMain
+ TinyZipper.lhs view
@@ -0,0 +1,31 @@+This is -*- Literate Haskell -*-++Our own wrappers around zip file handling in Haskell.++Written by Oleg Lobachev, 2010.++\begin{code}+module TinyZipper where++import Prelude hiding (readFile)+import Codec.Archive.Zip+import Data.ByteString.Lazy (ByteString, readFile)+import System.IO.Unsafe (unsafePerformIO) -- yeah!+import Data.Maybe+\end{code}++We need to read files from a zip archive, if possible: without unpacking it.++Ideal is something like String (with zip file name) -> [FileContents].++\begin{code}+type FileContents = ByteString+readZip :: FilePath -> IO (Either String [FileContents])+readZip filePath = do+ zippedFile <- readFile filePath+ let archive = toArchive zippedFile+ fileList = filesInArchive archive+ entries = catMaybes $ zipWith (findEntryByPath) fileList (repeat archive)+ files = map (fromEntry) entries+ return $ seq files $ Right files+\end{code}
+ edentv.cabal view
@@ -0,0 +1,54 @@+name: edentv+version: 4.1.0.0+synopsis: A Tool to Visualize Parallel Functional Program Executions+description: The Eden Trace Viewer is a tool designed to help+ programmers optimize Eden programs by visualising traces+ (eventlog files) of Eden program runs. It is similar to+ (and precedes) threadscope. However, it has been designed+ to visualize not just threads, but also different+ machines, processes, and messages between processes.+ EdenTV can show you what has happened during the+ execution of your program. This is very helpful to+ optimize parallel programs.+license: GPL-3+license-file: gpl.txt+homepage: http://www.mathematik.uni-marburg.de/~eden+author: Jost Berthold, Mischa Dieterle, Thomas Horstmeyer, Bernhard Pickenbrock, Tobias Sauerwein, Bjoern Struckmeier+maintainer: Eden group <eden@mathematik.uni-marburg.de>+copyright: Copyright (C) 2005-2012 Phillips Universitaet Marburg+category: Development, Eden, Profiling, Trace+build-type: Simple+cabal-version: >=1.6++data-files: edentv.glade++source-repository head+ type: git+ location: git://james.mathematik.uni-marburg.de/edentv-hs.git++executable edentv+ main-is: EdenTV.hs++ build-depends: base == 4.*,+ containers,+ bytestring,+ binary,+ mtl,+ filepath,+ directory,+ zip-archive,+ gtk >= 0.12,+ cairo >= 0.12,+ glade >= 0.12,+ array,+ ghc-events-parallel >= 0.4++ GHC-Options: -rtsopts++ other-modules: EdenTvBasic+ EdenTvInteract+ EdenTvType+ EdenTvViewer+ RTSEventsParser+ RTSEventsParserOld+ TinyZipper
+ edentv.glade view
@@ -0,0 +1,3112 @@+<?xml version="1.0" standalone="no"?> <!--*- mode: xml -*-->+<!DOCTYPE glade-interface SYSTEM "http://glade.gnome.org/glade-2.0.dtd">++<!--+{- The Eden Trace Viewer (or simply EdenTV) is a tool that can generate diagrams to visualize the behaviour of Eden programs.+ Copyright (C) 2005-2010 Phillips Universitaet Marburg++ This program is free software; you can redistribute it and/or modify+ it under the terms of the GNU General Public License as published by+ the Free Software Foundation; either version 3 of the License, or+ (at your option) any later version.+ This program is distributed in the hope that it will be useful,+ but WITHOUT ANY WARRANTY; without even the implied warranty of+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+ GNU General Public License for more details.+ You should have received a copy of the GNU General Public License+ along with this program; if not, write to the Free Software Foundation,+ Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA+-->++++<glade-interface>++<widget class="GtkWindow" id="EdTVMain">+ <property name="visible">True</property>+ <property name="title" translatable="yes">EdenTV</property>+ <property name="type">GTK_WINDOW_TOPLEVEL</property>+ <property name="window_position">GTK_WIN_POS_NONE</property>+ <property name="modal">False</property>+ <property name="resizable">False</property>+ <property name="destroy_with_parent">False</property>+ <property name="icon_name">gtk-network</property>+ <property name="decorated">True</property>+ <property name="skip_taskbar_hint">False</property>+ <property name="skip_pager_hint">False</property>+ <property name="type_hint">GDK_WINDOW_TYPE_HINT_NORMAL</property>+ <property name="gravity">GDK_GRAVITY_NORTH_WEST</property>+ <property name="focus_on_map">True</property>+ <property name="urgency_hint">False</property>++ <child>+ <widget class="GtkVBox" id="vbox1">+ <property name="visible">True</property>+ <property name="homogeneous">False</property>+ <property name="spacing">0</property>++ <child>+ <widget class="GtkMenuBar" id="menubar">+ <property name="visible">True</property>+ <property name="pack_direction">GTK_PACK_DIRECTION_LTR</property>+ <property name="child_pack_direction">GTK_PACK_DIRECTION_LTR</property>++ <child>+ <widget class="GtkMenuItem" id="menubar_File">+ <property name="visible">True</property>+ <property name="label" translatable="yes">_File</property>+ <property name="use_underline">True</property>++ <child>+ <widget class="GtkMenu" id="menubar_File_menu">++ <child>+ <widget class="GtkImageMenuItem" id="menuFile_Open">+ <property name="visible">True</property>+ <property name="label" translatable="yes">_Open</property>+ <property name="use_underline">True</property>+ <signal name="activate" handler="on_menuFile_Open_activate" last_modification_time="Mon, 06 Feb 2006 10:31:34 GMT"/>+ <accelerator key="O" modifiers="GDK_CONTROL_MASK" signal="activate"/>++ <child internal-child="image">+ <widget class="GtkImage" id="image506">+ <property name="visible">True</property>+ <property name="stock">gtk-open</property>+ <property name="icon_size">1</property>+ <property name="xalign">0.5</property>+ <property name="yalign">0.5</property>+ <property name="xpad">0</property>+ <property name="ypad">0</property>+ </widget>+ </child>+ </widget>+ </child>++ <child>+ <widget class="GtkImageMenuItem" id="menuFile_OpenWithoutMsgs">+ <property name="visible">True</property>+ <property name="label" translatable="yes">Open Without Messages</property>+ <property name="use_underline">True</property>+ <signal name="activate" handler="on_menuFile_OpenWithoutMsgs_activate" last_modification_time="Mon, 06 Feb 2006 10:31:34 GMT"/>+ <accelerator key="P" modifiers="GDK_CONTROL_MASK" signal="activate"/>+ </widget>+ </child>++ <child>+ <widget class="GtkSeparatorMenuItem" id="separatormenuitem">+ <property name="visible">True</property>+ </widget>+ </child>++ <child>+ <widget class="GtkImageMenuItem" id="menuFile_Quit">+ <property name="visible">True</property>+ <property name="label" translatable="yes">_Quit</property>+ <property name="use_underline">True</property>+ <signal name="activate" handler="on_menuFile_Quit_activate" last_modification_time="Tue, 18 Apr 2006 12:46:14 GMT"/>+ <accelerator key="Q" modifiers="GDK_CONTROL_MASK" signal="activate"/>++ <child internal-child="image">+ <widget class="GtkImage" id="image507">+ <property name="visible">True</property>+ <property name="stock">gtk-quit</property>+ <property name="icon_size">1</property>+ <property name="xalign">0.5</property>+ <property name="yalign">0.5</property>+ <property name="xpad">0</property>+ <property name="ypad">0</property>+ </widget>+ </child>+ </widget>+ </child>+ </widget>+ </child>+ </widget>+ </child>++ <child>+ <widget class="GtkMenuItem" id="options">+ <property name="visible">True</property>+ <property name="label" translatable="yes">_Colors</property>+ <property name="use_underline">True</property>+ <signal name="activate" handler="on_options1_activate" last_modification_time="Tue, 18 Apr 2006 12:43:30 GMT"/>++ <child>+ <widget class="GtkMenu" id="options_menu">++ <child>+ <widget class="GtkImageMenuItem" id="color_templates">+ <property name="visible">True</property>+ <property name="label" translatable="yes">Color _Templates</property>+ <property name="use_underline">True</property>+ <signal name="activate" handler="on_colortemplates_activate" last_modification_time="Thu, 20 Apr 2006 09:22:00 GMT"/>++ <child internal-child="image">+ <widget class="GtkImage" id="image508">+ <property name="visible">True</property>+ <property name="stock">gtk-color-picker</property>+ <property name="icon_size">1</property>+ <property name="xalign">0.5</property>+ <property name="yalign">0.5</property>+ <property name="xpad">0</property>+ <property name="ypad">0</property>+ </widget>+ </child>++ <child>+ <widget class="GtkMenu" id="color_templates_menu">++ <child>+ <widget class="GtkRadioMenuItem" id="default_colors">+ <property name="visible">True</property>+ <property name="label" translatable="yes">Default _Colors</property>+ <property name="use_underline">True</property>+ <property name="active">True</property>+ <signal name="activate" handler="on_default_colors_activate" last_modification_time="Thu, 20 Apr 2006 09:22:00 GMT"/>+ </widget>+ </child>++ <child>+ <widget class="GtkRadioMenuItem" id="default_colBW">+ <property name="visible">True</property>+ <property name="label" translatable="yes">Default _b/w</property>+ <property name="use_underline">True</property>+ <property name="active">False</property>+ <property name="group">default_colors</property>+ <signal name="activate" handler="on_default_colBW_activate" last_modification_time="Thu, 20 Apr 2006 09:22:00 GMT"/>+ </widget>+ </child>+ </widget>+ </child>+ </widget>+ </child>+++ <child>+ <widget class="GtkImageMenuItem" id="menuOptions_SetColors">+ <property name="visible">True</property>+ <property name="label" translatable="yes">Set Colors</property>+ <property name="use_underline">True</property>+ </widget>+ </child>+ + </widget>+ </child>+ </widget>+ </child>++ <child>+ <widget class="GtkMenuItem" id="windows">+ <property name="visible">True</property>+ <property name="label" translatable="yes">_Windows</property>+ <property name="use_underline">True</property>+ <signal name="activate" handler="on_windows1_activate" last_modification_time="Wed, 19 Apr 2006 12:09:48 GMT"/>++ <child>+ <widget class="GtkMenu" id="windows_menu">++ <child>+ <widget class="GtkImageMenuItem" id="refresh_all">+ <property name="visible">True</property>+ <property name="label" translatable="yes">Refresh All</property>+ <property name="use_underline">True</property>+ <accelerator key="F5" modifiers="0" signal="activate"/>++ <child internal-child="image">+ <widget class="GtkImage" id="image514">+ <property name="visible">True</property>+ <property name="stock">gtk-refresh</property>+ <property name="icon_size">1</property>+ <property name="xalign">0.5</property>+ <property name="yalign">0.5</property>+ <property name="xpad">0</property>+ <property name="ypad">0</property>+ </widget>+ </child>+ </widget>+ </child>+ </widget>+ </child>+ </widget>+ </child>++ <child>+ <widget class="GtkMenuItem" id="menubar_Help">+ <property name="visible">True</property>+ <property name="label" translatable="yes">_Help</property>+ <property name="use_underline">True</property>++ <child>+ <widget class="GtkMenu" id="menubar_Help_menu">++ <child>+ <widget class="GtkImageMenuItem" id="menuHelp_About">+ <property name="visible">True</property>+ <property name="label" translatable="yes">_About</property>+ <property name="use_underline">True</property>+ <signal name="activate" handler="on_about_activate" last_modification_time="Sun, 05 Feb 2006 13:42:48 GMT"/>++ <child internal-child="image">+ <widget class="GtkImage" id="image515">+ <property name="visible">True</property>+ <property name="stock">gtk-info</property>+ <property name="icon_size">1</property>+ <property name="xalign">0.5</property>+ <property name="yalign">0.5</property>+ <property name="xpad">0</property>+ <property name="ypad">0</property>+ </widget>+ </child>+ </widget>+ </child>+ </widget>+ </child>+ </widget>+ </child>+ </widget>+ <packing>+ <property name="padding">0</property>+ <property name="expand">False</property>+ <property name="fill">False</property>+ </packing>+ </child>++ <child>+ <widget class="GtkToolbar" id="toolbar">+ <property name="visible">True</property>+ <property name="orientation">GTK_ORIENTATION_HORIZONTAL</property>+ <property name="toolbar_style">GTK_TOOLBAR_BOTH</property>+ <property name="tooltips">True</property>+ <property name="show_arrow">False</property>++ <child>+ <widget class="GtkToolButton" id="toolbar_Open">+ <property name="visible">True</property>+ <property name="label" translatable="yes">_Open</property>+ <property name="use_underline">True</property>+ <property name="stock_id">gtk-open</property>+ <property name="visible_horizontal">True</property>+ <property name="visible_vertical">True</property>+ <property name="is_important">False</property>+ <signal name="clicked" handler="on_open" last_modification_time="Mon, 06 Feb 2006 10:48:58 GMT"/>+ <accelerator key="O" modifiers="GDK_MOD1_MASK" signal="clicked"/>+ </widget>+ <packing>+ <property name="expand">False</property>+ <property name="homogeneous">True</property>+ </packing>+ </child>++ <child>+ <widget class="GtkSeparatorToolItem" id="separatortoolitem9">+ <property name="visible">True</property>+ <property name="draw">True</property>+ <property name="visible_horizontal">True</property>+ <property name="visible_vertical">True</property>+ </widget>+ <packing>+ <property name="expand">False</property>+ <property name="homogeneous">False</property>+ </packing>+ </child>++ <child>+ <widget class="GtkToolItem" id="toolitem3">+ <property name="visible">True</property>+ <property name="visible_horizontal">True</property>+ <property name="visible_vertical">True</property>+ <property name="is_important">False</property>++ <child>+ <widget class="GtkTable" id="table1">+ <property name="visible">True</property>+ <property name="n_rows">2</property>+ <property name="n_columns">4</property>+ <property name="homogeneous">False</property>+ <property name="row_spacing">0</property>+ <property name="column_spacing">0</property>++ <child>+ <widget class="GtkColorButton" id="suspended_colorbutton">+ <property name="visible">True</property>+ <property name="tooltip" translatable="yes">suspended color</property>+ <property name="can_focus">True</property>+ <property name="use_alpha">False</property>+ <property name="title" translatable="yes">suspended color</property>+ <property name="focus_on_click">True</property>+ </widget>+ <packing>+ <property name="left_attach">1</property>+ <property name="right_attach">2</property>+ <property name="top_attach">1</property>+ <property name="bottom_attach">2</property>+ <property name="x_options">fill</property>+ <property name="y_options"></property>+ </packing>+ </child>++ <child>+ <widget class="GtkImage" id="image416">+ <property name="width_request">20</property>+ <property name="visible">True</property>+ <property name="stock">gtk-media-play</property>+ <property name="icon_size">1</property>+ <property name="xalign">1</property>+ <property name="yalign">0.5</property>+ <property name="xpad">0</property>+ <property name="ypad">0</property>+ </widget>+ <packing>+ <property name="left_attach">0</property>+ <property name="right_attach">1</property>+ <property name="top_attach">0</property>+ <property name="bottom_attach">1</property>+ <property name="y_options">fill</property>+ </packing>+ </child>++ <child>+ <widget class="GtkImage" id="image417">+ <property name="width_request">20</property>+ <property name="visible">True</property>+ <property name="stock">gtk-media-pause</property>+ <property name="icon_size">1</property>+ <property name="xalign">1</property>+ <property name="yalign">0.5</property>+ <property name="xpad">0</property>+ <property name="ypad">0</property>+ </widget>+ <packing>+ <property name="left_attach">0</property>+ <property name="right_attach">1</property>+ <property name="top_attach">1</property>+ <property name="bottom_attach">2</property>+ <property name="x_options">fill</property>+ <property name="y_options">fill</property>+ </packing>+ </child>++ <child>+ <widget class="GtkColorButton" id="running_colorbutton">+ <property name="visible">True</property>+ <property name="tooltip" translatable="yes">running color</property>+ <property name="can_focus">True</property>+ <property name="use_alpha">False</property>+ <property name="title" translatable="yes">running color</property>+ <property name="focus_on_click">True</property>+ </widget>+ <packing>+ <property name="left_attach">1</property>+ <property name="right_attach">2</property>+ <property name="top_attach">0</property>+ <property name="bottom_attach">1</property>+ <property name="x_options">fill</property>+ <property name="y_options"></property>+ </packing>+ </child>++ <child>+ <widget class="GtkColorButton" id="idle_colorbutton">+ <property name="visible">True</property>+ <property name="tooltip" translatable="yes">idle color</property>+ <property name="can_focus">True</property>+ <property name="use_alpha">False</property>+ <property name="title" translatable="yes">idle color</property>+ <property name="focus_on_click">True</property>+ </widget>+ <packing>+ <property name="left_attach">3</property>+ <property name="right_attach">4</property>+ <property name="top_attach">1</property>+ <property name="bottom_attach">2</property>+ <property name="x_options">fill</property>+ <property name="y_options"></property>+ </packing>+ </child>++ <child>+ <widget class="GtkColorButton" id="blocked_colorbutton">+ <property name="visible">True</property>+ <property name="tooltip" translatable="yes">blocked color</property>+ <property name="can_focus">True</property>+ <property name="use_alpha">False</property>+ <property name="title" translatable="yes">blocked color</property>+ <property name="focus_on_click">True</property>+ </widget>+ <packing>+ <property name="left_attach">3</property>+ <property name="right_attach">4</property>+ <property name="top_attach">0</property>+ <property name="bottom_attach">1</property>+ <property name="x_options">fill</property>+ <property name="y_options"></property>+ </packing>+ </child>++ <child>+ <widget class="GtkImage" id="image419">+ <property name="width_request">20</property>+ <property name="visible">True</property>+ <property name="stock">gtk-media-stop</property>+ <property name="icon_size">1</property>+ <property name="xalign">1</property>+ <property name="yalign">0.5</property>+ <property name="xpad">0</property>+ <property name="ypad">0</property>+ </widget>+ <packing>+ <property name="left_attach">2</property>+ <property name="right_attach">3</property>+ <property name="top_attach">0</property>+ <property name="bottom_attach">1</property>+ <property name="y_options">fill</property>+ </packing>+ </child>++ <child>+ <widget class="GtkImage" id="image418">+ <property name="width_request">20</property>+ <property name="visible">True</property>+ <property name="stock">gtk-execute</property>+ <property name="icon_size">1</property>+ <property name="xalign">1</property>+ <property name="yalign">0.5</property>+ <property name="xpad">0</property>+ <property name="ypad">0</property>+ </widget>+ <packing>+ <property name="left_attach">2</property>+ <property name="right_attach">3</property>+ <property name="top_attach">1</property>+ <property name="bottom_attach">2</property>+ <property name="x_options">fill</property>+ <property name="y_options">fill</property>+ </packing>+ </child>+ </widget>+ </child>+ </widget>+ <packing>+ <property name="expand">False</property>+ <property name="homogeneous">False</property>+ </packing>+ </child>+ </widget>+ <packing>+ <property name="padding">0</property>+ <property name="expand">False</property>+ <property name="fill">False</property>+ </packing>+ </child>+ </widget>+ </child>+</widget>++<widget class="GtkWindow" id="EdTVTrace">+ <property name="visible">True</property>+ <property name="title" translatable="yes">Trace</property>+ <property name="type">GTK_WINDOW_TOPLEVEL</property>+ <property name="window_position">GTK_WIN_POS_NONE</property>+ <property name="modal">False</property>+ <property name="default_width">900</property>+ <property name="default_height">600</property>+ <property name="resizable">True</property>+ <property name="destroy_with_parent">True</property>+ <property name="icon_name">gtk-zoom-fit</property>+ <property name="decorated">True</property>+ <property name="skip_taskbar_hint">False</property>+ <property name="skip_pager_hint">False</property>+ <property name="type_hint">GDK_WINDOW_TYPE_HINT_NORMAL</property>+ <property name="gravity">GDK_GRAVITY_NORTH_WEST</property>+ <property name="focus_on_map">True</property>+ <property name="urgency_hint">False</property>++ <child>+ <widget class="GtkVBox" id="vbox2">+ <property name="visible">True</property>+ <property name="homogeneous">False</property>+ <property name="spacing">0</property>++ <child>+ <widget class="GtkMenuBar" id="menubar1">+ <property name="visible">True</property>+ <property name="pack_direction">GTK_PACK_DIRECTION_LTR</property>+ <property name="child_pack_direction">GTK_PACK_DIRECTION_LTR</property>++ <child>+ <widget class="GtkMenuItem" id="menuitem1">+ <property name="visible">True</property>+ <property name="label" translatable="yes">_File</property>+ <property name="use_underline">True</property>++ <child>+ <widget class="GtkMenu" id="menuitem1_menu">++ <child>+ <widget class="GtkImageMenuItem" id="topen">+ <property name="visible">True</property>+ <property name="label" translatable="yes">_Open</property>+ <property name="use_underline">True</property>+ <signal name="activate" handler="on_open_activate" last_modification_time="Fri, 21 Apr 2006 18:28:44 GMT"/>+ <accelerator key="O" modifiers="GDK_CONTROL_MASK" signal="activate"/>++ <child internal-child="image">+ <widget class="GtkImage" id="image549">+ <property name="visible">True</property>+ <property name="stock">gtk-open</property>+ <property name="icon_size">1</property>+ <property name="xalign">0.5</property>+ <property name="yalign">0.5</property>+ <property name="xpad">0</property>+ <property name="ypad">0</property>+ </widget>+ </child>+ </widget>+ </child>++ <child>+ <widget class="GtkImageMenuItem" id="topenWithoutMsgs">+ <property name="visible">True</property>+ <property name="label" translatable="yes">Open Without Messages</property>+ <property name="use_underline">True</property>+ <signal name="activate" handler="on_openWithoutMsgs_activate" last_modification_time="Mon, 06 Feb 2006 10:31:34 GMT"/>+ <accelerator key="P" modifiers="GDK_CONTROL_MASK" signal="activate"/>+ </widget>+ </child>++ <child>+ <widget class="GtkImageMenuItem" id="save">+ <property name="visible">True</property>+ <property name="label" translatable="yes">_Save</property>+ <property name="use_underline">True</property>+ <signal name="activate" handler="on_save2_activate" last_modification_time="Fri, 21 Apr 2006 17:44:09 GMT"/>+ <accelerator key="S" modifiers="GDK_CONTROL_MASK" signal="activate"/>++ <child internal-child="image">+ <widget class="GtkImage" id="image550">+ <property name="visible">True</property>+ <property name="stock">gtk-save</property>+ <property name="icon_size">1</property>+ <property name="xalign">0.5</property>+ <property name="yalign">0.5</property>+ <property name="xpad">0</property>+ <property name="ypad">0</property>+ </widget>+ </child>+ </widget>+ </child>++ <child>+ <widget class="GtkSeparatorMenuItem" id="separatormenuitem1">+ <property name="visible">True</property>+ </widget>+ </child>++ <child>+ <widget class="GtkImageMenuItem" id="close">+ <property name="visible">True</property>+ <property name="label" translatable="yes">Close _Window</property>+ <property name="use_underline">True</property>+ <signal name="activate" handler="on_quit1_activate" last_modification_time="Fri, 21 Apr 2006 17:44:09 GMT"/>+ <accelerator key="W" modifiers="GDK_CONTROL_MASK" signal="activate"/>++ <child internal-child="image">+ <widget class="GtkImage" id="image551">+ <property name="visible">True</property>+ <property name="stock">gtk-close</property>+ <property name="icon_size">1</property>+ <property name="xalign">0.5</property>+ <property name="yalign">0.5</property>+ <property name="xpad">0</property>+ <property name="ypad">0</property>+ </widget>+ </child>+ </widget>+ </child>++ <child>+ <widget class="GtkImageMenuItem" id="tquit">+ <property name="visible">True</property>+ <property name="label" translatable="yes">_Quit Application</property>+ <property name="use_underline">True</property>+ <signal name="activate" handler="on_quit_application1_activate" last_modification_time="Fri, 05 May 2006 09:04:37 GMT"/>+ <accelerator key="Q" modifiers="GDK_CONTROL_MASK" signal="activate"/>++ <child internal-child="image">+ <widget class="GtkImage" id="image552">+ <property name="visible">True</property>+ <property name="stock">gtk-quit</property>+ <property name="icon_size">1</property>+ <property name="xalign">0.5</property>+ <property name="yalign">0.5</property>+ <property name="xpad">0</property>+ <property name="ypad">0</property>+ </widget>+ </child>+ </widget>+ </child>+ </widget>+ </child>+ </widget>+ </child>++ <child>+ <widget class="GtkMenuItem" id="menuitem3">+ <property name="visible">True</property>+ <property name="label" translatable="yes">_View</property>+ <property name="use_underline">True</property>++ <child>+ <widget class="GtkMenu" id="menuitem3_menu">++ <child>+ <widget class="GtkImageMenuItem" id="kind1">+ <property name="visible">True</property>+ <property name="label" translatable="yes">_Show</property>+ <property name="use_underline">True</property>+ <signal name="activate" handler="on_kind1_activate" last_modification_time="Fri, 21 Apr 2006 18:28:44 GMT"/>++ <child internal-child="image">+ <widget class="GtkImage" id="image553">+ <property name="visible">True</property>+ <property name="stock">gtk-execute</property>+ <property name="icon_size">1</property>+ <property name="xalign">0.5</property>+ <property name="yalign">0.5</property>+ <property name="xpad">0</property>+ <property name="ypad">0</property>+ </widget>+ </child>++ <child>+ <widget class="GtkMenu" id="kind1_menu">++ <child>+ <widget class="GtkRadioMenuItem" id="showAllMachines">+ <property name="visible">True</property>+ <property name="label" translatable="yes">All _Machines</property>+ <property name="use_underline">True</property>+ <property name="active">True</property>+ <signal name="activate" handler="on_all_machines_activate" last_modification_time="Fri, 21 Apr 2006 18:28:44 GMT"/>+ <accelerator key="M" modifiers="GDK_MOD1_MASK" signal="activate"/>+ </widget>+ </child>++ <child>+ <widget class="GtkRadioMenuItem" id="showAllProcesses">+ <property name="visible">True</property>+ <property name="label" translatable="yes">All _Processes</property>+ <property name="use_underline">True</property>+ <property name="active">False</property>+ <property name="group">showAllMachines</property>+ <signal name="activate" handler="on_all_processes_activate" last_modification_time="Fri, 21 Apr 2006 18:28:44 GMT"/>+ <accelerator key="P" modifiers="GDK_MOD1_MASK" signal="activate"/>+ </widget>+ </child>++ <child>+ <widget class="GtkRadioMenuItem" id="showAllThreads">+ <property name="visible">True</property>+ <property name="label" translatable="yes">All _Threads</property>+ <property name="use_underline">True</property>+ <property name="active">False</property>+ <property name="group">showAllMachines</property>+ <signal name="activate" handler="on_all_threads_activate" last_modification_time="Fri, 21 Apr 2006 18:28:44 GMT"/>+ <accelerator key="T" modifiers="GDK_MOD1_MASK" signal="activate"/>+ </widget>+ </child>++ <child>+ <widget class="GtkRadioMenuItem" id="showAllGProcesses">+ <property name="visible">True</property>+ <property name="label" translatable="yes">All Processes p. Machines</property>+ <property name="use_underline">True</property>+ <property name="active">False</property>+ <property name="group">showAllMachines</property>+ <signal name="activate" handler="on_all_processes_activate" last_modification_time="Fri, 21 Apr 2006 18:28:44 GMT"/>++ </widget>+ </child>+ </widget>+ </child>+ </widget>+ </child>++ <child>+ <widget class="GtkCheckMenuItem" id="show_marker">+ <property name="visible">True</property>+ <property name="label" translatable="yes">Show _Marker</property>+ <property name="use_underline">True</property>+ <property name="active">False</property>+ <signal name="activate" handler="on_show_marker_activate" last_modification_time="Tue, 27 Jun 2006 14:26:47 GMT"/>+ <accelerator key="M" modifiers="GDK_CONTROL_MASK" signal="activate"/>+ </widget>+ </child>++ <child>+ <widget class="GtkCheckMenuItem" id="show_blockmsgs">+ <property name="visible">True</property>+ <property name="label" translatable="yes">Show Block Messages</property>+ <property name="active">False</property>+ </widget>+ </child>++ <child>+ <widget class="GtkCheckMenuItem" id="show_startup">+ <property name="visible">True</property>+ <property name="label" translatable="yes">Show Startup-Marker</property>+ <property name="active">False</property>+ </widget>+ </child>+ + <child>+ <widget class="GtkCheckMenuItem" id="hide_startup_phase">+ <property name="visible">True</property>+ <property name="label" translatable="yes">Hide Startup-Phase</property>+ <property name="active">False</property>+ </widget>+ </child>+ + <child>+ <widget class="GtkSeparatorMenuItem" id="separator102">+ <property name="visible">True</property>+ </widget>+ </child>++ <child>+ <widget class="GtkCheckMenuItem" id="show_data_messages">+ <property name="visible">True</property>+ <property name="label" translatable="yes">Show Data Messages</property>+ <property name="active">True</property>+ </widget>+ </child>++ <child>+ <widget class="GtkCheckMenuItem" id="show_system_messages">+ <property name="visible">True</property>+ <property name="label" translatable="yes">Show System Messages</property>+ <property name="active">True</property>+ </widget>+ </child>+ + <child>+ <widget class="GtkSeparatorMenuItem" id="separator103">+ <property name="visible">True</property>+ </widget>+ </child>++ <child>+ <widget class="GtkImageMenuItem" id="sort">+ <property name="visible">True</property>+ <property name="label" translatable="yes">Sort</property>+ <property name="use_underline">True</property>+ <signal name="activate" handler="on_sort" last_modification_time="Mon, 10 Jul 2006 07:45:21 GMT"/>+ <accelerator key="S" modifiers="GDK_MOD1_MASK" signal="activate"/>++ <child internal-child="image">+ <widget class="GtkImage" id="image554">+ <property name="visible">True</property>+ <property name="stock">gtk-sort-ascending</property>+ <property name="icon_size">1</property>+ <property name="xalign">0.5</property>+ <property name="yalign">0.5</property>+ <property name="xpad">0</property>+ <property name="ypad">0</property>+ </widget>+ </child>+ </widget>+ </child>++ ++ <child>+ <widget class="GtkSeparatorMenuItem" id="separator2">+ <property name="visible">True</property>+ </widget>+ </child>++ <child>+ <widget class="GtkImageMenuItem" id="zoom1">+ <property name="visible">True</property>+ <property name="label" translatable="yes">Zoom</property>+ <property name="use_underline">True</property>++ <child internal-child="image">+ <widget class="GtkImage" id="image555">+ <property name="visible">True</property>+ <property name="stock">gtk-zoom-in</property>+ <property name="icon_size">1</property>+ <property name="xalign">0.5</property>+ <property name="yalign">0.5</property>+ <property name="xpad">0</property>+ <property name="ypad">0</property>+ </widget>+ </child>++ <child>+ <widget class="GtkMenu" id="zoom1_menu">++ <child>+ <widget class="GtkImageMenuItem" id="zoom_in">+ <property name="visible">True</property>+ <property name="label" translatable="yes">Zoom _in</property>+ <property name="use_underline">True</property>+ <signal name="activate" handler="on_zoom_in_activate" last_modification_time="Tue, 15 Aug 2006 10:56:42 GMT"/>+ <accelerator key="plus" modifiers="GDK_CONTROL_MASK" signal="activate"/>++ <child internal-child="image">+ <widget class="GtkImage" id="image556">+ <property name="visible">True</property>+ <property name="stock">gtk-zoom-in</property>+ <property name="icon_size">1</property>+ <property name="xalign">0.5</property>+ <property name="yalign">0.5</property>+ <property name="xpad">0</property>+ <property name="ypad">0</property>+ </widget>+ </child>+ </widget>+ </child>++ <child>+ <widget class="GtkImageMenuItem" id="zoom_out">+ <property name="visible">True</property>+ <property name="label" translatable="yes">Zoom _out</property>+ <property name="use_underline">True</property>+ <signal name="activate" handler="on_zoom_out_activate" last_modification_time="Tue, 15 Aug 2006 10:57:23 GMT"/>+ <accelerator key="minus" modifiers="GDK_CONTROL_MASK" signal="activate"/>++ <child internal-child="image">+ <widget class="GtkImage" id="image557">+ <property name="visible">True</property>+ <property name="stock">gtk-zoom-out</property>+ <property name="icon_size">1</property>+ <property name="xalign">0.5</property>+ <property name="yalign">0.5</property>+ <property name="xpad">0</property>+ <property name="ypad">0</property>+ </widget>+ </child>+ </widget>+ </child>++ <child>+ <widget class="GtkSeparatorMenuItem" id="separator1">+ <property name="visible">True</property>+ </widget>+ </child>++ <child>+ <widget class="GtkImageMenuItem" id="totalView">+ <property name="visible">True</property>+ <property name="label" translatable="yes">Total View</property>+ <property name="use_underline">True</property>+ <signal name="activate" handler="on_gesamtansicht_activate" last_modification_time="Fri, 21 Apr 2006 18:13:45 GMT"/>+ <accelerator key="A" modifiers="GDK_CONTROL_MASK" signal="activate"/>++ <child internal-child="image">+ <widget class="GtkImage" id="image558">+ <property name="visible">True</property>+ <property name="stock">gtk-zoom-fit</property>+ <property name="icon_size">1</property>+ <property name="xalign">0.5</property>+ <property name="yalign">0.5</property>+ <property name="xpad">0</property>+ <property name="ypad">0</property>+ </widget>+ </child>+ </widget>+ </child>+ </widget>+ </child>+ </widget>+ </child>++ <child>+ <widget class="GtkImageMenuItem" id="refresh">+ <property name="visible">True</property>+ <property name="tooltip" translatable="yes">refresh view</property>+ <property name="label" translatable="yes">_Refresh</property>+ <property name="use_underline">True</property>+ <signal name="activate" handler="on_refresh" last_modification_time="Mon, 10 Jul 2006 07:03:51 GMT"/>+ <accelerator key="F5" modifiers="0" signal="activate"/>++ <child internal-child="image">+ <widget class="GtkImage" id="image559">+ <property name="visible">True</property>+ <property name="stock">gtk-refresh</property>+ <property name="icon_size">1</property>+ <property name="xalign">0.5</property>+ <property name="yalign">0.5</property>+ <property name="xpad">0</property>+ <property name="ypad">0</property>+ </widget>+ </child>+ </widget>+ </child>++ <child>+ <widget class="GtkImageMenuItem" id="edit_range">+ <property name="visible">True</property>+ <property name="label" translatable="yes">Show Range</property>+ <property name="use_underline">True</property> + </widget>+ </child>++ <child>+ <widget class="GtkImageMenuItem" id="edit_ticks">+ <property name="visible">True</property>+ <property name="label" translatable="yes">Configure Ticks</property>+ <property name="use_underline">True</property> + </widget>+ </child>++ </widget>+ </child>+ </widget>+ </child>++ <child>+ <widget class="GtkMenuItem" id="windows">+ <property name="visible">True</property>+ <property name="label" translatable="yes">_Windows</property>+ <property name="use_underline">True</property>+ <signal name="activate" handler="on_windows1_activate" last_modification_time="Wed, 19 Apr 2006 12:09:48 GMT"/>++ <child>+ <widget class="GtkMenu" id="windows_menu">++ <child>+ <widget class="GtkImageMenuItem" id="refresh_all">+ <property name="visible">True</property>+ <property name="label" translatable="yes">Refresh All</property>+ <property name="use_underline">True</property>+ <accelerator key="F5" modifiers="0" signal="activate"/>++ <child internal-child="image">+ <widget class="GtkImage" id="image514">+ <property name="visible">True</property>+ <property name="stock">gtk-refresh</property>+ <property name="icon_size">1</property>+ <property name="xalign">0.5</property>+ <property name="yalign">0.5</property>+ <property name="xpad">0</property>+ <property name="ypad">0</property>+ </widget>+ </child>+ </widget>+ </child>+ </widget>+ </child>+ </widget>+ </child>++ <child>+ <widget class="GtkMenuItem" id="menuitem4">+ <property name="visible">True</property>+ <property name="label" translatable="yes">_Help</property>+ <property name="use_underline">True</property>++ <child>+ <widget class="GtkMenu" id="menuitem4_menu">++ <child>+ <widget class="GtkImageMenuItem" id="tabout">+ <property name="visible">True</property>+ <property name="label" translatable="yes">_About</property>+ <property name="use_underline">True</property>+ <signal name="activate" handler="on_about1_activate" last_modification_time="Fri, 21 Apr 2006 17:44:09 GMT"/>++ <child internal-child="image">+ <widget class="GtkImage" id="image560">+ <property name="visible">True</property>+ <property name="stock">gtk-info</property>+ <property name="icon_size">1</property>+ <property name="xalign">0.5</property>+ <property name="yalign">0.5</property>+ <property name="xpad">0</property>+ <property name="ypad">0</property>+ </widget>+ </child>+ </widget>+ </child>+ </widget>+ </child>+ </widget>+ </child>+ </widget>+ <packing>+ <property name="padding">0</property>+ <property name="expand">False</property>+ <property name="fill">False</property>+ </packing>+ </child>++ <child>+ <widget class="GtkToolbar" id="toolbar1">+ <property name="visible">True</property>+ <property name="orientation">GTK_ORIENTATION_HORIZONTAL</property>+ <property name="toolbar_style">GTK_TOOLBAR_BOTH</property>+ <property name="tooltips">True</property>+ <property name="show_arrow">True</property>++ <child>+ <widget class="GtkToolButton" id="saveAsPng">+ <property name="visible">True</property>+ <property name="label" translatable="yes">Save</property>+ <property name="use_underline">True</property>+ <property name="stock_id">gtk-save</property>+ <property name="visible_horizontal">True</property>+ <property name="visible_vertical">True</property>+ <property name="is_important">False</property>+ <accelerator key="s" modifiers="GDK_CONTROL_MASK" signal="clicked"/>+ </widget>+ <packing>+ <property name="expand">False</property>+ <property name="homogeneous">True</property>+ </packing>+ </child>++ <child>+ <widget class="GtkSeparatorToolItem" id="separatortoolitem7">+ <property name="visible">True</property>+ <property name="draw">True</property>+ <property name="visible_horizontal">True</property>+ <property name="visible_vertical">True</property>+ </widget>+ <packing>+ <property name="expand">False</property>+ <property name="homogeneous">False</property>+ </packing>+ </child>++ <child>+ <widget class="GtkToolItem" id="toolitemViewSelect">+ <property name="visible">True</property>+ <property name="visible_horizontal">True</property>+ <property name="visible_vertical">True</property>+ <property name="is_important">False</property>++ <child>+ <widget class="GtkTable" id="table5">+ <property name="visible">True</property>+ <property name="n_rows">2</property>+ <property name="n_columns">2</property>+ <property name="homogeneous">False</property>+ <property name="row_spacing">0</property>+ <property name="column_spacing">0</property>++ <child>+ <widget class="GtkComboBox" id="viewselect">+ <property name="visible">True</property>+ <property name="items" translatable="yes">Machines+Processes+Threads+Processes/Machines</property>+ <property name="add_tearoffs">False</property>+ <property name="focus_on_click">True</property>+ </widget>+ <packing>+ <property name="left_attach">0</property>+ <property name="right_attach">2</property>+ <property name="top_attach">1</property>+ <property name="bottom_attach">2</property>+ </packing>+ </child>++ <child>+ <widget class="GtkImage" id="image68">+ <property name="visible">True</property>+ <property name="icon_size">4</property>+ <property name="icon_name">gtk-execute</property>+ <property name="xalign">0.5</property>+ <property name="yalign">0.5</property>+ <property name="xpad">0</property>+ <property name="ypad">0</property>+ </widget>+ <packing>+ <property name="left_attach">0</property>+ <property name="right_attach">1</property>+ <property name="top_attach">0</property>+ <property name="bottom_attach">1</property>+ <property name="x_options">fill</property>+ <property name="y_options">fill</property>+ </packing>+ </child>++ <child>+ <widget class="GtkLabel" id="label8">+ <property name="visible">True</property>+ <property name="label" translatable="yes">View:</property>+ <property name="use_underline">False</property>+ <property name="use_markup">False</property>+ <property name="justify">GTK_JUSTIFY_LEFT</property>+ <property name="wrap">False</property>+ <property name="selectable">False</property>+ <property name="xalign">0.5</property>+ <property name="yalign">0.5</property>+ <property name="xpad">0</property>+ <property name="ypad">0</property>+ <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>+ <property name="width_chars">-1</property>+ <property name="single_line_mode">False</property>+ <property name="angle">0</property>+ </widget>+ <packing>+ <property name="left_attach">1</property>+ <property name="right_attach">2</property>+ <property name="top_attach">0</property>+ <property name="bottom_attach">1</property>+ <property name="y_options"></property>+ </packing>+ </child>+ </widget>+ </child>+ </widget>+ <packing>+ <property name="expand">False</property>+ <property name="homogeneous">False</property>+ </packing>+ </child>++ <child>+ <widget class="GtkSeparatorToolItem" id="separatortoolitem8">+ <property name="visible">True</property>+ <property name="draw">True</property>+ <property name="visible_horizontal">True</property>+ <property name="visible_vertical">True</property>+ </widget>+ <packing>+ <property name="expand">False</property>+ <property name="homogeneous">False</property>+ </packing>+ </child>++ <child>+ <widget class="GtkToolButton" id="infoButton">+ <property name="visible">True</property>+ <property name="label" translatable="yes">Info</property>+ <property name="use_underline">True</property>+ <property name="stock_id">gtk-info</property>+ <property name="visible_horizontal">True</property>+ <property name="visible_vertical">True</property>+ <property name="is_important">False</property>+ <accelerator key="I" modifiers="GDK_CONTROL_MASK" signal="clicked"/>+ </widget>+ <packing>+ <property name="expand">False</property>+ <property name="homogeneous">True</property>+ </packing>+ </child>++ <child>+ <widget class="GtkToolButton" id="msgs-relations">+ <property name="visible">True</property>+ <property name="label" translatable="yes">Configure Msgs.</property>+ <property name="use_underline">True</property>+ <property name="stock_id">gtk-network</property>+ <property name="visible_horizontal">True</property>+ <property name="visible_vertical">True</property>+ <property name="is_important">False</property>+ </widget>+ <packing>+ <property name="expand">False</property>+ <property name="homogeneous">False</property>+ </packing>+ </child>++ <child>+ <widget class="GtkToggleToolButton" id="messages">+ <property name="visible">True</property>+ <property name="label" translatable="yes">Messages</property>+ <property name="use_underline">True</property>+ <property name="stock_id">gtk-copy</property>+ <property name="visible_horizontal">True</property>+ <property name="visible_vertical">True</property>+ <property name="is_important">False</property>+ <property name="active">False</property>+ </widget>+ <packing>+ <property name="expand">False</property>+ <property name="homogeneous">False</property>+ </packing>+ </child>++ <child>+ <widget class="GtkToggleToolButton" id="localNull">+ <property name="visible">True</property>+ <property name="label" translatable="yes">Startup Sync.</property>+ <property name="use_underline">True</property>+ <property name="stock_id">gtk-goto-first</property>+ <property name="visible_horizontal">True</property>+ <property name="visible_vertical">True</property>+ <property name="is_important">False</property>+ <property name="active">False</property>+ </widget>+ <packing>+ <property name="expand">False</property>+ <property name="homogeneous">False</property>+ </packing>+ </child>++ <child>+ <widget class="GtkSeparatorToolItem" id="separatortoolitem1">+ <property name="visible">True</property>+ <property name="draw">True</property>+ <property name="visible_horizontal">True</property>+ <property name="visible_vertical">True</property>+ </widget>+ <packing>+ <property name="expand">False</property>+ <property name="homogeneous">False</property>+ </packing>+ </child> + <child>+ <widget class="GtkToolItem" id="toolitemSort">+ <property name="visible">True</property>+ <property name="visible_horizontal">True</property>+ <property name="visible_vertical">True</property>+ <property name="is_important">False</property>+ <child>+ <widget class="GtkTable" id="table4">+ <property name="visible">True</property>+ <property name="n_rows">2</property>+ <property name="n_columns">2</property>+ <property name="homogeneous">False</property>+ <property name="row_spacing">0</property>+ <property name="column_spacing">0</property>++ <child>+ <widget class="GtkToolButton" id="go_up">+ <property name="visible">True</property>+ <property name="tooltip" translatable="yes">up</property>+ <property name="label" translatable="yes">Up</property>+ <property name="use_underline">True</property>+ <property name="stock_id">gtk-go-up</property>+ <property name="visible_horizontal">True</property>+ <property name="visible_vertical">True</property>+ <property name="is_important">False</property>+ <accelerator key="U" modifiers="0" signal="clicked"/>+ </widget>+ <packing>+ <property name="left_attach">0</property>+ <property name="right_attach">1</property>+ <property name="top_attach">1</property>+ <property name="bottom_attach">2</property>+ <property name="x_options">fill</property>+ </packing>+ </child>++ <child>+ <widget class="GtkToolButton" id="go_down">+ <property name="visible">True</property>+ <property name="tooltip" translatable="yes">down</property>+ <property name="label" translatable="yes">Down</property>+ <property name="use_underline">True</property>+ <property name="stock_id">gtk-go-down</property>+ <property name="visible_horizontal">True</property>+ <property name="visible_vertical">True</property>+ <property name="is_important">False</property>+ <accelerator key="D" modifiers="0" signal="clicked"/>+ </widget>+ <packing>+ <property name="left_attach">1</property>+ <property name="right_attach">2</property>+ <property name="top_attach">1</property>+ <property name="bottom_attach">2</property>+ <property name="x_options">fill</property>+ <property name="y_options">fill</property>+ </packing>+ </child>++ <child>+ <widget class="GtkLabel" id="label7">+ <property name="visible">True</property>+ <property name="label" translatable="yes">Sort:</property>+ <property name="use_underline">False</property>+ <property name="use_markup">False</property>+ <property name="justify">GTK_JUSTIFY_LEFT</property>+ <property name="wrap">False</property>+ <property name="selectable">False</property>+ <property name="xalign">0.5</property>+ <property name="yalign">0.5</property>+ <property name="xpad">0</property>+ <property name="ypad">0</property>+ <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>+ <property name="width_chars">-1</property>+ <property name="single_line_mode">False</property>+ <property name="angle">0</property>+ </widget>+ <packing>+ <property name="left_attach">0</property>+ <property name="right_attach">2</property>+ <property name="top_attach">0</property>+ <property name="bottom_attach">1</property>+ <property name="x_options">fill</property>+ <property name="y_options"></property>+ </packing>+ </child>+ </widget>+ </child>+ </widget>+ <packing>+ <property name="expand">False</property>+ <property name="homogeneous">False</property>+ </packing>+ </child>++ <child>+ <widget class="GtkSeparatorToolItem" id="separatortoolitem4">+ <property name="visible">True</property>+ <property name="draw">True</property>+ <property name="visible_horizontal">True</property>+ <property name="visible_vertical">True</property>+ </widget>+ <packing>+ <property name="expand">False</property>+ <property name="homogeneous">False</property>+ </packing>+ </child>++ <child>+ <widget class="GtkToolItem" id="toolitemZoomH">+ <property name="visible">True</property>+ <property name="visible_horizontal">True</property>+ <property name="visible_vertical">True</property>+ <property name="is_important">False</property>++ <child>+ <widget class="GtkTable" id="table2">+ <property name="visible">True</property>+ <property name="n_rows">2</property>+ <property name="n_columns">2</property>+ <property name="homogeneous">False</property>+ <property name="row_spacing">0</property>+ <property name="column_spacing">0</property>++ <child>+ <widget class="GtkToolButton" id="zoomInH">+ <property name="visible">True</property>+ <property name="label" translatable="yes"></property>+ <property name="use_underline">True</property>+ <property name="stock_id">gtk-zoom-in</property>+ <property name="visible_horizontal">True</property>+ <property name="visible_vertical">True</property>+ <property name="is_important">False</property>+ </widget>+ <packing>+ <property name="left_attach">0</property>+ <property name="right_attach">1</property>+ <property name="top_attach">1</property>+ <property name="bottom_attach">2</property>+ <property name="x_options">fill</property>+ </packing>+ </child>++ <child>+ <widget class="GtkToolButton" id="zoomOutH">+ <property name="visible">True</property>+ <property name="label" translatable="yes"></property>+ <property name="use_underline">True</property>+ <property name="stock_id">gtk-zoom-out</property>+ <property name="visible_horizontal">True</property>+ <property name="visible_vertical">True</property>+ <property name="is_important">False</property>+ </widget>+ <packing>+ <property name="left_attach">1</property>+ <property name="right_attach">2</property>+ <property name="top_attach">1</property>+ <property name="bottom_attach">2</property>+ <property name="x_options">fill</property>+ <property name="y_options">fill</property>+ </packing>+ </child>++ <child>+ <widget class="GtkLabel" id="label3">+ <property name="visible">True</property>+ <property name="label" translatable="yes">Horizontal:</property>+ <property name="use_underline">False</property>+ <property name="use_markup">False</property>+ <property name="justify">GTK_JUSTIFY_LEFT</property>+ <property name="wrap">False</property>+ <property name="selectable">False</property>+ <property name="xalign">0.5</property>+ <property name="yalign">0.5</property>+ <property name="xpad">0</property>+ <property name="ypad">0</property>+ <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>+ <property name="width_chars">-1</property>+ <property name="single_line_mode">False</property>+ <property name="angle">0</property>+ </widget>+ <packing>+ <property name="left_attach">0</property>+ <property name="right_attach">2</property>+ <property name="top_attach">0</property>+ <property name="bottom_attach">1</property>+ <property name="x_options">fill</property>+ <property name="y_options"></property>+ </packing>+ </child>+ </widget>+ </child>+ </widget>+ <packing>+ <property name="expand">False</property>+ <property name="homogeneous">False</property>+ </packing>+ </child>++ <child>+ <widget class="GtkSeparatorToolItem" id="separatortoolitem6">+ <property name="visible">True</property>+ <property name="draw">True</property>+ <property name="visible_horizontal">True</property>+ <property name="visible_vertical">True</property>+ </widget>+ <packing>+ <property name="expand">False</property>+ <property name="homogeneous">False</property>+ </packing>+ </child>++ <child>+ <widget class="GtkToolItem" id="toolitemZoomV">+ <property name="visible">True</property>+ <property name="visible_horizontal">True</property>+ <property name="visible_vertical">True</property>+ <property name="is_important">False</property>++ <child>+ <widget class="GtkTable" id="table3">+ <property name="visible">True</property>+ <property name="n_rows">2</property>+ <property name="n_columns">2</property>+ <property name="homogeneous">False</property>+ <property name="row_spacing">0</property>+ <property name="column_spacing">0</property>++ <child>+ <widget class="GtkLabel" id="label4">+ <property name="visible">True</property>+ <property name="label" translatable="yes">Vertical:</property>+ <property name="use_underline">False</property>+ <property name="use_markup">False</property>+ <property name="justify">GTK_JUSTIFY_LEFT</property>+ <property name="wrap">False</property>+ <property name="selectable">False</property>+ <property name="xalign">0.5</property>+ <property name="yalign">0.5</property>+ <property name="xpad">0</property>+ <property name="ypad">0</property>+ <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>+ <property name="width_chars">-1</property>+ <property name="single_line_mode">False</property>+ <property name="angle">0</property>+ </widget>+ <packing>+ <property name="left_attach">0</property>+ <property name="right_attach">2</property>+ <property name="top_attach">0</property>+ <property name="bottom_attach">1</property>+ <property name="x_options">fill</property>+ <property name="y_options"></property>+ </packing>+ </child>++ <child>+ <widget class="GtkToolButton" id="zoomInV">+ <property name="visible">True</property>+ <property name="stock_id">gtk-zoom-in</property>+ <property name="visible_horizontal">True</property>+ <property name="visible_vertical">True</property>+ <property name="is_important">False</property>+ </widget>+ <packing>+ <property name="left_attach">0</property>+ <property name="right_attach">1</property>+ <property name="top_attach">1</property>+ <property name="bottom_attach">2</property>+ <property name="x_options">fill</property>+ </packing>+ </child>++ <child>+ <widget class="GtkToolButton" id="zoomOutV">+ <property name="visible">True</property>+ <property name="stock_id">gtk-zoom-out</property>+ <property name="visible_horizontal">True</property>+ <property name="visible_vertical">True</property>+ <property name="is_important">False</property>+ </widget>+ <packing>+ <property name="left_attach">1</property>+ <property name="right_attach">2</property>+ <property name="top_attach">1</property>+ <property name="bottom_attach">2</property>+ <property name="x_options">fill</property>+ <property name="y_options">fill</property>+ </packing>+ </child>+ </widget>+ </child>+ </widget>+ <packing>+ <property name="expand">False</property>+ <property name="homogeneous">False</property>+ </packing>+ </child>+ </widget>+ <packing>+ <property name="padding">0</property>+ <property name="expand">False</property>+ <property name="fill">False</property>+ </packing>+ </child>++ <child>+ <widget class="GtkScrolledWindow" id="scrolledwindow">+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="hscrollbar_policy">GTK_POLICY_ALWAYS</property>+ <property name="vscrollbar_policy">GTK_POLICY_ALWAYS</property>+ <property name="shadow_type">GTK_SHADOW_NONE</property>+ <property name="window_placement">GTK_CORNER_TOP_LEFT</property>++ <child>+ <widget class="GtkViewport" id="viewport">+ <property name="visible">True</property>+ <property name="shadow_type">GTK_SHADOW_IN</property>++ <child>+ <widget class="GtkDrawingArea" id="drawingarea">+ <property name="visible">True</property>+ <property name="events">GDK_BUTTON1_MOTION_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK</property>+ <property name="extension_events">GDK_EXTENSION_EVENTS_ALL</property>+ </widget>+ </child>+ </widget>+ </child>+ </widget>+ <packing>+ <property name="padding">0</property>+ <property name="expand">True</property>+ <property name="fill">True</property>+ </packing>+ </child>++ <child>+ <widget class="GtkStatusbar" id="traceStatusBar">+ <property name="visible">True</property>+ <property name="has_resize_grip">True</property>+ </widget>+ <packing>+ <property name="padding">0</property>+ <property name="expand">False</property>+ <property name="fill">False</property>+ </packing>+ </child>+ </widget>+ </child>+</widget>++<widget class="GtkDialog" id="dlg_err_save_filetype">+ <property name="visible">True</property>+ <property name="title" translatable="yes">Saving file</property>+ <property name="type">GTK_WINDOW_TOPLEVEL</property>+ <property name="window_position">GTK_WIN_POS_NONE</property>+ <property name="modal">False</property>+ <property name="resizable">False</property>+ <property name="destroy_with_parent">False</property>+ <property name="icon_name">gtk-dialog-error</property>+ <property name="decorated">True</property>+ <property name="skip_taskbar_hint">False</property>+ <property name="skip_pager_hint">False</property>+ <property name="type_hint">GDK_WINDOW_TYPE_HINT_DIALOG</property>+ <property name="gravity">GDK_GRAVITY_NORTH_WEST</property>+ <property name="focus_on_map">True</property>+ <property name="urgency_hint">False</property>+ <property name="has_separator">True</property>+ <accelerator key="Escape" modifiers="0" signal="close"/>++ <child internal-child="vbox">+ <widget class="GtkVBox" id="dialog-vbox2">+ <property name="visible">True</property>+ <property name="homogeneous">False</property>+ <property name="spacing">0</property>++ <child internal-child="action_area">+ <widget class="GtkHButtonBox" id="dialog-action_area2">+ <property name="visible">True</property>+ <property name="layout_style">GTK_BUTTONBOX_END</property>++ <child>+ <widget class="GtkButton" id="okbutton1">+ <property name="visible">True</property>+ <property name="can_default">True</property>+ <property name="can_focus">True</property>+ <property name="label">gtk-ok</property>+ <property name="use_stock">True</property>+ <property name="relief">GTK_RELIEF_NORMAL</property>+ <property name="focus_on_click">True</property>+ <property name="response_id">-5</property>+ </widget>+ </child>+ </widget>+ <packing>+ <property name="padding">0</property>+ <property name="expand">False</property>+ <property name="fill">True</property>+ <property name="pack_type">GTK_PACK_END</property>+ </packing>+ </child>++ <child>+ <widget class="GtkHBox" id="hbox2">+ <property name="visible">True</property>+ <property name="homogeneous">False</property>+ <property name="spacing">0</property>++ <child>+ <widget class="GtkImage" id="image6">+ <property name="visible">True</property>+ <property name="stock">gtk-dialog-error</property>+ <property name="icon_size">6</property>+ <property name="xalign">0.5</property>+ <property name="yalign">0.5</property>+ <property name="xpad">0</property>+ <property name="ypad">0</property>+ </widget>+ <packing>+ <property name="padding">10</property>+ <property name="expand">False</property>+ <property name="fill">False</property>+ </packing>+ </child>++ <child>+ <widget class="GtkLabel" id="label5">+ <property name="visible">True</property>+ <property name="label" translatable="yes">Filetype unknown!++Use one of png, bmp, jpeg. </property>+ <property name="use_underline">False</property>+ <property name="use_markup">False</property>+ <property name="justify">GTK_JUSTIFY_LEFT</property>+ <property name="wrap">False</property>+ <property name="selectable">False</property>+ <property name="xalign">0.5</property>+ <property name="yalign">0.5</property>+ <property name="xpad">0</property>+ <property name="ypad">0</property>+ <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>+ <property name="width_chars">-1</property>+ <property name="single_line_mode">False</property>+ <property name="angle">0</property>+ </widget>+ <packing>+ <property name="padding">0</property>+ <property name="expand">True</property>+ <property name="fill">False</property>+ </packing>+ </child>+ </widget>+ <packing>+ <property name="padding">0</property>+ <property name="expand">True</property>+ <property name="fill">False</property>+ </packing>+ </child>+ </widget>+ </child>+</widget>++<widget class="GtkWindow" id="info_win">+ <property name="visible">True</property>+ <property name="title" translatable="yes">Info</property>+ <property name="type">GTK_WINDOW_TOPLEVEL</property>+ <property name="window_position">GTK_WIN_POS_MOUSE</property>+ <property name="modal">False</property>+ <property name="default_width">400</property>+ <property name="default_height">300</property>+ <property name="resizable">True</property>+ <property name="destroy_with_parent">True</property>+ <property name="icon_name">gtk-info</property>+ <property name="decorated">True</property>+ <property name="skip_taskbar_hint">False</property>+ <property name="skip_pager_hint">False</property>+ <property name="type_hint">GDK_WINDOW_TYPE_HINT_NORMAL</property>+ <property name="gravity">GDK_GRAVITY_NORTH_WEST</property>+ <property name="focus_on_map">True</property>+ <property name="urgency_hint">False</property>++ <child>+ <widget class="GtkNotebook" id="notebook1">+ <property name="border_width">5</property>+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="show_tabs">True</property>+ <property name="show_border">True</property>+ <property name="tab_pos">GTK_POS_TOP</property>+ <property name="scrollable">False</property>+ <property name="enable_popup">False</property>++ <child>+ <widget class="GtkScrolledWindow" id="scrolledwindow4">+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="hscrollbar_policy">GTK_POLICY_ALWAYS</property>+ <property name="vscrollbar_policy">GTK_POLICY_ALWAYS</property>+ <property name="shadow_type">GTK_SHADOW_NONE</property>+ <property name="window_placement">GTK_CORNER_TOP_LEFT</property>++ <child>+ <widget class="GtkViewport" id="viewport1">+ <property name="visible">True</property>+ <property name="shadow_type">GTK_SHADOW_IN</property>++ <child>+ <widget class="GtkLabel" id="infoA">+ <property name="visible">True</property>+ <property name="label" translatable="yes">label14</property>+ <property name="use_underline">False</property>+ <property name="use_markup">False</property>+ <property name="justify">GTK_JUSTIFY_LEFT</property>+ <property name="wrap">False</property>+ <property name="selectable">False</property>+ <property name="xalign">0</property>+ <property name="yalign">0</property>+ <property name="xpad">5</property>+ <property name="ypad">3</property>+ <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>+ <property name="width_chars">-1</property>+ <property name="single_line_mode">False</property>+ <property name="angle">0</property>+ </widget>+ </child>+ </widget>+ </child>+ </widget>+ <packing>+ <property name="tab_expand">False</property>+ <property name="tab_fill">True</property>+ </packing>+ </child>++ <child>+ <widget class="GtkLabel" id="label13">+ <property name="visible">True</property>+ <property name="label" translatable="yes">Overview</property>+ <property name="use_underline">False</property>+ <property name="use_markup">False</property>+ <property name="justify">GTK_JUSTIFY_LEFT</property>+ <property name="wrap">False</property>+ <property name="selectable">False</property>+ <property name="xalign">0.5</property>+ <property name="yalign">0.5</property>+ <property name="xpad">0</property>+ <property name="ypad">0</property>+ <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>+ <property name="width_chars">-1</property>+ <property name="single_line_mode">False</property>+ <property name="angle">0</property>+ </widget>+ <packing>+ <property name="type">tab</property>+ </packing>+ </child>++ <child>+ <widget class="GtkScrolledWindow" id="scrolledwindow1">+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="hscrollbar_policy">GTK_POLICY_ALWAYS</property>+ <property name="vscrollbar_policy">GTK_POLICY_ALWAYS</property>+ <property name="shadow_type">GTK_SHADOW_IN</property>+ <property name="window_placement">GTK_CORNER_TOP_LEFT</property>++ <child>+ <widget class="GtkTreeView" id="infoM">+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="headers_visible">True</property>+ <property name="rules_hint">False</property>+ <property name="reorderable">True</property>+ <property name="enable_search">True</property>+ <property name="fixed_height_mode">False</property>+ <property name="hover_selection">False</property>+ <property name="hover_expand">False</property>+ </widget>+ </child>+ </widget>+ <packing>+ <property name="tab_expand">False</property>+ <property name="tab_fill">True</property>+ </packing>+ </child>++ <child>+ <widget class="GtkLabel" id="label10">+ <property name="visible">True</property>+ <property name="label" translatable="yes">Machines</property>+ <property name="use_underline">False</property>+ <property name="use_markup">False</property>+ <property name="justify">GTK_JUSTIFY_LEFT</property>+ <property name="wrap">False</property>+ <property name="selectable">False</property>+ <property name="xalign">0.5</property>+ <property name="yalign">0.5</property>+ <property name="xpad">0</property>+ <property name="ypad">0</property>+ <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>+ <property name="width_chars">-1</property>+ <property name="single_line_mode">False</property>+ <property name="angle">0</property>+ </widget>+ <packing>+ <property name="type">tab</property>+ </packing>+ </child>++ <child>+ <widget class="GtkScrolledWindow" id="scrolledwindow2">+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="hscrollbar_policy">GTK_POLICY_ALWAYS</property>+ <property name="vscrollbar_policy">GTK_POLICY_ALWAYS</property>+ <property name="shadow_type">GTK_SHADOW_IN</property>+ <property name="window_placement">GTK_CORNER_TOP_LEFT</property>++ <child>+ <widget class="GtkTreeView" id="infoP">+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="headers_visible">True</property>+ <property name="rules_hint">False</property>+ <property name="reorderable">True</property>+ <property name="enable_search">True</property>+ <property name="fixed_height_mode">False</property>+ <property name="hover_selection">False</property>+ <property name="hover_expand">False</property>+ </widget>+ </child>+ </widget>+ <packing>+ <property name="tab_expand">False</property>+ <property name="tab_fill">True</property>+ </packing>+ </child>++ <child>+ <widget class="GtkLabel" id="label11">+ <property name="visible">True</property>+ <property name="label" translatable="yes">Processes</property>+ <property name="use_underline">False</property>+ <property name="use_markup">False</property>+ <property name="justify">GTK_JUSTIFY_LEFT</property>+ <property name="wrap">False</property>+ <property name="selectable">False</property>+ <property name="xalign">0.5</property>+ <property name="yalign">0.5</property>+ <property name="xpad">0</property>+ <property name="ypad">0</property>+ <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>+ <property name="width_chars">-1</property>+ <property name="single_line_mode">False</property>+ <property name="angle">0</property>+ </widget>+ <packing>+ <property name="type">tab</property>+ </packing>+ </child>++ <child>+ <widget class="GtkScrolledWindow" id="scrolledwindow3">+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="hscrollbar_policy">GTK_POLICY_ALWAYS</property>+ <property name="vscrollbar_policy">GTK_POLICY_ALWAYS</property>+ <property name="shadow_type">GTK_SHADOW_IN</property>+ <property name="window_placement">GTK_CORNER_TOP_LEFT</property>++ <child>+ <widget class="GtkTreeView" id="infoT">+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="headers_visible">True</property>+ <property name="rules_hint">False</property>+ <property name="reorderable">True</property>+ <property name="enable_search">True</property>+ <property name="fixed_height_mode">False</property>+ <property name="hover_selection">False</property>+ <property name="hover_expand">False</property>+ </widget>+ </child>+ </widget>+ <packing>+ <property name="tab_expand">False</property>+ <property name="tab_fill">True</property>+ </packing>+ </child>++ <child>+ <widget class="GtkLabel" id="label12">+ <property name="visible">True</property>+ <property name="label" translatable="yes">Threads</property>+ <property name="use_underline">False</property>+ <property name="use_markup">False</property>+ <property name="justify">GTK_JUSTIFY_LEFT</property>+ <property name="wrap">False</property>+ <property name="selectable">False</property>+ <property name="xalign">0.5</property>+ <property name="yalign">0.5</property>+ <property name="xpad">0</property>+ <property name="ypad">0</property>+ <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>+ <property name="width_chars">-1</property>+ <property name="single_line_mode">False</property>+ <property name="angle">0</property>+ </widget>+ <packing>+ <property name="type">tab</property>+ </packing>+ </child>+ </widget>+ </child>+</widget>++++++++++++<widget class="GtkWindow" id="confmsgs_win">+ <property name="visible">True</property>+ <property name="title" translatable="yes">Configure Messages</property>+ <property name="window_position">mouse</property>+ <property name="default_width">400</property>+ <property name="default_height">300</property>+ <property name="destroy_with_parent">True</property>+ <property name="icon_name">gtk-info</property>+ <child>+ <widget class="GtkNotebook" id="notebook1">+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <child>+ <widget class="GtkVBox" id="vbox1">+ <property name="visible">True</property>+ <property name="orientation">vertical</property>+ <child>+ <widget class="GtkHBox" id="hbox1">+ <property name="height_request">50</property>+ <property name="visible">True</property>+ <child>+ <widget class="GtkButton" id="store_m">+ <property name="label" translatable="yes">Store</property>+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="receives_default">True</property>+ </widget>+ <packing>+ <property name="position">0</property>+ </packing>+ </child>+ <child>+ <widget class="GtkVBox" id="vbox2">+ <property name="visible">True</property>+ <property name="orientation">vertical</property>+ <child>+ <widget class="GtkButton" id="all_out_m">+ <property name="label" translatable="yes">All (send)</property>+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="receives_default">True</property>+ </widget>+ <packing>+ <property name="position">0</property>+ </packing>+ </child>+ <child>+ <widget class="GtkButton" id="none_out_m">+ <property name="label" translatable="yes">None (send)</property>+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="receives_default">True</property>+ </widget>+ <packing>+ <property name="position">1</property>+ </packing>+ </child>+ </widget>+ <packing>+ <property name="position">1</property>+ </packing>+ </child>+ <child>+ <widget class="GtkVBox" id="vbox3">+ <property name="visible">True</property>+ <property name="orientation">vertical</property>+ <child>+ <widget class="GtkButton" id="all_in_m">+ <property name="label" translatable="yes">All (receive)</property>+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="receives_default">True</property>+ </widget>+ <packing>+ <property name="position">0</property>+ </packing>+ </child>+ <child>+ <widget class="GtkButton" id="none_in_m">+ <property name="label" translatable="yes">None (receive)</property>+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="receives_default">True</property>+ </widget>+ <packing>+ <property name="position">1</property>+ </packing>+ </child>+ + </widget>+ <packing>+ <property name="position">2</property>+ </packing>+ </child>+ </widget>+ <packing>+ <property name="expand">False</property>+ <property name="fill">False</property>+ <property name="position">0</property>+ </packing>+ </child>+ <child>+ <widget class="GtkScrolledWindow" id="scrolledwindow1">+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="hscrollbar_policy">automatic</property>+ <property name="vscrollbar_policy">automatic</property>+ <child>+ <widget class="GtkTreeView" id="confM">+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ </widget>+ </child>+ </widget>+ <packing>+ <property name="position">1</property>+ </packing>+ </child>+ </widget>+ </child>+ <child>+ <widget class="GtkLabel" id="label1">+ <property name="visible">True</property>+ <property name="label" translatable="yes">Machines</property>+ </widget>+ <packing>+ <property name="tab_fill">False</property>+ <property name="type">tab</property>+ </packing>+ </child>+ <child>+ <widget class="GtkVBox" id="vbox4">+ <property name="visible">True</property>+ <property name="orientation">vertical</property>+ <child>+ <widget class="GtkHBox" id="hbox2">+ <property name="height_request">50</property>+ <property name="visible">True</property>+ <child>+ <widget class="GtkButton" id="store_p">+ <property name="label" translatable="yes">Store</property>+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="receives_default">True</property>+ </widget>+ <packing>+ <property name="position">0</property>+ </packing>+ </child>+ <child>+ <widget class="GtkVBox" id="vbox5">+ <property name="visible">True</property>+ <property name="orientation">vertical</property>+ <child>+ <widget class="GtkButton" id="all_out_p">+ <property name="label" translatable="yes">All (send)</property>+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="receives_default">True</property>+ </widget>+ <packing>+ <property name="position">0</property>+ </packing>+ </child>+ <child>+ <widget class="GtkButton" id="none_out_p">+ <property name="label" translatable="yes">None (send)</property>+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="receives_default">True</property>+ </widget>+ <packing>+ <property name="position">1</property>+ </packing>+ </child>+ </widget>+ <packing>+ <property name="position">1</property>+ </packing>+ </child>+ <child>+ <widget class="GtkVBox" id="vbox6">+ <property name="visible">True</property>+ <property name="orientation">vertical</property>+ <child>+ <widget class="GtkButton" id="all_in_p">+ <property name="label" translatable="yes">All (receive)</property>+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="receives_default">True</property>+ </widget>+ <packing>+ <property name="position">0</property>+ </packing>+ </child>+ <child>+ <widget class="GtkButton" id="none_in_p">+ <property name="label" translatable="yes">None (receive)</property>+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="receives_default">True</property>+ </widget>+ <packing>+ <property name="position">1</property>+ </packing>+ </child>+ </widget>+ <packing>+ <property name="position">2</property>+ </packing>+ </child>+ </widget>+ <packing>+ <property name="expand">False</property>+ <property name="position">0</property>+ </packing>+ </child>+ <child>+ <widget class="GtkScrolledWindow" id="scrolledwindow2">+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="hscrollbar_policy">automatic</property>+ <property name="vscrollbar_policy">automatic</property>+ <child>+ <widget class="GtkTreeView" id="confP">+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ </widget>+ </child>+ </widget>+ <packing>+ <property name="position">1</property>+ </packing>+ </child>+ </widget>+ <packing>+ <property name="position">1</property>+ </packing>+ </child>+ <child>+ <widget class="GtkLabel" id="label2">+ <property name="visible">True</property>+ <property name="label" translatable="yes">Processes</property>+ </widget>+ <packing>+ <property name="position">1</property>+ <property name="tab_fill">False</property>+ <property name="type">tab</property>+ </packing>+ </child>+ <child>+ <placeholder/>+ </child>+ <child>+ <placeholder/>+ <packing>+ <property name="type">tab</property>+ </packing>+ </child>+ </widget>+ </child>+ </widget>++<widget class="GtkWindow" id="ticks_win">+ <child>+ <widget class="GtkVBox" id="vbox1">+ <property name="visible">True</property>+ <property name="orientation">vertical</property>+ <child>+ <widget class="GtkHBox" id="hbox1">+ <property name="height_request">50</property>+ <property name="visible">True</property>+ <child>+ <widget class="GtkVBox" id="vbox2">+ <property name="visible">True</property>+ <property name="orientation">vertical</property>+ <child>+ <widget class="GtkLabel" id="label1">+ <property name="height_request">21</property>+ <property name="visible">True</property>+ <property name="label" translatable="yes">Draw Tick every x Seconds:</property>+ </widget>+ <packing>+ <property name="expand">False</property>+ <property name="position">0</property>+ </packing>+ </child>+ <child>+ <widget class="GtkSpinButton" id="ticks_skip">+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="invisible_char">●</property>+ </widget>+ <packing>+ <property name="expand">False</property>+ <property name="position">1</property>+ </packing>+ </child>+ </widget>+ <packing>+ <property name="position">0</property>+ </packing>+ </child>+ <child>+ <widget class="GtkVBox" id="vbox3">+ <property name="visible">True</property>+ <property name="orientation">vertical</property>+ <child>+ <widget class="GtkLabel" id="label2">+ <property name="height_request">21</property>+ <property name="visible">True</property>+ <property name="label" translatable="yes">Draw Time every x tick:</property>+ </widget>+ <packing>+ <property name="expand">False</property>+ <property name="fill">False</property>+ <property name="position">0</property>+ </packing>+ </child>+ <child>+ <widget class="GtkSpinButton" id="ticks_mark">+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="invisible_char">●</property>+ </widget>+ <packing>+ <property name="expand">False</property>+ <property name="position">1</property>+ </packing>+ </child>+ </widget>+ <packing>+ <property name="position">1</property>+ </packing>+ </child>+ </widget>+ <packing>+ <property name="expand">False</property>+ <property name="fill">False</property>+ <property name="position">0</property>+ </packing>+ </child>++ <child>+ <widget class="GtkCheckButton" id="auto_ticks">+ <property name="label" translatable="yes">Auto</property>+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="receives_default">False</property>+ <property name="draw_indicator">True</property>+ </widget>+ </child>++ <child>+ <widget class="GtkButton" id="set_ticks">+ <property name="label" translatable="yes">Set Ticks</property>+ <property name="height_request">26</property>+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="receives_default">True</property>+ </widget>+ <packing>+ <property name="expand">False</property>+ <property name="fill">False</property>+ <property name="position">1</property>+ </packing>+ </child>+ </widget>+ </child>+ </widget>++ <widget class="GtkWindow" id="range_win">+ <child>+ <widget class="GtkVBox" id="vbox1">+ <property name="visible">True</property>+ <property name="orientation">vertical</property>+ <child>+ <widget class="GtkHBox" id="hbox1">+ <property name="height_request">50</property>+ <property name="visible">True</property>+ <child>+ <widget class="GtkVBox" id="vbox2">+ <property name="visible">True</property>+ <property name="orientation">vertical</property>+ <child>+ <widget class="GtkLabel" id="label1">+ <property name="height_request">21</property>+ <property name="visible">True</property>+ <property name="label" translatable="yes">Start Time:</property>+ </widget>+ <packing>+ <property name="expand">False</property>+ <property name="position">0</property>+ </packing>+ </child>+ <child>+ <widget class="GtkSpinButton" id="range_begin">+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="invisible_char">●</property>+ </widget>+ <packing>+ <property name="expand">False</property>+ <property name="position">1</property>+ </packing>+ </child>+ </widget>+ <packing>+ <property name="position">0</property>+ </packing>+ </child>+ <child>+ <widget class="GtkVBox" id="vbox3">+ <property name="visible">True</property>+ <property name="orientation">vertical</property>+ <child>+ <widget class="GtkLabel" id="label2">+ <property name="height_request">21</property>+ <property name="visible">True</property>+ <property name="label" translatable="yes">End Time:</property>+ </widget>+ <packing>+ <property name="expand">False</property>+ <property name="fill">False</property>+ <property name="position">0</property>+ </packing>+ </child>+ <child>+ <widget class="GtkSpinButton" id="range_end">+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="invisible_char">●</property>+ </widget>+ <packing>+ <property name="expand">False</property>+ <property name="position">1</property>+ </packing>+ </child>+ </widget>+ <packing>+ <property name="position">1</property>+ </packing>+ </child>+ </widget>+ <packing>+ <property name="expand">False</property>+ <property name="fill">False</property>+ <property name="position">0</property>+ </packing>+ </child>+ <child>+ <widget class="GtkButton" id="show_intervall">+ <property name="label" translatable="yes">Show Range</property>+ <property name="height_request">26</property>+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="receives_default">True</property>+ </widget>+ <packing>+ <property name="expand">False</property>+ <property name="fill">False</property>+ <property name="position">1</property>+ </packing>+ </child>+ </widget>+ </child>+ </widget>++ <widget class="GtkDialog" id="dialogColors">+ <property name="border_width">5</property>+ <property name="title" translatable="yes">Set Colors</property>+ <property name="resizable">False</property>+ <property name="type_hint">normal</property>+ <property name="modal">True</property>+ <property name="has_separator">False</property>+ <property name="icon_name">preferences-other</property>+ <property name="type">GTK_WINDOW_TOPLEVEL</property>+ <child internal-child="vbox">+ <widget class="GtkVBox" id="dialog-vbox2">+ <property name="visible">True</property>+ <property name="spacing">2</property>+ <child>+ <widget class="GtkTable" id="table1">+ <property name="visible">True</property>+ <property name="n_rows">2</property>+ <property name="n_columns">2</property>+ <property name="column_spacing">3</property>+ <property name="row_spacing">3</property>+ <child>+ <widget class="GtkFrame" id="frame1">+ <property name="visible">True</property>+ <property name="label_xalign">0</property>+ <child>+ <widget class="GtkAlignment" id="alignment1">+ <property name="visible">True</property>+ <property name="left_padding">12</property>+ <child>+ <widget class="GtkTable" id="table2">+ <property name="visible">True</property>+ <property name="n_rows">4</property>+ <property name="n_columns">2</property>+ <child>+ <widget class="GtkLabel" id="label2">+ <property name="visible">True</property>+ <property name="xalign">0</property>+ <property name="xpad">4</property>+ <property name="label" translatable="yes">Running:</property>+ </widget>+ </child>+ <child>+ <widget class="GtkLabel" id="label3">+ <property name="visible">True</property>+ <property name="xalign">0</property>+ <property name="xpad">4</property>+ <property name="label" translatable="yes">Suspended:</property>+ </widget>+ <packing>+ <property name="top_attach">1</property>+ <property name="bottom_attach">2</property>+ </packing>+ </child>+ <child>+ <widget class="GtkLabel" id="label4">+ <property name="visible">True</property>+ <property name="xalign">0</property>+ <property name="xpad">4</property>+ <property name="label" translatable="yes">Blocked:</property>+ </widget>+ <packing>+ <property name="top_attach">2</property>+ <property name="bottom_attach">3</property>+ </packing>+ </child>+ <child>+ <widget class="GtkLabel" id="label5">+ <property name="visible">True</property>+ <property name="xalign">0</property>+ <property name="xpad">4</property>+ <property name="label" translatable="yes">Idle:</property>+ </widget>+ <packing>+ <property name="top_attach">3</property>+ <property name="bottom_attach">4</property>+ </packing>+ </child>+ <child>+ <widget class="GtkColorButton" id="btnStatusRunning">+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="receives_default">True</property>+ <property name="has_tooltip">True</property>+ <property name="tooltip" translatable="yes">Running</property>+ <property name="title" translatable="yes">Running</property>+ <property name="color">#000000000000</property>+ <property name="use_alpha">True</property>+ </widget>+ <packing>+ <property name="left_attach">1</property>+ <property name="right_attach">2</property>+ <property name="x_options">GTK_FILL</property>+ <property name="y_options"></property>+ </packing>+ </child>+ <child>+ <widget class="GtkColorButton" id="btnStatusSuspended">+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="receives_default">True</property>+ <property name="has_tooltip">True</property>+ <property name="tooltip" translatable="yes">Suspended</property>+ <property name="title" translatable="yes">Suspended</property>+ <property name="color">#000000000000</property>+ <property name="use_alpha">True</property>+ </widget>+ <packing>+ <property name="left_attach">1</property>+ <property name="right_attach">2</property>+ <property name="top_attach">1</property>+ <property name="bottom_attach">2</property>+ <property name="x_options">GTK_FILL</property>+ <property name="y_options"></property>+ </packing>+ </child>+ <child>+ <widget class="GtkColorButton" id="btnStatusBlocked">+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="receives_default">True</property>+ <property name="has_tooltip">True</property>+ <property name="tooltip" translatable="yes">Blocked</property>+ <property name="title" translatable="yes">Blocked</property>+ <property name="color">#000000000000</property>+ <property name="use_alpha">True</property>+ </widget>+ <packing>+ <property name="left_attach">1</property>+ <property name="right_attach">2</property>+ <property name="top_attach">2</property>+ <property name="bottom_attach">3</property>+ <property name="x_options">GTK_FILL</property>+ <property name="y_options"></property>+ </packing>+ </child>+ <child>+ <widget class="GtkColorButton" id="btnStatusIdle">+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="receives_default">True</property>+ <property name="has_tooltip">True</property>+ <property name="tooltip" translatable="yes">Idle</property>+ <property name="title" translatable="yes">Idle</property>+ <property name="color">#000000000000</property>+ <property name="use_alpha">True</property>+ </widget>+ <packing>+ <property name="left_attach">1</property>+ <property name="right_attach">2</property>+ <property name="top_attach">3</property>+ <property name="bottom_attach">4</property>+ <property name="x_options">GTK_FILL</property>+ <property name="y_options"></property>+ </packing>+ </child>+ </widget>+ </child>+ </widget>+ </child>+ <child>+ <widget class="GtkLabel" id="label1">+ <property name="visible">True</property>+ <property name="label" translatable="yes"><b>Status</b></property>+ <property name="use_markup">True</property>+ </widget>+ <packing>+ <property name="type">label_item</property>+ </packing>+ </child>+ </widget>+ </child>+ <child>+ <widget class="GtkFrame" id="frame2">+ <property name="visible">True</property>+ <property name="label_xalign">0</property>+ <child>+ <widget class="GtkAlignment" id="alignment2">+ <property name="visible">True</property>+ <property name="left_padding">12</property>+ <child>+ <widget class="GtkTable" id="table3">+ <property name="visible">True</property>+ <property name="n_rows">5</property>+ <property name="n_columns">2</property>+ <child>+ <widget class="GtkLabel" id="label6">+ <property name="visible">True</property>+ <property name="xalign">0</property>+ <property name="xpad">4</property>+ <property name="label" translatable="yes">System-Messages:</property>+ </widget>+ </child>+ <child>+ <widget class="GtkLabel" id="label7">+ <property name="visible">True</property>+ <property name="xalign">0</property>+ <property name="xpad">4</property>+ <property name="label" translatable="yes">Head-Messages:</property>+ </widget>+ <packing>+ <property name="top_attach">1</property>+ <property name="bottom_attach">2</property>+ </packing>+ </child>+ <child>+ <widget class="GtkLabel" id="label8">+ <property name="visible">True</property>+ <property name="xalign">0</property>+ <property name="xpad">4</property>+ <property name="label" translatable="yes">Data-Messages:</property>+ </widget>+ <packing>+ <property name="top_attach">2</property>+ <property name="bottom_attach">3</property>+ </packing>+ </child>+ <child>+ <widget class="GtkLabel" id="label9">+ <property name="visible">True</property>+ <property name="xalign">0</property>+ <property name="xpad">4</property>+ <property name="label" translatable="yes">Block-Messages:</property>+ </widget>+ <packing>+ <property name="top_attach">3</property>+ <property name="bottom_attach">4</property>+ </packing>+ </child>+ <child>+ <widget class="GtkLabel" id="label10">+ <property name="visible">True</property>+ <property name="xalign">0</property>+ <property name="xpad">4</property>+ <property name="label" translatable="yes">Receive-Phase:</property>+ </widget>+ <packing>+ <property name="top_attach">4</property>+ <property name="bottom_attach">5</property>+ </packing>+ </child>+ <child>+ <widget class="GtkColorButton" id="btnMessagesSystem">+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="receives_default">True</property>+ <property name="has_tooltip">True</property>+ <property name="tooltip" translatable="yes">System-Messages</property>+ <property name="title" translatable="yes">System-Messages</property>+ <property name="color">#000000000000</property>+ <property name="use_alpha">True</property>+ </widget>+ <packing>+ <property name="left_attach">1</property>+ <property name="right_attach">2</property>+ <property name="x_options">GTK_FILL</property>+ <property name="y_options"></property>+ </packing>+ </child>+ <child>+ <widget class="GtkColorButton" id="btnMessagesHead">+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="receives_default">True</property>+ <property name="has_tooltip">True</property>+ <property name="tooltip" translatable="yes">Head-Messages</property>+ <property name="title" translatable="yes">Head-Messages</property>+ <property name="color">#000000000000</property>+ <property name="use_alpha">True</property>+ </widget>+ <packing>+ <property name="left_attach">1</property>+ <property name="right_attach">2</property>+ <property name="top_attach">1</property>+ <property name="bottom_attach">2</property>+ <property name="x_options">GTK_FILL</property>+ <property name="y_options"></property>+ </packing>+ </child>+ <child>+ <widget class="GtkColorButton" id="btnMessagesData">+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="receives_default">True</property>+ <property name="has_tooltip">True</property>+ <property name="tooltip" translatable="yes">Data-Messages</property>+ <property name="title" translatable="yes">Data-Messages</property>+ <property name="color">#000000000000</property>+ <property name="use_alpha">True</property>+ </widget>+ <packing>+ <property name="left_attach">1</property>+ <property name="right_attach">2</property>+ <property name="top_attach">2</property>+ <property name="bottom_attach">3</property>+ <property name="x_options">GTK_FILL</property>+ <property name="y_options"></property>+ </packing>+ </child>+ <child>+ <widget class="GtkColorButton" id="btnMessagesBlock">+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="receives_default">True</property>+ <property name="has_tooltip">True</property>+ <property name="tooltip" translatable="yes">Block-Messages</property>+ <property name="title" translatable="yes">Block-Messages</property>+ <property name="color">#000000000000</property>+ <property name="use_alpha">False</property>+ </widget>+ <packing>+ <property name="left_attach">1</property>+ <property name="right_attach">2</property>+ <property name="top_attach">3</property>+ <property name="bottom_attach">4</property>+ <property name="x_options">GTK_FILL</property>+ <property name="y_options"></property>+ </packing>+ </child>+ <child>+ <widget class="GtkColorButton" id="btnMessagesReceive">+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="receives_default">True</property>+ <property name="has_tooltip">True</property>+ <property name="tooltip" translatable="yes">Receive-Phase</property>+ <property name="title" translatable="yes">Receive-Phase</property>+ <property name="color">#000000000000</property>+ <property name="use_alpha">True</property>+ </widget>+ <packing>+ <property name="left_attach">1</property>+ <property name="right_attach">2</property>+ <property name="top_attach">4</property>+ <property name="bottom_attach">5</property>+ <property name="x_options">GTK_FILL</property>+ <property name="y_options"></property>+ </packing>+ </child>+ </widget>+ </child>+ </widget>+ </child>+ <child>+ <widget class="GtkLabel" id="label10">+ <property name="visible">True</property>+ <property name="label" translatable="yes"><b>Messages</b></property>+ <property name="use_markup">True</property>+ </widget>+ <packing>+ <property name="type">label_item</property>+ </packing>+ </child>+ </widget>+ <packing>+ <property name="left_attach">1</property>+ <property name="right_attach">2</property>+ </packing>+ </child>+ <child>+ <widget class="GtkFrame" id="frame3">+ <property name="visible">True</property>+ <property name="label_xalign">0</property>+ <child>+ <widget class="GtkAlignment" id="alignment3">+ <property name="visible">True</property>+ <property name="left_padding">12</property>+ <child>+ <widget class="GtkTable" id="table4">+ <property name="visible">True</property>+ <property name="n_rows">3</property>+ <property name="n_columns">2</property>+ <child>+ <widget class="GtkLabel" id="label11">+ <property name="visible">True</property>+ <property name="xalign">0</property>+ <property name="xpad">4</property>+ <property name="label" translatable="yes">Marker-Line:</property>+ </widget>+ </child>+ <child>+ <widget class="GtkLabel" id="label12">+ <property name="visible">True</property>+ <property name="xalign">0</property>+ <property name="xpad">4</property>+ <property name="label" translatable="yes">Marker-Label:</property>+ </widget>+ <packing>+ <property name="top_attach">1</property>+ <property name="bottom_attach">2</property>+ </packing>+ </child>+ <child>+ <widget class="GtkLabel" id="label13">+ <property name="visible">True</property>+ <property name="xalign">0</property>+ <property name="xpad">4</property>+ <property name="label" translatable="yes">Startup-Marker:</property>+ </widget>+ <packing>+ <property name="top_attach">2</property>+ <property name="bottom_attach">3</property>+ </packing>+ </child>+ <child>+ <widget class="GtkColorButton" id="btnMarkerLine">+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="receives_default">True</property>+ <property name="has_tooltip">True</property>+ <property name="tooltip" translatable="yes">Marker-Line</property>+ <property name="title" translatable="yes">Marker-Line</property>+ <property name="color">#000000000000</property>+ <property name="use_alpha">True</property>+ </widget>+ <packing>+ <property name="left_attach">1</property>+ <property name="right_attach">2</property>+ <property name="x_options">GTK_FILL</property>+ <property name="y_options"></property>+ </packing>+ </child>+ <child>+ <widget class="GtkColorButton" id="btnMarkerLabel">+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="receives_default">True</property>+ <property name="has_tooltip">True</property>+ <property name="tooltip" translatable="yes">Marker-Label</property>+ <property name="title" translatable="yes">Marker-Label</property>+ <property name="color">#000000000000</property>+ <property name="use_alpha">True</property>+ </widget>+ <packing>+ <property name="left_attach">1</property>+ <property name="right_attach">2</property>+ <property name="top_attach">1</property>+ <property name="bottom_attach">2</property>+ <property name="x_options">GTK_FILL</property>+ <property name="y_options"></property>+ </packing>+ </child>+ <child>+ <widget class="GtkColorButton" id="btnMarkerStartup">+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="receives_default">True</property>+ <property name="has_tooltip">True</property>+ <property name="tooltip" translatable="yes">Startup-Marker</property>+ <property name="title" translatable="yes">Startup-Marker</property>+ <property name="color">#000000000000</property>+ <property name="use_alpha">True</property>+ </widget>+ <packing>+ <property name="left_attach">1</property>+ <property name="right_attach">2</property>+ <property name="top_attach">2</property>+ <property name="bottom_attach">3</property>+ <property name="x_options">GTK_FILL</property>+ <property name="y_options"></property>+ </packing>+ </child>+ </widget>+ </child>+ </widget>+ </child>+ <child>+ <widget class="GtkLabel" id="label15">+ <property name="visible">True</property>+ <property name="label" translatable="yes"><b>Marker</b></property>+ <property name="use_markup">True</property>+ </widget>+ <packing>+ <property name="type">label_item</property>+ </packing>+ </child>+ </widget>+ <packing>+ <property name="top_attach">1</property>+ <property name="bottom_attach">2</property>+ </packing>+ </child>+ <child>+ <widget class="GtkFrame" id="frame4">+ <property name="visible">True</property>+ <property name="label_xalign">0</property>+ <child>+ <widget class="GtkAlignment" id="alignment4">+ <property name="visible">True</property>+ <property name="left_padding">12</property>+ <child>+ <widget class="GtkTable" id="table5">+ <property name="visible">True</property>+ <property name="n_rows">3</property>+ <property name="n_columns">2</property>+ <child>+ <widget class="GtkLabel" id="label14">+ <property name="visible">True</property>+ <property name="xalign">0</property>+ <property name="xpad">4</property>+ <property name="label" translatable="yes">Background:</property>+ </widget>+ </child>+ <child>+ <widget class="GtkLabel" id="label16">+ <property name="visible">True</property>+ <property name="xalign">0</property>+ <property name="xpad">4</property>+ <property name="label" translatable="yes">Axes:</property>+ </widget>+ <packing>+ <property name="top_attach">1</property>+ <property name="bottom_attach">2</property>+ </packing>+ </child>+ <child>+ <widget class="GtkLabel" id="label17">+ <property name="visible">True</property>+ <property name="xalign">0</property>+ <property name="xpad">4</property>+ <property name="label" translatable="yes">Axes-Label:</property>+ </widget>+ <packing>+ <property name="top_attach">2</property>+ <property name="bottom_attach">3</property>+ </packing>+ </child>+ <child>+ <widget class="GtkColorButton" id="btnChartBackground">+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="receives_default">True</property>+ <property name="has_tooltip">True</property>+ <property name="tooltip" translatable="yes">Background-Color</property>+ <property name="title" translatable="yes">Background-Color</property>+ <property name="color">#000000000000</property>+ <property name="use_alpha">True</property>+ </widget>+ <packing>+ <property name="left_attach">1</property>+ <property name="right_attach">2</property>+ <property name="x_options">GTK_FILL</property>+ <property name="y_options"></property>+ </packing>+ </child>+ <child>+ <widget class="GtkColorButton" id="btnChartAxes">+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="receives_default">True</property>+ <property name="has_tooltip">True</property>+ <property name="tooltip" translatable="yes">Axes</property>+ <property name="title" translatable="yes">Axes</property>+ <property name="color">#000000000000</property>+ <property name="use_alpha">True</property>+ </widget>+ <packing>+ <property name="left_attach">1</property>+ <property name="right_attach">2</property>+ <property name="top_attach">1</property>+ <property name="bottom_attach">2</property>+ <property name="x_options">GTK_FILL</property>+ <property name="y_options"></property>+ </packing>+ </child>+ <child>+ <widget class="GtkColorButton" id="btnAxesLabel">+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="receives_default">True</property>+ <property name="has_tooltip">True</property>+ <property name="tooltip" translatable="yes">Axes-Label</property>+ <property name="title" translatable="yes">Axes-Label</property>+ <property name="color">#000000000000</property>+ <property name="use_alpha">True</property>+ </widget>+ <packing>+ <property name="left_attach">1</property>+ <property name="right_attach">2</property>+ <property name="top_attach">2</property>+ <property name="bottom_attach">3</property>+ <property name="x_options">GTK_FILL</property>+ <property name="y_options"></property>+ </packing>+ </child>+ </widget>+ </child>+ </widget>+ </child>+ <child>+ <widget class="GtkLabel" id="label18">+ <property name="visible">True</property>+ <property name="label" translatable="yes"><b>Chart</b></property>+ <property name="use_markup">True</property>+ </widget>+ <packing>+ <property name="type">label_item</property>+ </packing>+ </child>+ </widget>+ <packing>+ <property name="left_attach">1</property>+ <property name="right_attach">2</property>+ <property name="top_attach">1</property>+ <property name="bottom_attach">2</property>+ </packing>+ </child>+ </widget>+ <packing>+ <property name="position">1</property>+ </packing>+ </child>+ <child internal-child="action_area">+ <widget class="GtkHButtonBox" id="dialog-action_area2">+ <property name="visible">True</property>+ <property name="layout_style">end</property>+ <child>+ <widget class="GtkButton" id="btnColorsCancel">+ <property name="label">gtk-cancel</property>+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="receives_default">True</property>+ <property name="use_stock">True</property>+ </widget>+ <packing>+ <property name="expand">False</property>+ <property name="fill">False</property>+ <property name="position">0</property>+ </packing>+ </child>+ <child>+ <widget class="GtkButton" id="btnColorsSave">+ <property name="label">gtk-ok</property>+ <property name="response_id">-3</property>+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="receives_default">True</property>+ <property name="use_stock">True</property>+ </widget>+ <packing>+ <property name="expand">False</property>+ <property name="fill">False</property>+ <property name="position">1</property>+ </packing>+ </child>+ </widget>+ <packing>+ <property name="expand">False</property>+ <property name="pack_type">end</property>+ <property name="position">0</property>+ </packing>+ </child>+ </widget>+ </child>+ </widget>+</glade-interface>
+ gpl.txt view
@@ -0,0 +1,674 @@+ GNU GENERAL PUBLIC LICENSE+ Version 3, 29 June 2007++ Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>+ Everyone is permitted to copy and distribute verbatim copies+ of this license document, but changing it is not allowed.++ Preamble++ The GNU General Public License is a free, copyleft license for+software and other kinds of works.++ The licenses for most software and other practical works are designed+to take away your freedom to share and change the works. By contrast,+the GNU General Public License is intended to guarantee your freedom to+share and change all versions of a program--to make sure it remains free+software for all its users. We, the Free Software Foundation, use the+GNU General Public License for most of our software; it applies also to+any other work released this way by its authors. You can apply it to+your programs, too.++ When we speak of free software, we are referring to freedom, not+price. Our General Public Licenses are designed to make sure that you+have the freedom to distribute copies of free software (and charge for+them if you wish), that you receive source code or can get it if you+want it, that you can change the software or use pieces of it in new+free programs, and that you know you can do these things.++ To protect your rights, we need to prevent others from denying you+these rights or asking you to surrender the rights. Therefore, you have+certain responsibilities if you distribute copies of the software, or if+you modify it: responsibilities to respect the freedom of others.++ For example, if you distribute copies of such a program, whether+gratis or for a fee, you must pass on to the recipients the same+freedoms that you received. You must make sure that they, too, receive+or can get the source code. And you must show them these terms so they+know their rights.++ Developers that use the GNU GPL protect your rights with two steps:+(1) assert copyright on the software, and (2) offer you this License+giving you legal permission to copy, distribute and/or modify it.++ For the developers' and authors' protection, the GPL clearly explains+that there is no warranty for this free software. For both users' and+authors' sake, the GPL requires that modified versions be marked as+changed, so that their problems will not be attributed erroneously to+authors of previous versions.++ Some devices are designed to deny users access to install or run+modified versions of the software inside them, although the manufacturer+can do so. This is fundamentally incompatible with the aim of+protecting users' freedom to change the software. The systematic+pattern of such abuse occurs in the area of products for individuals to+use, which is precisely where it is most unacceptable. Therefore, we+have designed this version of the GPL to prohibit the practice for those+products. If such problems arise substantially in other domains, we+stand ready to extend this provision to those domains in future versions+of the GPL, as needed to protect the freedom of users.++ Finally, every program is threatened constantly by software patents.+States should not allow patents to restrict development and use of+software on general-purpose computers, but in those that do, we wish to+avoid the special danger that patents applied to a free program could+make it effectively proprietary. To prevent this, the GPL assures that+patents cannot be used to render the program non-free.++ The precise terms and conditions for copying, distribution and+modification follow.++ TERMS AND CONDITIONS++ 0. Definitions.++ "This License" refers to version 3 of the GNU General Public License.++ "Copyright" also means copyright-like laws that apply to other kinds of+works, such as semiconductor masks.++ "The Program" refers to any copyrightable work licensed under this+License. Each licensee is addressed as "you". "Licensees" and+"recipients" may be individuals or organizations.++ To "modify" a work means to copy from or adapt all or part of the work+in a fashion requiring copyright permission, other than the making of an+exact copy. The resulting work is called a "modified version" of the+earlier work or a work "based on" the earlier work.++ A "covered work" means either the unmodified Program or a work based+on the Program.++ To "propagate" a work means to do anything with it that, without+permission, would make you directly or secondarily liable for+infringement under applicable copyright law, except executing it on a+computer or modifying a private copy. Propagation includes copying,+distribution (with or without modification), making available to the+public, and in some countries other activities as well.++ To "convey" a work means any kind of propagation that enables other+parties to make or receive copies. Mere interaction with a user through+a computer network, with no transfer of a copy, is not conveying.++ An interactive user interface displays "Appropriate Legal Notices"+to the extent that it includes a convenient and prominently visible+feature that (1) displays an appropriate copyright notice, and (2)+tells the user that there is no warranty for the work (except to the+extent that warranties are provided), that licensees may convey the+work under this License, and how to view a copy of this License. If+the interface presents a list of user commands or options, such as a+menu, a prominent item in the list meets this criterion.++ 1. Source Code.++ The "source code" for a work means the preferred form of the work+for making modifications to it. "Object code" means any non-source+form of a work.++ A "Standard Interface" means an interface that either is an official+standard defined by a recognized standards body, or, in the case of+interfaces specified for a particular programming language, one that+is widely used among developers working in that language.++ The "System Libraries" of an executable work include anything, other+than the work as a whole, that (a) is included in the normal form of+packaging a Major Component, but which is not part of that Major+Component, and (b) serves only to enable use of the work with that+Major Component, or to implement a Standard Interface for which an+implementation is available to the public in source code form. A+"Major Component", in this context, means a major essential component+(kernel, window system, and so on) of the specific operating system+(if any) on which the executable work runs, or a compiler used to+produce the work, or an object code interpreter used to run it.++ The "Corresponding Source" for a work in object code form means all+the source code needed to generate, install, and (for an executable+work) run the object code and to modify the work, including scripts to+control those activities. However, it does not include the work's+System Libraries, or general-purpose tools or generally available free+programs which are used unmodified in performing those activities but+which are not part of the work. For example, Corresponding Source+includes interface definition files associated with source files for+the work, and the source code for shared libraries and dynamically+linked subprograms that the work is specifically designed to require,+such as by intimate data communication or control flow between those+subprograms and other parts of the work.++ The Corresponding Source need not include anything that users+can regenerate automatically from other parts of the Corresponding+Source.++ The Corresponding Source for a work in source code form is that+same work.++ 2. Basic Permissions.++ All rights granted under this License are granted for the term of+copyright on the Program, and are irrevocable provided the stated+conditions are met. This License explicitly affirms your unlimited+permission to run the unmodified Program. The output from running a+covered work is covered by this License only if the output, given its+content, constitutes a covered work. This License acknowledges your+rights of fair use or other equivalent, as provided by copyright law.++ You may make, run and propagate covered works that you do not+convey, without conditions so long as your license otherwise remains+in force. You may convey covered works to others for the sole purpose+of having them make modifications exclusively for you, or provide you+with facilities for running those works, provided that you comply with+the terms of this License in conveying all material for which you do+not control copyright. Those thus making or running the covered works+for you must do so exclusively on your behalf, under your direction+and control, on terms that prohibit them from making any copies of+your copyrighted material outside their relationship with you.++ Conveying under any other circumstances is permitted solely under+the conditions stated below. Sublicensing is not allowed; section 10+makes it unnecessary.++ 3. Protecting Users' Legal Rights From Anti-Circumvention Law.++ No covered work shall be deemed part of an effective technological+measure under any applicable law fulfilling obligations under article+11 of the WIPO copyright treaty adopted on 20 December 1996, or+similar laws prohibiting or restricting circumvention of such+measures.++ When you convey a covered work, you waive any legal power to forbid+circumvention of technological measures to the extent such circumvention+is effected by exercising rights under this License with respect to+the covered work, and you disclaim any intention to limit operation or+modification of the work as a means of enforcing, against the work's+users, your or third parties' legal rights to forbid circumvention of+technological measures.++ 4. Conveying Verbatim Copies.++ You may convey verbatim copies of the Program's source code as you+receive it, in any medium, provided that you conspicuously and+appropriately publish on each copy an appropriate copyright notice;+keep intact all notices stating that this License and any+non-permissive terms added in accord with section 7 apply to the code;+keep intact all notices of the absence of any warranty; and give all+recipients a copy of this License along with the Program.++ You may charge any price or no price for each copy that you convey,+and you may offer support or warranty protection for a fee.++ 5. Conveying Modified Source Versions.++ You may convey a work based on the Program, or the modifications to+produce it from the Program, in the form of source code under the+terms of section 4, provided that you also meet all of these conditions:++ a) The work must carry prominent notices stating that you modified+ it, and giving a relevant date.++ b) The work must carry prominent notices stating that it is+ released under this License and any conditions added under section+ 7. This requirement modifies the requirement in section 4 to+ "keep intact all notices".++ c) You must license the entire work, as a whole, under this+ License to anyone who comes into possession of a copy. This+ License will therefore apply, along with any applicable section 7+ additional terms, to the whole of the work, and all its parts,+ regardless of how they are packaged. This License gives no+ permission to license the work in any other way, but it does not+ invalidate such permission if you have separately received it.++ d) If the work has interactive user interfaces, each must display+ Appropriate Legal Notices; however, if the Program has interactive+ interfaces that do not display Appropriate Legal Notices, your+ work need not make them do so.++ A compilation of a covered work with other separate and independent+works, which are not by their nature extensions of the covered work,+and which are not combined with it such as to form a larger program,+in or on a volume of a storage or distribution medium, is called an+"aggregate" if the compilation and its resulting copyright are not+used to limit the access or legal rights of the compilation's users+beyond what the individual works permit. Inclusion of a covered work+in an aggregate does not cause this License to apply to the other+parts of the aggregate.++ 6. Conveying Non-Source Forms.++ You may convey a covered work in object code form under the terms+of sections 4 and 5, provided that you also convey the+machine-readable Corresponding Source under the terms of this License,+in one of these ways:++ a) Convey the object code in, or embodied in, a physical product+ (including a physical distribution medium), accompanied by the+ Corresponding Source fixed on a durable physical medium+ customarily used for software interchange.++ b) Convey the object code in, or embodied in, a physical product+ (including a physical distribution medium), accompanied by a+ written offer, valid for at least three years and valid for as+ long as you offer spare parts or customer support for that product+ model, to give anyone who possesses the object code either (1) a+ copy of the Corresponding Source for all the software in the+ product that is covered by this License, on a durable physical+ medium customarily used for software interchange, for a price no+ more than your reasonable cost of physically performing this+ conveying of source, or (2) access to copy the+ Corresponding Source from a network server at no charge.++ c) Convey individual copies of the object code with a copy of the+ written offer to provide the Corresponding Source. This+ alternative is allowed only occasionally and noncommercially, and+ only if you received the object code with such an offer, in accord+ with subsection 6b.++ d) Convey the object code by offering access from a designated+ place (gratis or for a charge), and offer equivalent access to the+ Corresponding Source in the same way through the same place at no+ further charge. You need not require recipients to copy the+ Corresponding Source along with the object code. If the place to+ copy the object code is a network server, the Corresponding Source+ may be on a different server (operated by you or a third party)+ that supports equivalent copying facilities, provided you maintain+ clear directions next to the object code saying where to find the+ Corresponding Source. Regardless of what server hosts the+ Corresponding Source, you remain obligated to ensure that it is+ available for as long as needed to satisfy these requirements.++ e) Convey the object code using peer-to-peer transmission, provided+ you inform other peers where the object code and Corresponding+ Source of the work are being offered to the general public at no+ charge under subsection 6d.++ A separable portion of the object code, whose source code is excluded+from the Corresponding Source as a System Library, need not be+included in conveying the object code work.++ A "User Product" is either (1) a "consumer product", which means any+tangible personal property which is normally used for personal, family,+or household purposes, or (2) anything designed or sold for incorporation+into a dwelling. In determining whether a product is a consumer product,+doubtful cases shall be resolved in favor of coverage. For a particular+product received by a particular user, "normally used" refers to a+typical or common use of that class of product, regardless of the status+of the particular user or of the way in which the particular user+actually uses, or expects or is expected to use, the product. A product+is a consumer product regardless of whether the product has substantial+commercial, industrial or non-consumer uses, unless such uses represent+the only significant mode of use of the product.++ "Installation Information" for a User Product means any methods,+procedures, authorization keys, or other information required to install+and execute modified versions of a covered work in that User Product from+a modified version of its Corresponding Source. The information must+suffice to ensure that the continued functioning of the modified object+code is in no case prevented or interfered with solely because+modification has been made.++ If you convey an object code work under this section in, or with, or+specifically for use in, a User Product, and the conveying occurs as+part of a transaction in which the right of possession and use of the+User Product is transferred to the recipient in perpetuity or for a+fixed term (regardless of how the transaction is characterized), the+Corresponding Source conveyed under this section must be accompanied+by the Installation Information. But this requirement does not apply+if neither you nor any third party retains the ability to install+modified object code on the User Product (for example, the work has+been installed in ROM).++ The requirement to provide Installation Information does not include a+requirement to continue to provide support service, warranty, or updates+for a work that has been modified or installed by the recipient, or for+the User Product in which it has been modified or installed. Access to a+network may be denied when the modification itself materially and+adversely affects the operation of the network or violates the rules and+protocols for communication across the network.++ Corresponding Source conveyed, and Installation Information provided,+in accord with this section must be in a format that is publicly+documented (and with an implementation available to the public in+source code form), and must require no special password or key for+unpacking, reading or copying.++ 7. Additional Terms.++ "Additional permissions" are terms that supplement the terms of this+License by making exceptions from one or more of its conditions.+Additional permissions that are applicable to the entire Program shall+be treated as though they were included in this License, to the extent+that they are valid under applicable law. If additional permissions+apply only to part of the Program, that part may be used separately+under those permissions, but the entire Program remains governed by+this License without regard to the additional permissions.++ When you convey a copy of a covered work, you may at your option+remove any additional permissions from that copy, or from any part of+it. (Additional permissions may be written to require their own+removal in certain cases when you modify the work.) You may place+additional permissions on material, added by you to a covered work,+for which you have or can give appropriate copyright permission.++ Notwithstanding any other provision of this License, for material you+add to a covered work, you may (if authorized by the copyright holders of+that material) supplement the terms of this License with terms:++ a) Disclaiming warranty or limiting liability differently from the+ terms of sections 15 and 16 of this License; or++ b) Requiring preservation of specified reasonable legal notices or+ author attributions in that material or in the Appropriate Legal+ Notices displayed by works containing it; or++ c) Prohibiting misrepresentation of the origin of that material, or+ requiring that modified versions of such material be marked in+ reasonable ways as different from the original version; or++ d) Limiting the use for publicity purposes of names of licensors or+ authors of the material; or++ e) Declining to grant rights under trademark law for use of some+ trade names, trademarks, or service marks; or++ f) Requiring indemnification of licensors and authors of that+ material by anyone who conveys the material (or modified versions of+ it) with contractual assumptions of liability to the recipient, for+ any liability that these contractual assumptions directly impose on+ those licensors and authors.++ All other non-permissive additional terms are considered "further+restrictions" within the meaning of section 10. If the Program as you+received it, or any part of it, contains a notice stating that it is+governed by this License along with a term that is a further+restriction, you may remove that term. If a license document contains+a further restriction but permits relicensing or conveying under this+License, you may add to a covered work material governed by the terms+of that license document, provided that the further restriction does+not survive such relicensing or conveying.++ If you add terms to a covered work in accord with this section, you+must place, in the relevant source files, a statement of the+additional terms that apply to those files, or a notice indicating+where to find the applicable terms.++ Additional terms, permissive or non-permissive, may be stated in the+form of a separately written license, or stated as exceptions;+the above requirements apply either way.++ 8. Termination.++ You may not propagate or modify a covered work except as expressly+provided under this License. Any attempt otherwise to propagate or+modify it is void, and will automatically terminate your rights under+this License (including any patent licenses granted under the third+paragraph of section 11).++ However, if you cease all violation of this License, then your+license from a particular copyright holder is reinstated (a)+provisionally, unless and until the copyright holder explicitly and+finally terminates your license, and (b) permanently, if the copyright+holder fails to notify you of the violation by some reasonable means+prior to 60 days after the cessation.++ Moreover, your license from a particular copyright holder is+reinstated permanently if the copyright holder notifies you of the+violation by some reasonable means, this is the first time you have+received notice of violation of this License (for any work) from that+copyright holder, and you cure the violation prior to 30 days after+your receipt of the notice.++ Termination of your rights under this section does not terminate the+licenses of parties who have received copies or rights from you under+this License. If your rights have been terminated and not permanently+reinstated, you do not qualify to receive new licenses for the same+material under section 10.++ 9. Acceptance Not Required for Having Copies.++ You are not required to accept this License in order to receive or+run a copy of the Program. Ancillary propagation of a covered work+occurring solely as a consequence of using peer-to-peer transmission+to receive a copy likewise does not require acceptance. However,+nothing other than this License grants you permission to propagate or+modify any covered work. These actions infringe copyright if you do+not accept this License. Therefore, by modifying or propagating a+covered work, you indicate your acceptance of this License to do so.++ 10. Automatic Licensing of Downstream Recipients.++ Each time you convey a covered work, the recipient automatically+receives a license from the original licensors, to run, modify and+propagate that work, subject to this License. You are not responsible+for enforcing compliance by third parties with this License.++ An "entity transaction" is a transaction transferring control of an+organization, or substantially all assets of one, or subdividing an+organization, or merging organizations. If propagation of a covered+work results from an entity transaction, each party to that+transaction who receives a copy of the work also receives whatever+licenses to the work the party's predecessor in interest had or could+give under the previous paragraph, plus a right to possession of the+Corresponding Source of the work from the predecessor in interest, if+the predecessor has it or can get it with reasonable efforts.++ You may not impose any further restrictions on the exercise of the+rights granted or affirmed under this License. For example, you may+not impose a license fee, royalty, or other charge for exercise of+rights granted under this License, and you may not initiate litigation+(including a cross-claim or counterclaim in a lawsuit) alleging that+any patent claim is infringed by making, using, selling, offering for+sale, or importing the Program or any portion of it.++ 11. Patents.++ A "contributor" is a copyright holder who authorizes use under this+License of the Program or a work on which the Program is based. The+work thus licensed is called the contributor's "contributor version".++ A contributor's "essential patent claims" are all patent claims+owned or controlled by the contributor, whether already acquired or+hereafter acquired, that would be infringed by some manner, permitted+by this License, of making, using, or selling its contributor version,+but do not include claims that would be infringed only as a+consequence of further modification of the contributor version. For+purposes of this definition, "control" includes the right to grant+patent sublicenses in a manner consistent with the requirements of+this License.++ Each contributor grants you a non-exclusive, worldwide, royalty-free+patent license under the contributor's essential patent claims, to+make, use, sell, offer for sale, import and otherwise run, modify and+propagate the contents of its contributor version.++ In the following three paragraphs, a "patent license" is any express+agreement or commitment, however denominated, not to enforce a patent+(such as an express permission to practice a patent or covenant not to+sue for patent infringement). To "grant" such a patent license to a+party means to make such an agreement or commitment not to enforce a+patent against the party.++ If you convey a covered work, knowingly relying on a patent license,+and the Corresponding Source of the work is not available for anyone+to copy, free of charge and under the terms of this License, through a+publicly available network server or other readily accessible means,+then you must either (1) cause the Corresponding Source to be so+available, or (2) arrange to deprive yourself of the benefit of the+patent license for this particular work, or (3) arrange, in a manner+consistent with the requirements of this License, to extend the patent+license to downstream recipients. "Knowingly relying" means you have+actual knowledge that, but for the patent license, your conveying the+covered work in a country, or your recipient's use of the covered work+in a country, would infringe one or more identifiable patents in that+country that you have reason to believe are valid.++ If, pursuant to or in connection with a single transaction or+arrangement, you convey, or propagate by procuring conveyance of, a+covered work, and grant a patent license to some of the parties+receiving the covered work authorizing them to use, propagate, modify+or convey a specific copy of the covered work, then the patent license+you grant is automatically extended to all recipients of the covered+work and works based on it.++ A patent license is "discriminatory" if it does not include within+the scope of its coverage, prohibits the exercise of, or is+conditioned on the non-exercise of one or more of the rights that are+specifically granted under this License. You may not convey a covered+work if you are a party to an arrangement with a third party that is+in the business of distributing software, under which you make payment+to the third party based on the extent of your activity of conveying+the work, and under which the third party grants, to any of the+parties who would receive the covered work from you, a discriminatory+patent license (a) in connection with copies of the covered work+conveyed by you (or copies made from those copies), or (b) primarily+for and in connection with specific products or compilations that+contain the covered work, unless you entered into that arrangement,+or that patent license was granted, prior to 28 March 2007.++ Nothing in this License shall be construed as excluding or limiting+any implied license or other defenses to infringement that may+otherwise be available to you under applicable patent law.++ 12. No Surrender of Others' Freedom.++ If conditions are imposed on you (whether by court order, agreement or+otherwise) that contradict the conditions of this License, they do not+excuse you from the conditions of this License. If you cannot convey a+covered work so as to satisfy simultaneously your obligations under this+License and any other pertinent obligations, then as a consequence you may+not convey it at all. For example, if you agree to terms that obligate you+to collect a royalty for further conveying from those to whom you convey+the Program, the only way you could satisfy both those terms and this+License would be to refrain entirely from conveying the Program.++ 13. Use with the GNU Affero General Public License.++ Notwithstanding any other provision of this License, you have+permission to link or combine any covered work with a work licensed+under version 3 of the GNU Affero General Public License into a single+combined work, and to convey the resulting work. The terms of this+License will continue to apply to the part which is the covered work,+but the special requirements of the GNU Affero General Public License,+section 13, concerning interaction through a network will apply to the+combination as such.++ 14. Revised Versions of this License.++ The Free Software Foundation may publish revised and/or new versions of+the GNU General Public License from time to time. Such new versions will+be similar in spirit to the present version, but may differ in detail to+address new problems or concerns.++ Each version is given a distinguishing version number. If the+Program specifies that a certain numbered version of the GNU General+Public License "or any later version" applies to it, you have the+option of following the terms and conditions either of that numbered+version or of any later version published by the Free Software+Foundation. If the Program does not specify a version number of the+GNU General Public License, you may choose any version ever published+by the Free Software Foundation.++ If the Program specifies that a proxy can decide which future+versions of the GNU General Public License can be used, that proxy's+public statement of acceptance of a version permanently authorizes you+to choose that version for the Program.++ Later license versions may give you additional or different+permissions. However, no additional obligations are imposed on any+author or copyright holder as a result of your choosing to follow a+later version.++ 15. Disclaimer of Warranty.++ THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY+APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT+HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY+OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO,+THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR+PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM+IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF+ALL NECESSARY SERVICING, REPAIR OR CORRECTION.++ 16. Limitation of Liability.++ IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS+THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY+GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE+USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF+DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD+PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS),+EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF+SUCH DAMAGES.++ 17. Interpretation of Sections 15 and 16.++ If the disclaimer of warranty and limitation of liability provided+above cannot be given local legal effect according to their terms,+reviewing courts shall apply local law that most closely approximates+an absolute waiver of all civil liability in connection with the+Program, unless a warranty or assumption of liability accompanies a+copy of the Program in return for a fee.++ END OF TERMS AND CONDITIONS++ How to Apply These Terms to Your New Programs++ If you develop a new program, and you want it to be of the greatest+possible use to the public, the best way to achieve this is to make it+free software which everyone can redistribute and change under these terms.++ To do so, attach the following notices to the program. It is safest+to attach them to the start of each source file to most effectively+state the exclusion of warranty; and each file should have at least+the "copyright" line and a pointer to where the full notice is found.++ <one line to give the program's name and a brief idea of what it does.>+ Copyright (C) <year> <name of author>++ This program is free software: you can redistribute it and/or modify+ it under the terms of the GNU General Public License as published by+ the Free Software Foundation, either version 3 of the License, or+ (at your option) any later version.++ This program is distributed in the hope that it will be useful,+ but WITHOUT ANY WARRANTY; without even the implied warranty of+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+ GNU General Public License for more details.++ You should have received a copy of the GNU General Public License+ along with this program. If not, see <http://www.gnu.org/licenses/>.++Also add information on how to contact you by electronic and paper mail.++ If the program does terminal interaction, make it output a short+notice like this when it starts in an interactive mode:++ <program> Copyright (C) <year> <name of author>+ This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'.+ This is free software, and you are welcome to redistribute it+ under certain conditions; type `show c' for details.++The hypothetical commands `show w' and `show c' should show the appropriate+parts of the General Public License. Of course, your program's commands+might be different; for a GUI interface, you would use an "about box".++ You should also get your employer (if you work as a programmer) or school,+if any, to sign a "copyright disclaimer" for the program, if necessary.+For more information on this, and how to apply and follow the GNU GPL, see+<http://www.gnu.org/licenses/>.++ The GNU General Public License does not permit incorporating your program+into proprietary programs. If your program is a subroutine library, you+may consider it more useful to permit linking proprietary applications with+the library. If this is what you want to do, use the GNU Lesser General+Public License instead of this License. But first, please read+<http://www.gnu.org/philosophy/why-not-lgpl.html>.