{-# LANGUAGE CPP #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE ExistentialQuantification #-}
module Graphics.Rendering.Chart.Layout
(
Layout(..)
, LayoutLR(..)
, LayoutAxis(..)
, LayoutPick(..)
, StackedLayouts(..)
, StackedLayout(..)
, MAxisFn
, layoutToRenderable
, layoutToGrid
, layoutLRToRenderable
, layoutLRToGrid
, renderStackedLayouts
, laxis_title_style
, laxis_title
, laxis_style
, laxis_generate
, laxis_override
, laxis_reverse
, 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_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
, 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
type MAxisFn t = [t] -> Maybe (AxisData t)
data LayoutAxis x = LayoutAxis
{ forall x. LayoutAxis x -> FontStyle
_laxis_title_style :: FontStyle
, forall x. LayoutAxis x -> String
_laxis_title :: String
, forall x. LayoutAxis x -> AxisStyle
_laxis_style :: AxisStyle
, forall x. LayoutAxis x -> AxisFn x
_laxis_generate :: AxisFn x
, forall x. LayoutAxis x -> AxisData x -> AxisData x
_laxis_override :: AxisData x -> AxisData x
, forall x. LayoutAxis x -> Bool
_laxis_reverse :: Bool
}
data LayoutPick x y1 y2 = LayoutPick_Legend String
| LayoutPick_Title String
| LayoutPick_XTopAxisTitle String
| LayoutPick_XBottomAxisTitle String
| LayoutPick_YLeftAxisTitle String
| LayoutPick_YRightAxisTitle String
| LayoutPick_PlotArea x y1 y2
| LayoutPick_XTopAxis x
| LayoutPick_XBottomAxis x
| LayoutPick_YLeftAxis y1
| LayoutPick_YRightAxis y2
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 ())
data Layout x y = Layout
{ forall x y. Layout x y -> FillStyle
_layout_background :: FillStyle
, forall x y. Layout x y -> Maybe FillStyle
_layout_plot_background :: Maybe FillStyle
, forall x y. Layout x y -> String
_layout_title :: String
, forall x y. Layout x y -> FontStyle
_layout_title_style :: FontStyle
, forall x y. Layout x y -> LayoutAxis x
_layout_x_axis :: LayoutAxis x
, forall x y. Layout x y -> AxisVisibility
_layout_top_axis_visibility :: AxisVisibility
, forall x y. Layout x y -> AxisVisibility
_layout_bottom_axis_visibility :: AxisVisibility
, forall x y. Layout x y -> LayoutAxis y
_layout_y_axis :: LayoutAxis y
, forall x y. Layout x y -> AxisVisibility
_layout_left_axis_visibility :: AxisVisibility
, forall x y. Layout x y -> AxisVisibility
_layout_right_axis_visibility :: AxisVisibility
, forall x y. Layout x y -> [Plot x y]
_layout_plots :: [Plot x y]
, forall x y. Layout x y -> Maybe LegendStyle
_layout_legend :: Maybe LegendStyle
, forall x y. Layout x y -> Double
_layout_margin :: Double
, forall x y. Layout x y -> Bool
_layout_grid_last :: Bool
}
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
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)
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 ]
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 ]
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
}
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
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)
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
}
data LayoutLR x y1 y2 = LayoutLR
{ forall x y1 y2. LayoutLR x y1 y2 -> FillStyle
_layoutlr_background :: FillStyle
, forall x y1 y2. LayoutLR x y1 y2 -> Maybe FillStyle
_layoutlr_plot_background :: Maybe FillStyle
, forall x y1 y2. LayoutLR x y1 y2 -> String
_layoutlr_title :: String
, forall x y1 y2. LayoutLR x y1 y2 -> FontStyle
_layoutlr_title_style :: FontStyle
, forall x y1 y2. LayoutLR x y1 y2 -> LayoutAxis x
_layoutlr_x_axis :: LayoutAxis x
, forall x y1 y2. LayoutLR x y1 y2 -> AxisVisibility
_layoutlr_top_axis_visibility :: AxisVisibility
, forall x y1 y2. LayoutLR x y1 y2 -> AxisVisibility
_layoutlr_bottom_axis_visibility :: AxisVisibility
, forall x y1 y2. LayoutLR x y1 y2 -> LayoutAxis y1
_layoutlr_left_axis :: LayoutAxis y1
, forall x y1 y2. LayoutLR x y1 y2 -> AxisVisibility
_layoutlr_left_axis_visibility :: AxisVisibility
, forall x y1 y2. LayoutLR x y1 y2 -> LayoutAxis y2
_layoutlr_right_axis :: LayoutAxis y2
, forall x y1 y2. LayoutLR x y1 y2 -> AxisVisibility
_layoutlr_right_axis_visibility :: AxisVisibility
, forall x y1 y2.
LayoutLR x y1 y2 -> [Either (Plot x y1) (Plot x y2)]
_layoutlr_plots :: [Either (Plot x y1) (Plot x y2)]
, forall x y1 y2. LayoutLR x y1 y2 -> Maybe LegendStyle
_layoutlr_legend :: Maybe LegendStyle
, forall x y1 y2. LayoutLR x y1 y2 -> Double
_layoutlr_margin :: Double
, forall x y1 y2. LayoutLR x y1 y2 -> Bool
_layoutlr_grid_last :: Bool
}
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
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
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 ]
)
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 ]
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
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)
data StackedLayout x = forall y . (Ord y) => StackedLayout (Layout x y)
| forall yl yr . (Ord yl, Ord yr) => StackedLayoutLR (LayoutLR x yl yr)
data StackedLayouts x = StackedLayouts
{ forall x. StackedLayouts x -> [StackedLayout x]
_slayouts_layouts :: [StackedLayout x]
, forall x. StackedLayouts x -> Bool
_slayouts_compress_legend :: Bool
}
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
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
(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)
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
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)
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)
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))
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
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
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
}
$( makeLenses ''Layout )
$( makeLenses ''LayoutLR )
$( makeLenses ''LayoutAxis )
$( makeLenses ''StackedLayouts )
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)
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)
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)
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)
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)
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)
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)
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)