-----------------------------------------------------------------------------
-- |
-- Module      :  Graphics.Rendering.Chart.Layout
-- Copyright   :  (c) Tim Docker 2006, 2014
-- License     :  BSD-style (see chart/COPYRIGHT)
--
-- This module glues together axes and plots to actually create a renderable
-- for a chart.
--
-- Note that Template haskell is used to derive accessor functions
-- (see 'Control.Lens') for each field of the following data types:
--
--     * 'Layout'
--
--     * 'LayoutLR'
--
--     * 'StackedLayouts'
--
--     * 'LayoutAxis'
--
{-# LANGUAGE CPP #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE ExistentialQuantification #-}

module Graphics.Rendering.Chart.Layout
  ( -- * Types
    Layout(..)
  , LayoutLR(..)
  , LayoutAxis(..)
  , LayoutPick(..)
  , StackedLayouts(..)
  , StackedLayout(..)
  -- , LegendItem  haddock complains about this being missing, but from what?
  , MAxisFn

    -- * Rendering
  , layoutToRenderable
  , layoutToGrid
  , layoutLRToRenderable
  , layoutLRToGrid
  , renderStackedLayouts

    -- * LayoutAxis lenses
  , laxis_title_style
  , laxis_title
  , laxis_style
  , laxis_generate
  , laxis_override
  , laxis_reverse

    -- * Layout lenses
  , layout_background
  , layout_plot_background
  , layout_title
  , layout_title_style
  , layout_x_axis
  , layout_top_axis_visibility
  , layout_bottom_axis_visibility
  , layout_y_axis
  , layout_left_axis_visibility
  , layout_right_axis_visibility
  , layout_margin
  , layout_plots
  , layout_legend
  , layout_grid_last

  , layout_axes_styles
  , layout_axes_title_styles
  , layout_all_font_styles
  , layout_foreground

    -- * LayoutLR lenses
  , layoutlr_background
  , layoutlr_plot_background
  , layoutlr_title
  , layoutlr_title_style
  , layoutlr_x_axis
  , layoutlr_top_axis_visibility
  , layoutlr_bottom_axis_visibility
  , layoutlr_left_axis
  , layoutlr_right_axis
  , layoutlr_left_axis_visibility
  , layoutlr_right_axis_visibility
  , layoutlr_plots
  , layoutlr_legend
  , layoutlr_margin
  , layoutlr_grid_last

  , layoutlr_axes_styles
  , layoutlr_axes_title_styles
  , layoutlr_all_font_styles
  , layoutlr_foreground

    -- * StackedLayouts lenses
  , slayouts_layouts
  , slayouts_compress_legend
  ) where

#if !MIN_VERSION_base(4,8,0)
import Control.Applicative ((<$>))
#endif

import Graphics.Rendering.Chart.Axis
import Graphics.Rendering.Chart.Geometry
import Graphics.Rendering.Chart.Drawing
import Graphics.Rendering.Chart.Utils
import Graphics.Rendering.Chart.Plot
import Graphics.Rendering.Chart.Legend
import Graphics.Rendering.Chart.Renderable
import Graphics.Rendering.Chart.Grid
import Control.Monad
import Control.Lens hiding (at)
import Data.Colour
import Data.Colour.Names (white)
import Data.Default.Class

-- | A @MAxisFn@ is a function that generates an (optional) axis
--   given the points plotted against that axis.
type MAxisFn t = [t] -> Maybe (AxisData t)

-- | Type of axis that is used in 'Layout' and 'LayoutLR'.
--
--   To generate the actual axis type ('AxisData' and 'AxisT')
--   the '_laxis_generate' function is called and custom settings
--   are applied with '_laxis_override'. Note that the 'AxisVisibility'
--   values in 'Layout' and 'LayoutLR' override visibility related
--   settings of the axis.
data LayoutAxis x = LayoutAxis
  { forall x. LayoutAxis x -> FontStyle
_laxis_title_style :: FontStyle
    -- ^ Font style to use for the axis title.
  , forall x. LayoutAxis x -> String
_laxis_title       :: String
    -- ^ Title displayed for the axis.
  , forall x. LayoutAxis x -> AxisStyle
_laxis_style       :: AxisStyle
    -- ^ Axis style applied.

  , forall x. LayoutAxis x -> AxisFn x
_laxis_generate    :: AxisFn x
    -- ^ Function that generates the axis data, based upon the
    --   points plotted. The default value is 'autoAxis'.

  , forall x. LayoutAxis x -> AxisData x -> AxisData x
_laxis_override    :: AxisData x -> AxisData x
    -- ^ Function that can be used to override the generated axis data.
    --   The default value is 'id'.

  , forall x. LayoutAxis x -> Bool
_laxis_reverse     :: Bool
    -- ^ True if left to right (bottom to top) is to show descending values.

  }

-- | Information on what is at a specifc location of a 'Layout' or 'LayoutLR'.
--   This is delivered by the 'PickFn' of a 'Renderable'.
data LayoutPick x y1 y2 = LayoutPick_Legend String           -- ^ A legend entry.
                        | LayoutPick_Title String            -- ^ The title.
                        | LayoutPick_XTopAxisTitle String    -- ^ The title of the top x axis.
                        | LayoutPick_XBottomAxisTitle String -- ^ The title of the bottom x axis.
                        | LayoutPick_YLeftAxisTitle String   -- ^ The title of the left y axis.
                        | LayoutPick_YRightAxisTitle String  -- ^ The title of the right y axis.
                        | LayoutPick_PlotArea x y1 y2        -- ^ The plot area at the given plot coordinates.
                        | LayoutPick_XTopAxis x              -- ^ The top x axis at the given plot coordinate.
                        | LayoutPick_XBottomAxis x           -- ^ The bottom x axis at the given plot coordinate.
                        | LayoutPick_YLeftAxis y1            -- ^ The left y axis at the given plot coordinate.
                        | LayoutPick_YRightAxis y2           -- ^ The right y axis at the given plot coordinate.
                          deriving (Int -> LayoutPick x y1 y2 -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall x y1 y2.
(Show x, Show y1, Show y2) =>
Int -> LayoutPick x y1 y2 -> ShowS
forall x y1 y2.
(Show x, Show y1, Show y2) =>
[LayoutPick x y1 y2] -> ShowS
forall x y1 y2.
(Show x, Show y1, Show y2) =>
LayoutPick x y1 y2 -> String
showList :: [LayoutPick x y1 y2] -> ShowS
$cshowList :: forall x y1 y2.
(Show x, Show y1, Show y2) =>
[LayoutPick x y1 y2] -> ShowS
show :: LayoutPick x y1 y2 -> String
$cshow :: forall x y1 y2.
(Show x, Show y1, Show y2) =>
LayoutPick x y1 y2 -> String
showsPrec :: Int -> LayoutPick x y1 y2 -> ShowS
$cshowsPrec :: forall x y1 y2.
(Show x, Show y1, Show y2) =>
Int -> LayoutPick x y1 y2 -> ShowS
Show)

type LegendItem = (String,Rect -> BackendProgram ())

-- | A Layout value is a single plot area, with single x and y
--   axis. The title is at the top and the legend at the bottom. It's
--   parametrized by the types of values to be plotted on the x
--   and y axes.
data Layout x y = Layout
  { forall x y. Layout x y -> FillStyle
_layout_background      :: FillStyle
    -- ^ How to fill the background of everything.
  , forall x y. Layout x y -> Maybe FillStyle
_layout_plot_background :: Maybe FillStyle
    -- ^ How to fill the background of the plot,
    --   if different from the overall background.

  , forall x y. Layout x y -> String
_layout_title           :: String
    -- ^ Title to display above the chart.
  , forall x y. Layout x y -> FontStyle
_layout_title_style     :: FontStyle
    -- ^ Font style to use for the title.

  , forall x y. Layout x y -> LayoutAxis x
_layout_x_axis                 :: LayoutAxis x
    -- ^ Rules to generate the x axis.
  , forall x y. Layout x y -> AxisVisibility
_layout_top_axis_visibility    :: AxisVisibility
    -- ^ Visibility options for the top axis.
  , forall x y. Layout x y -> AxisVisibility
_layout_bottom_axis_visibility :: AxisVisibility
    -- ^ Visibility options for the bottom axis.

  , forall x y. Layout x y -> LayoutAxis y
_layout_y_axis                :: LayoutAxis y
    -- ^ Rules to generate the y axis.
  , forall x y. Layout x y -> AxisVisibility
_layout_left_axis_visibility  :: AxisVisibility
    -- ^ Visibility options for the left axis.
  , forall x y. Layout x y -> AxisVisibility
_layout_right_axis_visibility :: AxisVisibility
    -- ^ Visibility options for the right axis.

  , forall x y. Layout x y -> [Plot x y]
_layout_plots           :: [Plot x y]
    -- ^ The data sets to plot in the chart.
    --   They are plotted over each other.

  , forall x y. Layout x y -> Maybe LegendStyle
_layout_legend          :: Maybe LegendStyle
    -- ^ How to style the legend.
  , forall x y. Layout x y -> Double
_layout_margin          :: Double
    -- ^ The margin distance to use.
  , forall x y. Layout x y -> Bool
_layout_grid_last       :: Bool
    -- ^ If the grid shall be rendered
    --   beneath (@False@) or over (@True@) all plots.
  }

instance (Ord x, Ord y) => ToRenderable (Layout x y) where
  toRenderable :: Layout x y -> Renderable ()
toRenderable = forall b a. PickFn b -> Renderable a -> Renderable b
setPickFn forall a. PickFn a
nullPickFn forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x y.
(Ord x, Ord y) =>
Layout x y -> Renderable (LayoutPick x y y)
layoutToRenderable

-- | Render the given 'Layout'.
layoutToRenderable :: forall x y . (Ord x, Ord y) => Layout x y -> Renderable (LayoutPick x y y)
layoutToRenderable :: forall x y.
(Ord x, Ord y) =>
Layout x y -> Renderable (LayoutPick x y y)
layoutToRenderable Layout x y
l = forall a. FillStyle -> Renderable a -> Renderable a
fillBackground (forall x y. Layout x y -> FillStyle
_layout_background Layout x y
l) forall a b. (a -> b) -> a -> b
$ forall a. Grid (Renderable a) -> Renderable a
gridToRenderable (forall x y.
(Ord x, Ord y) =>
Layout x y -> Grid (Renderable (LayoutPick x y y))
layoutToGrid Layout x y
l)

layoutToGrid :: forall x y . (Ord x, Ord y) => Layout x y -> Grid (Renderable (LayoutPick x y y))
layoutToGrid :: forall x y.
(Ord x, Ord y) =>
Layout x y -> Grid (Renderable (LayoutPick x y y))
layoutToGrid Layout x y
l = Grid (Renderable (LayoutPick x y y))
grid
  where
    lp :: Grid a -> a -> Grid a
    lp :: forall a. Grid a -> a -> Grid a
lp = case forall b a. b -> (a -> b) -> Maybe a -> b
maybe LegendPosition
LegendBelow LegendStyle -> LegendPosition
_legend_position forall a b. (a -> b) -> a -> b
$ forall x y. Layout x y -> Maybe LegendStyle
_layout_legend Layout x y
l of
              LegendPosition
LegendAbove -> forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. a -> Grid a -> Grid a
wideAbove
              LegendPosition
LegendBelow -> forall a. Grid a -> a -> Grid a
aboveWide
              LegendPosition
LegendRight -> forall a. Grid a -> a -> Grid a
besideTall
              LegendPosition
LegendLeft  -> forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. a -> Grid a -> Grid a
tallBeside

    title :: Renderable (LayoutPick x yl yr)
title = forall x yl yr.
Double -> FontStyle -> String -> Renderable (LayoutPick x yl yr)
titleToRenderable Double
lm (forall x y. Layout x y -> FontStyle
_layout_title_style Layout x y
l) (forall x y. Layout x y -> String
_layout_title Layout x y
l)
    plotArea :: Grid (Renderable (LayoutPick x y y))
plotArea = forall a.
(Double, Double, Double, Double)
-> Grid (Renderable a) -> Grid (Renderable a)
addMarginsToGrid (Double
lm,Double
lm,Double
lm,Double
lm) (forall x y.
(Ord x, Ord y) =>
Layout x y -> Grid (Renderable (LayoutPick x y y))
layoutPlotAreaToGrid Layout x y
l)
    legend :: Renderable (LayoutPick x y y)
legend = forall x y.
Layout x y -> [LegendItem] -> Renderable (LayoutPick x y y)
renderLegend Layout x y
l (forall x y. Layout x y -> [LegendItem]
getLegendItems Layout x y
l)
    grid :: Grid (Renderable (LayoutPick x y y))
grid = forall {x} {yl} {yr}. Renderable (LayoutPick x yl yr)
title forall a. a -> Grid a -> Grid a
`wideAbove` (Grid (Renderable (LayoutPick x y y))
plotArea forall a. Grid a -> a -> Grid a
`lp` Renderable (LayoutPick x y y)
legend)
    lm :: Double
lm = forall x y. Layout x y -> Double
_layout_margin Layout x y
l

getLayoutXVals :: Layout x y -> [x]
getLayoutXVals :: forall x y. Layout x y -> [x]
getLayoutXVals Layout x y
l = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x y. Plot x y -> ([x], [y])
_plot_all_points) (forall x y. Layout x y -> [Plot x y]
_layout_plots Layout x y
l)

-- | Extract all 'LegendItem's from the plots of a 'Layout'.
getLegendItems :: Layout x y -> [LegendItem]
getLegendItems :: forall x y. Layout x y -> [LegendItem]
getLegendItems Layout x y
l = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ forall x y. Plot x y -> [LegendItem]
_plot_legend Plot x y
p | Plot x y
p <- forall x y. Layout x y -> [Plot x y]
_layout_plots Layout x y
l ]

-- | Render the given 'LegendItem's for a 'Layout'.
renderLegend :: Layout x y -> [LegendItem] -> Renderable (LayoutPick x y y)
renderLegend :: forall x y.
Layout x y -> [LegendItem] -> Renderable (LayoutPick x y y)
renderLegend Layout x y
l [LegendItem]
legItems = forall a. Grid (Renderable a) -> Renderable a
gridToRenderable forall {x} {yl} {yr}. Grid (Renderable (LayoutPick x yl yr))
g
  where
    g :: Grid (Renderable (LayoutPick x yl yr))
g      = forall a. [Grid a] -> Grid a
besideN [ forall a. a -> Grid a
tval forall a b. (a -> b) -> a -> b
$ forall x yl yr.
Maybe LegendStyle
-> Double -> [LegendItem] -> Renderable (LayoutPick x yl yr)
mkLegend (forall x y. Layout x y -> Maybe LegendStyle
_layout_legend Layout x y
l) (forall x y. Layout x y -> Double
_layout_margin Layout x y
l) [LegendItem]
legItems
                     , forall a. SpaceWeight -> Grid a -> Grid a
weights (Double
1,Double
1) forall a b. (a -> b) -> a -> b
$ forall a. a -> Grid a
tval forall a. Renderable a
emptyRenderable ]

-- | Render the plot area of a 'Layout'. This consists of the
--   actual plot area with all plots, the axis and their titles.
layoutPlotAreaToGrid :: forall x y. (Ord x, Ord y) =>
                        Layout x y -> Grid (Renderable (LayoutPick x y y))
layoutPlotAreaToGrid :: forall x y.
(Ord x, Ord y) =>
Layout x y -> Grid (Renderable (LayoutPick x y y))
layoutPlotAreaToGrid Layout x y
l = forall x yl yr.
(Ord x, Ord yl, Ord yr) =>
LayoutGridElements x yl yr
-> Grid (Renderable (LayoutPick x yl yr))
buildGrid LayoutGridElements{
  lge_plots :: Renderable (LayoutPick x y y)
lge_plots = forall a. Maybe FillStyle -> Renderable a -> Renderable a
mfill (forall x y. Layout x y -> Maybe FillStyle
_layout_plot_background Layout x y
l) forall a b. (a -> b) -> a -> b
$ Layout x y -> Renderable (LayoutPick x y y)
plotsToRenderable Layout x y
l,
  lge_taxis :: (Maybe (AxisT x), String, FontStyle)
lge_taxis = (Maybe (AxisT x)
tAxis,forall x. LayoutAxis x -> String
_laxis_title forall a b. (a -> b) -> a -> b
$ forall x y. Layout x y -> LayoutAxis x
_layout_x_axis Layout x y
l, forall x. LayoutAxis x -> FontStyle
_laxis_title_style forall a b. (a -> b) -> a -> b
$ forall x y. Layout x y -> LayoutAxis x
_layout_x_axis Layout x y
l),
  lge_baxis :: (Maybe (AxisT x), String, FontStyle)
lge_baxis = (Maybe (AxisT x)
bAxis,forall x. LayoutAxis x -> String
_laxis_title forall a b. (a -> b) -> a -> b
$ forall x y. Layout x y -> LayoutAxis x
_layout_x_axis Layout x y
l, forall x. LayoutAxis x -> FontStyle
_laxis_title_style forall a b. (a -> b) -> a -> b
$ forall x y. Layout x y -> LayoutAxis x
_layout_x_axis Layout x y
l),
  lge_laxis :: (Maybe (AxisT y), String, FontStyle)
lge_laxis = (Maybe (AxisT y)
lAxis,forall x. LayoutAxis x -> String
_laxis_title forall a b. (a -> b) -> a -> b
$ forall x y. Layout x y -> LayoutAxis y
_layout_y_axis Layout x y
l, forall x. LayoutAxis x -> FontStyle
_laxis_title_style forall a b. (a -> b) -> a -> b
$ forall x y. Layout x y -> LayoutAxis y
_layout_y_axis Layout x y
l),
  lge_raxis :: (Maybe (AxisT y), String, FontStyle)
lge_raxis = (Maybe (AxisT y)
rAxis,String
"", forall a. Default a => a
def),
  lge_margin :: Double
lge_margin = forall x y. Layout x y -> Double
_layout_margin Layout x y
l
  }
  where
    xvals :: [x]
xvals = [ x
x | Plot x y
p <- forall x y. Layout x y -> [Plot x y]
_layout_plots Layout x y
l, x
x <- forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall x y. Plot x y -> ([x], [y])
_plot_all_points Plot x y
p]
    yvals :: [y]
yvals = [ y
y | Plot x y
p <- forall x y. Layout x y -> [Plot x y]
_layout_plots Layout x y
l, y
y <- forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall x y. Plot x y -> ([x], [y])
_plot_all_points Plot x y
p]

    bAxis :: Maybe (AxisT x)
bAxis = forall z. RectEdge -> LayoutAxis z -> [z] -> Maybe (AxisT z)
mkAxis RectEdge
E_Bottom (forall layout z.
layout
-> (layout -> LayoutAxis z)
-> (layout -> AxisVisibility)
-> LayoutAxis z
overrideAxisVisibility Layout x y
l forall x y. Layout x y -> LayoutAxis x
_layout_x_axis forall x y. Layout x y -> AxisVisibility
_layout_bottom_axis_visibility) [x]
xvals
    tAxis :: Maybe (AxisT x)
tAxis = forall z. RectEdge -> LayoutAxis z -> [z] -> Maybe (AxisT z)
mkAxis RectEdge
E_Top    (forall layout z.
layout
-> (layout -> LayoutAxis z)
-> (layout -> AxisVisibility)
-> LayoutAxis z
overrideAxisVisibility Layout x y
l forall x y. Layout x y -> LayoutAxis x
_layout_x_axis forall x y. Layout x y -> AxisVisibility
_layout_top_axis_visibility   ) [x]
xvals
    lAxis :: Maybe (AxisT y)
lAxis = forall z. RectEdge -> LayoutAxis z -> [z] -> Maybe (AxisT z)
mkAxis RectEdge
E_Left   (forall layout z.
layout
-> (layout -> LayoutAxis z)
-> (layout -> AxisVisibility)
-> LayoutAxis z
overrideAxisVisibility Layout x y
l forall x y. Layout x y -> LayoutAxis y
_layout_y_axis forall x y. Layout x y -> AxisVisibility
_layout_left_axis_visibility  ) [y]
yvals
    rAxis :: Maybe (AxisT y)
rAxis = forall z. RectEdge -> LayoutAxis z -> [z] -> Maybe (AxisT z)
mkAxis RectEdge
E_Right  (forall layout z.
layout
-> (layout -> LayoutAxis z)
-> (layout -> AxisVisibility)
-> LayoutAxis z
overrideAxisVisibility Layout x y
l forall x y. Layout x y -> LayoutAxis y
_layout_y_axis forall x y. Layout x y -> AxisVisibility
_layout_right_axis_visibility ) [y]
yvals
    axes :: (Maybe (AxisT x), Maybe (AxisT y), Maybe (AxisT x),
 Maybe (AxisT y))
axes = (Maybe (AxisT x)
bAxis,Maybe (AxisT y)
lAxis,Maybe (AxisT x)
tAxis,Maybe (AxisT y)
rAxis)

    plotsToRenderable :: Layout x y -> Renderable (LayoutPick x y y)
plotsToRenderable Layout x y
lxy = Renderable {
        minsize :: BackendProgram SpaceWeight
minsize = forall (m :: * -> *) a. Monad m => a -> m a
return (Double
0,Double
0),
        render :: SpaceWeight -> BackendProgram (PickFn (LayoutPick x y y))
render  = Layout x y
-> SpaceWeight -> BackendProgram (PickFn (LayoutPick x y y))
renderPlots Layout x y
lxy
    }

    -- | Render the plots of a 'Layout' to a plot area of given size.
    renderPlots :: Layout x y -> RectSize -> BackendProgram (PickFn (LayoutPick x y y))
    renderPlots :: Layout x y
-> SpaceWeight -> BackendProgram (PickFn (LayoutPick x y y))
renderPlots Layout x y
lxy sz :: SpaceWeight
sz@(Double
w,Double
h) = do
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall x y. Layout x y -> Bool
_layout_grid_last Layout x y
lxy) (forall x yl yr.
SpaceWeight
-> (Maybe (AxisT x), Maybe (AxisT yl), Maybe (AxisT x),
    Maybe (AxisT yr))
-> BackendProgram ()
renderGrids SpaceWeight
sz (Maybe (AxisT x), Maybe (AxisT y), Maybe (AxisT x),
 Maybe (AxisT y))
axes)
        forall a. Rect -> BackendProgram a -> BackendProgram a
withClipRegion (Point -> Point -> Rect
Rect (Double -> Double -> Point
Point Double
0 Double
0) (Double -> Double -> Point
Point Double
w Double
h)) forall a b. (a -> b) -> a -> b
$
          forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Plot x y -> BackendProgram ()
rPlot (forall x y. Layout x y -> [Plot x y]
_layout_plots Layout x y
lxy)
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall x y. Layout x y -> Bool
_layout_grid_last Layout x y
lxy) (forall x yl yr.
SpaceWeight
-> (Maybe (AxisT x), Maybe (AxisT yl), Maybe (AxisT x),
    Maybe (AxisT yr))
-> BackendProgram ()
renderGrids SpaceWeight
sz (Maybe (AxisT x), Maybe (AxisT y), Maybe (AxisT x),
 Maybe (AxisT y))
axes)
        forall (m :: * -> *) a. Monad m => a -> m a
return PickFn (LayoutPick x y y)
pickfn
      where
        rPlot :: Plot x y -> BackendProgram ()
rPlot = forall x y.
SpaceWeight
-> Maybe (AxisT x)
-> Maybe (AxisT y)
-> Plot x y
-> BackendProgram ()
renderSinglePlot SpaceWeight
sz Maybe (AxisT x)
bAxis Maybe (AxisT y)
lAxis

        xr :: SpaceWeight
xr = (Double
0, Double
w)
        yr :: SpaceWeight
yr = (Double
h, Double
0)

        pickfn :: PickFn (LayoutPick x y y)
        pickfn :: PickFn (LayoutPick x y y)
pickfn (Point Double
x Double
y) = do  -- Maybe monad
            AxisT x
xat <- Maybe (AxisT x)
mxat
            AxisT y
yat <- Maybe (AxisT y)
myat
            forall (m :: * -> *) a. Monad m => a -> m a
return (forall x y1 y2. x -> y1 -> y2 -> LayoutPick x y1 y2
LayoutPick_PlotArea (forall {x}. AxisT x -> Double -> x
mapx AxisT x
xat Double
x) (forall {x}. AxisT x -> Double -> x
mapy AxisT y
yat Double
y) (forall {x}. AxisT x -> Double -> x
mapy AxisT y
yat Double
y))
          where
            mxat :: Maybe (AxisT x)
mxat = case (Maybe (AxisT x)
bAxis,Maybe (AxisT x)
tAxis) of
                (Just AxisT x
at,Maybe (AxisT x)
_)       -> forall a. a -> Maybe a
Just AxisT x
at
                (Maybe (AxisT x)
_,Just AxisT x
at)       -> forall a. a -> Maybe a
Just AxisT x
at
                (Maybe (AxisT x)
Nothing,Maybe (AxisT x)
Nothing) -> forall a. Maybe a
Nothing
            myat :: Maybe (AxisT y)
myat = case (Maybe (AxisT y)
lAxis,Maybe (AxisT y)
rAxis) of
                (Just AxisT y
at,Maybe (AxisT y)
_)   -> forall a. a -> Maybe a
Just AxisT y
at
                (Maybe (AxisT y)
_,Just AxisT y
at)   -> forall a. a -> Maybe a
Just AxisT y
at
                (Maybe (AxisT y)
Nothing,Maybe (AxisT y)
Nothing)   -> forall a. Maybe a
Nothing
            mapx :: AxisT x -> Double -> x
mapx (AxisT RectEdge
_ AxisStyle
_ Bool
rev AxisData x
ad) = forall x. AxisData x -> SpaceWeight -> Double -> x
_axis_tropweiv AxisData x
ad (forall a. Bool -> (a, a) -> (a, a)
optPairReverse Bool
rev SpaceWeight
xr)
            mapy :: AxisT x -> Double -> x
mapy (AxisT RectEdge
_ AxisStyle
_ Bool
rev AxisData x
ad) = forall x. AxisData x -> SpaceWeight -> Double -> x
_axis_tropweiv AxisData x
ad (forall a. Bool -> (a, a) -> (a, a)
optPairReverse Bool
rev SpaceWeight
yr)

-- | Empty 'Layout' without title and plots. The background is white and
--   the grid is drawn beneath all plots. There will be a legend. The top
--   and right axis will not be visible.
instance (PlotValue x, PlotValue y) => Default (Layout x y) where
  def :: Layout x y
def = Layout
    { _layout_background :: FillStyle
_layout_background      = AlphaColour Double -> FillStyle
solidFillStyle forall a b. (a -> b) -> a -> b
$ forall a. Num a => Colour a -> AlphaColour a
opaque forall a. (Ord a, Floating a) => Colour a
white
    , _layout_plot_background :: Maybe FillStyle
_layout_plot_background = forall a. Maybe a
Nothing

    , _layout_title :: String
_layout_title           = String
""
    , _layout_title_style :: FontStyle
_layout_title_style     = forall a. Default a => a
def { _font_size :: Double
_font_size   = Double
15
                                    , _font_weight :: FontWeight
_font_weight = FontWeight
FontWeightBold }

    , _layout_x_axis :: LayoutAxis x
_layout_x_axis                 = forall a. Default a => a
def
    , _layout_top_axis_visibility :: AxisVisibility
_layout_top_axis_visibility    = forall a. Default a => a
def { _axis_show_line :: Bool
_axis_show_line   = Bool
False
                                           , _axis_show_ticks :: Bool
_axis_show_ticks  = Bool
False
                                           , _axis_show_labels :: Bool
_axis_show_labels = Bool
False }
    , _layout_bottom_axis_visibility :: AxisVisibility
_layout_bottom_axis_visibility = forall a. Default a => a
def
    , _layout_y_axis :: LayoutAxis y
_layout_y_axis                 = forall a. Default a => a
def
    , _layout_left_axis_visibility :: AxisVisibility
_layout_left_axis_visibility   = forall a. Default a => a
def
    , _layout_right_axis_visibility :: AxisVisibility
_layout_right_axis_visibility  = forall a. Default a => a
def { _axis_show_line :: Bool
_axis_show_line   = Bool
False
                                           , _axis_show_ticks :: Bool
_axis_show_ticks  = Bool
False
                                           , _axis_show_labels :: Bool
_axis_show_labels = Bool
False }

    , _layout_margin :: Double
_layout_margin          = Double
10
    , _layout_plots :: [Plot x y]
_layout_plots           = []
    , _layout_legend :: Maybe LegendStyle
_layout_legend          = forall a. a -> Maybe a
Just forall a. Default a => a
def
    , _layout_grid_last :: Bool
_layout_grid_last       = Bool
False
    }

----------------------------------------------------------------------

-- | A LayoutLR value is a single plot area, with an x axis and
--   independent left and right y axes, with a title at the top;
--   legend at the bottom. It's parametrized by the types of values
--   to be plotted on the x and two y axes.
data LayoutLR x y1 y2 = LayoutLR
  { forall x y1 y2. LayoutLR x y1 y2 -> FillStyle
_layoutlr_background      :: FillStyle
    -- ^ How to fill the background of everything.
  , forall x y1 y2. LayoutLR x y1 y2 -> Maybe FillStyle
_layoutlr_plot_background :: Maybe FillStyle
    -- ^ How to fill the background of the plot,
    --   if different from the overall background.

  , forall x y1 y2. LayoutLR x y1 y2 -> String
_layoutlr_title           :: String
    -- ^ Title to display above the chart.
  , forall x y1 y2. LayoutLR x y1 y2 -> FontStyle
_layoutlr_title_style     :: FontStyle
    -- ^ Font style to use for the title.

  , forall x y1 y2. LayoutLR x y1 y2 -> LayoutAxis x
_layoutlr_x_axis                 :: LayoutAxis x
    -- ^ Rules to generate the x axis.
  , forall x y1 y2. LayoutLR x y1 y2 -> AxisVisibility
_layoutlr_top_axis_visibility    :: AxisVisibility
    -- ^ Visibility options for the top axis.
  , forall x y1 y2. LayoutLR x y1 y2 -> AxisVisibility
_layoutlr_bottom_axis_visibility :: AxisVisibility
    -- ^ Visibility options for the bottom axis.

  , forall x y1 y2. LayoutLR x y1 y2 -> LayoutAxis y1
_layoutlr_left_axis             :: LayoutAxis y1
    -- ^ Rules to generate the left y axis.
  , forall x y1 y2. LayoutLR x y1 y2 -> AxisVisibility
_layoutlr_left_axis_visibility  :: AxisVisibility
    -- ^ Visibility options for the left axis.
  , forall x y1 y2. LayoutLR x y1 y2 -> LayoutAxis y2
_layoutlr_right_axis            :: LayoutAxis y2
    -- ^ Rules to generate the right y axis.
  , forall x y1 y2. LayoutLR x y1 y2 -> AxisVisibility
_layoutlr_right_axis_visibility :: AxisVisibility
    -- ^ Visibility options for the right axis.

  , forall x y1 y2.
LayoutLR x y1 y2 -> [Either (Plot x y1) (Plot x y2)]
_layoutlr_plots      :: [Either (Plot x y1) (Plot x y2)]
    -- ^ The data sets to plot in the chart.
    --   They are plotted over each other.
    --   The either type associates the plot with the
    --   left or right y axis.

  , forall x y1 y2. LayoutLR x y1 y2 -> Maybe LegendStyle
_layoutlr_legend          :: Maybe LegendStyle
    -- ^ How to style the legend.
  , forall x y1 y2. LayoutLR x y1 y2 -> Double
_layoutlr_margin          :: Double
    -- ^ The margin distance to use.
  , forall x y1 y2. LayoutLR x y1 y2 -> Bool
_layoutlr_grid_last       :: Bool
    -- ^ If the grid shall be rendered
    --   beneath (@False@) or over (@True@) all plots.
  }

instance (Ord x, Ord yl, Ord yr) => ToRenderable (LayoutLR x yl yr) where
  toRenderable :: LayoutLR x yl yr -> Renderable ()
toRenderable = forall b a. PickFn b -> Renderable a -> Renderable b
setPickFn forall a. PickFn a
nullPickFn forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x yl yr.
(Ord x, Ord yl, Ord yr) =>
LayoutLR x yl yr -> Renderable (LayoutPick x yl yr)
layoutLRToRenderable

-- | Render the given 'LayoutLR'.
layoutLRToRenderable :: forall x yl yr . (Ord x, Ord yl, Ord yr)
                     => LayoutLR x yl yr -> Renderable (LayoutPick x yl yr)
layoutLRToRenderable :: forall x yl yr.
(Ord x, Ord yl, Ord yr) =>
LayoutLR x yl yr -> Renderable (LayoutPick x yl yr)
layoutLRToRenderable LayoutLR x yl yr
l = forall a. FillStyle -> Renderable a -> Renderable a
fillBackground (forall x y1 y2. LayoutLR x y1 y2 -> FillStyle
_layoutlr_background LayoutLR x yl yr
l)
                       forall a b. (a -> b) -> a -> b
$ forall a. Grid (Renderable a) -> Renderable a
gridToRenderable (forall x yl yr.
(Ord x, Ord yl, Ord yr) =>
LayoutLR x yl yr -> Grid (Renderable (LayoutPick x yl yr))
layoutLRToGrid LayoutLR x yl yr
l)

layoutLRToGrid :: forall x yl yr . (Ord x, Ord yl, Ord yr)
                     => LayoutLR x yl yr -> Grid (Renderable (LayoutPick x yl yr))
layoutLRToGrid :: forall x yl yr.
(Ord x, Ord yl, Ord yr) =>
LayoutLR x yl yr -> Grid (Renderable (LayoutPick x yl yr))
layoutLRToGrid LayoutLR x yl yr
l = Grid (Renderable (LayoutPick x yl yr))
grid
  where
    grid :: Grid (Renderable (LayoutPick x yl yr))
grid = forall x yl yr.
Double -> FontStyle -> String -> Renderable (LayoutPick x yl yr)
titleToRenderable Double
lm (forall x y1 y2. LayoutLR x y1 y2 -> FontStyle
_layoutlr_title_style LayoutLR x yl yr
l) (forall x y1 y2. LayoutLR x y1 y2 -> String
_layoutlr_title LayoutLR x yl yr
l)
           forall a. a -> Grid a -> Grid a
`wideAbove`
           forall a.
(Double, Double, Double, Double)
-> Grid (Renderable a) -> Grid (Renderable a)
addMarginsToGrid (Double
lm,Double
lm,Double
lm,Double
lm) (forall x yl yr.
(Ord x, Ord yl, Ord yr) =>
LayoutLR x yl yr -> Grid (Renderable (LayoutPick x yl yr))
layoutLRPlotAreaToGrid LayoutLR x yl yr
l)
           forall a. Grid a -> a -> Grid a
`aboveWide`
           forall x yl yr.
LayoutLR x yl yr
-> ([LegendItem], [LegendItem]) -> Renderable (LayoutPick x yl yr)
renderLegendLR LayoutLR x yl yr
l (forall x yl yr. LayoutLR x yl yr -> ([LegendItem], [LegendItem])
getLegendItemsLR LayoutLR x yl yr
l)
    lm :: Double
lm = forall x y1 y2. LayoutLR x y1 y2 -> Double
_layoutlr_margin LayoutLR x yl yr
l

getLayoutLRXVals :: LayoutLR x yl yr -> [x]
getLayoutLRXVals :: forall x yl yr. LayoutLR x yl yr -> [x]
getLayoutLRXVals LayoutLR x yl yr
l = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall x yl yr. Either (Plot x yl) (Plot x yr) -> [x]
deEither forall a b. (a -> b) -> a -> b
$ forall x y1 y2.
LayoutLR x y1 y2 -> [Either (Plot x y1) (Plot x y2)]
_layoutlr_plots LayoutLR x yl yr
l
  where
    deEither :: Either (Plot x yl) (Plot x yr) -> [x]
    deEither :: forall x yl yr. Either (Plot x yl) (Plot x yr) -> [x]
deEither (Left Plot x yl
x)  = forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall x y. Plot x y -> ([x], [y])
_plot_all_points Plot x yl
x
    deEither (Right Plot x yr
x) = forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall x y. Plot x y -> ([x], [y])
_plot_all_points Plot x yr
x

-- | Extract all 'LegendItem's from the plots of a 'LayoutLR'.
--   Left and right plot legend items are still separated.
getLegendItemsLR :: LayoutLR x yl yr -> ([LegendItem],[LegendItem])
getLegendItemsLR :: forall x yl yr. LayoutLR x yl yr -> ([LegendItem], [LegendItem])
getLegendItemsLR LayoutLR x yl yr
l = (
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ forall x y. Plot x y -> [LegendItem]
_plot_legend Plot x yl
p | (Left Plot x yl
p ) <- forall x y1 y2.
LayoutLR x y1 y2 -> [Either (Plot x y1) (Plot x y2)]
_layoutlr_plots LayoutLR x yl yr
l ],
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ forall x y. Plot x y -> [LegendItem]
_plot_legend Plot x yr
p | (Right Plot x yr
p) <- forall x y1 y2.
LayoutLR x y1 y2 -> [Either (Plot x y1) (Plot x y2)]
_layoutlr_plots LayoutLR x yl yr
l ]
    )

-- | Render the given 'LegendItem's for a 'LayoutLR'.
renderLegendLR :: LayoutLR x yl yr -> ([LegendItem],[LegendItem]) -> Renderable (LayoutPick x yl yr)
renderLegendLR :: forall x yl yr.
LayoutLR x yl yr
-> ([LegendItem], [LegendItem]) -> Renderable (LayoutPick x yl yr)
renderLegendLR LayoutLR x yl yr
l ([LegendItem]
lefts,[LegendItem]
rights) = forall a. Grid (Renderable a) -> Renderable a
gridToRenderable forall {x} {yl} {yr}. Grid (Renderable (LayoutPick x yl yr))
g
  where
    g :: Grid (Renderable (LayoutPick x yl yr))
g      = forall a. [Grid a] -> Grid a
besideN [ forall a. a -> Grid a
tval forall a b. (a -> b) -> a -> b
$ forall x yl yr.
Maybe LegendStyle
-> Double -> [LegendItem] -> Renderable (LayoutPick x yl yr)
mkLegend (forall x y1 y2. LayoutLR x y1 y2 -> Maybe LegendStyle
_layoutlr_legend LayoutLR x yl yr
l) (forall x y1 y2. LayoutLR x y1 y2 -> Double
_layoutlr_margin LayoutLR x yl yr
l) [LegendItem]
lefts
                     , forall a. SpaceWeight -> Grid a -> Grid a
weights (Double
1,Double
1) forall a b. (a -> b) -> a -> b
$ forall a. a -> Grid a
tval forall a. Renderable a
emptyRenderable
                     , forall a. a -> Grid a
tval forall a b. (a -> b) -> a -> b
$ forall x yl yr.
Maybe LegendStyle
-> Double -> [LegendItem] -> Renderable (LayoutPick x yl yr)
mkLegend (forall x y1 y2. LayoutLR x y1 y2 -> Maybe LegendStyle
_layoutlr_legend LayoutLR x yl yr
l) (forall x y1 y2. LayoutLR x y1 y2 -> Double
_layoutlr_margin LayoutLR x yl yr
l) [LegendItem]
rights ]
    -- lm     = _layoutlr_margin l

layoutLRPlotAreaToGrid :: forall x yl yr. (Ord x, Ord yl, Ord yr)
                       => LayoutLR x yl yr
                       -> Grid (Renderable (LayoutPick x yl yr))
layoutLRPlotAreaToGrid :: forall x yl yr.
(Ord x, Ord yl, Ord yr) =>
LayoutLR x yl yr -> Grid (Renderable (LayoutPick x yl yr))
layoutLRPlotAreaToGrid LayoutLR x yl yr
l = forall x yl yr.
(Ord x, Ord yl, Ord yr) =>
LayoutGridElements x yl yr
-> Grid (Renderable (LayoutPick x yl yr))
buildGrid LayoutGridElements{
  lge_plots :: Renderable (LayoutPick x yl yr)
lge_plots = forall a. Maybe FillStyle -> Renderable a -> Renderable a
mfill (forall x y1 y2. LayoutLR x y1 y2 -> Maybe FillStyle
_layoutlr_plot_background LayoutLR x yl yr
l) forall a b. (a -> b) -> a -> b
$ LayoutLR x yl yr -> Renderable (LayoutPick x yl yr)
plotsToRenderable LayoutLR x yl yr
l,
  lge_taxis :: (Maybe (AxisT x), String, FontStyle)
lge_taxis = (Maybe (AxisT x)
tAxis,forall x. LayoutAxis x -> String
_laxis_title forall a b. (a -> b) -> a -> b
$ forall x y1 y2. LayoutLR x y1 y2 -> LayoutAxis x
_layoutlr_x_axis LayoutLR x yl yr
l, forall x. LayoutAxis x -> FontStyle
_laxis_title_style forall a b. (a -> b) -> a -> b
$ forall x y1 y2. LayoutLR x y1 y2 -> LayoutAxis x
_layoutlr_x_axis LayoutLR x yl yr
l),
  lge_baxis :: (Maybe (AxisT x), String, FontStyle)
lge_baxis = (Maybe (AxisT x)
bAxis,forall x. LayoutAxis x -> String
_laxis_title forall a b. (a -> b) -> a -> b
$ forall x y1 y2. LayoutLR x y1 y2 -> LayoutAxis x
_layoutlr_x_axis LayoutLR x yl yr
l, forall x. LayoutAxis x -> FontStyle
_laxis_title_style forall a b. (a -> b) -> a -> b
$ forall x y1 y2. LayoutLR x y1 y2 -> LayoutAxis x
_layoutlr_x_axis LayoutLR x yl yr
l),
  lge_laxis :: (Maybe (AxisT yl), String, FontStyle)
lge_laxis = (Maybe (AxisT yl)
lAxis,forall x. LayoutAxis x -> String
_laxis_title forall a b. (a -> b) -> a -> b
$ forall x y1 y2. LayoutLR x y1 y2 -> LayoutAxis y1
_layoutlr_left_axis LayoutLR x yl yr
l, forall x. LayoutAxis x -> FontStyle
_laxis_title_style forall a b. (a -> b) -> a -> b
$ forall x y1 y2. LayoutLR x y1 y2 -> LayoutAxis y1
_layoutlr_left_axis LayoutLR x yl yr
l),
  lge_raxis :: (Maybe (AxisT yr), String, FontStyle)
lge_raxis = (Maybe (AxisT yr)
rAxis,forall x. LayoutAxis x -> String
_laxis_title forall a b. (a -> b) -> a -> b
$ forall x y1 y2. LayoutLR x y1 y2 -> LayoutAxis y2
_layoutlr_right_axis LayoutLR x yl yr
l, forall x. LayoutAxis x -> FontStyle
_laxis_title_style forall a b. (a -> b) -> a -> b
$ forall x y1 y2. LayoutLR x y1 y2 -> LayoutAxis y2
_layoutlr_right_axis LayoutLR x yl yr
l),
  lge_margin :: Double
lge_margin = forall x y1 y2. LayoutLR x y1 y2 -> Double
_layoutlr_margin LayoutLR x yl yr
l
  }
  where
    xvals :: [x]
xvals =  [ x
x | (Left Plot x yl
p)  <- forall x y1 y2.
LayoutLR x y1 y2 -> [Either (Plot x y1) (Plot x y2)]
_layoutlr_plots LayoutLR x yl yr
l, x
x <- forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall x y. Plot x y -> ([x], [y])
_plot_all_points Plot x yl
p]
          forall a. [a] -> [a] -> [a]
++ [ x
x | (Right Plot x yr
p) <- forall x y1 y2.
LayoutLR x y1 y2 -> [Either (Plot x y1) (Plot x y2)]
_layoutlr_plots LayoutLR x yl yr
l, x
x <- forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall x y. Plot x y -> ([x], [y])
_plot_all_points Plot x yr
p]
    yvalsL :: [yl]
yvalsL = [ yl
y | (Left Plot x yl
p)  <- forall x y1 y2.
LayoutLR x y1 y2 -> [Either (Plot x y1) (Plot x y2)]
_layoutlr_plots LayoutLR x yl yr
l, yl
y <- forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall x y. Plot x y -> ([x], [y])
_plot_all_points Plot x yl
p]
    yvalsR :: [yr]
yvalsR = [ yr
y | (Right Plot x yr
p) <- forall x y1 y2.
LayoutLR x y1 y2 -> [Either (Plot x y1) (Plot x y2)]
_layoutlr_plots LayoutLR x yl yr
l, yr
y <- forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall x y. Plot x y -> ([x], [y])
_plot_all_points Plot x yr
p]

    bAxis :: Maybe (AxisT x)
bAxis = forall z. RectEdge -> LayoutAxis z -> [z] -> Maybe (AxisT z)
mkAxis RectEdge
E_Bottom (forall layout z.
layout
-> (layout -> LayoutAxis z)
-> (layout -> AxisVisibility)
-> LayoutAxis z
overrideAxisVisibility LayoutLR x yl yr
l forall x y1 y2. LayoutLR x y1 y2 -> LayoutAxis x
_layoutlr_x_axis forall x y1 y2. LayoutLR x y1 y2 -> AxisVisibility
_layoutlr_bottom_axis_visibility) [x]
xvals
    tAxis :: Maybe (AxisT x)
tAxis = forall z. RectEdge -> LayoutAxis z -> [z] -> Maybe (AxisT z)
mkAxis RectEdge
E_Top    (forall layout z.
layout
-> (layout -> LayoutAxis z)
-> (layout -> AxisVisibility)
-> LayoutAxis z
overrideAxisVisibility LayoutLR x yl yr
l forall x y1 y2. LayoutLR x y1 y2 -> LayoutAxis x
_layoutlr_x_axis forall x y1 y2. LayoutLR x y1 y2 -> AxisVisibility
_layoutlr_top_axis_visibility   ) [x]
xvals
    lAxis :: Maybe (AxisT yl)
lAxis = forall z. RectEdge -> LayoutAxis z -> [z] -> Maybe (AxisT z)
mkAxis RectEdge
E_Left   (forall layout z.
layout
-> (layout -> LayoutAxis z)
-> (layout -> AxisVisibility)
-> LayoutAxis z
overrideAxisVisibility LayoutLR x yl yr
l forall x y1 y2. LayoutLR x y1 y2 -> LayoutAxis y1
_layoutlr_left_axis  forall x y1 y2. LayoutLR x y1 y2 -> AxisVisibility
_layoutlr_left_axis_visibility ) [yl]
yvalsL
    rAxis :: Maybe (AxisT yr)
rAxis = forall z. RectEdge -> LayoutAxis z -> [z] -> Maybe (AxisT z)
mkAxis RectEdge
E_Right  (forall layout z.
layout
-> (layout -> LayoutAxis z)
-> (layout -> AxisVisibility)
-> LayoutAxis z
overrideAxisVisibility LayoutLR x yl yr
l forall x y1 y2. LayoutLR x y1 y2 -> LayoutAxis y2
_layoutlr_right_axis forall x y1 y2. LayoutLR x y1 y2 -> AxisVisibility
_layoutlr_right_axis_visibility) [yr]
yvalsR
    axes :: (Maybe (AxisT x), Maybe (AxisT yl), Maybe (AxisT x),
 Maybe (AxisT yr))
axes = (Maybe (AxisT x)
bAxis,Maybe (AxisT yl)
lAxis,Maybe (AxisT x)
tAxis,Maybe (AxisT yr)
rAxis)

    plotsToRenderable :: LayoutLR x yl yr -> Renderable (LayoutPick x yl yr)
plotsToRenderable LayoutLR x yl yr
llr = Renderable {
        minsize :: BackendProgram SpaceWeight
minsize = forall (m :: * -> *) a. Monad m => a -> m a
return (Double
0,Double
0),
        render :: SpaceWeight -> BackendProgram (PickFn (LayoutPick x yl yr))
render  = LayoutLR x yl yr
-> SpaceWeight -> BackendProgram (PickFn (LayoutPick x yl yr))
renderPlots LayoutLR x yl yr
llr
    }

    renderPlots :: LayoutLR x yl yr -> RectSize -> BackendProgram (PickFn (LayoutPick x yl yr))
    renderPlots :: LayoutLR x yl yr
-> SpaceWeight -> BackendProgram (PickFn (LayoutPick x yl yr))
renderPlots LayoutLR x yl yr
llr sz :: SpaceWeight
sz@(Double
w,Double
h) = do
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall x y1 y2. LayoutLR x y1 y2 -> Bool
_layoutlr_grid_last LayoutLR x yl yr
llr) (forall x yl yr.
SpaceWeight
-> (Maybe (AxisT x), Maybe (AxisT yl), Maybe (AxisT x),
    Maybe (AxisT yr))
-> BackendProgram ()
renderGrids SpaceWeight
sz (Maybe (AxisT x), Maybe (AxisT yl), Maybe (AxisT x),
 Maybe (AxisT yr))
axes)
        forall a. Rect -> BackendProgram a -> BackendProgram a
withClipRegion (Point -> Point -> Rect
Rect (Double -> Double -> Point
Point Double
0 Double
0) (Double -> Double -> Point
Point Double
w Double
h)) forall a b. (a -> b) -> a -> b
$
          forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Either (Plot x yl) (Plot x yr) -> BackendProgram ()
rPlot (forall x y1 y2.
LayoutLR x y1 y2 -> [Either (Plot x y1) (Plot x y2)]
_layoutlr_plots LayoutLR x yl yr
llr)
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall x y1 y2. LayoutLR x y1 y2 -> Bool
_layoutlr_grid_last LayoutLR x yl yr
llr) (forall x yl yr.
SpaceWeight
-> (Maybe (AxisT x), Maybe (AxisT yl), Maybe (AxisT x),
    Maybe (AxisT yr))
-> BackendProgram ()
renderGrids SpaceWeight
sz (Maybe (AxisT x), Maybe (AxisT yl), Maybe (AxisT x),
 Maybe (AxisT yr))
axes)
        forall (m :: * -> *) a. Monad m => a -> m a
return PickFn (LayoutPick x yl yr)
pickfn
      where
        rPlot :: Either (Plot x yl) (Plot x yr) -> BackendProgram ()
rPlot (Left  Plot x yl
p) = forall x y.
SpaceWeight
-> Maybe (AxisT x)
-> Maybe (AxisT y)
-> Plot x y
-> BackendProgram ()
renderSinglePlot SpaceWeight
sz Maybe (AxisT x)
bAxis Maybe (AxisT yl)
lAxis Plot x yl
p
        rPlot (Right Plot x yr
p) = forall x y.
SpaceWeight
-> Maybe (AxisT x)
-> Maybe (AxisT y)
-> Plot x y
-> BackendProgram ()
renderSinglePlot SpaceWeight
sz Maybe (AxisT x)
bAxis Maybe (AxisT yr)
rAxis Plot x yr
p

        xr :: SpaceWeight
xr = (Double
0, Double
w)
        yr :: SpaceWeight
yr = (Double
h, Double
0)

        pickfn :: PickFn (LayoutPick x yl yr)
pickfn (Point Double
x Double
y) = do  -- Maybe monad
            AxisT x
xat <- Maybe (AxisT x)
mxat
            (AxisT yl
yatL,AxisT yr
yatR) <- Maybe (AxisT yl, AxisT yr)
myats
            forall (m :: * -> *) a. Monad m => a -> m a
return (forall x y1 y2. x -> y1 -> y2 -> LayoutPick x y1 y2
LayoutPick_PlotArea (forall {x}. AxisT x -> Double -> x
mapx AxisT x
xat Double
x) (forall {x}. AxisT x -> Double -> x
mapy AxisT yl
yatL Double
y) (forall {x}. AxisT x -> Double -> x
mapy AxisT yr
yatR Double
y))
          where
            mxat :: Maybe (AxisT x)
mxat = case (Maybe (AxisT x)
bAxis,Maybe (AxisT x)
tAxis) of
                (Just AxisT x
at,Maybe (AxisT x)
_)       -> forall a. a -> Maybe a
Just AxisT x
at
                (Maybe (AxisT x)
_,Just AxisT x
at)       -> forall a. a -> Maybe a
Just AxisT x
at
                (Maybe (AxisT x)
Nothing,Maybe (AxisT x)
Nothing) -> forall a. Maybe a
Nothing
            myats :: Maybe (AxisT yl, AxisT yr)
myats = case (Maybe (AxisT yl)
lAxis,Maybe (AxisT yr)
rAxis) of
                (Just AxisT yl
at1,Just AxisT yr
at2) -> forall a. a -> Maybe a
Just (AxisT yl
at1,AxisT yr
at2)
                (Maybe (AxisT yl)
_,Maybe (AxisT yr)
_)   -> forall a. Maybe a
Nothing
            mapx :: AxisT x -> Double -> x
mapx (AxisT RectEdge
_ AxisStyle
_ Bool
rev AxisData x
ad) = forall x. AxisData x -> SpaceWeight -> Double -> x
_axis_tropweiv AxisData x
ad (forall a. Bool -> (a, a) -> (a, a)
optPairReverse Bool
rev SpaceWeight
xr)
            mapy :: AxisT x -> Double -> x
mapy (AxisT RectEdge
_ AxisStyle
_ Bool
rev AxisData x
ad) = forall x. AxisData x -> SpaceWeight -> Double -> x
_axis_tropweiv AxisData x
ad (forall a. Bool -> (a, a) -> (a, a)
optPairReverse Bool
rev SpaceWeight
yr)

----------------------------------------------------------------------

-- | A layout with its y type hidden, so that it can be stacked
--   with other layouts with differing y axis, but the same x axis.
--   See 'StackedLayouts'.
data StackedLayout x = forall y     . (Ord y)          => StackedLayout (Layout x y)
                       -- ^ A 'Layout' to stack.
                     | forall yl yr . (Ord yl, Ord yr) => StackedLayoutLR (LayoutLR x yl yr)
                       -- ^ A 'LayoutLR' to stack.

-- | A container for a set of vertically 'StackedLayout's.
--   The x axis of the different layouts will be aligned.
data StackedLayouts x = StackedLayouts
  { forall x. StackedLayouts x -> [StackedLayout x]
_slayouts_layouts :: [StackedLayout x]
    -- ^ The stacked layouts from top (first element) to bottom (last element).
  , forall x. StackedLayouts x -> Bool
_slayouts_compress_legend :: Bool
    -- ^ If the different legends shall be combined in one legend at the bottom.
  }

-- | A empty 'StackedLayout' with compressions applied.
instance Default (StackedLayouts x) where
  def :: StackedLayouts x
def = forall x. [StackedLayout x] -> Bool -> StackedLayouts x
StackedLayouts [] Bool
True



instance Ord x => ToRenderable (StackedLayouts x) where
  toRenderable :: StackedLayouts x -> Renderable ()
toRenderable = forall x. Ord x => StackedLayouts x -> Renderable ()
renderStackedLayouts


-- | Render several layouts with the same x-axis type and range,
--   vertically stacked so that their origins and x-values are aligned.
--
--   The legends from all the charts may be optionally combined, and shown
--   once on the bottom chart. See 'StackedLayouts' for further information.
renderStackedLayouts :: forall x. (Ord x) => StackedLayouts x -> Renderable ()
renderStackedLayouts :: forall x. Ord x => StackedLayouts x -> Renderable ()
renderStackedLayouts (StackedLayouts{_slayouts_layouts :: forall x. StackedLayouts x -> [StackedLayout x]
_slayouts_layouts=[]}) = forall a. Renderable a
emptyRenderable
renderStackedLayouts slp :: StackedLayouts x
slp@(StackedLayouts{_slayouts_layouts :: forall x. StackedLayouts x -> [StackedLayout x]
_slayouts_layouts=sls :: [StackedLayout x]
sls@(StackedLayout x
sl1:[StackedLayout x]
_)}) = forall a. Grid (Renderable a) -> Renderable a
gridToRenderable Grid (Renderable ())
g
  where
    g :: Grid (Renderable ())
g = forall a. a -> Grid a -> Grid a
fullOverlayUnder (forall a. FillStyle -> Renderable a -> Renderable a
fillBackground FillStyle
bg forall a. Renderable a
emptyRenderable)
      forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall a. Grid a -> Grid a -> Grid a
aboveforall b c a. (b -> c) -> (a -> b) -> a -> c
.(StackedLayout x, Int) -> Grid (Renderable ())
mkGrid) forall a. Grid a
nullt (forall a b. [a] -> [b] -> [(a, b)]
zip [StackedLayout x]
sls [Int
0,Int
1..])

    mkGrid :: (StackedLayout x, Int) -> Grid (Renderable ())
    mkGrid :: (StackedLayout x, Int) -> Grid (Renderable ())
mkGrid (StackedLayout x
sl, Int
i)
        = Renderable ()
titleR
          forall a. a -> Grid a -> Grid a
`wideAbove`
          forall a.
(Double, Double, Double, Double)
-> Grid (Renderable a) -> Grid (Renderable a)
addMarginsToGrid (Double
lm,Double
lm,Double
lm,Double
lm) (LayoutAxis x -> Grid (Renderable ())
mkPlotArea LayoutAxis x
usedAxis)
          forall a. Grid a -> a -> Grid a
`aboveWide`
          (if Bool
showLegend then Renderable ()
legendR else forall a. Renderable a
emptyRenderable)
      where
        titleR :: Renderable ()
titleR = case StackedLayout x
sl of
                   StackedLayout Layout x y
l -> forall a. Renderable a -> Renderable ()
noPickFn forall a b. (a -> b) -> a -> b
$ forall x yl yr.
Double -> FontStyle -> String -> Renderable (LayoutPick x yl yr)
titleToRenderable (forall x y. Layout x y -> Double
_layout_margin Layout x y
l) (forall x y. Layout x y -> FontStyle
_layout_title_style Layout x y
l) (forall x y. Layout x y -> String
_layout_title Layout x y
l)
                   StackedLayoutLR LayoutLR x yl yr
l -> forall a. Renderable a -> Renderable ()
noPickFn forall a b. (a -> b) -> a -> b
$ forall x yl yr.
Double -> FontStyle -> String -> Renderable (LayoutPick x yl yr)
titleToRenderable (forall x y1 y2. LayoutLR x y1 y2 -> Double
_layoutlr_margin LayoutLR x yl yr
l) (forall x y1 y2. LayoutLR x y1 y2 -> FontStyle
_layoutlr_title_style LayoutLR x yl yr
l) (forall x y1 y2. LayoutLR x y1 y2 -> String
_layoutlr_title LayoutLR x yl yr
l)
        legendR :: Renderable ()
legendR = case StackedLayout x
sl of
                    StackedLayout Layout x y
l -> forall a. Renderable a -> Renderable ()
noPickFn forall a b. (a -> b) -> a -> b
$ forall x y.
Layout x y -> [LegendItem] -> Renderable (LayoutPick x y y)
renderLegend Layout x y
l forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst ([LegendItem], [LegendItem])
legenditems
                    StackedLayoutLR LayoutLR x yl yr
l -> forall a. Renderable a -> Renderable ()
noPickFn forall a b. (a -> b) -> a -> b
$ forall x yl yr.
LayoutLR x yl yr
-> ([LegendItem], [LegendItem]) -> Renderable (LayoutPick x yl yr)
renderLegendLR LayoutLR x yl yr
l ([LegendItem], [LegendItem])
legenditems

        legenditems :: ([LegendItem], [LegendItem])
legenditems = case (forall x. StackedLayouts x -> Bool
_slayouts_compress_legend StackedLayouts x
slp,Bool
isBottomPlot) of
            (Bool
False,Bool
_) -> case StackedLayout x
sl of
                           StackedLayout Layout x y
l -> (forall x y. Layout x y -> [LegendItem]
getLegendItems Layout x y
l, [])
                           StackedLayoutLR LayoutLR x yl yr
l -> forall x yl yr. LayoutLR x yl yr -> ([LegendItem], [LegendItem])
getLegendItemsLR LayoutLR x yl yr
l
            (Bool
True,Bool
True) -> ([LegendItem], [LegendItem])
allLegendItems
            (Bool
True,Bool
False) -> ([],[])

        mkPlotArea :: LayoutAxis x -> Grid (Renderable ())
        mkPlotArea :: LayoutAxis x -> Grid (Renderable ())
mkPlotArea LayoutAxis x
axis = case StackedLayout x
sl of
          StackedLayout Layout x y
l -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Renderable a -> Renderable ()
noPickFn
                           forall a b. (a -> b) -> a -> b
$ forall x y.
(Ord x, Ord y) =>
Layout x y -> Grid (Renderable (LayoutPick x y y))
layoutPlotAreaToGrid
                           forall a b. (a -> b) -> a -> b
$ Layout x y
l { _layout_x_axis :: LayoutAxis x
_layout_x_axis = LayoutAxis x
axis }
          StackedLayoutLR LayoutLR x yl yr
l -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Renderable a -> Renderable ()
noPickFn
                             forall a b. (a -> b) -> a -> b
$ forall x yl yr.
(Ord x, Ord yl, Ord yr) =>
LayoutLR x yl yr -> Grid (Renderable (LayoutPick x yl yr))
layoutLRPlotAreaToGrid
                             forall a b. (a -> b) -> a -> b
$ LayoutLR x yl yr
l { _layoutlr_x_axis :: LayoutAxis x
_layoutlr_x_axis = LayoutAxis x
axis }

        showLegend :: Bool
showLegend = Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null (forall a b. (a, b) -> a
fst ([LegendItem], [LegendItem])
legenditems)) Bool -> Bool -> Bool
|| Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null (forall a b. (a, b) -> b
snd ([LegendItem], [LegendItem])
legenditems))

        isBottomPlot :: Bool
isBottomPlot = Int
i forall a. Eq a => a -> a -> Bool
== forall (t :: * -> *) a. Foldable t => t a -> Int
length [StackedLayout x]
sls forall a. Num a => a -> a -> a
- Int
1

        lm :: Double
lm = case StackedLayout x
sl of
          StackedLayout Layout x y
l -> forall x y. Layout x y -> Double
_layout_margin Layout x y
l
          StackedLayoutLR LayoutLR x yl yr
l -> forall x y1 y2. LayoutLR x y1 y2 -> Double
_layoutlr_margin LayoutLR x yl yr
l

        xAxis :: LayoutAxis x
        xAxis :: LayoutAxis x
xAxis = case StackedLayout x
sl of
          StackedLayout Layout x y
l -> forall x y. Layout x y -> LayoutAxis x
_layout_x_axis Layout x y
l
          StackedLayoutLR LayoutLR x yl yr
l -> forall x y1 y2. LayoutLR x y1 y2 -> LayoutAxis x
_layoutlr_x_axis LayoutLR x yl yr
l

        usedAxis :: LayoutAxis x
        usedAxis :: LayoutAxis x
usedAxis = LayoutAxis x
xAxis
          { _laxis_generate :: AxisFn x
_laxis_generate = forall a b. a -> b -> a
const (forall x. LayoutAxis x -> AxisFn x
_laxis_generate LayoutAxis x
xAxis [x]
all_xvals) }

    bg :: FillStyle
bg = case StackedLayout x
sl1 of
           StackedLayout Layout x y
l -> forall x y. Layout x y -> FillStyle
_layout_background Layout x y
l
           StackedLayoutLR LayoutLR x yl yr
l -> forall x y1 y2. LayoutLR x y1 y2 -> FillStyle
_layoutlr_background LayoutLR x yl yr
l

    getXVals :: StackedLayout x -> [x]
    getXVals :: StackedLayout x -> [x]
getXVals (StackedLayout Layout x y
l) = forall x y. Layout x y -> [x]
getLayoutXVals Layout x y
l
    getXVals (StackedLayoutLR LayoutLR x yl yr
l) = forall x yl yr. LayoutLR x yl yr -> [x]
getLayoutLRXVals LayoutLR x yl yr
l

    all_xvals :: [x]
all_xvals = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap StackedLayout x -> [x]
getXVals [StackedLayout x]
sls

    allLegendItems :: ([LegendItem], [LegendItem])
allLegendItems = (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a b. (a, b) -> a
fstforall b c a. (b -> c) -> (a -> b) -> a -> c
.StackedLayout x -> ([LegendItem], [LegendItem])
legendItems) [StackedLayout x]
sls, forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a b. (a, b) -> b
sndforall b c a. (b -> c) -> (a -> b) -> a -> c
.StackedLayout x -> ([LegendItem], [LegendItem])
legendItems) [StackedLayout x]
sls)

    legendItems :: StackedLayout x -> ([LegendItem], [LegendItem])
    legendItems :: StackedLayout x -> ([LegendItem], [LegendItem])
legendItems (StackedLayout Layout x y
l)   = (forall x y. Layout x y -> [LegendItem]
getLegendItems Layout x y
l, [])
    legendItems (StackedLayoutLR LayoutLR x yl yr
l) = forall x yl yr. LayoutLR x yl yr -> ([LegendItem], [LegendItem])
getLegendItemsLR LayoutLR x yl yr
l

    noPickFn :: Renderable a -> Renderable ()
    noPickFn :: forall a. Renderable a -> Renderable ()
noPickFn = forall a b. (a -> b) -> Renderable a -> Renderable b
mapPickFn (forall a b. a -> b -> a
const ())

----------------------------------------------------------------------

addMarginsToGrid :: (Double,Double,Double,Double) -> Grid (Renderable a)
                 -> Grid (Renderable a)
addMarginsToGrid :: forall a.
(Double, Double, Double, Double)
-> Grid (Renderable a) -> Grid (Renderable a)
addMarginsToGrid (Double
t,Double
b,Double
l,Double
r) Grid (Renderable a)
g = forall a. [Grid a] -> Grid a
aboveN [
     forall a. [Grid a] -> Grid a
besideN [forall a. Grid a
er, forall {a}. Grid (Renderable a)
ts, forall a. Grid a
er],
     forall a. [Grid a] -> Grid a
besideN [forall {a}. Grid (Renderable a)
ls, Grid (Renderable a)
g,  forall {a}. Grid (Renderable a)
rs],
     forall a. [Grid a] -> Grid a
besideN [forall a. Grid a
er, forall {a}. Grid (Renderable a)
bs, forall a. Grid a
er]
  ]
  where
    er :: Grid a
er = forall a. Grid a
empty
    ts :: Grid (Renderable a)
ts = forall a. a -> Grid a
tval forall a b. (a -> b) -> a -> b
$ forall a. SpaceWeight -> Renderable a
spacer (Double
0,Double
t)
    ls :: Grid (Renderable a)
ls = forall a. a -> Grid a
tval forall a b. (a -> b) -> a -> b
$ forall a. SpaceWeight -> Renderable a
spacer (Double
l,Double
0)
    bs :: Grid (Renderable a)
bs = forall a. a -> Grid a
tval forall a b. (a -> b) -> a -> b
$ forall a. SpaceWeight -> Renderable a
spacer (Double
0,Double
b)
    rs :: Grid (Renderable a)
rs = forall a. a -> Grid a
tval forall a b. (a -> b) -> a -> b
$ forall a. SpaceWeight -> Renderable a
spacer (Double
r,Double
0)

titleToRenderable :: Double -> FontStyle -> String -> Renderable (LayoutPick x yl yr)
titleToRenderable :: forall x yl yr.
Double -> FontStyle -> String -> Renderable (LayoutPick x yl yr)
titleToRenderable Double
_  FontStyle
_  String
"" = forall a. Renderable a
emptyRenderable
titleToRenderable Double
lm FontStyle
fs String
s = forall a.
(Double, Double, Double, Double) -> Renderable a -> Renderable a
addMargins (Double
lmforall a. Fractional a => a -> a -> a
/Double
2,Double
0,Double
0,Double
0) (forall a b. (a -> b) -> Renderable a -> Renderable b
mapPickFn forall x y1 y2. String -> LayoutPick x y1 y2
LayoutPick_Title Renderable String
title)
  where
    title :: Renderable String
title = FontStyle
-> HTextAnchor -> VTextAnchor -> String -> Renderable String
label FontStyle
fs HTextAnchor
HTA_Centre VTextAnchor
VTA_Centre String
s

mkLegend :: Maybe LegendStyle -> Double -> [LegendItem] -> Renderable (LayoutPick x yl yr)
mkLegend :: forall x yl yr.
Maybe LegendStyle
-> Double -> [LegendItem] -> Renderable (LayoutPick x yl yr)
mkLegend Maybe LegendStyle
mls Double
lm [LegendItem]
vals = case Maybe LegendStyle
mls of
    Maybe LegendStyle
Nothing -> forall a. Renderable a
emptyRenderable
    Just LegendStyle
ls ->  case forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
/=String
"")forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. (a, b) -> a
fst) [LegendItem]
vals of
        []  -> forall a. Renderable a
emptyRenderable ;
        [LegendItem]
lvs -> forall a.
(Double, Double, Double, Double) -> Renderable a -> Renderable a
addMargins (Double
0,Double
lm,Double
lm,Double
lm) forall a b. (a -> b) -> a -> b
$
                   forall a b. (a -> b) -> Renderable a -> Renderable b
mapPickFn forall x y1 y2. String -> LayoutPick x y1 y2
LayoutPick_Legend forall a b. (a -> b) -> a -> b
$ forall x y. Legend x y -> Renderable String
legendToRenderable (forall x y. LegendStyle -> [LegendItem] -> Legend x y
Legend LegendStyle
ls [LegendItem]
lvs)


data LayoutGridElements x yl yr = LayoutGridElements {
  forall x yl yr.
LayoutGridElements x yl yr -> Renderable (LayoutPick x yl yr)
lge_plots :: Renderable (LayoutPick x yl yr),

  forall x yl yr.
LayoutGridElements x yl yr -> (Maybe (AxisT x), String, FontStyle)
lge_taxis :: (Maybe (AxisT x),String,FontStyle),
  forall x yl yr.
LayoutGridElements x yl yr -> (Maybe (AxisT x), String, FontStyle)
lge_baxis :: (Maybe (AxisT x),String,FontStyle),
  forall x yl yr.
LayoutGridElements x yl yr -> (Maybe (AxisT yl), String, FontStyle)
lge_laxis :: (Maybe (AxisT yl),String,FontStyle),
  forall x yl yr.
LayoutGridElements x yl yr -> (Maybe (AxisT yr), String, FontStyle)
lge_raxis :: (Maybe (AxisT yr),String,FontStyle),

  forall x yl yr. LayoutGridElements x yl yr -> Double
lge_margin :: Double
}

buildGrid :: (Ord x, Ord yl, Ord yr) => LayoutGridElements x yl yr -> Grid (Renderable (LayoutPick x yl yr))
buildGrid :: forall x yl yr.
(Ord x, Ord yl, Ord yr) =>
LayoutGridElements x yl yr
-> Grid (Renderable (LayoutPick x yl yr))
buildGrid LayoutGridElements x yl yr
lge = Grid (Renderable (LayoutPick x yl yr))
layer2 forall a. Grid a -> Grid a -> Grid a
`overlay` Grid (Renderable (LayoutPick x yl yr))
layer1
  where
    layer1 :: Grid (Renderable (LayoutPick x yl yr))
layer1 = forall a. [Grid a] -> Grid a
aboveN
         [ forall a. [Grid a] -> Grid a
besideN [forall {a}. Grid (Renderable a)
er,     forall {a}. Grid (Renderable a)
er,  forall {a}. Grid (Renderable a)
er,    forall {a}. Grid (Renderable a)
er   ]
         , forall a. [Grid a] -> Grid a
besideN [forall {a}. Grid (Renderable a)
er,     forall {a}. Grid (Renderable a)
er,  forall {a}. Grid (Renderable a)
er,    forall a. SpaceWeight -> Grid a -> Grid a
weights (Double
1,Double
1) Grid (Renderable (LayoutPick x yl yr))
plots ]
         ]

    layer2 :: Grid (Renderable (LayoutPick x yl yr))
layer2 = forall a. [Grid a] -> Grid a
aboveN
         [ forall a. [Grid a] -> Grid a
besideN [forall {a}. Grid (Renderable a)
er,     forall {a}. Grid (Renderable a)
er,  forall {a}. Grid (Renderable a)
tl,    forall {y1} {y2}. Grid (Renderable (LayoutPick x y1 y2))
taxis,  forall {a}. Grid (Renderable a)
tr,    forall {a}. Grid (Renderable a)
er,  forall {a}. Grid (Renderable a)
er       ]
         , forall a. [Grid a] -> Grid a
besideN [forall {x} {yl} {yr}. Grid (Renderable (LayoutPick x yl yr))
ltitle, forall {x} {yl} {yr}. Grid (Renderable (LayoutPick x yl yr))
lam, forall {x} {y2}. Grid (Renderable (LayoutPick x yl y2))
laxis, forall {a}. Grid (Renderable a)
er,     forall {x} {y1}. Grid (Renderable (LayoutPick x y1 yr))
raxis, forall {x} {yl} {yr}. Grid (Renderable (LayoutPick x yl yr))
ram, forall {x} {yl} {yr}. Grid (Renderable (LayoutPick x yl yr))
rtitle   ]
         , forall a. [Grid a] -> Grid a
besideN [forall {a}. Grid (Renderable a)
er,     forall {a}. Grid (Renderable a)
er,  forall {a}. Grid (Renderable a)
bl,    forall {y1} {y2}. Grid (Renderable (LayoutPick x y1 y2))
baxis,  forall {a}. Grid (Renderable a)
br,    forall {a}. Grid (Renderable a)
er,  forall {a}. Grid (Renderable a)
er       ]
         , forall a. [Grid a] -> Grid a
besideN [forall {a}. Grid (Renderable a)
er,     forall {a}. Grid (Renderable a)
er,  forall {a}. Grid (Renderable a)
er,    forall {x} {yl} {yr}. Grid (Renderable (LayoutPick x yl yr))
btitle, forall {a}. Grid (Renderable a)
er,    forall {a}. Grid (Renderable a)
er,  forall {a}. Grid (Renderable a)
er       ]
         ]

    er :: Grid (Renderable a)
er = forall a. a -> Grid a
tval forall a. Renderable a
emptyRenderable

    plots :: Grid (Renderable (LayoutPick x yl yr))
plots = forall a. a -> Grid a
tval forall a b. (a -> b) -> a -> b
$ forall x yl yr.
LayoutGridElements x yl yr -> Renderable (LayoutPick x yl yr)
lge_plots LayoutGridElements x yl yr
lge

    (Maybe (AxisT x)
tdata,String
_,FontStyle
_)         = forall x yl yr.
LayoutGridElements x yl yr -> (Maybe (AxisT x), String, FontStyle)
lge_taxis LayoutGridElements x yl yr
lge
    (Maybe (AxisT x)
bdata,String
blbl,FontStyle
bstyle) = forall x yl yr.
LayoutGridElements x yl yr -> (Maybe (AxisT x), String, FontStyle)
lge_baxis LayoutGridElements x yl yr
lge
    (Maybe (AxisT yl)
ldata,String
llbl,FontStyle
lstyle) = forall x yl yr.
LayoutGridElements x yl yr -> (Maybe (AxisT yl), String, FontStyle)
lge_laxis LayoutGridElements x yl yr
lge
    (Maybe (AxisT yr)
rdata,String
rlbl,FontStyle
rstyle) = forall x yl yr.
LayoutGridElements x yl yr -> (Maybe (AxisT yr), String, FontStyle)
lge_raxis LayoutGridElements x yl yr
lge

    -- (ttitle,_) = mktitle HTA_Centre VTA_Bottom   0 tlbl tstyle LayoutPick_XTopAxisTitle
    (Grid (Renderable (LayoutPick x yl yr))
btitle,Grid (Renderable (LayoutPick x yl yr))
_) = forall x yl yr.
HTextAnchor
-> VTextAnchor
-> Double
-> String
-> FontStyle
-> (String -> LayoutPick x yl yr)
-> (Grid (Renderable (LayoutPick x yl yr)),
    Grid (Renderable (LayoutPick x yl yr)))
mktitle HTextAnchor
HTA_Centre VTextAnchor
VTA_Top      Double
0 String
blbl FontStyle
bstyle forall x y1 y2. String -> LayoutPick x y1 y2
LayoutPick_XBottomAxisTitle
    (Grid (Renderable (LayoutPick x yl yr))
ltitle,Grid (Renderable (LayoutPick x yl yr))
lam) = forall x yl yr.
HTextAnchor
-> VTextAnchor
-> Double
-> String
-> FontStyle
-> (String -> LayoutPick x yl yr)
-> (Grid (Renderable (LayoutPick x yl yr)),
    Grid (Renderable (LayoutPick x yl yr)))
mktitle HTextAnchor
HTA_Right  VTextAnchor
VTA_Centre Double
270 String
llbl FontStyle
lstyle forall x y1 y2. String -> LayoutPick x y1 y2
LayoutPick_YLeftAxisTitle
    (Grid (Renderable (LayoutPick x yl yr))
rtitle,Grid (Renderable (LayoutPick x yl yr))
ram) = forall x yl yr.
HTextAnchor
-> VTextAnchor
-> Double
-> String
-> FontStyle
-> (String -> LayoutPick x yl yr)
-> (Grid (Renderable (LayoutPick x yl yr)),
    Grid (Renderable (LayoutPick x yl yr)))
mktitle HTextAnchor
HTA_Left   VTextAnchor
VTA_Centre Double
270 String
rlbl FontStyle
rstyle forall x y1 y2. String -> LayoutPick x y1 y2
LayoutPick_YRightAxisTitle

    baxis :: Grid (Renderable (LayoutPick x y1 y2))
baxis = forall a. a -> Grid a
tval forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Renderable a
emptyRenderable
                         (forall a b. (a -> b) -> Renderable a -> Renderable b
mapPickFn forall x y1 y2. x -> LayoutPick x y1 y2
LayoutPick_XBottomAxis forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x. AxisT x -> Renderable x
axisToRenderable) Maybe (AxisT x)
bdata
    taxis :: Grid (Renderable (LayoutPick x y1 y2))
taxis = forall a. a -> Grid a
tval forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Renderable a
emptyRenderable
                         (forall a b. (a -> b) -> Renderable a -> Renderable b
mapPickFn forall x y1 y2. x -> LayoutPick x y1 y2
LayoutPick_XTopAxis forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x. AxisT x -> Renderable x
axisToRenderable) Maybe (AxisT x)
tdata
    laxis :: Grid (Renderable (LayoutPick x yl y2))
laxis = forall a. a -> Grid a
tval forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Renderable a
emptyRenderable
                         (forall a b. (a -> b) -> Renderable a -> Renderable b
mapPickFn forall x y1 y2. y1 -> LayoutPick x y1 y2
LayoutPick_YLeftAxis forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x. AxisT x -> Renderable x
axisToRenderable) Maybe (AxisT yl)
ldata
    raxis :: Grid (Renderable (LayoutPick x y1 yr))
raxis = forall a. a -> Grid a
tval forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Renderable a
emptyRenderable
                         (forall a b. (a -> b) -> Renderable a -> Renderable b
mapPickFn forall x y1 y2. y2 -> LayoutPick x y1 y2
LayoutPick_YRightAxis forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x. AxisT x -> Renderable x
axisToRenderable) Maybe (AxisT yr)
rdata

    tl :: Grid (Renderable a)
tl = forall a. a -> Grid a
tval forall a b. (a -> b) -> a -> b
$ forall x y a.
(Ord x, Ord y) =>
(SpaceWeight -> Double)
-> Maybe (AxisT x)
-> (SpaceWeight -> Double)
-> Maybe (AxisT y)
-> Renderable a
axesSpacer forall a b. (a, b) -> a
fst Maybe (AxisT x)
tdata forall a b. (a, b) -> a
fst Maybe (AxisT yl)
ldata
    bl :: Grid (Renderable a)
bl = forall a. a -> Grid a
tval forall a b. (a -> b) -> a -> b
$ forall x y a.
(Ord x, Ord y) =>
(SpaceWeight -> Double)
-> Maybe (AxisT x)
-> (SpaceWeight -> Double)
-> Maybe (AxisT y)
-> Renderable a
axesSpacer forall a b. (a, b) -> a
fst Maybe (AxisT x)
bdata forall a b. (a, b) -> b
snd Maybe (AxisT yl)
ldata
    tr :: Grid (Renderable a)
tr = forall a. a -> Grid a
tval forall a b. (a -> b) -> a -> b
$ forall x y a.
(Ord x, Ord y) =>
(SpaceWeight -> Double)
-> Maybe (AxisT x)
-> (SpaceWeight -> Double)
-> Maybe (AxisT y)
-> Renderable a
axesSpacer forall a b. (a, b) -> b
snd Maybe (AxisT x)
tdata forall a b. (a, b) -> a
fst Maybe (AxisT yr)
rdata
    br :: Grid (Renderable a)
br = forall a. a -> Grid a
tval forall a b. (a -> b) -> a -> b
$ forall x y a.
(Ord x, Ord y) =>
(SpaceWeight -> Double)
-> Maybe (AxisT x)
-> (SpaceWeight -> Double)
-> Maybe (AxisT y)
-> Renderable a
axesSpacer forall a b. (a, b) -> b
snd Maybe (AxisT x)
bdata forall a b. (a, b) -> b
snd Maybe (AxisT yr)
rdata

    mktitle :: HTextAnchor -> VTextAnchor
            -> Double
            -> String -> FontStyle
            -> (String -> LayoutPick x yl yr)
            -> ( Grid (Renderable (LayoutPick x yl yr))
               , Grid (Renderable (LayoutPick x yl yr)) )
    mktitle :: forall x yl yr.
HTextAnchor
-> VTextAnchor
-> Double
-> String
-> FontStyle
-> (String -> LayoutPick x yl yr)
-> (Grid (Renderable (LayoutPick x yl yr)),
    Grid (Renderable (LayoutPick x yl yr)))
mktitle HTextAnchor
ha VTextAnchor
va Double
rot String
lbl FontStyle
style String -> LayoutPick x yl yr
pf = if String
lbl forall a. Eq a => a -> a -> Bool
== String
"" then (forall {a}. Grid (Renderable a)
er,forall {a}. Grid (Renderable a)
er) else (Grid (Renderable (LayoutPick x yl yr))
labelG,forall {a}. Grid (Renderable a)
gapG)
      where
        labelG :: Grid (Renderable (LayoutPick x yl yr))
labelG = forall a. a -> Grid a
tval forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> Renderable a -> Renderable b
mapPickFn String -> LayoutPick x yl yr
pf forall a b. (a -> b) -> a -> b
$ FontStyle
-> HTextAnchor
-> VTextAnchor
-> Double
-> String
-> Renderable String
rlabel FontStyle
style HTextAnchor
ha VTextAnchor
va Double
rot String
lbl
        gapG :: Grid (Renderable a)
gapG = forall a. a -> Grid a
tval forall a b. (a -> b) -> a -> b
$ forall a. SpaceWeight -> Renderable a
spacer (forall x yl yr. LayoutGridElements x yl yr -> Double
lge_margin LayoutGridElements x yl yr
lge,Double
0)

-- | Render the grids of the given axis to a plot area of given size.
renderGrids :: RectSize -> (Maybe (AxisT x), Maybe (AxisT yl), Maybe (AxisT x), Maybe (AxisT yr)) -> BackendProgram ()
renderGrids :: forall x yl yr.
SpaceWeight
-> (Maybe (AxisT x), Maybe (AxisT yl), Maybe (AxisT x),
    Maybe (AxisT yr))
-> BackendProgram ()
renderGrids SpaceWeight
sz (Maybe (AxisT x)
bAxis, Maybe (AxisT yl)
lAxis, Maybe (AxisT x)
tAxis, Maybe (AxisT yr)
rAxis) = do
  forall (m :: * -> *) b a.
Monad m =>
b -> (a -> m b) -> Maybe a -> m b
maybeM () (forall z. SpaceWeight -> AxisT z -> BackendProgram ()
renderAxisGrid SpaceWeight
sz) Maybe (AxisT x)
tAxis
  forall (m :: * -> *) b a.
Monad m =>
b -> (a -> m b) -> Maybe a -> m b
maybeM () (forall z. SpaceWeight -> AxisT z -> BackendProgram ()
renderAxisGrid SpaceWeight
sz) Maybe (AxisT x)
bAxis
  forall (m :: * -> *) b a.
Monad m =>
b -> (a -> m b) -> Maybe a -> m b
maybeM () (forall z. SpaceWeight -> AxisT z -> BackendProgram ()
renderAxisGrid SpaceWeight
sz) Maybe (AxisT yl)
lAxis
  forall (m :: * -> *) b a.
Monad m =>
b -> (a -> m b) -> Maybe a -> m b
maybeM () (forall z. SpaceWeight -> AxisT z -> BackendProgram ()
renderAxisGrid SpaceWeight
sz) Maybe (AxisT yr)
rAxis

-- | Swap the contents of the pair depending on the flag.
optPairReverse :: Bool -> (a,a) -> (a,a)
optPairReverse :: forall a. Bool -> (a, a) -> (a, a)
optPairReverse Bool
rev (a
a,a
b) = if Bool
rev then (a
b,a
a) else (a
a,a
b)

-- | Render a single set of plot data onto a plot area of given size using
--   the given x and y axis.
renderSinglePlot :: RectSize -> Maybe (AxisT x) -> Maybe (AxisT y) -> Plot x y -> BackendProgram ()
renderSinglePlot :: forall x y.
SpaceWeight
-> Maybe (AxisT x)
-> Maybe (AxisT y)
-> Plot x y
-> BackendProgram ()
renderSinglePlot (Double
w, Double
h) (Just (AxisT RectEdge
_ AxisStyle
_ Bool
xrev AxisData x
xaxis)) (Just (AxisT RectEdge
_ AxisStyle
_ Bool
yrev AxisData y
yaxis)) Plot x y
p =
  let xr :: SpaceWeight
xr = forall a. Bool -> (a, a) -> (a, a)
optPairReverse Bool
xrev (Double
0, Double
w)
      yr :: SpaceWeight
yr = forall a. Bool -> (a, a) -> (a, a)
optPairReverse Bool
yrev (Double
h, Double
0)
      -- yrange = if yrev then (0, h) else (h, 0)
      pmfn :: (Limit x, Limit y) -> Point
pmfn (Limit x
x,Limit y
y) = Double -> Double -> Point
Point (forall {a} {t}. (a, a) -> (t -> a) -> Limit t -> a
mapv SpaceWeight
xr (forall x. AxisData x -> SpaceWeight -> x -> Double
_axis_viewport AxisData x
xaxis SpaceWeight
xr) Limit x
x)
                         (forall {a} {t}. (a, a) -> (t -> a) -> Limit t -> a
mapv SpaceWeight
yr (forall x. AxisData x -> SpaceWeight -> x -> Double
_axis_viewport AxisData y
yaxis SpaceWeight
yr) Limit y
y)
      mapv :: (a, a) -> (t -> a) -> Limit t -> a
mapv (a, a)
lims t -> a
_ Limit t
LMin       = forall a b. (a, b) -> a
fst (a, a)
lims
      mapv (a, a)
lims t -> a
_ Limit t
LMax       = forall a b. (a, b) -> b
snd (a, a)
lims
      mapv (a, a)
_    t -> a
f (LValue t
v) = t -> a
f t
v
  in forall x y. Plot x y -> PointMapFn x y -> BackendProgram ()
_plot_render Plot x y
p (Limit x, Limit y) -> Point
pmfn
renderSinglePlot SpaceWeight
_ Maybe (AxisT x)
_ Maybe (AxisT y)
_ Plot x y
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()

axesSpacer :: (Ord x, Ord y)
           => ((Double, Double) -> Double) -> Maybe (AxisT x)
           -> ((Double, Double) -> Double) -> Maybe (AxisT y)
           -> Renderable a
axesSpacer :: forall x y a.
(Ord x, Ord y) =>
(SpaceWeight -> Double)
-> Maybe (AxisT x)
-> (SpaceWeight -> Double)
-> Maybe (AxisT y)
-> Renderable a
axesSpacer SpaceWeight -> Double
f1 Maybe (AxisT x)
a1 SpaceWeight -> Double
f2 Maybe (AxisT y)
a2 = forall a. BackendProgram (Renderable a) -> Renderable a
embedRenderable forall a b. (a -> b) -> a -> b
$ do
    SpaceWeight
oh1 <- forall (m :: * -> *) b a.
Monad m =>
b -> (a -> m b) -> Maybe a -> m b
maybeM (Double
0,Double
0) forall x. Ord x => AxisT x -> BackendProgram SpaceWeight
axisOverhang Maybe (AxisT x)
a1
    SpaceWeight
oh2 <- forall (m :: * -> *) b a.
Monad m =>
b -> (a -> m b) -> Maybe a -> m b
maybeM (Double
0,Double
0) forall x. Ord x => AxisT x -> BackendProgram SpaceWeight
axisOverhang Maybe (AxisT y)
a2
    forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. SpaceWeight -> Renderable a
spacer (SpaceWeight -> Double
f1 SpaceWeight
oh1, SpaceWeight -> Double
f2 SpaceWeight
oh2))

-- | Construct a axis for the given edge using the attributes
--   from a 'LayoutAxis' the given values.
mkAxis :: RectEdge -> LayoutAxis z -> [z] -> Maybe (AxisT z)
mkAxis :: forall z. RectEdge -> LayoutAxis z -> [z] -> Maybe (AxisT z)
mkAxis RectEdge
edge LayoutAxis z
laxis [z]
vals = if Bool
axisVisible
                           then forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall x. RectEdge -> AxisStyle -> Bool -> AxisData x -> AxisT x
AxisT RectEdge
edge AxisStyle
style Bool
rev AxisData z
adata
                           else forall a. Maybe a
Nothing
  where
    style :: AxisStyle
style = forall x. LayoutAxis x -> AxisStyle
_laxis_style LayoutAxis z
laxis
    rev :: Bool
rev   = forall x. LayoutAxis x -> Bool
_laxis_reverse LayoutAxis z
laxis
    adata :: AxisData z
adata = forall x. LayoutAxis x -> AxisData x -> AxisData x
_laxis_override LayoutAxis z
laxis (forall x. LayoutAxis x -> AxisFn x
_laxis_generate LayoutAxis z
laxis [z]
vals)
    vis :: AxisVisibility
vis   = forall x. AxisData x -> AxisVisibility
_axis_visibility AxisData z
adata
    axisVisible :: Bool
axisVisible = AxisVisibility -> Bool
_axis_show_labels AxisVisibility
vis Bool -> Bool -> Bool
|| AxisVisibility -> Bool
_axis_show_line AxisVisibility
vis Bool -> Bool -> Bool
|| AxisVisibility -> Bool
_axis_show_ticks AxisVisibility
vis

-- | Override the visibility of a selected axis with the selected 'AxisVisibility'.
overrideAxisVisibility :: layout
                       -> (layout -> LayoutAxis z)
                       -> (layout -> AxisVisibility)
                       -> LayoutAxis z
overrideAxisVisibility :: forall layout z.
layout
-> (layout -> LayoutAxis z)
-> (layout -> AxisVisibility)
-> LayoutAxis z
overrideAxisVisibility layout
ly layout -> LayoutAxis z
selAxis layout -> AxisVisibility
selVis =
  let vis :: AxisVisibility
vis = layout -> AxisVisibility
selVis layout
ly
  in (layout -> LayoutAxis z
selAxis layout
ly) { _laxis_override :: AxisData z -> AxisData z
_laxis_override = (\AxisData z
ad -> AxisData z
ad { _axis_visibility :: AxisVisibility
_axis_visibility = AxisVisibility
vis })
                                    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x. LayoutAxis x -> AxisData x -> AxisData x
_laxis_override (layout -> LayoutAxis z
selAxis layout
ly)
                  }

mfill :: Maybe FillStyle -> Renderable a -> Renderable a
mfill :: forall a. Maybe FillStyle -> Renderable a -> Renderable a
mfill Maybe FillStyle
Nothing   = forall a. a -> a
id
mfill (Just FillStyle
fs) = forall a. FillStyle -> Renderable a -> Renderable a
fillBackground FillStyle
fs

-- | Empty 'LayoutLR' without title and plots. The background is white and
--   the grid is drawn beneath all plots. There will be a legend. The top
--   axis will not be visible.
instance (PlotValue x, PlotValue y1, PlotValue y2) => Default (LayoutLR x y1 y2) where
  def :: LayoutLR x y1 y2
def = LayoutLR
    { _layoutlr_background :: FillStyle
_layoutlr_background      = AlphaColour Double -> FillStyle
solidFillStyle forall a b. (a -> b) -> a -> b
$ forall a. Num a => Colour a -> AlphaColour a
opaque forall a. (Ord a, Floating a) => Colour a
white
    , _layoutlr_plot_background :: Maybe FillStyle
_layoutlr_plot_background = forall a. Maybe a
Nothing

    , _layoutlr_title :: String
_layoutlr_title           = String
""
    , _layoutlr_title_style :: FontStyle
_layoutlr_title_style     = forall a. Default a => a
def { _font_size :: Double
_font_size   = Double
15
                                      , _font_weight :: FontWeight
_font_weight = FontWeight
FontWeightBold }

    , _layoutlr_x_axis :: LayoutAxis x
_layoutlr_x_axis                 = forall a. Default a => a
def
    , _layoutlr_top_axis_visibility :: AxisVisibility
_layoutlr_top_axis_visibility    = forall a. Default a => a
def { _axis_show_line :: Bool
_axis_show_line   = Bool
False
                                             , _axis_show_ticks :: Bool
_axis_show_ticks  = Bool
False
                                             , _axis_show_labels :: Bool
_axis_show_labels = Bool
False }
    , _layoutlr_bottom_axis_visibility :: AxisVisibility
_layoutlr_bottom_axis_visibility = forall a. Default a => a
def

    , _layoutlr_left_axis :: LayoutAxis y1
_layoutlr_left_axis           = forall a. Default a => a
def
    , _layoutlr_left_axis_visibility :: AxisVisibility
_layoutlr_left_axis_visibility  = forall a. Default a => a
def
    , _layoutlr_right_axis :: LayoutAxis y2
_layoutlr_right_axis          = forall a. Default a => a
def
    , _layoutlr_right_axis_visibility :: AxisVisibility
_layoutlr_right_axis_visibility = forall a. Default a => a
def

    , _layoutlr_plots :: [Either (Plot x y1) (Plot x y2)]
_layoutlr_plots      = []

    , _layoutlr_legend :: Maybe LegendStyle
_layoutlr_legend          = forall a. a -> Maybe a
Just forall a. Default a => a
def
    , _layoutlr_margin :: Double
_layoutlr_margin          = Double
10
    , _layoutlr_grid_last :: Bool
_layoutlr_grid_last       = Bool
False
    }

instance PlotValue t => Default (LayoutAxis t) where
  def :: LayoutAxis t
def = LayoutAxis
    { _laxis_title_style :: FontStyle
_laxis_title_style = forall a. Default a => a
def { _font_size :: Double
_font_size=Double
10 }
    , _laxis_title :: String
_laxis_title       = String
""
    , _laxis_style :: AxisStyle
_laxis_style       = forall a. Default a => a
def
    , _laxis_generate :: AxisFn t
_laxis_generate    = forall a. PlotValue a => AxisFn a
autoAxis
    , _laxis_override :: AxisData t -> AxisData t
_laxis_override    = forall a. a -> a
id
    , _laxis_reverse :: Bool
_laxis_reverse     = Bool
False
    }

----------------------------------------------------------------------
-- Template haskell to derive an instance of Data.Accessor.Accessor
-- for each field.
$( makeLenses ''Layout )
$( makeLenses ''LayoutLR )
$( makeLenses ''LayoutAxis )
$( makeLenses ''StackedLayouts )

-- | Setter to update all axis styles on a `Layout`
layout_axes_styles :: Setter' (Layout x y) AxisStyle
layout_axes_styles :: forall x y. Setter' (Layout x y) AxisStyle
layout_axes_styles = forall (p :: * -> * -> *) (q :: * -> * -> *) (f :: * -> *) a b s t.
(Profunctor p, Profunctor q, Settable f) =>
(p a b -> q s t) -> Optical p q f s t a b
sets forall a b. (a -> b) -> a -> b
$ \AxisStyle -> AxisStyle
af ->
    (forall x y. Lens' (Layout x y) (LayoutAxis x)
layout_x_axis forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x. Lens' (LayoutAxis x) AxisStyle
laxis_style forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ AxisStyle -> AxisStyle
af) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    (forall x y. Lens' (Layout x y) (LayoutAxis y)
layout_y_axis forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x. Lens' (LayoutAxis x) AxisStyle
laxis_style forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ AxisStyle -> AxisStyle
af)

-- | Setter to update all the axes title styles on a `Layout`
layout_axes_title_styles :: Setter' (Layout x y) FontStyle
layout_axes_title_styles :: forall x y. Setter' (Layout x y) FontStyle
layout_axes_title_styles = forall (p :: * -> * -> *) (q :: * -> * -> *) (f :: * -> *) a b s t.
(Profunctor p, Profunctor q, Settable f) =>
(p a b -> q s t) -> Optical p q f s t a b
sets forall a b. (a -> b) -> a -> b
$ \FontStyle -> FontStyle
af ->
    (forall x y. Lens' (Layout x y) (LayoutAxis x)
layout_x_axis forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x. Lens' (LayoutAxis x) FontStyle
laxis_title_style forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ FontStyle -> FontStyle
af) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    (forall x y. Lens' (Layout x y) (LayoutAxis y)
layout_y_axis forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x. Lens' (LayoutAxis x) FontStyle
laxis_title_style forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ FontStyle -> FontStyle
af)

-- | Setter to update all the font styles on a `Layout`
layout_all_font_styles :: Setter' (Layout x y) FontStyle
layout_all_font_styles :: forall x y. Setter' (Layout x y) FontStyle
layout_all_font_styles = forall (p :: * -> * -> *) (q :: * -> * -> *) (f :: * -> *) a b s t.
(Profunctor p, Profunctor q, Settable f) =>
(p a b -> q s t) -> Optical p q f s t a b
sets forall a b. (a -> b) -> a -> b
$ \FontStyle -> FontStyle
af ->
    (forall x y. Setter' (Layout x y) FontStyle
layout_axes_title_styles forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ FontStyle -> FontStyle
af) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    (forall x y. Lens' (Layout x y) (LayoutAxis x)
layout_x_axis forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x. Lens' (LayoutAxis x) AxisStyle
laxis_style forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' AxisStyle FontStyle
axis_label_style forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ FontStyle -> FontStyle
af) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    (forall x y. Lens' (Layout x y) (LayoutAxis y)
layout_y_axis forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x. Lens' (LayoutAxis x) AxisStyle
laxis_style forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' AxisStyle FontStyle
axis_label_style forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ FontStyle -> FontStyle
af) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    (forall x y. Lens' (Layout x y) (Maybe LegendStyle)
layout_legend forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' LegendStyle FontStyle
legend_label_style forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ FontStyle -> FontStyle
af) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    (forall x y. Lens' (Layout x y) FontStyle
layout_title_style forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ FontStyle -> FontStyle
af)

-- | Setter to update the foreground color of core chart elements on a `Layout`
layout_foreground ::  Setter' (Layout x y) (AlphaColour Double)
layout_foreground :: forall x y. Setter' (Layout x y) (AlphaColour Double)
layout_foreground = forall (p :: * -> * -> *) (q :: * -> * -> *) (f :: * -> *) a b s t.
(Profunctor p, Profunctor q, Settable f) =>
(p a b -> q s t) -> Optical p q f s t a b
sets forall a b. (a -> b) -> a -> b
$ \AlphaColour Double -> AlphaColour Double
af ->
    (forall x y. Setter' (Layout x y) FontStyle
layout_all_font_styles forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FontStyle (AlphaColour Double)
font_color forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ AlphaColour Double -> AlphaColour Double
af) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    (forall x y. Setter' (Layout x y) AxisStyle
layout_axes_styles forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' AxisStyle LineStyle
axis_line_style forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' LineStyle (AlphaColour Double)
line_color forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ AlphaColour Double -> AlphaColour Double
af)

-- | Setter to update all axis styles on a `LayoutLR`
layoutlr_axes_styles :: Setter' (LayoutLR x y1 y2) AxisStyle
layoutlr_axes_styles :: forall x y1 y2. Setter' (LayoutLR x y1 y2) AxisStyle
layoutlr_axes_styles = forall (p :: * -> * -> *) (q :: * -> * -> *) (f :: * -> *) a b s t.
(Profunctor p, Profunctor q, Settable f) =>
(p a b -> q s t) -> Optical p q f s t a b
sets forall a b. (a -> b) -> a -> b
$ \AxisStyle -> AxisStyle
af ->
    (forall x y1 y2. Lens' (LayoutLR x y1 y2) (LayoutAxis x)
layoutlr_x_axis forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x. Lens' (LayoutAxis x) AxisStyle
laxis_style forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ AxisStyle -> AxisStyle
af) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    (forall x y1 y2. Lens' (LayoutLR x y1 y2) (LayoutAxis y1)
layoutlr_left_axis forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x. Lens' (LayoutAxis x) AxisStyle
laxis_style forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ AxisStyle -> AxisStyle
af) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    (forall x y1 y2. Lens' (LayoutLR x y1 y2) (LayoutAxis y2)
layoutlr_right_axis forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x. Lens' (LayoutAxis x) AxisStyle
laxis_style forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ AxisStyle -> AxisStyle
af)

-- | Setter to update all the axes title styles on a `LayoutLR`
layoutlr_axes_title_styles :: Setter' (LayoutLR x y1 y2) FontStyle
layoutlr_axes_title_styles :: forall x y1 y2. Setter' (LayoutLR x y1 y2) FontStyle
layoutlr_axes_title_styles = forall (p :: * -> * -> *) (q :: * -> * -> *) (f :: * -> *) a b s t.
(Profunctor p, Profunctor q, Settable f) =>
(p a b -> q s t) -> Optical p q f s t a b
sets forall a b. (a -> b) -> a -> b
$ \FontStyle -> FontStyle
af ->
    (forall x y1 y2. Lens' (LayoutLR x y1 y2) (LayoutAxis x)
layoutlr_x_axis forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x. Lens' (LayoutAxis x) FontStyle
laxis_title_style forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ FontStyle -> FontStyle
af) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    (forall x y1 y2. Lens' (LayoutLR x y1 y2) (LayoutAxis y1)
layoutlr_left_axis forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x. Lens' (LayoutAxis x) FontStyle
laxis_title_style forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ FontStyle -> FontStyle
af) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    (forall x y1 y2. Lens' (LayoutLR x y1 y2) (LayoutAxis y2)
layoutlr_right_axis forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x. Lens' (LayoutAxis x) FontStyle
laxis_title_style forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ FontStyle -> FontStyle
af)

-- | Setter to update all the font styles on a `LayoutLR`
layoutlr_all_font_styles :: Setter' (LayoutLR x y1 y2) FontStyle
layoutlr_all_font_styles :: forall x y1 y2. Setter' (LayoutLR x y1 y2) FontStyle
layoutlr_all_font_styles = forall (p :: * -> * -> *) (q :: * -> * -> *) (f :: * -> *) a b s t.
(Profunctor p, Profunctor q, Settable f) =>
(p a b -> q s t) -> Optical p q f s t a b
sets forall a b. (a -> b) -> a -> b
$ \FontStyle -> FontStyle
af ->
    (forall x y1 y2. Setter' (LayoutLR x y1 y2) FontStyle
layoutlr_axes_title_styles forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ FontStyle -> FontStyle
af) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    (forall x y1 y2. Lens' (LayoutLR x y1 y2) (LayoutAxis x)
layoutlr_x_axis forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x. Lens' (LayoutAxis x) AxisStyle
laxis_style forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' AxisStyle FontStyle
axis_label_style forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ FontStyle -> FontStyle
af) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    (forall x y1 y2. Lens' (LayoutLR x y1 y2) (LayoutAxis y1)
layoutlr_left_axis forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x. Lens' (LayoutAxis x) AxisStyle
laxis_style forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' AxisStyle FontStyle
axis_label_style forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ FontStyle -> FontStyle
af) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    (forall x y1 y2. Lens' (LayoutLR x y1 y2) (LayoutAxis y2)
layoutlr_right_axis forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x. Lens' (LayoutAxis x) AxisStyle
laxis_style forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' AxisStyle FontStyle
axis_label_style forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ FontStyle -> FontStyle
af) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    (forall x y1 y2. Lens' (LayoutLR x y1 y2) (Maybe LegendStyle)
layoutlr_legend forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' LegendStyle FontStyle
legend_label_style forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ FontStyle -> FontStyle
af) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    (forall x y1 y2. Lens' (LayoutLR x y1 y2) FontStyle
layoutlr_title_style forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ FontStyle -> FontStyle
af)

-- | Setter to update the foreground color of core chart elements on a `LayoutLR`
layoutlr_foreground ::  Setter' (LayoutLR x y1 y2) (AlphaColour Double)
layoutlr_foreground :: forall x y1 y2. Setter' (LayoutLR x y1 y2) (AlphaColour Double)
layoutlr_foreground = forall (p :: * -> * -> *) (q :: * -> * -> *) (f :: * -> *) a b s t.
(Profunctor p, Profunctor q, Settable f) =>
(p a b -> q s t) -> Optical p q f s t a b
sets forall a b. (a -> b) -> a -> b
$ \AlphaColour Double -> AlphaColour Double
af ->
    (forall x y1 y2. Setter' (LayoutLR x y1 y2) FontStyle
layoutlr_all_font_styles forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FontStyle (AlphaColour Double)
font_color forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ AlphaColour Double -> AlphaColour Double
af) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    (forall x y1 y2. Setter' (LayoutLR x y1 y2) AxisStyle
layoutlr_axes_styles forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' AxisStyle LineStyle
axis_line_style forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' LineStyle (AlphaColour Double)
line_color forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ AlphaColour Double -> AlphaColour Double
af)