diff --git a/Graphics/Rendering/Chart/Event.hs b/Graphics/Rendering/Chart/Event.hs --- a/Graphics/Rendering/Chart/Event.hs +++ b/Graphics/Rendering/Chart/Event.hs @@ -6,7 +6,6 @@ eventStart, eventEnd, - defaultPlotEvent, plot_event_title, plot_event_data, plot_event_long_fillstyle, @@ -16,12 +15,11 @@ plot_event_label, ) where -import qualified Graphics.Rendering.Cairo as C +import Control.Lens import Graphics.Rendering.Chart import Data.Colour import Data.Colour.Names -import Data.Accessor -import Data.Accessor.Template +import Data.Default import Control.Monad data Event t e = LongEvent (t,Bool) (t,Bool) e -- ^ An event that has a beginning and an end. @@ -29,10 +27,12 @@ | PulseEvent t e -- ^ A zero-length event deriving (Show) -eventStart (LongEvent (t0,_) (t1,_) _) = t0 +eventStart :: Event t e -> t +eventStart (LongEvent (t0,_) (_,_) _) = t0 eventStart (PulseEvent t _) = t -eventEnd (LongEvent (t0,_) (t1,_) _) = t1 +eventEnd :: Event t e -> t +eventEnd (LongEvent (_,_) (t1,_) _) = t1 eventEnd (PulseEvent t _) = t -- | A chart that depict events. @@ -40,91 +40,87 @@ -- is drawn like "--[=====]---" and has a beginning and ending moment, and -- an impulse event is drawn like "---|----" and has an occurence moment. data PlotEvent t e = PlotEvent { - plot_event_title_ :: String, - plot_event_data_ :: [Event t e], + _plot_event_title :: String, + _plot_event_data :: [Event t e], -- | Linestyle with which marks for pulse events will be drawn - plot_event_pulse_linestyle_ :: e -> CairoLineStyle, + _plot_event_pulse_linestyle :: e -> LineStyle, -- | Linestyle with which borders of rectangles for long events will be drawn - plot_event_long_linestyle_ :: e -> CairoLineStyle, + _plot_event_long_linestyle :: e -> LineStyle, -- | Fillstyle with which interiors of rectangles for long events will be filled - plot_event_long_fillstyle_ :: e -> CairoFillStyle, + _plot_event_long_fillstyle :: e -> FillStyle, -- | Linestyle with which the "track line" will be drawn - plot_event_track_linestyle_ :: CairoLineStyle, - plot_event_label_ :: e -> String + _plot_event_track_linestyle :: LineStyle, + _plot_event_label :: e -> String } +makeLenses ''PlotEvent -defaultPlotEvent = PlotEvent { - plot_event_title_ = "", - plot_event_data_ = [], - plot_event_pulse_linestyle_ = const $ solidLine 2 (opaque red), - plot_event_long_linestyle_ = const $ solidLine 1 (opaque black), - plot_event_long_fillstyle_ = const $ solidFillStyle (opaque lightgray), - plot_event_track_linestyle_ = solidLine 1 (opaque black), - plot_event_label_ = const "" -} +instance Default (PlotEvent t e) where + def = PlotEvent { + _plot_event_title = "", + _plot_event_data = [], + _plot_event_pulse_linestyle = const $ solidLine 2 (opaque red), + _plot_event_long_linestyle = const $ solidLine 1 (opaque black), + _plot_event_long_fillstyle = const $ solidFillStyle (opaque lightgray), + _plot_event_track_linestyle = solidLine 1 (opaque black), + _plot_event_label = const "" + } instance ToPlot PlotEvent where toPlot p = Plot { - plot_render_ = renderPlotEvent p, - plot_legend_ = [(plot_event_title_ p, renderPlotLegendEvent p)], - plot_all_points_ = plotAllPointsEvent p + _plot_render = renderPlotEvent p, + _plot_legend = [(_plot_event_title p, renderPlotLegendEvent p)], + _plot_all_points = plotAllPointsEvent p } -renderPlotLegendEvent :: PlotEvent t e -> Rect -> CRender () +renderPlotLegendEvent :: PlotEvent t e -> Rect -> ChartBackend () renderPlotLegendEvent p r = return () -filledRect :: CairoFillStyle -> Rect -> CRender () -filledRect fs r = setFillStyle fs >> fillPath (rectPath r) +filledRect :: FillStyle -> Rect -> ChartBackend () +filledRect fs r = withFillStyle fs $ fillPath (rectPath r) -framedRect :: CairoLineStyle -> Rect -> CRender () -framedRect ls r = setLineStyle ls >> strokePath (rectPath r) +framedRect :: LineStyle -> Rect -> ChartBackend () +framedRect ls r = withLineStyle ls $ strokePath (rectPath r) barHeight = 7 pulseHeight = 15 -renderPlotEvent :: PlotEvent t e -> PointMapFn t e -> CRender () +renderPlotEvent :: PlotEvent t e -> PointMapFn t e -> ChartBackend () renderPlotEvent p pmap = do - setLineStyle $ plot_event_track_linestyle_ p - moveTo (Point x0 cy) - lineTo (Point x1 cy) - c $ C.stroke - mapM_ drawEventFill (plot_event_data_ p) - mapM_ drawEventFrame (plot_event_data_ p) + withLineStyle (p ^. plot_event_track_linestyle) $ do + strokePointPath [Point x0 cy, Point x1 cy] + mapM_ drawEventFill (p ^. plot_event_data) + mapM_ drawEventFrame (p ^. plot_event_data) where (Point x0 y0) = pmap (LMin,LMin) (Point x1 y1) = pmap (LMax,LMax) (cx,cy) = ((x0+x1)/2, (y0+y1)/2) + drawEventFill (PulseEvent t e) = return () drawEventFill (LongEvent (t1,_) (t2,_) e) = do let (Point x1 cy) = pmap (LValue t1, LValue e) let (Point x2 cy') = pmap (LValue t2, LValue e) -- Assume cy' == cy (pmap is coordinate-wise) - filledRect (plot_event_long_fillstyle_ p e) $ Rect + filledRect (p ^. plot_event_long_fillstyle $ e) $ Rect (Point x1 (cy-barHeight/2)) (Point x2 (cy+barHeight/2)) drawEventFrame (PulseEvent t e) = do - setLineStyle $ plot_event_pulse_linestyle_ p e - let (Point x y) = pmap (LValue t, LValue e) - moveTo (Point x (y-pulseHeight/2)) - lineTo (Point x (y+pulseHeight/2)) - c $ C.stroke - let label = plot_event_label_ p e - when (not (null label)) $ do - extents <- c $ C.textExtents label - moveTo (Point x (y - pulseHeight/2 - C.textExtentsHeight extents - C.textExtentsYbearing extents - 1)) - setLineStyle $ solidLine 2 (opaque black) - c $ C.showText label + withLineStyle (p ^. plot_event_pulse_linestyle $ e) $ do + let (Point x y) = pmap (LValue t, LValue e) + strokePointPath [Point x (y-pulseHeight/2), Point x (y+pulseHeight/2)] + let label = p ^. plot_event_label $ e + unless (null label) $ do + textSize <- textSize label + withLineStyle (solidLine 2 $ opaque black) $ do + drawText (Point x (y - pulseHeight/2 - textSizeHeight textSize - textSizeYBearing textSize - 1)) label drawEventFrame (LongEvent (t1,_) (t2,_) e) = do let (Point x1 cy) = pmap (LValue t1, LValue e) let (Point x2 cy') = pmap (LValue t2, LValue e) -- Assume cy' == cy (pmap is coordinate-wise) - framedRect (plot_event_long_linestyle_ p e) $ Rect + framedRect (p ^. plot_event_long_linestyle $ e) $ Rect (Point x1 (cy-barHeight/2)) (Point x2 (cy+barHeight/2)) plotAllPointsEvent :: PlotEvent t e -> ([t], [e]) -plotAllPointsEvent p = let (ts, es) = unzip (map decomp d) in (concat ts, es) +plotAllPointsEvent p = (concat ts, es) where - d = plot_event_data_ p decomp (PulseEvent t e) = ([t], e) decomp (LongEvent (t1,_) (t2,_) e) = ([t1,t2], e) - -$( deriveAccessors ''PlotEvent ) + (ts, es) = unzip $ p ^.. plot_event_data . traverse . to decomp diff --git a/Tools/TimePlot.hs b/Tools/TimePlot.hs --- a/Tools/TimePlot.hs +++ b/Tools/TimePlot.hs @@ -6,7 +6,9 @@ import Distribution.VcsRevision.Git import Language.Haskell.TH.Syntax +import Control.Lens import Control.Monad +import Data.Default import Data.List import Data.Ord import qualified Data.Map as M @@ -17,9 +19,8 @@ import Data.Time hiding (parseTime) -import Data.Accessor - import Graphics.Rendering.Chart +import Graphics.Rendering.Chart.Backend.Cairo import Tools.TimePlot.Types import Tools.TimePlot.Conf @@ -62,7 +63,7 @@ let minOutTime = case minT of Just t -> t ; Nothing -> minTime let maxOutTime = case maxT of Just t -> t ; Nothing -> maxTime - let transformLabels axis = axis { axis_labels_ = map (map (\(t, s) -> (t, transformLabel t s))) (axis_labels_ axis) } + let transformLabels axis = axis & axis_labels %~ map (map (\(t, s) -> (t, transformLabel t s))) let commonTimeAxis = transformLabels $ autoAxis [minOutTime, maxOutTime] -- Pass 2 @@ -74,8 +75,8 @@ -- Render return $ renderStackedLayouts $ - slayouts_layouts ^= map (dataToPlot commonTimeAxis (minOutTime,maxOutTime)) (M.elems plots) $ - defaultStackedLayouts + slayouts_layouts .~ map (dataToPlot commonTimeAxis (minOutTime,maxOutTime)) (M.elems plots) $ + def showHelp = mapM_ putStrLn [ "", "tplot - a tool for drawing timing diagrams.", diff --git a/Tools/TimePlot/Plots.hs b/Tools/TimePlot/Plots.hs --- a/Tools/TimePlot/Plots.hs +++ b/Tools/TimePlot/Plots.hs @@ -14,8 +14,6 @@ import Data.Time -import Data.Accessor - import Graphics.Rendering.Chart import Graphics.Rendering.Chart.Event @@ -32,7 +30,7 @@ initGen (KindAPercent bs b) = genActivity (\sns n -> 100*n/b) bs initGen (KindAFreq bs) = genActivity (\sns n -> if n == 0 then 0 else (n / sum (M.elems sns))) bs initGen (KindFreq bs k) = genAtoms atoms2freqs bs k - where atoms2freqs as m = let s = sum [c | (a,c) <- M.toList m] + where atoms2freqs as m = let s = sum [c | (a,c) <- M.toList m] in if s==0 then [0] else 0:[fromIntegral (M.findWithDefault 0 a m)/fromIntegral s | a <- as] initGen (KindHistogram bs k) = genAtoms atoms2hist bs k where atoms2hist as m = 0:[fromIntegral (M.findWithDefault 0 a m) | a <- as] @@ -44,12 +42,12 @@ initGen (KindDots alpha) = genDots alpha initGen (KindSum bs ss) = genSum bs ss initGen (KindCumSum bs ss) = genCumSum bs ss -initGen (KindDuration sk dropSubtrack) = genDuration sk dropSubtrack -initGen (KindWithin _ _) = \name -> error $ +initGen (KindDuration sk dropSubtrack) = genDuration sk dropSubtrack +initGen (KindWithin _ _) = \name -> error $ "KindWithin should not be plotted (this is a bug): track " ++ show name -initGen KindNone = \name -> error $ +initGen KindNone = \name -> error $ "KindNone should not be plotted (this is a bug): track " ++ show name -initGen KindUnspecified = \name -> error $ +initGen KindUnspecified = \name -> error $ "Kind not specified for track " ++ show name ++ " (have you misspelled -dk or any of -k arguments?)" -- Auxiliary functions for two common plot varieties @@ -59,7 +57,7 @@ plotName = name, barsStyle = BarsStacked, barsValues = vals, - barsStyles = [ (solidFillStyle c, Nothing) + barsStyles = [ (solidFillStyle c, Nothing) | c <- transparent:map opaque colors], barsTitles = "":titles } @@ -116,14 +114,14 @@ -- Arguments of f will be: value bin boundaries, values in the current time bin genByBins :: ([Double] -> [Double] -> [Double]) -> NominalDiffTime -> [Double] -> PlotGen -genByBins f timeBinSize valueBinBounds name t0 t1 = I.filterMap valuesDropTrack $ +genByBins f timeBinSize valueBinBounds name t0 t1 = I.filterMap valuesDropTrack $ summaryByFixedTimeBins t0 timeBinSize $ I.mapInput (\(t,xs) -> (t, 0:f valueBinBounds xs)) $ (\tfs -> plotTrackBars tfs binTitles name colors) <$> I.collect where - binTitles = [low]++[showDt v1++".."++showDt v2 - | v1 <- valueBinBounds + binTitles = [low]++[showDt v1++".."++showDt v2 + | v1 <- valueBinBounds | v2 <- tail valueBinBounds]++ [high] where @@ -188,7 +186,7 @@ genAtoms :: ([S.ByteString] -> M.Map S.ByteString Int -> [Double]) -> NominalDiffTime -> PlotBarsStyle -> PlotGen genAtoms f binSize k name t0 t1 = I.filterMap atomsDropTrack (h <$> unique (\(t,atom) -> atom) <*> fInBins) - where + where fInBins :: I.StreamSummary (LocalTime, S.ByteString) [(LocalTime, M.Map S.ByteString Int)] fInBins = summaryByFixedTimeBins t0 binSize $ I.mapInput (second counts) I.collect counts = foldl' insert M.empty @@ -208,7 +206,7 @@ genSum :: NominalDiffTime -> SumSubtrackStyle -> PlotGen genSum binSize ss name t0 t1 = I.filterMap values (h <$> uniqueSubtracks <*> sumsInBins t0 binSize) - where + where h :: [S.ByteString] -> [(LocalTime, M.Map S.ByteString Double)] -> PlotData h tracks binSums = plotLines name rows where @@ -218,7 +216,7 @@ stack :: M.Map S.ByteString Double -> [(S.ByteString, Double)] stack ss = zip tracks (scanl1 (+) (map (\x -> M.findWithDefault 0 x ss) tracks)) - + rows :: [(S.ByteString, [(LocalTime, Double)])] rows = M.toList $ fmap sort $ M.fromListWith (++) $ [(track, [(t,sum)]) | (t, m) <- rowsT', (track, sum) <- m] @@ -234,11 +232,11 @@ where accumulate :: [S.ByteString] -> [(LocalTime, M.Map S.ByteString Double)] -> PlotData accumulate tracks tss = plotLines name [(track, [(t, ss M.! track) | (t,ss) <- cumsums]) | track <- tracks] - where + where cumsums = scanl' f (t0, M.fromList $ zip tracks (repeat 0)) (map normalize tss) normalize (t,binSums) = (t, M.fromList [ (track, M.findWithDefault 0 track binSums) | track <- tracks ]) - f (_,bases) (t,binSums) = (t,) $ M.fromList $ zip tracks $ zipWith (+) trackBases $ case ss of + f (_,bases) (t,binSums) = (t,) $ M.fromList $ zip tracks $ zipWith (+) trackBases $ case ss of SumOverlayed -> trackSums SumStacked -> trackAccSums where @@ -251,7 +249,7 @@ genActivity :: (M.Map S.ByteString Double -> Double -> Double) -> NominalDiffTime -> PlotGen genActivity f bs name t0 t1 = I.filterMap edges (h <$> uniqueSubtracks <*> binAreas) - where + where binAreas :: I.StreamSummary (LocalTime,S.ByteString,Edge) [(LocalTime, M.Map S.ByteString Double)] binAreas = fmap (map (\((t1,t2),m) -> (t1,m))) $ edges2binsSummary bs t0 t1 @@ -259,13 +257,13 @@ where barsData = [(t, 0:map (f m . flip (M.findWithDefault 0) m) tracks) | (t,m) <- binAreas] -edges2binsSummary :: (Ord t,HasDelta t,Show t) => - Delta t -> t -> t -> +edges2binsSummary :: (Ord t,HasDelta t,Show t) => + Delta t -> t -> t -> I.StreamSummary (t,S.ByteString,Edge) [((t,t), M.Map S.ByteString Double)] edges2binsSummary binSize tMin tMax = I.stateful (M.empty, iterate (add binSize) tMin, []) step flush where -- State: (m, ts, r) where: - -- * m = subtrack => state of current bin: + -- * m = subtrack => state of current bin: -- (area, starting time, level = rise-fall, num pulse events) -- * ts = infinite list of time bin boundaries -- * r = reversed list of results per bins @@ -277,7 +275,7 @@ where states = M.toList m binSizeSec = deltaToSeconds t2 t1 - binValue (area,start,nopen,npulse) = + binValue (area,start,nopen,npulse) = (fromIntegral npulse + area + deltaToSeconds t2 start*nopen) / binSizeSec !r' = ((t1,t2), M.fromList [(s, binValue bin) | (s, bin) <- states]) : r !m' = fmap (\(_,_,nopen,_) -> (0,t2,nopen,0)) m @@ -289,19 +287,19 @@ step'' ev@(t,s,e) st@(m, t1:t2:ts, r) = if (t < t1 || t >= t2) then error "Outside bin" else step' ev st step' (t, s, SetTo _) st = st - step' (t, s, Pulse _) st = modState s t st $ + step' (t, s, Pulse _) st = modState s t st $ \(!area, !start, !nopen, !npulse) -> (area, t, nopen, npulse+1) - step' (t, s, Rise) st = modState s t st $ + step' (t, s, Rise) st = modState s t st $ \(!area, !start, !nopen, !npulse) -> (area+deltaToSeconds t start*nopen, t, nopen+1, npulse) - step' (t, s, Fall) st = modState s t st $ + step' (t, s, Fall) st = modState s t st $ \(!area, !start, !nopen, !npulse) -> (area+deltaToSeconds t start*nopen, t, nopen-1, npulse) - flush st@(m, t1:t2:ts, r) + flush st@(m, t1:t2:ts, r) | t2 <= tMax = flush (flushBin st) | True = reverse r type StreamTransformer a b = forall r . I.StreamSummary b r -> I.StreamSummary a r -edges2eventsSummary :: forall t . (Ord t) => +edges2eventsSummary :: forall t . (Ord t) => t -> t -> StreamTransformer (t,S.ByteString,Edge) (S.ByteString, Event t Status) edges2eventsSummary t0 t1 s = I.stateful (M.empty,s) step flush where @@ -313,7 +311,7 @@ getTrack s (!ts,sum) = M.findWithDefault (t0, 0, emptyStatus) s ts putTrack s t (!ts,sum) = (M.insert s t ts, sum) killTrack s (!ts,sum) = (M.delete s ts, sum) - trackCase s whenZero withNonzero st + trackCase s whenZero withNonzero st | numActive == 0 = whenZero | True = withNonzero t0 numActive status where (t0, numActive, status) = getTrack s st @@ -321,12 +319,12 @@ emptyStatus = Status "" "" step (t,s,Pulse st) state = tellSummary (s, PulseEvent t st) state - step (t,s,SetTo st) state = trackCase s + step (t,s,SetTo st) state = trackCase s (putTrack s (t, 1, st) state) (\t0 !n st0 -> putTrack s (t,n,st) $ tellSummary (s, LongEvent (t0,True) (t,True) st0) state) state - step (t,s,Rise) state = trackCase s - (putTrack s (t, 1, emptyStatus) state) + step (t,s,Rise) state = trackCase s + (putTrack s (t, 1, emptyStatus) state) (\t0 !n st -> putTrack s (t, n+1, st) state) state step (t,s,Fall) state @@ -339,12 +337,12 @@ where addEvent sum (s,(t0,_,st)) = I.insert sum (s, LongEvent (t0,True) (t1,False) st) -edges2durationsSummary :: forall t . (Ord t, HasDelta t) => +edges2durationsSummary :: forall t . (Ord t, HasDelta t) => t -> t -> Maybe String -> StreamTransformer (t,S.ByteString,Edge) (t,InEvent) edges2durationsSummary t0 t1 commonTrack = edges2eventsSummary t0 t1 . I.filterMap genDurations where genDurations (track, e) = case e of - LongEvent (t1,True) (t2,True) _ -> Just (t2, InValue (case commonTrack of + LongEvent (t1,True) (t2,True) _ -> Just (t2, InValue (case commonTrack of Nothing -> track _ -> commonTrackBS) (deltaToSeconds t2 t1)) @@ -352,13 +350,13 @@ commonTrackBS = S.pack (fromJust commonTrack) genEvent :: PlotGen -genEvent name t0 t1 = I.filterMap edges $ - fmap (\evs -> PlotEventData { plotName = name, eventData = map snd evs }) $ +genEvent name t0 t1 = I.filterMap edges $ + fmap (\evs -> PlotEventData { plotName = name, eventData = map snd evs }) $ edges2eventsSummary t0 t1 I.collect -- TODO Multiple tracks genDuration :: ChartKind LocalTime -> Bool -> PlotGen -genDuration sk dropSubtrack name t0 t1 = I.filterMap edges $ +genDuration sk dropSubtrack name t0 t1 = I.filterMap edges $ edges2durationsSummary t0 t1 (if dropSubtrack then Just name else Nothing) (initGen sk name t0 t1) fromListWith' f kvs = foldl' insert M.empty kvs @@ -370,4 +368,3 @@ colors = cycle [green,blue,red,brown,yellow,orange,grey,purple,violet,lightblue] groupByTrack xs = M.toList $ sort `fmap` M.fromListWith (++) [(s, [(t,v)]) | (t,s,v) <- xs] - diff --git a/Tools/TimePlot/Render.hs b/Tools/TimePlot/Render.hs --- a/Tools/TimePlot/Render.hs +++ b/Tools/TimePlot/Render.hs @@ -5,10 +5,11 @@ import Graphics.Rendering.Chart import Graphics.Rendering.Chart.Event +import Control.Lens import Data.Time -import Data.Accessor import Data.Colour import Data.Colour.Names +import Data.Default import Data.Maybe import Tools.TimePlot.Types @@ -28,49 +29,49 @@ dataToPlot' :: AxisData LocalTime -> PlotData -> StackedLayout LocalTime dataToPlot' commonTimeAxis p@PlotBarsData{} = StackedLayout $ layoutWithTitle commonTimeAxis [plotBars plot] (plotName p) (length (barsTitles p) > 1) - where plot = plot_bars_values ^= barsValues p $ - plot_bars_item_styles ^= barsStyles p $ - plot_bars_style ^= barsStyle p $ - plot_bars_titles ^= barsTitles p $ + where plot = plot_bars_values .~ barsValues p $ + plot_bars_item_styles .~ barsStyles p $ + plot_bars_style .~ barsStyle p $ + plot_bars_titles .~ barsTitles p $ ourPlotBars dataToPlot' commonTimeAxis p@PlotEventData{} = StackedLayout $ layoutWithTitle commonTimeAxis [toPlot plot] (plotName p) False - where plot = plot_event_data ^= eventData p $ - plot_event_long_fillstyle ^= toFillStyle $ - plot_event_label ^= toLabel $ - defaultPlotEvent + where plot = plot_event_data .~ eventData p $ + plot_event_long_fillstyle .~ toFillStyle $ + plot_event_label .~ toLabel $ + def toFillStyle s = solidFillStyle . opaque $ fromMaybe lightgray (readColourName (statusColor s)) - toLabel s = statusLabel s + toLabel s = statusLabel s dataToPlot' commonTimeAxis p@PlotLinesData{} = StackedLayout $ layoutWithTitle commonTimeAxis (map toPlot plots) (plotName p) (length (linesData p) > 1) - where plots = [plot_lines_values ^= [vs] $ - plot_lines_title ^= title $ - plot_lines_style ^= lineStyle $ - defaultPlotLines + where plots = [plot_lines_values .~ [vs] $ + plot_lines_title .~ title $ + plot_lines_style .~ lineStyle $ + def | vs <- linesData p | title <- linesTitles p | lineStyle <- linesStyles p] dataToPlot' commonTimeAxis p@PlotDotsData{} = StackedLayout $ layoutWithTitle commonTimeAxis (map toPlot plots) (plotName p) (length (dotsData p) > 1) - where plots = [plot_points_values ^= vs $ - plot_points_style ^= hollowCircles 4 1 color $ - plot_points_title ^= subtrack $ - defaultPlotPoints + where plots = [plot_points_values .~ vs $ + plot_points_style .~ hollowCircles 4 1 color $ + plot_points_title .~ subtrack $ + def | subtrack <- dotsTitles p | color <- dotsColors p | vs <- dotsData p] layoutWithTitle :: (PlotValue a, Show a) => AxisData LocalTime -> [Plot LocalTime a] -> String -> Bool -> Layout1 LocalTime a layoutWithTitle commonTimeAxis plots name showLegend = - layout1_title ^= "" $ - layout1_plots ^= map Left plots $ - (if showLegend then id else (layout1_legend ^= Nothing)) $ - layout1_bottom_axis .> laxis_generate ^= (\_ -> commonTimeAxis) $ - layout1_top_axis .> laxis_generate ^= (\_ -> commonTimeAxis) $ - layout1_left_axis .> laxis_title ^= name $ - layout1_margin ^= 0 $ - layout1_grid_last ^= True $ - defaultLayout1 + layout1_title .~ "" $ + layout1_plots .~ map Left plots $ + (if showLegend then id else (layout1_legend .~ Nothing)) $ + layout1_bottom_axis . laxis_generate .~ (\_ -> commonTimeAxis) $ + layout1_top_axis . laxis_generate .~ (\_ -> commonTimeAxis) $ + layout1_left_axis . laxis_title .~ name $ + layout1_margin .~ 0 $ + layout1_grid_last .~ True $ + def ourPlotBars :: (BarsPlotValue a) => PlotBars LocalTime a -ourPlotBars = plot_bars_spacing ^= BarsFixGap 0 0 $ - plot_bars_style ^= BarsStacked $ - plot_bars_alignment ^= BarsLeft $ - defaultPlotBars +ourPlotBars = plot_bars_spacing .~ BarsFixGap 0 0 $ + plot_bars_style .~ BarsStacked $ + plot_bars_alignment .~ BarsLeft $ + def diff --git a/Tools/TimePlot/Types.hs b/Tools/TimePlot/Types.hs --- a/Tools/TimePlot/Types.hs +++ b/Tools/TimePlot/Types.hs @@ -5,7 +5,6 @@ import qualified Data.ByteString.Char8 as S import Graphics.Rendering.Chart import Data.Colour -import Data.Accessor import Graphics.Rendering.Chart.Event data Status = Status {statusColor :: String, statusLabel :: String} deriving (Eq, Show, Ord) @@ -17,11 +16,11 @@ unitStatusAxis :: AxisData Status unitStatusAxis = AxisData { - axis_viewport_ = \(x0,x1) _ -> (x0+x1)/2, - axis_tropweiv_ = \_ _ -> Status "" "", - axis_ticks_ = [(Status "" "", 0)], - axis_labels_ = [[(Status "" "", "")]], - axis_grid_ = [] + _axis_viewport = \(x0,x1) _ -> (x0+x1)/2, + _axis_tropweiv = \_ _ -> Status "" "", + _axis_ticks = [(Status "" "", 0)], + _axis_labels = [[(Status "" "", "")]], + _axis_grid = [] } data Edge = Rise | Fall | Pulse Status | SetTo Status deriving (Eq,Show) @@ -101,22 +100,20 @@ | KindBinHist { binSize :: Delta t, delims :: [Double] } | KindFreq { binSize :: Delta t, style :: PlotBarsStyle } | KindHistogram { binSize :: Delta t, style :: PlotBarsStyle } - | KindLines + | KindLines | KindDots { alpha :: Double } | KindCumSum { binSize :: Delta t, subtrackStyle :: SumSubtrackStyle } | KindSum { binSize :: Delta t, subtrackStyle :: SumSubtrackStyle } | KindNone - | KindUnspecified -- Causes an error message + | KindUnspecified -- Causes an error message -instance Show CairoLineStyle where show _ = "" -instance Show CairoFillStyle where show _ = "" data PlotData = PlotBarsData { plotName :: String, - barsStyle :: PlotBarsStyle, - barsValues :: [ (LocalTime, [Double]) ], - barsStyles :: [(CairoFillStyle, Maybe CairoLineStyle)], - barsTitles :: [String] + barsStyle :: PlotBarsStyle, + barsValues :: [ (LocalTime, [Double]) ], + barsStyles :: [(FillStyle, Maybe LineStyle)], + barsTitles :: [String] } | PlotEventData { @@ -127,7 +124,7 @@ { plotName :: String, linesData :: [[(LocalTime, Double)]], - linesStyles :: [CairoLineStyle], + linesStyles :: [LineStyle], linesTitles :: [String] } | PlotDotsData diff --git a/timeplot.cabal b/timeplot.cabal --- a/timeplot.cabal +++ b/timeplot.cabal @@ -1,5 +1,5 @@ name: timeplot -version: 1.0.21 +version: 1.0.22 cabal-version: >=1.6 build-type: Simple license: BSD3 @@ -29,9 +29,9 @@ buildable: True ghc-options: -rtsopts other-modules: Graphics.Rendering.Chart.Event - build-depends: Chart >=0.17 && < 0.18, base >=3 && <5, bytestring -any, + build-depends: Chart == 1.*, Chart-cairo == 1.*, base >=3 && <5, bytestring -any, bytestring-lexing -any, cairo -any, colour -any, containers -any, - data-accessor ==0.2.*, data-accessor-template >=0.2.1.1 && <0.3, + data-default -any, lens >= 3.9, regex-tdfa -any, strptime >=0.1.7, time -any, transformers -any, vcs-revision -any, template-haskell -any