1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
|
-----------------------------------------------------------------------------
-- |
-- Module : Graphics.Rendering.Chart.Plot.Lines
-- Copyright : (c) Tim Docker 2006, 2014
-- License : BSD-style (see chart/COPYRIGHT)
--
-- Line plots
--
{-# LANGUAGE TemplateHaskell #-}
module Graphics.Rendering.Chart.Plot.Lines(
PlotLines(..),
defaultPlotLineStyle,
hlinePlot,
vlinePlot,
plot_lines_title,
plot_lines_style,
plot_lines_values,
plot_lines_limit_values,
) where
import Control.Lens
import Graphics.Rendering.Chart.Geometry
import Graphics.Rendering.Chart.Drawing
import Graphics.Rendering.Chart.Plot.Types
import Data.Colour (opaque)
import Data.Colour.Names (blue)
import Data.Default.Class
-- | Value defining a series of (possibly disjointed) lines,
-- and a style in which to render them.
data PlotLines x y = PlotLines {
_plot_lines_title :: String,
_plot_lines_style :: LineStyle,
-- | The lines to be plotted
_plot_lines_values :: [[(x,y)]],
-- | Additional lines to be plotted, specified using
-- the Limit type to allow referencing the edges of
-- the plot area.
_plot_lines_limit_values :: [[(Limit x, Limit y)]]
}
instance ToPlot PlotLines where
toPlot p = Plot {
_plot_render = renderPlotLines p,
_plot_legend = [(_plot_lines_title p, renderPlotLegendLines p)],
_plot_all_points = ( map fst pts ++ xs, map snd pts ++ ys )
}
where
pts = concat (_plot_lines_values p)
xs = [ x | (LValue x,_) <- concat (_plot_lines_limit_values p)]
ys = [ y | (_,LValue y) <- concat (_plot_lines_limit_values p)]
renderPlotLines :: PlotLines x y -> PointMapFn x y -> BackendProgram ()
renderPlotLines p pmap =
withLineStyle (_plot_lines_style p) $ do
mapM_ (drawLines (mapXY pmap)) (_plot_lines_values p)
mapM_ (drawLines pmap) (_plot_lines_limit_values p)
where
drawLines mapfn pts = alignStrokePoints (map mapfn pts) >>= strokePointPath
renderPlotLegendLines :: PlotLines x y -> Rect -> BackendProgram ()
renderPlotLegendLines p (Rect p1 p2) =
withLineStyle (_plot_lines_style p) $ do
let y = (p_y p1 + p_y p2) / 2
ps <- alignStrokePoints [Point (p_x p1) y, Point (p_x p2) y]
strokePointPath ps
defaultPlotLineStyle :: LineStyle
defaultPlotLineStyle = (solidLine 1 $ opaque blue){
_line_cap = LineCapRound,
_line_join = LineJoinRound
}
instance Default (PlotLines x y) where
def = PlotLines
{ _plot_lines_title = ""
, _plot_lines_style = defaultPlotLineStyle
, _plot_lines_values = []
, _plot_lines_limit_values = []
}
-- | Helper function to plot a single horizontal line.
hlinePlot :: String -> LineStyle -> b -> Plot a b
hlinePlot t ls v = toPlot def {
_plot_lines_title = t,
_plot_lines_style = ls,
_plot_lines_limit_values = [[(LMin, LValue v),(LMax, LValue v)]]
}
-- | Helper function to plot a single vertical line.
vlinePlot :: String -> LineStyle -> a -> Plot a b
vlinePlot t ls v = toPlot def {
_plot_lines_title = t,
_plot_lines_style = ls,
_plot_lines_limit_values = [[(LValue v,LMin),(LValue v,LMax)]]
}
$( makeLenses ''PlotLines )
|
