module Graphics.Rendering.Chart.Plot(
Plot(..),
ToPlot(..),
PlotPoints(..),
PlotErrBars(..),
PlotLines(..),
PlotFillBetween(..),
ErrPoint(..),
symErrPoint,
defaultPlotLineStyle,
defaultPlotPoints,
defaultPlotErrBars,
defaultPlotFillBetween,
defaultPlotLines,
plot_lines_style,
plot_lines_values,
plot_render,
plot_render_legend,
plot_all_points,
plot_points_style,
plot_points_values,
plot_fillbetween_style,
plot_fillbetween_values,
plot_errbars_line_style,
plot_errbars_tick_length,
plot_errbars_overhang,
plot_errbars_values,
) where
import qualified Graphics.Rendering.Cairo as C
import Graphics.Rendering.Chart.Types
import Control.Monad
import Data.Accessor.Template
data Plot x y = Plot {
plot_render_ :: PointMapFn x y -> CRender (),
plot_render_legend_ :: Rect -> CRender (),
plot_all_points_ :: [(x,y)]
}
class ToPlot a where
toPlot :: a x y -> Plot x y
data PlotLines x y = PlotLines {
plot_lines_style_ :: CairoLineStyle,
plot_lines_values_ :: [[(x,y)]]
}
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 x y -> PointMapFn x y -> 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 x y -> 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){
line_cap_ = C.LineCapRound,
line_join_ = C.LineJoinRound
}
defaultPlotLines = PlotLines {
plot_lines_style_ = defaultPlotLineStyle,
plot_lines_values_ = []
}
data PlotPoints x y = PlotPoints {
plot_points_style_ :: CairoPointStyle,
plot_points_values_ :: [(x,y)]
}
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 x y -> PointMapFn x y -> CRender ()
renderPlotPoints p pmap = preserveCState $ do
mapM_ (drawPoint.pmap) (plot_points_values_ p)
where
(CairoPointStyle drawPoint) = (plot_points_style_ p)
renderPlotLegendPoints :: PlotPoints x y -> 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 x y = PlotFillBetween {
plot_fillbetween_style_ :: CairoFillStyle,
plot_fillbetween_values_ :: [ (x, (y,y))]
}
instance ToPlot PlotFillBetween where
toPlot p = Plot {
plot_render_ = renderPlotFillBetween p,
plot_render_legend_ = renderPlotLegendFill p,
plot_all_points_ = plotAllPointsFillBetween p
}
renderPlotFillBetween :: PlotFillBetween x y -> PointMapFn x y -> 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 [ (x,y1) | (x,(y1,y2)) <- vs ]
p2s = map pmap [ (x,y2) | (x,(y1,y2)) <- vs ]
renderPlotLegendFill :: PlotFillBetween x y -> Rect -> CRender ()
renderPlotLegendFill p r = preserveCState $ do
setFillStyle (plot_fillbetween_style_ p)
rectPath r
c $ C.fill
plotAllPointsFillBetween :: PlotFillBetween x y -> [(x,y)]
plotAllPointsFillBetween p = concat [ [(x, y1), (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 ErrValue x = ErrValue {
ev_low :: x,
ev_best :: x,
ev_high :: x
} deriving Show
data ErrPoint x y = ErrPoint {
ep_x :: ErrValue x,
ep_y :: ErrValue y
} deriving Show
symErrPoint x y dx dy = ErrPoint (ErrValue (xdx) x (x+dx))
(ErrValue (ydy) y (y+dy))
data PlotErrBars x y = PlotErrBars {
plot_errbars_line_style_ :: CairoLineStyle,
plot_errbars_tick_length_ :: Double,
plot_errbars_overhang_ :: Double,
plot_errbars_values_ :: [ErrPoint x y]
}
instance ToPlot PlotErrBars where
toPlot p = Plot {
plot_render_ = renderPlotErrBars p,
plot_render_legend_ = renderPlotLegendErrBars p,
plot_all_points_ = concat
[[((ev_low x),(ev_low y)), ((ev_high x),(ev_high y))]
| ErrPoint x y <- plot_errbars_values_ p]
}
renderPlotErrBars :: PlotErrBars x y -> PointMapFn x y -> CRender ()
renderPlotErrBars p pmap = preserveCState $ do
mapM_ (drawErrBar.epmap) (plot_errbars_values_ p)
where
epmap (ErrPoint (ErrValue xl x xh) (ErrValue yl y yh)) =
ErrPoint (ErrValue xl' x' xh') (ErrValue yl' y' yh')
where (Point x' y') = pmap (x,y)
(Point xl' yl') = pmap (xl,yl)
(Point xh' yh') = pmap (xh,yh)
drawErrBar = drawErrBar0 p
drawErrBar0 ps (ErrPoint (ErrValue xl x xh) (ErrValue yl y yh)) = 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 (xloh) y
c $ C.lineTo (xh+oh) y
c $ C.moveTo x (yloh)
c $ C.lineTo x (yh+oh)
c $ C.moveTo xl (ytl)
c $ C.lineTo xl (y+tl)
c $ C.moveTo (xtl) yl
c $ C.lineTo (x+tl) yl
c $ C.moveTo xh (ytl)
c $ C.lineTo xh (y+tl)
c $ C.moveTo (xtl) yh
c $ C.lineTo (x+tl) yh
c $ C.stroke
renderPlotLegendErrBars :: PlotErrBars x y -> Rect -> CRender ()
renderPlotLegendErrBars p r@(Rect p1 p2) = preserveCState $ do
drawErrBar (symErrPoint (p_x p1) ((p_y p1 + p_y p2)/2) dx dx )
drawErrBar (symErrPoint ((p_x p1 + p_x p2)/2) ((p_y p1 + p_y p2)/2) dx dx)
drawErrBar (symErrPoint (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_ = []
}
$( deriveAccessors ''Plot )
$( deriveAccessors ''PlotLines )
$( deriveAccessors ''PlotPoints )
$( deriveAccessors ''PlotFillBetween )
$( deriveAccessors ''PlotErrBars )