module Graphics.Rendering.Chart.Plot(
Plot(..),
ToPlot(..),
PlotPoints(..),
PlotErrBars(..),
PlotLines(..),
PlotFillBetween(..),
ErrPoint(..),
defaultPlotLineStyle,
defaultPlotPoints,
defaultPlotErrBars,
defaultPlotFillBetween,
defaultPlotLines
) where
import qualified Graphics.Rendering.Cairo as C
import Graphics.Rendering.Chart.Types
import Control.Monad
data Plot = Plot {
plot_render :: PointMapFn -> CRender (),
plot_render_legend :: Rect -> CRender (),
plot_all_points :: [Point]
};
class ToPlot a where
toPlot :: a -> Plot
data PlotLines = PlotLines {
plot_lines_style :: CairoLineStyle,
plot_lines_values :: [[Point]]
}
instance ToPlot PlotLines where
toPlot p = Plot {
plot_render = renderPlotLines p,
plot_render_legend = renderPlotLegendLines p,
plot_all_points = concat (plot_lines_values p)
}
renderPlotLines :: PlotLines -> PointMapFn -> CRender ()
renderPlotLines p pmap = preserveCState $ do
setLineStyle (plot_lines_style p)
mapM_ drawLines (plot_lines_values p)
where
drawLines (p:ps) = do
moveTo (pmap p)
mapM_ (\p -> lineTo (pmap p)) ps
c $ C.stroke
renderPlotLegendLines :: PlotLines -> Rect -> CRender ()
renderPlotLegendLines p r@(Rect p1 p2) = preserveCState $ do
setLineStyle (plot_lines_style p)
let y = (p_y p1 + p_y p2) / 2
moveTo (Point (p_x p1) y)
lineTo (Point (p_x p2) y)
c $ C.stroke
defaultPlotLineStyle = solidLine 1 blue
defaultPlotLines = PlotLines {
plot_lines_style = defaultPlotLineStyle,
plot_lines_values = []
}
data PlotPoints = PlotPoints {
plot_points_style :: CairoPointStyle,
plot_points_values :: [Point]
}
instance ToPlot PlotPoints where
toPlot p = Plot {
plot_render = renderPlotPoints p,
plot_render_legend = renderPlotLegendPoints p,
plot_all_points = plot_points_values p
}
renderPlotPoints :: PlotPoints -> PointMapFn -> CRender ()
renderPlotPoints p pmap = preserveCState $ do
mapM_ (drawPoint.pmap) (plot_points_values p)
where
(CairoPointStyle drawPoint) = (plot_points_style p)
renderPlotLegendPoints :: PlotPoints -> Rect -> CRender ()
renderPlotLegendPoints p r@(Rect p1 p2) = preserveCState $ do
drawPoint (Point (p_x p1) ((p_y p1 + p_y p2)/2))
drawPoint (Point ((p_x p1 + p_x p2)/2) ((p_y p1 + p_y p2)/2))
drawPoint (Point (p_x p2) ((p_y p1 + p_y p2)/2))
where
(CairoPointStyle drawPoint) = (plot_points_style p)
defaultPlotPoints = PlotPoints {
plot_points_style =defaultPointStyle,
plot_points_values = []
}
data PlotFillBetween = PlotFillBetween {
plot_fillbetween_style :: CairoFillStyle,
plot_fillbetween_values :: [ (Double, (Double,Double))]
}
instance ToPlot PlotFillBetween where
toPlot p = Plot {
plot_render = renderPlotFillBetween p,
plot_render_legend = renderPlotLegendFill p,
plot_all_points = plotAllPointsFillBetween p
}
renderPlotFillBetween :: PlotFillBetween -> PointMapFn -> CRender ()
renderPlotFillBetween p pmap = renderPlotFillBetween' p (plot_fillbetween_values p) pmap
renderPlotFillBetween' p [] _ = return ()
renderPlotFillBetween' p vs pmap = preserveCState $ do
setFillStyle (plot_fillbetween_style p)
moveTo p0
mapM_ lineTo p1s
mapM_ lineTo (reverse p2s)
lineTo p0
c $ C.fill
where
(p0:p1s) = map pmap [ Point x y1 | (x,(y1,y2)) <- vs ]
p2s = map pmap [ Point x y2 | (x,(y1,y2)) <- vs ]
renderPlotLegendFill :: PlotFillBetween -> Rect -> CRender ()
renderPlotLegendFill p r = preserveCState $ do
setFillStyle (plot_fillbetween_style p)
rectPath r
c $ C.fill
plotAllPointsFillBetween :: PlotFillBetween -> [Point]
plotAllPointsFillBetween p = concat [ [Point x y1, Point x y2]
| (x,(y1,y2)) <- plot_fillbetween_values p]
defaultPlotFillBetween = PlotFillBetween {
plot_fillbetween_style=solidFillStyle (Color 0.5 0.5 1.0),
plot_fillbetween_values=[]
}
data ErrPoint = ErrPoint {
ep_x :: Double,
ep_y :: Double,
ep_dx :: Double,
ep_dy :: Double
} deriving Show
data PlotErrBars = PlotErrBars {
plot_errbars_line_style :: CairoLineStyle,
plot_errbars_tick_length :: Double,
plot_errbars_overhang :: Double,
plot_errbars_values :: [ErrPoint]
}
instance ToPlot PlotErrBars where
toPlot p = Plot {
plot_render = renderPlotErrBars p,
plot_render_legend = renderPlotLegendErrBars p,
plot_all_points = map (\(ErrPoint x y _ _) -> Point x y ) $ plot_errbars_values p
}
renderPlotErrBars :: PlotErrBars -> PointMapFn -> CRender ()
renderPlotErrBars p pmap = preserveCState $ do
mapM_ (drawErrBar.epmap) (plot_errbars_values p)
where
epmap (ErrPoint x y dx dy) = ErrPoint x' y' (abs $ x''x') (abs $ y''y')
where (Point x' y') = pmap (Point x y)
(Point x'' y'') = pmap (Point (x+dx) (y+dy))
drawErrBar = drawErrBar0 p
drawErrBar0 ps (ErrPoint x y dx dy) = do
let tl = plot_errbars_tick_length ps
let oh = plot_errbars_overhang ps
setLineStyle (plot_errbars_line_style ps)
c $ C.newPath
c $ C.moveTo (xdxoh) y
c $ C.lineTo (x+dx+oh) y
c $ C.moveTo x (ydyoh)
c $ C.lineTo x (y+dy+oh)
c $ C.moveTo (xdx) (ytl)
c $ C.lineTo (xdx) (y+tl)
c $ C.moveTo (xtl) (ydy)
c $ C.lineTo (x+tl) (ydy)
c $ C.moveTo (x+dx) (ytl)
c $ C.lineTo (x+dx) (y+tl)
c $ C.moveTo (xtl) (y+dy)
c $ C.lineTo (x+tl) (y+dy)
c $ C.stroke
renderPlotLegendErrBars :: PlotErrBars -> Rect -> CRender ()
renderPlotLegendErrBars p r@(Rect p1 p2) = preserveCState $ do
drawErrBar (ErrPoint (p_x p1) ((p_y p1 + p_y p2)/2) dx dx )
drawErrBar (ErrPoint ((p_x p1 + p_x p2)/2) ((p_y p1 + p_y p2)/2) dx dx)
drawErrBar (ErrPoint (p_x p2) ((p_y p1 + p_y p2)/2) dx dx)
where
drawErrBar = drawErrBar0 p
dx = min ((p_x p2 p_x p1)/6) ((p_y p2 p_y p1)/2)
defaultPlotErrBars = PlotErrBars {
plot_errbars_line_style = solidLine 1 blue,
plot_errbars_tick_length = 3,
plot_errbars_overhang = 0,
plot_errbars_values = []
}