edentv 4.9.1 → 4.9.2
raw patch · 2 files changed
+96/−93 lines, 2 filesdep +textdep ~gtk
Dependencies added: text
Dependency ranges changed: gtk
Files
- EdenTV.hs +92/−90
- edentv.cabal +4/−3
EdenTV.hs view
@@ -43,6 +43,7 @@ import System.CPUTime import System.IO import Data.List+import Data.Text(pack, unpack) import RTSEventsParser import System.IO.Unsafe @@ -853,96 +854,97 @@ -- 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- gladeXML <- edentvGladeFile ["dlg_err_save_filetype", "accelgroup1"]- dlg <- builderGetObject 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+ -- 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 (pack $ if filetype == "jpg" then "jpeg" else filetype) ([] :: [(String, String)])+ 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+ gladeXML <- edentvGladeFile ["dlg_err_save_filetype", "accelgroup1"]+ dlg <- builderGetObject 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 :: (FileChooserClass a) => a -> [ImageFormat] -> IO ()+ addSpecialFilters _ [] = return ()+ addSpecialFilters dlg (f:fs) = do+ filter <- fileFilterNew+ filter `fileFilterAddPattern` ("*." ++ (unpack f))+ case unpack 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 ()
edentv.cabal view
@@ -1,5 +1,5 @@ name: edentv-version: 4.9.1+version: 4.9.2 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@@ -37,10 +37,11 @@ filepath, directory, zip-archive,- gtk >= 0.12,+ gtk >= 0.13, cairo >= 0.12, array,- ghc-events-parallel >= 0.5.0.1+ ghc-events-parallel >= 0.5.0.1,+ text GHC-Options: -rtsopts