splot 0.3.5 → 0.3.6
raw patch · 3 files changed
+34/−12 lines, 3 files
Files
- Tools/SPlotMain.hs +5/−1
- Tools/StatePlot.hs +28/−10
- splot.cabal +1/−1
Tools/SPlotMain.hs view
@@ -39,6 +39,7 @@ " [-tf TIMEFORMAT] [-expire EXPIRE]", " [-fromTime TIME] [-toTime TIME] [-numTracks NUMTRACKS]", " [-tickInterval TICKINTERVAL] [-largeTickFreq N]",+ " [-legendWidth WIDTH]", " [-colorscheme SCHEME COLORS]...", " --help - show help", " --version - show version",@@ -66,6 +67,8 @@ " -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 for better performance on very large data",+ " -legendWidth WIDTH - allocate WIDTH pixels to the left of the plot area to a legend.",+ " Default: 0 (no legend)", " -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. ",@@ -145,12 +148,13 @@ | otherwise = b let expireTimeMs = read $ getArg "expire" "Infinity" args let phantomColor = case getArg "phantom" "" args of { "" -> Nothing; c -> Just (S.pack c) }+ let legendWidth = case getArg "legendWidth" "0" args of { "0" -> Nothing; n -> Just (read n) } let readInput = if inputFile == "-" then B.getContents else B.readFile inputFile let readEvents = (map (parse parseTime . pruneLF) . B.lines) `fmap` readInput let colorMaps = [(S.pack scheme, map S.pack (words wheel)) | ("-colorscheme":scheme:wheel:_) <- tails args ] - let pic = renderEvents (RenderConf barHeight tickIntervalMs largeTickFreq expireTimeMs phantomColor fromTime toTime forcedNumTracks colorMaps) readEvents+ let pic = renderEvents (RenderConf barHeight tickIntervalMs largeTickFreq expireTimeMs phantomColor fromTime toTime forcedNumTracks colorMaps legendWidth) readEvents renderableToPNGFile pic w h outPNG
Tools/StatePlot.hs view
@@ -69,7 +69,8 @@ fromTime :: Maybe LocalTime, toTime :: Maybe LocalTime, forcedNumTracks :: Maybe Int,- colorWheels :: [(S.ByteString, [S.ByteString])]+ colorWheels :: [(S.ByteString, [S.ByteString])],+ legendWidth :: Maybe Int } data TickSize = LargeTick | SmallTick@@ -88,8 +89,11 @@ maybeM f (Just x) = f x >> return () -- Returns: whether we have any non-bars glyphs (text)- genGlyphs :: (UTCTime -> Double) -> Double -> [Event] -> Bool -> (Int -> OutputGlyph -> RenderState s ()) -> RenderState s Bool- genGlyphs time2ms !rangeMs es drawGlyphsNotBars withGlyph = genGlyphs' es M.empty False+ genGlyphs :: (UTCTime -> Double) -> Double -> [Event] -> Bool + -> (Int -> OutputGlyph -> RenderState s ()) -- Glyph+ -> (Int -> S.ByteString -> RenderState s ()) -- Legend item+ -> RenderState s Bool+ genGlyphs time2ms !rangeMs es drawGlyphsNotBars withGlyph withLegend = genGlyphs' es M.empty False where genGlyphs' [] m !havePulses = when (not drawGlyphsNotBars) (mapM_ flushTrack (M.toList m)) >> return havePulses where@@ -123,6 +127,7 @@ Nothing -> do let i = M.size m let m' = M.insert track (i, Nothing) m+ withLegend i track when (not drawGlyphsNotBars) $ case (phantomColor conf, edge) of (_, End c) | not (S.null c) -> withGlyph i (Bar 0 mst c) (Just c, End _) -> withGlyph i (Bar 0 mst c)@@ -168,7 +173,8 @@ then (LargeTick, fromIntegral i*tickIntervalMs conf) else (SmallTick, fromIntegral i*tickIntervalMs conf)) [0..] - let ms2x ms = 10 + ms / rangeMs * (w - 10)+ let legendW = case legendWidth conf of { Just w -> fromIntegral w; Nothing -> 0 }+ let ms2x ms = legendW + 10 + ms / rangeMs * (w - 10) let yStep = case barHeight conf of { BarHeightFixed _ -> (h-20) / fromIntegral (numTracks+1) ; BarHeightFill -> (h-20) / fromIntegral numTracks@@ -229,6 +235,18 @@ } } + let drawLegendItem :: Int -> S.ByteString -> RenderState ColorMap ()+ drawLegendItem !i !s = liftR $ case legendWidth conf of { + Nothing -> return ()+ ; Just w -> do {+ setLineStyle $ solidLine 1 (opaque black)+ ; let y = track2y i+ ; C.TextExtents xbear ybear tw th _ _ <- c $ C.textExtents (S.unpack s)+ ; moveTo (Point (fromIntegral w - tw - xbear - 5) (y - th/2 - ybear))+ ; c $ C.showText (S.unpack s)+ }+ }+ when (not drawGlyphsNotBars) $ do c $ C.setAntialias C.AntialiasNone setLineStyle $ solidLine 1 (opaque black)@@ -237,19 +255,19 @@ -- 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))+ moveTo (Point (legendW+10) (h-20))+ lineTo (Point w (h-20)) c $ C.stroke- moveTo (Point 10 (h-20))- lineTo (Point 10 0)+ moveTo (Point (legendW+10) (h-20))+ lineTo (Point (legendW+10) 0) c $ C.stroke mapM_ drawTick ticks- moveTo (Point 10 (h-3))+ moveTo (Point (legendW+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+ evalStateT (runRenderState $ genGlyphs time2ms rangeMs es drawGlyphsNotBars drawGlyph drawLegendItem) colorMap
splot.cabal view
@@ -1,5 +1,5 @@ Name: splot-Version: 0.3.5+Version: 0.3.6 License: BSD3 License-file: LICENSE Copyright: Eugene Kirpichov, 2010