-----------------------------------------------------------------------------
-- |
-- Module      :  Graphics.Rendering.Chart.Plot.FillBetween
-- Copyright   :  (c) Tim Docker 2006, 2014
-- License     :  BSD-style (see chart/COPYRIGHT)
--
-- Plots that fill the area between two lines.
--
{-# LANGUAGE TemplateHaskell #-}

module Graphics.Rendering.Chart.Plot.FillBetween(
    PlotFillBetween(..),

    -- * Accessors
    -- | These accessors are generated by template haskell
    plot_fillbetween_title,
    plot_fillbetween_style,
    plot_fillbetween_line,
    plot_fillbetween_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.SRGB (sRGB)
import Data.Default.Class

-- | Value specifying a plot filling the area between two sets of Y
--   coordinates, given common X coordinates.

data PlotFillBetween x y = PlotFillBetween {
    PlotFillBetween x y -> String
_plot_fillbetween_title  :: String,
    PlotFillBetween x y -> FillStyle
_plot_fillbetween_style  :: FillStyle,
    PlotFillBetween x y -> Maybe LineStyle
_plot_fillbetween_line  :: Maybe LineStyle,
    PlotFillBetween x y -> [(x, (y, y))]
_plot_fillbetween_values :: [ (x, (y,y))]
}


instance ToPlot PlotFillBetween where
    toPlot :: PlotFillBetween x y -> Plot x y
toPlot PlotFillBetween 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     = PlotFillBetween x y -> PointMapFn x y -> BackendProgram ()
forall x y.
PlotFillBetween x y -> PointMapFn x y -> BackendProgram ()
renderPlotFillBetween PlotFillBetween x y
p,
        _plot_legend :: [(String, Rect -> BackendProgram ())]
_plot_legend     = [(PlotFillBetween x y -> String
forall x y. PlotFillBetween x y -> String
_plot_fillbetween_title PlotFillBetween x y
p,PlotFillBetween x y -> Rect -> BackendProgram ()
forall x y. PlotFillBetween x y -> Rect -> BackendProgram ()
renderPlotLegendFill PlotFillBetween x y
p)],
        _plot_all_points :: ([x], [y])
_plot_all_points = PlotFillBetween x y -> ([x], [y])
forall x y. PlotFillBetween x y -> ([x], [y])
plotAllPointsFillBetween PlotFillBetween x y
p
    }

renderPlotFillBetween :: PlotFillBetween x y -> PointMapFn x y -> BackendProgram ()
renderPlotFillBetween :: PlotFillBetween x y -> PointMapFn x y -> BackendProgram ()
renderPlotFillBetween PlotFillBetween x y
p =
    PlotFillBetween x y
-> [(x, (y, y))] -> PointMapFn x y -> BackendProgram ()
forall x y a b.
PlotFillBetween x y
-> [(a, (b, b))]
-> ((Limit a, Limit b) -> Point)
-> BackendProgram ()
renderPlotFillBetween' PlotFillBetween x y
p (PlotFillBetween x y -> [(x, (y, y))]
forall x y. PlotFillBetween x y -> [(x, (y, y))]
_plot_fillbetween_values PlotFillBetween x y
p)

renderPlotFillBetween' :: 
  PlotFillBetween x y 
  -> [(a, (b, b))]
  -> ((Limit a, Limit b) -> Point)
  -> BackendProgram ()
renderPlotFillBetween' :: PlotFillBetween x y
-> [(a, (b, b))]
-> ((Limit a, Limit b) -> Point)
-> BackendProgram ()
renderPlotFillBetween' PlotFillBetween x y
_ [] (Limit a, Limit b) -> Point
_     = () -> BackendProgram ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
renderPlotFillBetween' PlotFillBetween x y
p [(a, (b, b))]
vs (Limit a, Limit b) -> Point
pmap  = 
  FillStyle -> BackendProgram () -> BackendProgram ()
forall a. FillStyle -> BackendProgram a -> BackendProgram a
withFillStyle (PlotFillBetween x y -> FillStyle
forall x y. PlotFillBetween x y -> FillStyle
_plot_fillbetween_style PlotFillBetween x y
p) (BackendProgram () -> BackendProgram ())
-> BackendProgram () -> BackendProgram ()
forall a b. (a -> b) -> a -> b
$ do
    [Point]
ps <- [Point] -> BackendProgram [Point]
alignFillPoints ([Point] -> BackendProgram [Point])
-> [Point] -> BackendProgram [Point]
forall a b. (a -> b) -> a -> b
$ [Point
p0] [Point] -> [Point] -> [Point]
forall a. [a] -> [a] -> [a]
++ [Point]
p1s [Point] -> [Point] -> [Point]
forall a. [a] -> [a] -> [a]
++ [Point] -> [Point]
forall a. [a] -> [a]
reverse [Point]
p2s [Point] -> [Point] -> [Point]
forall a. [a] -> [a] -> [a]
++ [Point
p0]
    [Point] -> BackendProgram ()
fillPointPath [Point]
ps
    case PlotFillBetween x y -> Maybe LineStyle
forall x y. PlotFillBetween x y -> Maybe LineStyle
_plot_fillbetween_line PlotFillBetween x y
p of
      Maybe LineStyle
Nothing -> () -> BackendProgram ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Just LineStyle
lineStyle -> LineStyle -> BackendProgram () -> BackendProgram ()
forall a. LineStyle -> BackendProgram a -> BackendProgram a
withLineStyle LineStyle
lineStyle (BackendProgram () -> BackendProgram ())
-> BackendProgram () -> BackendProgram ()
forall a b. (a -> b) -> a -> b
$ [Point] -> BackendProgram ()
strokePointPath [Point]
ps
  where
    pmap' :: (a, b) -> Point
pmap'    = ((Limit a, Limit b) -> Point) -> (a, b) -> Point
forall x y. PointMapFn x y -> (x, y) -> Point
mapXY (Limit a, Limit b) -> Point
pmap
    (Point
p0:[Point]
p1s) = ((a, b) -> Point) -> [(a, b)] -> [Point]
forall a b. (a -> b) -> [a] -> [b]
map (a, b) -> Point
pmap' [ (a
x,b
y1) | (a
x,(b
y1,b
_)) <- [(a, (b, b))]
vs ]
    p2s :: [Point]
p2s      = ((a, b) -> Point) -> [(a, b)] -> [Point]
forall a b. (a -> b) -> [a] -> [b]
map (a, b) -> Point
pmap' [ (a
x,b
y2) | (a
x,(b
_,b
y2)) <- [(a, (b, b))]
vs ]

renderPlotLegendFill :: PlotFillBetween x y -> Rect -> BackendProgram ()
renderPlotLegendFill :: PlotFillBetween x y -> Rect -> BackendProgram ()
renderPlotLegendFill PlotFillBetween x y
p Rect
r = 
  FillStyle -> BackendProgram () -> BackendProgram ()
forall a. FillStyle -> BackendProgram a -> BackendProgram a
withFillStyle (PlotFillBetween x y -> FillStyle
forall x y. PlotFillBetween x y -> FillStyle
_plot_fillbetween_style PlotFillBetween x y
p) (BackendProgram () -> BackendProgram ())
-> BackendProgram () -> BackendProgram ()
forall a b. (a -> b) -> a -> b
$ 
    Path -> BackendProgram ()
fillPath (Rect -> Path
rectPath Rect
r)

plotAllPointsFillBetween :: PlotFillBetween x y -> ([x],[y])
plotAllPointsFillBetween :: PlotFillBetween x y -> ([x], [y])
plotAllPointsFillBetween PlotFillBetween x y
p = ( [ x
x | (x
x,(y
_,y
_)) <- [(x, (y, y))]
pts ]
                             , [[y]] -> [y]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ [y
y1,y
y2] | (x
_,(y
y1,y
y2)) <- [(x, (y, y))]
pts ] )
  where
    pts :: [(x, (y, y))]
pts = PlotFillBetween x y -> [(x, (y, y))]
forall x y. PlotFillBetween x y -> [(x, (y, y))]
_plot_fillbetween_values PlotFillBetween x y
p

instance Default (PlotFillBetween x y) where
  def :: PlotFillBetween x y
def = PlotFillBetween :: forall x y.
String
-> FillStyle
-> Maybe LineStyle
-> [(x, (y, y))]
-> PlotFillBetween x y
PlotFillBetween 
    { _plot_fillbetween_title :: String
_plot_fillbetween_title  = String
""
    , _plot_fillbetween_style :: FillStyle
_plot_fillbetween_style  = AlphaColour Double -> FillStyle
solidFillStyle (Colour Double -> AlphaColour Double
forall a. Num a => Colour a -> AlphaColour a
opaque (Colour Double -> AlphaColour Double)
-> Colour Double -> AlphaColour Double
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Double -> Colour Double
forall b. (Ord b, Floating b) => b -> b -> b -> Colour b
sRGB Double
0.5 Double
0.5 Double
1.0)
    , _plot_fillbetween_line :: Maybe LineStyle
_plot_fillbetween_line   = Maybe LineStyle
forall a. Maybe a
Nothing
    , _plot_fillbetween_values :: [(x, (y, y))]
_plot_fillbetween_values = []
    }

$( makeLenses ''PlotFillBetween )