packages feed

hp2any-manager 0.4.5 → 0.4.6

raw patch · 3 files changed

+28/−33 lines, 3 files

Files

CHANGES view
@@ -1,3 +1,6 @@+0.4.6 - 130304+* various improvements by Sönke Hahn+ 0.4.5 - 110414 * added ability to load files specified as command line arguments 
hp2any-manager.cabal view
@@ -1,6 +1,6 @@ Name:          hp2any-manager-Version:       0.4.5-Cabal-Version: >= 1.2+Version:       0.4.6+Cabal-Version: >= 1.6 Synopsis:      A utility to visualise and compare heap profiles. Category:      profiling, development, utils Description:@@ -10,7 +10,7 @@  Author:        Patai Gergely Maintainer:    Patai Gergely (patai.gergely@gmail.com)-Copyright:     (c) 2009-2011, Patai Gergely+Copyright:     (c) 2009-2013, Patai Gergely Homepage:      http://www.haskell.org/haskellwiki/Hp2any License:       BSD3 License-File:  LICENSE@@ -30,3 +30,7 @@                   glib, gtk, gtkglext, glade, cairo, OpenGL,                   bytestring, hp2any-core, hp2any-graph   GHC-Options:    -Wall -O2++source-repository head+  type:     git+  location: https://github.com/cobbpg/hp2any.git
src/Manager.hs view
@@ -248,7 +248,7 @@             <*> (getCost <$> treeModelGetRow model i2)    cellLayoutSetAttributes nameColumn nameRender model $ \ccdat -> [cellTextMarkup := Just (getName ccdat)]-  cellLayoutSetAttributes costColumn costRender model $ \ccdat -> [cellText := show (getCost ccdat)]+  cellLayoutSetAttributes costColumn costRender model $ \ccdat -> [cellText := showBigInteger (getCost ccdat)]    mapM_ (treeViewAppendColumn tree) [nameColumn,costColumn] @@ -383,46 +383,23 @@   -- Repaint handler, called after every resize for instance.   onExpose glCanvas $ const $ repaint >> return True -  -- Managing the life cycle of the coordinate window.-  coordWindow <- windowNew-  Gtk.set coordWindow [ windowDecorated := False-                      , windowAcceptFocus := False-                      , windowSkipPagerHint := True-                      , windowSkipTaskbarHint := True-                      , windowResizable := False-                      ]-  windowSetKeepAbove coordWindow True   coordLabel <- labelNew Nothing-  containerAdd coordWindow coordLabel--  onDestroy glCanvas $ widgetDestroy coordWindow--  -- Displaying coordinate tooltip when entering the graph area.-  onEnterNotify glCanvas $ const $ do-    widgetShowAll coordWindow-    return True--  -- Hiding the coordinate display unless that was the very widget we-  -- left the canvas for.-  onLeaveNotify glCanvas $ \evt -> do-    let (x,y) = (floor (eventX evt),floor (eventY evt))-    Size w h <- readIORef canvasSize-    unless (x >= 0 && x < w && y >= 0 && y < h) $ widgetHideAll coordWindow-    return True+  boxPackStart mainBox coordLabel PackNatural 0    -- Highlighting cost centre names on hover and displaying   -- coordinates (time and cost).   onMotionNotify glCanvas False $ \evt -> do-    let (x,y) = (floor (eventX evt),floor (eventY evt))+    let x,y :: Int+        (x,y) = (floor (eventX evt),floor (eventY evt))      -- Updating coordinate window.     Size w h <- readIORef canvasSize -    windowMove coordWindow (floor (eventXRoot evt)+16) (floor (eventYRoot evt)+8)     (t1,t2) <- getInterval     c <- getMaxCost-    labelSetText coordLabel $ printf " time=%0.2f, cost=%d " (t1+eventX evt*(t2-t1)/fromIntegral w)-                     ((fromIntegral h-fromIntegral y)*fromIntegral c `div` fromIntegral h :: Integer)+    labelSetText coordLabel $ printf " time=%0.2f, cost=%s "+        (t1+eventX evt*(t2-t1)/fromIntegral w)+        (showBigInteger ((fromIntegral h-fromIntegral y)*fromIntegral c `div` fromIntegral h :: Integer))      -- Highlighting current cost centre under the mouse.     withGLDrawingArea glCanvas $ \glw -> do@@ -466,6 +443,17 @@         readIORef graphMode    return (mainBox,toggleViewMode,repaint >> widgetQueueDraw glCanvas)++showBigInteger :: Integral n => n -> String+showBigInteger n =+    reverse $ inner $ reverse $ show (fromIntegral n :: Integer)+  where+    inner :: String -> String+    inner s = case splitAt 3 s of+        (r, [])  -> r+        (_, "-") -> s+        (a, b)   -> a ++ "," ++ inner b+          -- Fast hack: run this bugger only once in order to reduce the chance -- of hanging...