splot 0.2.9 → 0.3.0
raw patch · 4 files changed
+64/−27 lines, 4 files
Files
- Tools/ColorMap.hs +33/−18
- Tools/SPlotMain.hs +24/−3
- Tools/StatePlot.hs +6/−5
- splot.cabal +1/−1
Tools/ColorMap.hs view
@@ -6,7 +6,7 @@ -- other than internal consistency. module Tools.ColorMap ( ColorMap,- defaultColorMap,+ prepareColorMap, cycleColor, computeColor) where@@ -14,16 +14,26 @@ import Data.Colour import Data.Colour.SRGB import Data.Colour.Names+import Data.Maybe import qualified Data.ByteString.Char8 as S import qualified Data.Map as M -data (Show b, Eq b, Ord b, Floating b) => ColorMap b = ColorMap {- colorMap :: M.Map S.ByteString (RGB b), -- ^ Current map from arbitrary strings to color descriptions- colorWheel :: [RGB b] -- ^ Next colors for assigning to as yet unknown names++data ColorMap = ColorMap {+ colorMaps :: M.Map S.ByteString ColorMap1 -- ^ Color scheme id -> Color map+}++data ColorMap1 = ColorMap1 {+ colorMap :: M.Map S.ByteString (RGB Double), -- ^ Current map from arbitrary strings to color descriptions+ colorWheel :: [RGB Double] -- ^ Next colors for assigning to as yet unknown names } deriving (Eq, Show) +prepareColorMap :: [(S.ByteString, [S.ByteString])] -> ColorMap+prepareColorMap ms = ColorMap $ M.fromList $ (S.pack "", defaultColorMap):+ [(scheme, ColorMap1 M.empty $ cycle $ map (fromJust . readColor) colorNames) | (scheme, colorNames) <- ms]+ -- | Starts with empty names-colors map and mid-range grey-defaultColorMap = ColorMap M.empty defaultColorWheel+defaultColorMap = ColorMap1 M.empty defaultColorWheel defaultColorWheel = map toSRGB [green, blue, red, brown, orange, magenta, grey, purple, violet, lightblue, crimson, burlywood] ++ map nextColor defaultColorWheel @@ -55,28 +65,33 @@ readColor' cs = toSRGB `fmap` readColourName cs +cycleColor :: ColorMap+ -> S.ByteString + -> (RGB Double,ColorMap)+cycleColor (ColorMap map) name = case M.lookup scheme map of+ Nothing -> cycleColor (ColorMap map) S.empty -- Use default color scheme then.+ Just m -> let (res, m') = cycleColor1 m subColor in (res, ColorMap $ M.insert scheme m' map)+ where+ (scheme, subColor) = case S.uncons name of+ -- /scheme/color+ Just ('/', name') -> S.break (=='/') name'+ _ -> (S.empty, name)+ -- | Compute the color associated to a given name, providing an updated map with -- possibly new colors in the cycle.-cycleColor :: (RealFrac b, Show b, Eq b, Ord b, Floating b) => - ColorMap b+cycleColor1 :: ColorMap1 -> S.ByteString - -> (RGB b,ColorMap b)-cycleColor map name = case M.lookup name (colorMap map) of+ -> (RGB Double, ColorMap1)+cycleColor1 map name = case M.lookup name (colorMap map) of Just c -> (c, map) Nothing -> (next, augment map (name,next) wheel') where (next:wheel') = colorWheel map -nextColor :: (RealFrac b, Floating b) => - RGB b -> - RGB b+nextColor :: RGB Double -> RGB Double nextColor (RGB r g b) = RGB (r+7) (g+17) (b+23) -augment :: (Show b, Eq b, Ord b, Floating b) => - ColorMap b -> - (S.ByteString, RGB b) -> - [RGB b] ->- ColorMap b-augment map (name,col) wheel = ColorMap (M.insert name col (colorMap map)) wheel+augment :: ColorMap1 -> (S.ByteString, RGB Double) -> [RGB Double] -> ColorMap1+augment map (name,col) wheel = ColorMap1 (M.insert name col (colorMap map)) wheel
Tools/SPlotMain.hs view
@@ -12,6 +12,8 @@ import Data.Maybe(fromMaybe,isNothing) import Data.Ord(comparing) +import Data.List (tails)+ import qualified Data.ByteString.Char8 as S import qualified Data.ByteString.Lazy.Char8 as B @@ -30,7 +32,7 @@ " [-tf TIMEFORMAT] [-sort SORT] [-expire EXPIRE]", " [-fromTime TIME] [-toTime TIME] [-numTracks NUMTRACKS]", " [-tickInterval TICKINTERVAL] [-largeTickFreq N]",- " [-stream true]",+ " [-stream true] [-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.",@@ -62,12 +64,18 @@ " Note that you better also indicate -fromTime, -toTime and -numTracks,", " otherwise the data will be re-scanned once per each of these properties", " that is not indicated.",+ " -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. ",+ " 'red green #0000FF'. You may specify multiple -colorscheme arguments.", "", "Input is read from stdin. Example input (speaks for itself):", "2010-10-21 16:45:09,431 >foo green", "2010-10-21 16:45:09,541 >bar green", "2010-10-21 16:45:10,631 >foo yellow", "2010-10-21 16:45:10,725 >foo #ff0000",+ "2010-10-21 16:45:10,755 >foo /pale/THREAD25",+ "2010-10-21 16:45:10,775 >bar /bright/THREAD37", "2010-10-21 16:45:10,836 !foo black Some text", "2010-10-21 16:45:10,930 >bar blue", "2010-10-21 16:45:11,322 <foo",@@ -84,7 +92,18 @@ "", "Note that COLOR may be an hexadecimal RGB specification (like '#4B3AF7'), ", " a color name (see SVG 1.1 specifications) or an arbitrary token in which ",- " case splot will generate a new color for each different token"+ " case splot will generate a new color for each different token.",+ "COLOR may also have the form '/SCHEME/TOKEN', in which case the colors for ",+ " tokens are cycled within colors specified by --colorscheme for SCHEME.",+ "For example, if you have two types of threads in your program and you want them", + " to be colored differently but do not want to assign colors to each thread ",+ " individually, you can use colors named like /pale/THREADID and /bright/THREADID",+ " and specify --colorscheme bright 'red green blue orange yellow' --colorscheme pale ",+ " 'lightgray lightblue pink'.",+ "If you use an unspecified color scheme, or don't specify a color scheme at all, ",+ " the tool resorts to using a default scheme, which consists of a sequence of",+ " contrast and bright colors.",+ "" ] main = do@@ -114,11 +133,13 @@ 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 ] + when (streaming && (inputFile == "-")) $ error "In streaming mode (-stream true) you MUST use an actual filename in '-if'" when (streaming && (isNothing fromTime || isNothing toTime || isNothing forcedNumTracks)) $ do putStrLn "Warning: without all of -fromTime, -toTime, -numTracks, input will be scanned an extra time" - pic <- renderEvents (RenderConf barHeight tickIntervalMs largeTickFreq expireTimeMs cmpTracks phantomColor fromTime toTime forcedNumTracks streaming) readEvents+ pic <- renderEvents (RenderConf barHeight tickIntervalMs largeTickFreq expireTimeMs cmpTracks phantomColor fromTime toTime forcedNumTracks streaming colorMaps) readEvents case outPNG of "" -> renderableToWindow pic w h f -> const () `fmap` renderableToPNGFile pic w h outPNG
Tools/StatePlot.hs view
@@ -70,7 +70,8 @@ fromTime :: Maybe LocalTime, toTime :: Maybe LocalTime, forcedNumTracks :: Maybe Int,- streaming :: Bool+ streaming :: Bool,+ colorWheels :: [(S.ByteString, [S.ByteString])] } data TickSize = LargeTick | SmallTick@@ -190,7 +191,7 @@ let fillRect !x1 !y1 !x2 !y2 = C.rectangle x1 y1 (x2-x1) (y2-y1) >> C.fill let strokeLine !x1 !y1 !x2 !y2 = C.moveTo x1 y1 >> C.lineTo x2 y2 >> C.stroke - let getColor :: S.ByteString -> RenderState (ColorMap Double) (RGB Double)+ let getColor :: S.ByteString -> RenderState ColorMap (RGB Double) getColor c = do { map <- ST.get ; let (color, map') = computeColor map c@@ -198,7 +199,7 @@ ; return color } - let drawGlyph :: Int -> OutputGlyph -> RenderState (ColorMap Double) ()+ let drawGlyph :: Int -> OutputGlyph -> RenderState ColorMap () drawGlyph !i (Bar !ms1 !ms2 !color) | drawGlyphsNotBars = return () | otherwise = getColor color >>= \(RGB r g b) -> liftR $ c $ do {@@ -245,5 +246,5 @@ setLineStyle $ solidLine 1 (opaque black) mapM_ drawTick ticks - let colorMap = defaultColorMap- evalStateT (runRenderState $ genGlyphs time2ms rangeMs es drawGlyphsNotBars drawGlyph) defaultColorMap+ 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.2.9+Version: 0.3.0 License: BSD3 License-file: LICENSE Copyright: Eugene Kirpichov, 2010