splot 0.3.2 → 0.3.3
raw patch · 3 files changed
+36/−35 lines, 3 files
Files
- Tools/SPlotMain.hs +7/−11
- Tools/StatePlot.hs +28/−23
- splot.cabal +1/−1
Tools/SPlotMain.hs view
@@ -28,25 +28,22 @@ showHelp = mapM_ putStrLn [ "splot - a tool for visualizing the lifecycle of many concurrent multi-stage processes. See http://www.haskell.org/haskellwiki/Splot", "Usage: splot [-if INFILE] [-o PNGFILE] [-w WIDTH] [-h HEIGHT] [-bh BARHEIGHT] ",- " [-tf TIMEFORMAT] [-sort SORT] [-expire EXPIRE]",+ " [-tf TIMEFORMAT] [-expire EXPIRE]", " [-fromTime TIME] [-toTime TIME] [-numTracks NUMTRACKS]", " [-tickInterval TICKINTERVAL] [-largeTickFreq N]",- " [-stream true] [-colorscheme SCHEME COLORS]...",+ " [-colorscheme SCHEME COLORS]...", " -if INFILE - filename from where to read the trace.",- " If omitted or '-', read from stdin.", " -o PNGFILE - filename to which the output will be written in PNG format. Required.", " -w, -h - width and height of the resulting picture. Default 640x480.", " -bh - height of the bar depicting each individual process. Default 5 pixels.", " Use 1 or so, or 'fill' if you have a lot of them. ",- " '-bh fill' means 'fill the screen with bars, without vertical gaps'",+ " '-bh fill' (default) means 'fill the screen with bars, without vertical gaps'", " -tf - time format, as in http://linux.die.net/man/3/strptime but with ", " fractional seconds supported via %OS - will parse 12.4039 or 12,4039", " Also, %^[+-][N]s will parse seconds since the epoch, for example ", " %^-3s are milliseconds since the epoch (N can only be 1 digit)", " -tickInterval - ticks on the X axis will be this often (in millis, default 1000).", " -largeTickFreq N - every N'th tick will be larger than the others (default 10).",- " -sort SORT - sort tracks by SORT, where: 'time' - sort by time of first event, ",- " 'name' - sort by track name.", " -expire - expire activities after given time period (in millis) - for instance,", " to account that if an activity doesn't tell you it's finished for too long,", " then it probably was killed.",@@ -55,7 +52,7 @@ " Useful if you're drawing pieces of large logs.", " -fromTime TIME - clip picture on left (time in same format as in trace)", " -toTime TIME - clip picture on right (time in same format as in trace)",- " -numTracks NUMTRACKS - explicitly specify number of tracks when using '-stream true'",+ " -numTracks NUMTRACKS - explicitly specify number of tracks for better performance on very large data", " -colorscheme SCHEME COLORS - declare a color scheme (see note about colors at the end).", " SCHEME is an arbitrary string, e.g.: 'pale' or 'bright'.", " COLORS is a space-separated list of colors in SVG or hex, e.g. ",@@ -104,7 +101,7 @@ ["--help"] -> showHelp >> exitSuccess _ -> return () let (w,h) = (read $ getArg "w" "640" args, read $ getArg "h" "480" args)- let barHeight = case getArg "bh" "5" args of { "fill" -> BarHeightFill ; bh -> BarHeightFixed $ read bh }+ let barHeight = case getArg "bh" "fill" args of { "fill" -> BarHeightFill ; bh -> BarHeightFixed $ read bh } let tickIntervalMs = read $ getArg "tickInterval" "1000" args let largeTickFreq = read $ getArg "largeTickFreq" "10" args let timeFormat = getArg "tf" "%Y-%m-%d %H:%M:%OS" args@@ -114,10 +111,9 @@ let toTime = fst `fmap` (strptime timeFormat $ getArg "toTime" "" args) let forcedNumTracks = case getArg "numTracks" "" args of { "" -> Nothing ; n -> Just $ read n } let outPNG = getArg "o" "" args- let inputFile = getArg "if" "-" args+ let inputFile = getArg "if" (error "Input file not specified") args let pruneLF b | not (B.null b) && (B.last b == '\r') = B.init b | otherwise = b- let cmpTracks = case getArg "sort" "time" args of { "time" -> comparing utcTime ; "name" -> comparing track } let expireTimeMs = read $ getArg "expire" "Infinity" args let phantomColor = case getArg "phantom" "" args of { "" -> Nothing; c -> Just (S.pack c) } @@ -126,6 +122,6 @@ let colorMaps = [(S.pack scheme, map S.pack (words wheel)) | ("-colorscheme":scheme:wheel:_) <- tails args ] - pic <- renderEvents (RenderConf barHeight tickIntervalMs largeTickFreq expireTimeMs cmpTracks phantomColor fromTime toTime forcedNumTracks True colorMaps) readEvents+ let pic = renderEvents (RenderConf barHeight tickIntervalMs largeTickFreq expireTimeMs phantomColor fromTime toTime forcedNumTracks colorMaps) readEvents renderableToPNGFile pic w h outPNG
Tools/StatePlot.hs view
@@ -65,12 +65,10 @@ tickIntervalMs :: Double, largeTickFreq :: Int, expireTimeMs :: Double,- cmpTracks :: Event -> Event -> Ordering, phantomColor :: Maybe S.ByteString, fromTime :: Maybe LocalTime, toTime :: Maybe LocalTime, forcedNumTracks :: Maybe Int,- streaming :: Bool, colorWheels :: [(S.ByteString, [S.ByteString])] } @@ -81,10 +79,8 @@ liftR :: CRender () -> RenderState s () liftR r = RenderState $ lift r -renderEvents :: RenderConfiguration -> IO [Event] -> IO (Renderable ())-renderEvents conf readEs = if streaming conf - then return (Renderable {minsize = return (0,0), render = renderGlyphsAtFront (c $ liftIO readEs)})- else readEs >>= \es -> return $ Renderable {minsize = return (0,0), render = renderGlyphsAtFront (return es)}+renderEvents :: RenderConfiguration -> IO [Event] -> Renderable ()+renderEvents conf readEs = Renderable {minsize = return (0,0), render = renderGlyphsAtFront (c $ liftIO readEs)} where {-# INLINE maybeM #-} maybeM :: (Monad m) => (a -> m b) -> Maybe a -> m ()@@ -156,10 +152,9 @@ render' readEs (w,h) drawGlyphsNotBars = do es <- readEs - (minRenderLocalTime, maxRenderLocalTime, numTracks) <- case (fromTime conf, toTime conf, forcedNumTracks conf, streaming conf) of- (Just a, Just b, Just c, _) -> return (a, b, c)- (_, _, _, True) -> fmap (override . computeTimesTracks) readEs- (_, _, _, False) -> return $ override (computeTimesTracks es) -- Will evaluate the whole of 'es' and hold it in memory+ (minRenderLocalTime, maxRenderLocalTime, numTracks) <- case (fromTime conf, toTime conf, forcedNumTracks conf) of+ (Just a, Just b, Just c) -> return (a, b, c)+ (_, _, _) -> fmap (override . computeTimesTracks) readEs let (minRenderTime, maxRenderTime) = (localTimeToUTC utc minRenderLocalTime, localTimeToUTC utc maxRenderLocalTime) let rangeMs = diffToMillis maxRenderTime minRenderTime@@ -183,8 +178,8 @@ ; BarHeightFill -> fromIntegral (i+1) * yStep - yStep/2 } let drawTick (t, ms) = c $ do {- C.moveTo (ms2x ms) (h-20)- ; C.lineTo (ms2x ms) (h-case t of { LargeTick -> 13 ; SmallTick -> 17 })+ C.moveTo (ms2x ms + 1) (h-20)+ ; C.lineTo (ms2x ms + 1) (h-case t of { LargeTick -> 13 ; SmallTick -> 17 }) ; C.stroke } @@ -234,17 +229,27 @@ } } - setLineStyle $ solidLine 1 (opaque black)- moveTo (Point 10 (h-20))- lineTo (Point w (h-20))- c $ C.stroke- moveTo (Point 10 (h-20))- lineTo (Point 10 0)- c $ C.stroke- moveTo (Point 10 (h-3))- c $ C.showText $ "Origin at " ++ show minRenderLocalTime ++ ", 1 small tick = " ++ show (tickIntervalMs conf) ++ "ms"- setLineStyle $ solidLine 1 (opaque black)- mapM_ drawTick ticks+ when (not drawGlyphsNotBars) $ do+ c $ C.setAntialias C.AntialiasNone+ setLineStyle $ solidLine 1 (opaque black)+ + -- Until a bug in Chart is resolved: http://hackage.haskell.org/packages/archive/Chart/0.13.1/doc/html/src/Graphics-Rendering-Chart-Types.html+ -- setLineStyle for a solid line doesn't clear dashes because it doesn't call setDash if line_dashes_ ls is [] (???)+ c $ C.setDash [] 0 + moveTo (Point 10 (h-20))+ lineTo (Point w (h-20))+ c $ C.stroke+ moveTo (Point 10 (h-20))+ lineTo (Point 10 0)+ c $ C.stroke+ mapM_ drawTick ticks+ moveTo (Point 10 (h-3))+ c $ C.setAntialias C.AntialiasGray+ c $ C.setFontSize 12+ c $ C.showText $ "Origin at " ++ show minRenderLocalTime ++ ", 1 small tick = " ++ show (tickIntervalMs conf) ++ "ms"++ c $ C.setAntialias C.AntialiasSubpixel let colorMap = prepareColorMap (colorWheels conf) evalStateT (runRenderState $ genGlyphs time2ms rangeMs es drawGlyphsNotBars drawGlyph) colorMap+
splot.cabal view
@@ -1,5 +1,5 @@ Name: splot-Version: 0.3.2+Version: 0.3.3 License: BSD3 License-file: LICENSE Copyright: Eugene Kirpichov, 2010