timeplot 0.1.2 → 0.1.3

raw patch · 2 files changed

+105/−1 lines, 2 files

Files

• Graphics/Rendering/Chart/Event.hs +103/−0
• timeplot.cabal +2/−1

@@ -0,0 +1,103 @@+{-# LANGUAGE TemplateHaskell #-}+module Graphics.Rendering.Chart.Event (+    PlotEvent(..),+    Event(..),++    defaultPlotEvent,+    plot_event_title,+    plot_event_data,+    plot_event_long_fillstyle,+    plot_event_long_linestyle,+    plot_event_pulse_linestyle,+    plot_event_track_linestyle,+) where++import qualified Graphics.Rendering.Cairo as C+import Graphics.Rendering.Chart+import Data.Colour+import Data.Colour.Names+import Data.Accessor+import Data.Accessor.Template++data Event t e = LongEvent t t e  -- ^ An event that has a beginning and an end+               | PulseEvent t e   -- ^ A zero-length event+               deriving (Show)++-- | A chart that depict events.+-- There are two kinds of events: long and impulse events. A long event+-- 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],+   -- | Linestyle with which marks for pulse events will be drawn+   plot_event_pulse_linestyle_ :: e -> CairoLineStyle,+   -- | Linestyle with which borders of rectangles for long events will be drawn+   plot_event_long_linestyle_  :: e -> CairoLineStyle,+   -- | Fillstyle with which interiors of rectangles for long events will be filled+   plot_event_long_fillstyle_  :: e -> CairoFillStyle,+   -- | Linestyle with which the "track line" will be drawn+   plot_event_track_linestyle_ :: CairoLineStyle+}++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 white),+   plot_event_track_linestyle_ = solidLine 1 (opaque black)+}++instance ToPlot PlotEvent where+    toPlot p = Plot {+        plot_render_ = renderPlotEvent p,+	    plot_legend_ = [(plot_event_title_ p, renderPlotLegendEvent p)],+	    plot_all_points_ = plotAllPointsEvent p+    }++renderPlotLegendEvent :: PlotEvent t e -> Rect -> CRender ()+renderPlotLegendEvent p r = return ()+++filledRect :: CairoLineStyle -> CairoFillStyle -> Rect -> CRender ()+filledRect ls fs r     = do+  rectPath r+  c C.closePath+  setFillStyle fs ; c C.fillPreserve+  setLineStyle ls ; c C.stroke++barHeight = 15+pulseHeight = 15++renderPlotEvent :: PlotEvent t e -> PointMapFn t e  -> CRender ()+renderPlotEvent p pmap = do+      setLineStyle $ plot_event_track_linestyle_ p+      moveTo (Point x0 cy)+      lineTo (Point x1 cy)+      c $ C.stroke+      mapM_ drawEvent (plot_event_data_ p)+    where+      (Point x0 y0) = pmap (LMin,LMin)+      (Point x1 y1) = pmap (LMax,LMax)+      (cx,cy) = ((x0+x1)/2, (y0+y1)/2)+      drawEvent (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+      drawEvent (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_linestyle_ p e) (plot_event_long_fillstyle_ p 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)+  where+    d = plot_event_data_ p+    decomp (PulseEvent t     e) = ([t],     e)+    decomp (LongEvent  t1 t2 e) = ([t1,t2], e)++$( deriveAccessors ''PlotEvent )

@@ -1,5 +1,5 @@ Name: timeplot-Version: 0.1.2+Version: 0.1.3 License: BSD3 License-file: LICENSE Copyright: Eugene Kirpichov, 2009@@ -31,3 +31,4 @@                  containers, colour, data-accessor == 0.2.*, data-accessor-template >= 0.2.1.1 && < 0.3,                   haskell98, regex-pcre   Main-Is: Tools/TimePlot.hs+  Other-Modules: Graphics.Rendering.Chart.Event