{-# 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
data PlotLines x y = PlotLines {
PlotLines x y -> String
_plot_lines_title :: String,
PlotLines x y -> LineStyle
_plot_lines_style :: LineStyle,
PlotLines x y -> [[(x, y)]]
_plot_lines_values :: [[(x,y)]],
PlotLines x y -> [[(Limit x, Limit y)]]
_plot_lines_limit_values :: [[(Limit x, Limit y)]]
}
instance ToPlot PlotLines where
toPlot :: PlotLines x y -> Plot x y
toPlot PlotLines x y
p = Plot :: forall x y.
(PointMapFn x y -> BackendProgram ())
-> [(String, Rect -> BackendProgram ())] -> ([x], [y]) -> Plot x y
Plot {
_plot_render :: PointMapFn x y -> BackendProgram ()
_plot_render = PlotLines x y -> PointMapFn x y -> BackendProgram ()
forall x y. PlotLines x y -> PointMapFn x y -> BackendProgram ()
renderPlotLines PlotLines x y
p,
_plot_legend :: [(String, Rect -> BackendProgram ())]
_plot_legend = [(PlotLines x y -> String
forall x y. PlotLines x y -> String
_plot_lines_title PlotLines x y
p, PlotLines x y -> Rect -> BackendProgram ()
forall x y. PlotLines x y -> Rect -> BackendProgram ()
renderPlotLegendLines PlotLines x y
p)],
_plot_all_points :: ([x], [y])
_plot_all_points = ( ((x, y) -> x) -> [(x, y)] -> [x]
forall a b. (a -> b) -> [a] -> [b]
map (x, y) -> x
forall a b. (a, b) -> a
fst [(x, y)]
pts [x] -> [x] -> [x]
forall a. [a] -> [a] -> [a]
++ [x]
xs, ((x, y) -> y) -> [(x, y)] -> [y]
forall a b. (a -> b) -> [a] -> [b]
map (x, y) -> y
forall a b. (a, b) -> b
snd [(x, y)]
pts [y] -> [y] -> [y]
forall a. [a] -> [a] -> [a]
++ [y]
ys )
}
where
pts :: [(x, y)]
pts = [[(x, y)]] -> [(x, y)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (PlotLines x y -> [[(x, y)]]
forall x y. PlotLines x y -> [[(x, y)]]
_plot_lines_values PlotLines x y
p)
xs :: [x]
xs = [ x
x | (LValue x
x,Limit y
_) <- [[(Limit x, Limit y)]] -> [(Limit x, Limit y)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (PlotLines x y -> [[(Limit x, Limit y)]]
forall x y. PlotLines x y -> [[(Limit x, Limit y)]]
_plot_lines_limit_values PlotLines x y
p)]
ys :: [y]
ys = [ y
y | (Limit x
_,LValue y
y) <- [[(Limit x, Limit y)]] -> [(Limit x, Limit y)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (PlotLines x y -> [[(Limit x, Limit y)]]
forall x y. PlotLines x y -> [[(Limit x, Limit y)]]
_plot_lines_limit_values PlotLines x y
p)]
renderPlotLines :: PlotLines x y -> PointMapFn x y -> BackendProgram ()
renderPlotLines :: PlotLines x y -> PointMapFn x y -> BackendProgram ()
renderPlotLines PlotLines x y
p PointMapFn x y
pmap =
LineStyle -> BackendProgram () -> BackendProgram ()
forall a. LineStyle -> BackendProgram a -> BackendProgram a
withLineStyle (PlotLines x y -> LineStyle
forall x y. PlotLines x y -> LineStyle
_plot_lines_style PlotLines x y
p) (BackendProgram () -> BackendProgram ())
-> BackendProgram () -> BackendProgram ()
forall a b. (a -> b) -> a -> b
$ do
([(x, y)] -> BackendProgram ()) -> [[(x, y)]] -> BackendProgram ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (((x, y) -> Point) -> [(x, y)] -> BackendProgram ()
forall a. (a -> Point) -> [a] -> BackendProgram ()
drawLines (PointMapFn x y -> (x, y) -> Point
forall x y. PointMapFn x y -> (x, y) -> Point
mapXY PointMapFn x y
pmap)) (PlotLines x y -> [[(x, y)]]
forall x y. PlotLines x y -> [[(x, y)]]
_plot_lines_values PlotLines x y
p)
([(Limit x, Limit y)] -> BackendProgram ())
-> [[(Limit x, Limit y)]] -> BackendProgram ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (PointMapFn x y -> [(Limit x, Limit y)] -> BackendProgram ()
forall a. (a -> Point) -> [a] -> BackendProgram ()
drawLines PointMapFn x y
pmap) (PlotLines x y -> [[(Limit x, Limit y)]]
forall x y. PlotLines x y -> [[(Limit x, Limit y)]]
_plot_lines_limit_values PlotLines x y
p)
where
drawLines :: (a -> Point) -> [a] -> BackendProgram ()
drawLines a -> Point
mapfn [a]
pts = [Point] -> BackendProgram [Point]
alignStrokePoints ((a -> Point) -> [a] -> [Point]
forall a b. (a -> b) -> [a] -> [b]
map a -> Point
mapfn [a]
pts) BackendProgram [Point]
-> ([Point] -> BackendProgram ()) -> BackendProgram ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Point] -> BackendProgram ()
strokePointPath
renderPlotLegendLines :: PlotLines x y -> Rect -> BackendProgram ()
renderPlotLegendLines :: PlotLines x y -> Rect -> BackendProgram ()
renderPlotLegendLines PlotLines x y
p (Rect Point
p1 Point
p2) =
LineStyle -> BackendProgram () -> BackendProgram ()
forall a. LineStyle -> BackendProgram a -> BackendProgram a
withLineStyle (PlotLines x y -> LineStyle
forall x y. PlotLines x y -> LineStyle
_plot_lines_style PlotLines x y
p) (BackendProgram () -> BackendProgram ())
-> BackendProgram () -> BackendProgram ()
forall a b. (a -> b) -> a -> b
$ do
let y :: Double
y = (Point -> Double
p_y Point
p1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Point -> Double
p_y Point
p2) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2
[Point]
ps <- [Point] -> BackendProgram [Point]
alignStrokePoints [Double -> Double -> Point
Point (Point -> Double
p_x Point
p1) Double
y, Double -> Double -> Point
Point (Point -> Double
p_x Point
p2) Double
y]
[Point] -> BackendProgram ()
strokePointPath [Point]
ps
defaultPlotLineStyle :: LineStyle
defaultPlotLineStyle :: LineStyle
defaultPlotLineStyle = (Double -> AlphaColour Double -> LineStyle
solidLine Double
1 (AlphaColour Double -> LineStyle)
-> AlphaColour Double -> LineStyle
forall a b. (a -> b) -> a -> b
$ Colour Double -> AlphaColour Double
forall a. Num a => Colour a -> AlphaColour a
opaque Colour Double
forall a. (Ord a, Floating a) => Colour a
blue){
_line_cap :: LineCap
_line_cap = LineCap
LineCapRound,
_line_join :: LineJoin
_line_join = LineJoin
LineJoinRound
}
instance Default (PlotLines x y) where
def :: PlotLines x y
def = PlotLines :: forall x y.
String
-> LineStyle
-> [[(x, y)]]
-> [[(Limit x, Limit y)]]
-> PlotLines x y
PlotLines
{ _plot_lines_title :: String
_plot_lines_title = String
""
, _plot_lines_style :: LineStyle
_plot_lines_style = LineStyle
defaultPlotLineStyle
, _plot_lines_values :: [[(x, y)]]
_plot_lines_values = []
, _plot_lines_limit_values :: [[(Limit x, Limit y)]]
_plot_lines_limit_values = []
}
hlinePlot :: String -> LineStyle -> b -> Plot a b
hlinePlot :: String -> LineStyle -> b -> Plot a b
hlinePlot String
t LineStyle
ls b
v = PlotLines a b -> Plot a b
forall (a :: * -> * -> *) x y. ToPlot a => a x y -> Plot x y
toPlot PlotLines a b
forall a. Default a => a
def {
_plot_lines_title :: String
_plot_lines_title = String
t,
_plot_lines_style :: LineStyle
_plot_lines_style = LineStyle
ls,
_plot_lines_limit_values :: [[(Limit a, Limit b)]]
_plot_lines_limit_values = [[(Limit a
forall a. Limit a
LMin, b -> Limit b
forall a. a -> Limit a
LValue b
v),(Limit a
forall a. Limit a
LMax, b -> Limit b
forall a. a -> Limit a
LValue b
v)]]
}
vlinePlot :: String -> LineStyle -> a -> Plot a b
vlinePlot :: String -> LineStyle -> a -> Plot a b
vlinePlot String
t LineStyle
ls a
v = PlotLines a b -> Plot a b
forall (a :: * -> * -> *) x y. ToPlot a => a x y -> Plot x y
toPlot PlotLines a b
forall a. Default a => a
def {
_plot_lines_title :: String
_plot_lines_title = String
t,
_plot_lines_style :: LineStyle
_plot_lines_style = LineStyle
ls,
_plot_lines_limit_values :: [[(Limit a, Limit b)]]
_plot_lines_limit_values = [[(a -> Limit a
forall a. a -> Limit a
LValue a
v,Limit b
forall a. Limit a
LMin),(a -> Limit a
forall a. a -> Limit a
LValue a
v,Limit b
forall a. Limit a
LMax)]]
}
$( makeLenses ''PlotLines )