{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}

-- | Examples of chart construction.
module Chart.Examples
  ( -- * Unit & Hud
    unitExample,
    hudOptionsExample,

    -- * Iconic primitives.
    lineExample,
    rectExample,
    textExample,
    glyphsExample,
    pathExample,

    -- * Compounds
    barExample,
    barDataExample,
    sbarExample,
    waveExample,
    surfaceExample,
    rosenbrock,
    arcFlagsExample,
    ellipseExample,
    quadExample,
    cubicExample,
    vennExample,
    arrowExample,
    dateExample,

    -- * Colour
    gradientExample,
    wheelExample,

    -- * Debugging
    debugExample,

    -- * Compound Charts
    compoundExample,
    stackExample,

    -- * Priority
    priorityv1Example,
    priorityv2Example,

    -- * Writing to file
    pathChartOptions,
    writeAllExamples,
    writeAllExamplesDark,
  )
where

import Chart
import Data.Bifunctor
import Data.Bool
import Data.ByteString (ByteString)
import Data.Function
import Data.Maybe
import Data.String.Interpolate
import Data.Text (Text)
import Data.Text qualified as Text
import Data.Time
import NumHask.Space
import Optics.Core
import Prelude hiding (abs)

-- | unit example
--
-- ![unit example](other/unit.svg)
unitExample :: ChartOptions
unitExample :: ChartOptions
unitExample =
  ChartOptions
forall a. Monoid a => a
mempty
    ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx ChartOptions ChartOptions ChartTree ChartTree
-> ChartTree -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx ChartOptions ChartOptions ChartTree ChartTree
#chartTree (Text -> [Chart] -> ChartTree
named Text
"unit" [Style -> ChartData -> Chart
Chart Style
defaultRectStyle ([Rect Double] -> ChartData
RectData [Rect Double
forall a. Multiplicative a => a
one])])
    ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
-> HudOptions -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
#hudOptions HudOptions
defaultHudOptions

-- | A 'BlankChart', 'defaultHudOptions' example.
--
-- ![hudoptions example](other/hudoptions.svg)
hudOptionsExample :: ChartOptions
hudOptionsExample :: ChartOptions
hudOptionsExample =
  ChartOptions
forall a. Monoid a => a
mempty
    ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
-> HudOptions -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
#hudOptions HudOptions
defaultHudOptions
    ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx ChartOptions ChartOptions ChartTree ChartTree
-> ChartTree -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx ChartOptions ChartOptions ChartTree ChartTree
#chartTree (Rect Double -> ChartTree
blank Rect Double
forall a. Multiplicative a => a
one)

-- | rect example
--
-- ![rect example](other/rect.svg)
rectExample :: ChartOptions
rectExample :: ChartOptions
rectExample =
  ChartOptions
forall a. Monoid a => a
mempty
    ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
-> HudOptions -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
#hudOptions (HudOptions
forall a. Monoid a => a
mempty HudOptions -> (HudOptions -> HudOptions) -> HudOptions
forall a b. a -> (a -> b) -> b
& Optic
  A_Lens
  NoIx
  HudOptions
  HudOptions
  [Priority AxisOptions]
  [Priority AxisOptions]
-> [Priority AxisOptions] -> HudOptions -> HudOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic
  A_Lens
  NoIx
  HudOptions
  HudOptions
  [Priority AxisOptions]
  [Priority AxisOptions]
#axes [Double -> AxisOptions -> Priority AxisOptions
forall a. Double -> a -> Priority a
Priority Double
5 (AxisOptions
defaultXAxisOptions AxisOptions -> (AxisOptions -> AxisOptions) -> AxisOptions
forall a b. a -> (a -> b) -> b
& Optic
  A_Lens
  NoIx
  AxisOptions
  AxisOptions
  (Maybe TickStyle)
  (Maybe TickStyle)
-> Maybe TickStyle -> AxisOptions -> AxisOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
#ticks Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
-> Optic
     A_Lens NoIx Ticks Ticks (Maybe TickStyle) (Maybe TickStyle)
-> Optic
     A_Lens
     NoIx
     AxisOptions
     AxisOptions
     (Maybe TickStyle)
     (Maybe TickStyle)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Ticks Ticks (Maybe TickStyle) (Maybe TickStyle)
#lineTick) Maybe TickStyle
forall a. Maybe a
Nothing)])
    ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx ChartOptions ChartOptions ChartTree ChartTree
-> ChartTree -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx ChartOptions ChartOptions ChartTree ChartTree
#chartTree (Text -> [Chart] -> ChartTree
named Text
"rect" ((Style -> [Rect Double] -> Chart)
-> [Style] -> [[Rect Double]] -> [Chart]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Style
s [Rect Double]
x -> Style -> ChartData -> Chart
Chart Style
s ([Rect Double] -> ChartData
RectData [Rect Double]
x)) [Style]
ropts [[Rect Double]]
rss))

rss :: [[Rect Double]]
rss :: [[Rect Double]]
rss =
  [ (Double -> Double) -> Range Double -> Int -> [Rect Double]
forall a.
(Field a, FromIntegral a Int, Ord a) =>
(a -> a) -> Range a -> Int -> [Rect a]
gridR (\Double
x -> Double -> Double
forall a. Floating a => a -> a
exp (-(Double
x Double -> Double -> Double
forall a. Floating a => a -> a -> a
** Double
2 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2))) (Double -> Double -> Range Double
forall a. a -> a -> Range a
Range (-Double
5) Double
5) Int
50,
    (Double -> Double) -> Range Double -> Int -> [Rect Double]
forall a.
(Field a, FromIntegral a Int, Ord a) =>
(a -> a) -> Range a -> Int -> [Rect a]
gridR (\Double
x -> Double
0.5 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double
forall a. Floating a => a -> a
exp (-(Double
x Double -> Double -> Double
forall a. Floating a => a -> a -> a
** Double
2 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
8))) (Double -> Double -> Range Double
forall a. a -> a -> Range a
Range (-Double
5) Double
5) Int
50
  ]

ropts :: [Style]
ropts :: [Style]
ropts =
  [ Colour -> Style
blob (Int -> Double -> Colour
paletteO Int
1 Double
0.4),
    Colour -> Style
blob (Int -> Double -> Colour
paletteO Int
2 Double
0.4)
  ]

-- | line example
--
-- ![line example](other/line.svg)
lineExample :: ChartOptions
lineExample :: ChartOptions
lineExample =
  ChartOptions
forall a. Monoid a => a
mempty ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
-> HudOptions -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
#hudOptions HudOptions
ho ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx ChartOptions ChartOptions ChartTree ChartTree
-> ChartTree -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx ChartOptions ChartOptions ChartTree ChartTree
#chartTree (Text -> [Chart] -> ChartTree
named Text
"line" [Chart]
cs)
  where
    ho :: HudOptions
ho =
      HudOptions
defaultHudOptions
        HudOptions -> (HudOptions -> HudOptions) -> HudOptions
forall a b. a -> (a -> b) -> b
& Optic
  A_Lens
  NoIx
  HudOptions
  HudOptions
  [Priority TitleOptions]
  [Priority TitleOptions]
-> [Priority TitleOptions] -> HudOptions -> HudOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set
          #titles
          [ Double -> TitleOptions -> Priority TitleOptions
forall a. Double -> a -> Priority a
Priority Double
6 (Text -> TitleOptions
defaultTitleOptions Text
"Line Chart" TitleOptions -> (TitleOptions -> TitleOptions) -> TitleOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx TitleOptions TitleOptions Double Double
-> Double -> TitleOptions -> TitleOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (Optic A_Lens NoIx TitleOptions TitleOptions Style Style
#style Optic A_Lens NoIx TitleOptions TitleOptions Style Style
-> Optic A_Lens NoIx Style Style Double Double
-> Optic A_Lens NoIx TitleOptions TitleOptions Double Double
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Style Style Double Double
#size) Double
0.08),
            Double -> TitleOptions -> Priority TitleOptions
forall a. Double -> a -> Priority a
Priority Double
13 (TitleOptions -> Priority TitleOptions)
-> TitleOptions -> Priority TitleOptions
forall a b. (a -> b) -> a -> b
$
              Text -> TitleOptions
defaultTitleOptions Text
"Made with 🧡 and chart-svg"
                TitleOptions -> (TitleOptions -> TitleOptions) -> TitleOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx TitleOptions TitleOptions Double Double
-> Double -> TitleOptions -> TitleOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (Optic A_Lens NoIx TitleOptions TitleOptions Style Style
#style Optic A_Lens NoIx TitleOptions TitleOptions Style Style
-> Optic A_Lens NoIx Style Style Double Double
-> Optic A_Lens NoIx TitleOptions TitleOptions Double Double
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Style Style Double Double
#size) Double
0.04
                TitleOptions -> (TitleOptions -> TitleOptions) -> TitleOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx TitleOptions TitleOptions Place Place
-> Place -> TitleOptions -> TitleOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx TitleOptions TitleOptions Place Place
#place Place
PlaceBottom
                TitleOptions -> (TitleOptions -> TitleOptions) -> TitleOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx TitleOptions TitleOptions Double Double
-> Double -> TitleOptions -> TitleOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx TitleOptions TitleOptions Double Double
#anchoring Double
0.5
          ]
        HudOptions -> (HudOptions -> HudOptions) -> HudOptions
forall a b. a -> (a -> b) -> b
& Optic
  A_Lens
  NoIx
  HudOptions
  HudOptions
  [Priority LegendOptions]
  [Priority LegendOptions]
-> [Priority LegendOptions] -> HudOptions -> HudOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set
          #legends
          [ Double -> LegendOptions -> Priority LegendOptions
forall a. Double -> a -> Priority a
Priority Double
12 (LegendOptions -> Priority LegendOptions)
-> LegendOptions -> Priority LegendOptions
forall a b. (a -> b) -> a -> b
$
              LegendOptions
defaultLegendOptions
                LegendOptions -> (LegendOptions -> LegendOptions) -> LegendOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx LegendOptions LegendOptions ScaleP ScaleP
-> ScaleP -> LegendOptions -> LegendOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx LegendOptions LegendOptions ScaleP ScaleP
#scaleP ScaleP
ScalePX
                LegendOptions -> (LegendOptions -> LegendOptions) -> LegendOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx LegendOptions LegendOptions Place Place
-> Place -> LegendOptions -> LegendOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx LegendOptions LegendOptions Place Place
#place (Point Double -> Place
PlaceAbsolute (Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
0.35 (-Double
0.35)))
                LegendOptions -> (LegendOptions -> LegendOptions) -> LegendOptions
forall a b. a -> (a -> b) -> b
& Optic
  A_Lens
  NoIx
  LegendOptions
  LegendOptions
  [(Text, [Chart])]
  [(Text, [Chart])]
-> [(Text, [Chart])] -> LegendOptions -> LegendOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic
  A_Lens
  NoIx
  LegendOptions
  LegendOptions
  [(Text, [Chart])]
  [(Text, [Chart])]
#legendCharts ((Text -> Chart -> (Text, [Chart]))
-> [Text] -> [Chart] -> [(Text, [Chart])]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Text
t Chart
c -> (Text
t, [Chart
c])) [Text
"palette #0", Text
"palette #1", Text
"palette #2"] [Chart]
cs)
          ]
    cs :: [Chart]
cs =
      (Int -> [Point Double] -> Chart)
-> [Int] -> [[Point Double]] -> [Chart]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith
        ( \Int
c [Point Double]
l ->
            Style -> [[Point Double]] -> Chart
LineChart
              ( Style
defaultLineStyle
                  Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Colour Colour
-> Colour -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Colour Colour
#color (Int -> Colour
palette Int
c)
                  Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Double Double
-> Double -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Double Double
#size Double
0.015
              )
              [[Point Double]
l]
        )
        [Int
0 ..]
        [[Point Double]]
ls
    ls :: [[Point Double]]
ls =
      [ [Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
0.0 Double
1.0, Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
1.0 Double
1.0, Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
2.0 Double
5.0],
        [Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
0.0 Double
0.0, Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
2.8 Double
3.0],
        [Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
0.5 Double
4.0, Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
0.5 Double
0]
      ]

-- | priority Version 1 example
--
-- ![priorityv1 example](other/priorityv1.svg)
priorityv1Example :: ChartOptions
priorityv1Example :: ChartOptions
priorityv1Example =
  ChartOptions
lineExample
    ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic
  A_Lens
  NoIx
  ChartOptions
  ChartOptions
  [Priority FrameOptions]
  [Priority FrameOptions]
-> [Priority FrameOptions] -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set
      (Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
#hudOptions Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
-> Optic
     A_Lens
     NoIx
     HudOptions
     HudOptions
     [Priority FrameOptions]
     [Priority FrameOptions]
-> Optic
     A_Lens
     NoIx
     ChartOptions
     ChartOptions
     [Priority FrameOptions]
     [Priority FrameOptions]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  NoIx
  HudOptions
  HudOptions
  [Priority FrameOptions]
  [Priority FrameOptions]
#frames)
      [ Double -> FrameOptions -> Priority FrameOptions
forall a. Double -> a -> Priority a
Priority Double
1 (Maybe Style -> HudChartSection -> Double -> FrameOptions
FrameOptions (Style -> Maybe Style
forall a. a -> Maybe a
Just Style
defaultRectStyle) HudChartSection
CanvasStyleSection Double
0),
        Double -> FrameOptions -> Priority FrameOptions
forall a. Double -> a -> Priority a
Priority Double
100 (Maybe Style -> HudChartSection -> Double -> FrameOptions
FrameOptions (Style -> Maybe Style
forall a. a -> Maybe a
Just (Style
defaultRectStyle Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Colour Colour
-> Colour -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Colour Colour
#color (Int -> Colour
palette Int
4 Colour -> (Colour -> Colour) -> Colour
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Colour Colour Double Double
-> Double -> Colour -> Colour
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Colour Colour Double Double
opac' Double
0.05) Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Colour Colour
-> Colour -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Colour Colour
#borderColor (Int -> Colour
palette Int
4))) HudChartSection
HudStyleSection Double
0.1)
      ]
    ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic
  A_Traversal (Int : NoIx) ChartOptions ChartOptions Double Double
-> Double -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
#hudOptions Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
-> Optic
     A_Lens
     NoIx
     HudOptions
     HudOptions
     [Priority LegendOptions]
     [Priority LegendOptions]
-> Optic
     A_Lens
     NoIx
     ChartOptions
     ChartOptions
     [Priority LegendOptions]
     [Priority LegendOptions]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  NoIx
  HudOptions
  HudOptions
  [Priority LegendOptions]
  [Priority LegendOptions]
#legends Optic
  A_Lens
  NoIx
  ChartOptions
  ChartOptions
  [Priority LegendOptions]
  [Priority LegendOptions]
-> Optic
     A_Traversal
     (Int : NoIx)
     [Priority LegendOptions]
     [Priority LegendOptions]
     (Priority LegendOptions)
     (Priority LegendOptions)
-> Optic
     A_Traversal
     (Int : NoIx)
     ChartOptions
     ChartOptions
     (Priority LegendOptions)
     (Priority LegendOptions)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Traversal
  (Int : NoIx)
  [Priority LegendOptions]
  [Priority LegendOptions]
  (Priority LegendOptions)
  (Priority LegendOptions)
forall i s t a b. Each i s t a b => IxTraversal i s t a b
each Optic
  A_Traversal
  (Int : NoIx)
  ChartOptions
  ChartOptions
  (Priority LegendOptions)
  (Priority LegendOptions)
-> Optic
     A_Lens
     NoIx
     (Priority LegendOptions)
     (Priority LegendOptions)
     Double
     Double
-> Optic
     A_Traversal (Int : NoIx) ChartOptions ChartOptions Double Double
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  NoIx
  (Priority LegendOptions)
  (Priority LegendOptions)
  Double
  Double
#priority) Double
50
    ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic
  A_Traversal (Int : NoIx) ChartOptions ChartOptions Place Place
-> Place -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
#hudOptions Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
-> Optic
     A_Lens
     NoIx
     HudOptions
     HudOptions
     [Priority LegendOptions]
     [Priority LegendOptions]
-> Optic
     A_Lens
     NoIx
     ChartOptions
     ChartOptions
     [Priority LegendOptions]
     [Priority LegendOptions]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  NoIx
  HudOptions
  HudOptions
  [Priority LegendOptions]
  [Priority LegendOptions]
#legends Optic
  A_Lens
  NoIx
  ChartOptions
  ChartOptions
  [Priority LegendOptions]
  [Priority LegendOptions]
-> Optic
     A_Traversal
     (Int : NoIx)
     [Priority LegendOptions]
     [Priority LegendOptions]
     (Priority LegendOptions)
     (Priority LegendOptions)
-> Optic
     A_Traversal
     (Int : NoIx)
     ChartOptions
     ChartOptions
     (Priority LegendOptions)
     (Priority LegendOptions)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Traversal
  (Int : NoIx)
  [Priority LegendOptions]
  [Priority LegendOptions]
  (Priority LegendOptions)
  (Priority LegendOptions)
forall i s t a b. Each i s t a b => IxTraversal i s t a b
each Optic
  A_Traversal
  (Int : NoIx)
  ChartOptions
  ChartOptions
  (Priority LegendOptions)
  (Priority LegendOptions)
-> Optic
     A_Lens
     NoIx
     (Priority LegendOptions)
     (Priority LegendOptions)
     LegendOptions
     LegendOptions
-> Optic
     A_Traversal
     (Int : NoIx)
     ChartOptions
     ChartOptions
     LegendOptions
     LegendOptions
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  NoIx
  (Priority LegendOptions)
  (Priority LegendOptions)
  LegendOptions
  LegendOptions
#item Optic
  A_Traversal
  (Int : NoIx)
  ChartOptions
  ChartOptions
  LegendOptions
  LegendOptions
-> Optic A_Lens NoIx LegendOptions LegendOptions Place Place
-> Optic
     A_Traversal (Int : NoIx) ChartOptions ChartOptions Place Place
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx LegendOptions LegendOptions Place Place
#place) Place
PlaceRight

-- | priority Version 2 example
--
-- ![priorityv2 example](other/priorityv2.svg)
priorityv2Example :: ChartOptions
priorityv2Example :: ChartOptions
priorityv2Example =
  ChartOptions
priorityv1Example
    ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic
  A_Traversal (Int : NoIx) ChartOptions ChartOptions Double Double
-> Double -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
#hudOptions Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
-> Optic
     A_Lens
     NoIx
     HudOptions
     HudOptions
     [Priority TitleOptions]
     [Priority TitleOptions]
-> Optic
     A_Lens
     NoIx
     ChartOptions
     ChartOptions
     [Priority TitleOptions]
     [Priority TitleOptions]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  NoIx
  HudOptions
  HudOptions
  [Priority TitleOptions]
  [Priority TitleOptions]
#titles Optic
  A_Lens
  NoIx
  ChartOptions
  ChartOptions
  [Priority TitleOptions]
  [Priority TitleOptions]
-> Optic
     A_Traversal
     (Int : NoIx)
     [Priority TitleOptions]
     [Priority TitleOptions]
     (Priority TitleOptions)
     (Priority TitleOptions)
-> Optic
     A_Traversal
     (Int : NoIx)
     ChartOptions
     ChartOptions
     (Priority TitleOptions)
     (Priority TitleOptions)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Traversal
  (Int : NoIx)
  [Priority TitleOptions]
  [Priority TitleOptions]
  (Priority TitleOptions)
  (Priority TitleOptions)
forall i s t a b. Each i s t a b => IxTraversal i s t a b
each Optic
  A_Traversal
  (Int : NoIx)
  ChartOptions
  ChartOptions
  (Priority TitleOptions)
  (Priority TitleOptions)
-> Optic
     A_Lens
     NoIx
     (Priority TitleOptions)
     (Priority TitleOptions)
     Double
     Double
-> Optic
     A_Traversal (Int : NoIx) ChartOptions ChartOptions Double Double
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  NoIx
  (Priority TitleOptions)
  (Priority TitleOptions)
  Double
  Double
#priority) Double
51

-- | text example
--
-- ![text example](other/text.svg)
textExample :: ChartOptions
textExample :: ChartOptions
textExample =
  ChartOptions
forall a. Monoid a => a
mempty
    ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx ChartOptions ChartOptions ChartTree ChartTree
-> ChartTree -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx ChartOptions ChartOptions ChartTree ChartTree
#chartTree (Text -> [Chart] -> ChartTree
named Text
"text" [Style -> [(Text, Point Double)] -> Chart
TextChart (Style
defaultTextStyle Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Colour Colour
-> Colour -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Colour Colour
#color Colour
dark Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Double Double
-> Double -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Double Double
#size Double
0.1) [(Text, Point Double)]
ts])
    ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
-> HudOptions -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
#hudOptions HudOptions
defaultHudOptions
    ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic
  A_Lens
  NoIx
  ChartOptions
  ChartOptions
  PreferColorScheme
  PreferColorScheme
-> PreferColorScheme -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (Optic
  A_Lens NoIx ChartOptions ChartOptions MarkupOptions MarkupOptions
#markupOptions Optic
  A_Lens NoIx ChartOptions ChartOptions MarkupOptions MarkupOptions
-> Optic
     A_Lens NoIx MarkupOptions MarkupOptions CssOptions CssOptions
-> Optic
     A_Lens NoIx ChartOptions ChartOptions CssOptions CssOptions
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx MarkupOptions MarkupOptions CssOptions CssOptions
#cssOptions Optic A_Lens NoIx ChartOptions ChartOptions CssOptions CssOptions
-> Optic
     A_Lens
     NoIx
     CssOptions
     CssOptions
     PreferColorScheme
     PreferColorScheme
-> Optic
     A_Lens
     NoIx
     ChartOptions
     ChartOptions
     PreferColorScheme
     PreferColorScheme
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  NoIx
  CssOptions
  CssOptions
  PreferColorScheme
  PreferColorScheme
#preferColorScheme) PreferColorScheme
PreferHud
    ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx ChartOptions ChartOptions ByteString ByteString
-> ByteString -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (Optic
  A_Lens NoIx ChartOptions ChartOptions MarkupOptions MarkupOptions
#markupOptions Optic
  A_Lens NoIx ChartOptions ChartOptions MarkupOptions MarkupOptions
-> Optic
     A_Lens NoIx MarkupOptions MarkupOptions CssOptions CssOptions
-> Optic
     A_Lens NoIx ChartOptions ChartOptions CssOptions CssOptions
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx MarkupOptions MarkupOptions CssOptions CssOptions
#cssOptions Optic A_Lens NoIx ChartOptions ChartOptions CssOptions CssOptions
-> Optic A_Lens NoIx CssOptions CssOptions ByteString ByteString
-> Optic
     A_Lens NoIx ChartOptions ChartOptions ByteString ByteString
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx CssOptions CssOptions ByteString ByteString
#cssExtra) ((Colour, Colour) -> ByteString -> ByteString -> ByteString
fillSwitch (Colour
dark, Colour
light) ByteString
"dark" ByteString
"text")
  where
    ts :: [(Text, Point Double)]
    ts :: [(Text, Point Double)]
ts =
      [Text] -> [Point Double] -> [(Text, Point Double)]
forall a b. [a] -> [b] -> [(a, b)]
zip
        ((Char -> Text) -> FilePath -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Text
Text.singleton [Char
'a' .. Char
'z'])
        ((\Double
x -> Double -> Double -> Point Double
forall a. a -> a -> Point a
Point (Double -> Double
forall a. Floating a => a -> a
sin (Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
0.1)) Double
x) (Double -> Point Double) -> [Double] -> [Point Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Double
0 .. Double
25])

-- | glyphs example
--
-- ![glyphs example](other/glyphs.svg)
glyphsExample :: ChartOptions
glyphsExample :: ChartOptions
glyphsExample =
  ChartOptions
forall a. Monoid a => a
mempty
    ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic
  A_Lens NoIx ChartOptions ChartOptions (Maybe Double) (Maybe Double)
-> Maybe Double -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (Optic
  A_Lens NoIx ChartOptions ChartOptions MarkupOptions MarkupOptions
#markupOptions Optic
  A_Lens NoIx ChartOptions ChartOptions MarkupOptions MarkupOptions
-> Optic
     A_Lens
     NoIx
     MarkupOptions
     MarkupOptions
     (Maybe Double)
     (Maybe Double)
-> Optic
     A_Lens NoIx ChartOptions ChartOptions (Maybe Double) (Maybe Double)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  NoIx
  MarkupOptions
  MarkupOptions
  (Maybe Double)
  (Maybe Double)
#markupHeight) (Double -> Maybe Double
forall a. a -> Maybe a
Just Double
50)
    ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx ChartOptions ChartOptions ChartAspect ChartAspect
-> ChartAspect -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (Optic
  A_Lens NoIx ChartOptions ChartOptions MarkupOptions MarkupOptions
#markupOptions Optic
  A_Lens NoIx ChartOptions ChartOptions MarkupOptions MarkupOptions
-> Optic
     A_Lens NoIx MarkupOptions MarkupOptions ChartAspect ChartAspect
-> Optic
     A_Lens NoIx ChartOptions ChartOptions ChartAspect ChartAspect
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens NoIx MarkupOptions MarkupOptions ChartAspect ChartAspect
#chartAspect) (Double -> ChartAspect
FixedAspect Double
12)
    ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx ChartOptions ChartOptions ChartTree ChartTree
-> ChartTree -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set
      #chartTree
      ( Text -> [Chart] -> ChartTree
named Text
"glyphs" ([Chart] -> ChartTree) -> [Chart] -> ChartTree
forall a b. (a -> b) -> a -> b
$
          ((GlyphShape, Double) -> Point Double -> Chart)
-> [(GlyphShape, Double)] -> [Point Double] -> [Chart]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith
            ( \(GlyphShape
sh, Double
bs) Point Double
p ->
                Style -> [Point Double] -> Chart
GlyphChart
                  ( Style
defaultGlyphStyle
                      Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style GlyphShape GlyphShape
-> GlyphShape -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style GlyphShape GlyphShape
#glyphShape GlyphShape
sh
                      Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Double Double
-> Double -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Double Double
#size (Double
0.8 :: Double)
                      Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Double Double
-> Double -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Double Double
#borderSize Double
bs
                  )
                  [Point Double
p]
            )
            [ (GlyphShape
CircleGlyph, Double
0.02 :: Double),
              (GlyphShape
SquareGlyph, Double
0.02),
              (Double -> GlyphShape
RectSharpGlyph Double
0.75, Double
0.02),
              (Double -> Double -> Double -> GlyphShape
RectRoundedGlyph Double
0.75 Double
0.01 Double
0.01, Double
0.02),
              (Double -> GlyphShape
EllipseGlyph Double
0.75, Double
0.02),
              (GlyphShape
VLineGlyph, Double
0.02),
              (GlyphShape
HLineGlyph, Double
0.02),
              (Point Double -> Point Double -> Point Double -> GlyphShape
TriangleGlyph (Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
0.0 (Double
0.5 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double
forall a. Floating a => a -> a
sqrt Double
2)) (Double -> Double -> Point Double
forall a. a -> a -> Point a
Point (-(Double -> Double
forall a. Floating a => a -> a
cos (Double
forall a. Floating a => a
pi Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
3))) (-(Double -> Double
forall a. Floating a => a -> a
sin (Double
forall a. Floating a => a
pi Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
3) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2))) (Double -> Double -> Point Double
forall a. a -> a -> Point a
Point (Double -> Double
forall a. Floating a => a -> a
cos (Double
forall a. Floating a => a
pi Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
3)) (-(Double -> Double
forall a. Floating a => a -> a
sin (Double
forall a. Floating a => a
pi Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
3) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2))), Double
0.02),
              (ByteString -> GlyphShape
PathGlyph ByteString
"M 0.5,-0.3660 A 1.0 1.0 -0.0 0 1 0,0.5 A 1.0 1.0 -0.0 0 1 -0.5,-0.3660 A 1.0 1.0 -0.0 0 1 0.5,-0.3660 L 0.5,-0.3660 Z", Double
0.02)
            ]
            ((Double -> Point Double) -> [Double] -> [Point Double]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Double
x -> Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
x Double
0) [Double
0 ..])
      )

-- | Example data for Bar chart
barDataExample :: BarData
barDataExample :: BarData
barDataExample =
  [[Double]] -> [Text] -> [Text] -> BarData
BarData
    [[Double
1, Double
2, Double
3, Double
5, Double
8, Double
0, -Double
2, Double
11, Double
2, Double
1], [Double
1 .. Double
10]]
    ((Text
"row " <>) (Text -> Text) -> (Int -> Text) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
Text.pack (FilePath -> Text) -> (Int -> FilePath) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> FilePath
forall a. Show a => a -> FilePath
show (Int -> Text) -> [Int] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int
1 .. Int
11 :: Int])
    ((Text
"column " <>) (Text -> Text) -> (Int -> Text) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
Text.pack (FilePath -> Text) -> (Int -> FilePath) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> FilePath
forall a. Show a => a -> FilePath
show (Int -> Text) -> [Int] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int
1 .. Int
2 :: Int])

-- | Bar chart example.
--
-- ![bar example](other/bar.svg)
barExample :: ChartOptions
barExample :: ChartOptions
barExample =
  BarOptions -> BarData -> ChartOptions
barChart BarOptions
defaultBarOptions BarData
barDataExample
    ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic
  A_Lens
  NoIx
  ChartOptions
  ChartOptions
  [Priority FrameOptions]
  [Priority FrameOptions]
-> [Priority FrameOptions] -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
#hudOptions Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
-> Optic
     A_Lens
     NoIx
     HudOptions
     HudOptions
     [Priority FrameOptions]
     [Priority FrameOptions]
-> Optic
     A_Lens
     NoIx
     ChartOptions
     ChartOptions
     [Priority FrameOptions]
     [Priority FrameOptions]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  NoIx
  HudOptions
  HudOptions
  [Priority FrameOptions]
  [Priority FrameOptions]
#frames) [Double -> FrameOptions -> Priority FrameOptions
forall a. Double -> a -> Priority a
Priority Double
101 (FrameOptions
defaultFrameOptions FrameOptions -> (FrameOptions -> FrameOptions) -> FrameOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx FrameOptions FrameOptions Double Double
-> Double -> FrameOptions -> FrameOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx FrameOptions FrameOptions Double Double
#buffer Double
0.02)]

-- | Stacked bar chart example.
--
-- ![sbar example](other/sbar.svg)
sbarExample :: ChartOptions
sbarExample :: ChartOptions
sbarExample = BarOptions -> BarData -> ChartOptions
barChart (BarOptions
defaultBarOptions BarOptions -> (BarOptions -> BarOptions) -> BarOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx BarOptions BarOptions Orientation Orientation
-> Orientation -> BarOptions -> BarOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx BarOptions BarOptions Orientation Orientation
#barOrientation Orientation
Vert BarOptions -> (BarOptions -> BarOptions) -> BarOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx BarOptions BarOptions Stacked Stacked
-> Stacked -> BarOptions -> BarOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx BarOptions BarOptions Stacked Stacked
#barStacked Stacked
Stacked BarOptions -> (BarOptions -> BarOptions) -> BarOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx BarOptions BarOptions Bool Bool
-> Bool -> BarOptions -> BarOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx BarOptions BarOptions Bool Bool
#displayValues Bool
False BarOptions -> (BarOptions -> BarOptions) -> BarOptions
forall a b. a -> (a -> b) -> b
& Optic A_Traversal (Int : NoIx) BarOptions BarOptions Double Double
-> Double -> BarOptions -> BarOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (Optic A_Lens NoIx BarOptions BarOptions [Style] [Style]
#barRectStyles Optic A_Lens NoIx BarOptions BarOptions [Style] [Style]
-> Optic A_Traversal (Int : NoIx) [Style] [Style] Style Style
-> Optic A_Traversal (Int : NoIx) BarOptions BarOptions Style Style
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Traversal (Int : NoIx) [Style] [Style] Style Style
forall i s t a b. Each i s t a b => IxTraversal i s t a b
each Optic A_Traversal (Int : NoIx) BarOptions BarOptions Style Style
-> Optic A_Lens NoIx Style Style Double Double
-> Optic
     A_Traversal (Int : NoIx) BarOptions BarOptions Double Double
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Style Style Double Double
#borderSize) Double
0) BarData
barDataExample

-- | wave example
--
-- ![wave example](other/wave.svg)
waveExample :: ChartOptions
waveExample :: ChartOptions
waveExample = ChartOptions
forall a. Monoid a => a
mempty ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx ChartOptions ChartOptions ChartTree ChartTree
-> ChartTree -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx ChartOptions ChartOptions ChartTree ChartTree
#chartTree (Text -> [Chart] -> ChartTree
named Text
"wave" [Style -> [Point Double] -> Chart
GlyphChart (Style
defaultGlyphStyle Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style GlyphShape GlyphShape
-> GlyphShape -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style GlyphShape GlyphShape
#glyphShape GlyphShape
SquareGlyph) ((Double -> Double)
-> Range Double -> Grid (Range Double) -> [Point Double]
forall a.
FieldSpace (Range a) =>
(a -> a) -> Range a -> Grid (Range a) -> [Point a]
gridP Double -> Double
forall a. Floating a => a -> a
sin (Double -> Double -> Range Double
forall a. a -> a -> Range a
Range Double
0 (Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
forall a. Floating a => a
pi)) Int
Grid (Range Double)
30)]) ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
-> HudOptions -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
#hudOptions HudOptions
defaultHudOptions

-- | venn diagram
--
-- ![venn diagram](other/venn.svg)
vennExample :: ChartOptions
vennExample :: ChartOptions
vennExample =
  ChartOptions
forall a. Monoid a => a
mempty
    ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx ChartOptions ChartOptions ChartTree ChartTree
-> ChartTree -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx ChartOptions ChartOptions ChartTree ChartTree
#chartTree (Text -> [Chart] -> ChartTree
named Text
"venn" ((Int -> [PathData Double] -> Chart)
-> [Int] -> [[PathData Double]] -> [Chart]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Int
c [PathData Double]
x -> Style -> [PathData Double] -> Chart
PathChart (Style
defaultPathStyle Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Double Double
-> Double -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Double Double
#borderSize Double
0.005 Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Colour Colour
-> Colour -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Colour Colour
#color (Int -> Double -> Colour
paletteO Int
c Double
0.2) Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Colour Colour
-> (Colour -> Colour) -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over Optic A_Lens NoIx Style Style Colour Colour
#borderColor (Optic A_Lens NoIx Colour Colour Double Double
-> Double -> Colour -> Colour
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Colour Colour Double Double
opac' Double
1)) [PathData Double]
x) [Int
0 ..] (ByteString -> [PathData Double]
svgToPathData (ByteString -> [PathData Double])
-> [ByteString] -> [[PathData Double]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ByteString]
vennSegs)))
    ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
-> HudOptions -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
#hudOptions HudOptions
defaultHudOptions
    ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx ChartOptions ChartOptions ChartAspect ChartAspect
-> ChartAspect -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (Optic
  A_Lens NoIx ChartOptions ChartOptions MarkupOptions MarkupOptions
#markupOptions Optic
  A_Lens NoIx ChartOptions ChartOptions MarkupOptions MarkupOptions
-> Optic
     A_Lens NoIx MarkupOptions MarkupOptions ChartAspect ChartAspect
-> Optic
     A_Lens NoIx ChartOptions ChartOptions ChartAspect ChartAspect
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens NoIx MarkupOptions MarkupOptions ChartAspect ChartAspect
#chartAspect) (Double -> ChartAspect
FixedAspect Double
1)

{-
These were originally based on:

    [ ("origin", Point 0 0), -- origin
      ("circle1", Point 0.5 (-0.5 + cos (pi / 6))), -- center of circle 1
      ("circle2", Point 0 -0.5), -- center of circle 2
      ("circle3", Point -0.5 (-0.5 + cos (pi / 6))), -- center of circle 3
      ("corner1", Point 0 (-0.5 + 2 * cos (pi / 6))), -- corner 1
      ("corner2", Point 1 -0.5), -- corner 2
      ("corner3", Point -1 -0.5) -- corner 3
    ]
-}
vennSegs :: [ByteString]
vennSegs :: [ByteString]
vennSegs =
  [ ByteString
"M0.0,-1.2320508075688774 A0.5 0.5 0.0 1 1 1.0,0.5 1.0 1.0 0.0 0 0 0.5,-0.3660254037844387 1.0 1.0 0.0 0 0 0.0,-1.2320508075688774 Z",
    ByteString
"M-1.0,0.5 A0.5 0.5 0.0 1 0 1.0,0.5 1.0 1.0 0.0 0 1 0.0,0.5 1.0 1.0 0.0 0 1 -1.0,0.5 Z",
    ByteString
"M-1.0,0.5 A0.5 0.5 0.0 1 1 0.0,-1.2320508075688774 1.0 1.0 0.0 0 0 -0.5,-0.3660254037844387 1.0 1.0 0.0 0 0 -1.0,0.5 Z",
    ByteString
"M0.5,-0.3660254037844387 A1.0 1.0 0.0 0 1 1.0,0.5 1.0 1.0 0.0 0 1 0.0,0.5 1.0 1.0 0.0 0 0 0.5,-0.3660254037844387 Z",
    ByteString
"M0.0,0.5 A1.0 1.0 0.0 0 1 -1.0,0.5 1.0 1.0 0.0 0 1 -0.5,-0.3660254037844387 1.0 1.0 0.0 0 0 0.0,0.5 Z",
    ByteString
"M0.0,-1.2320508075688774 A1.0 1.0 0.0 0 1 0.5,-0.3660254037844387 1.0 1.0 0.0 0 0 -0.5,-0.3660254037844387 1.0 1.0 0.0 0 1 0.0,-1.2320508075688774 Z",
    ByteString
"M0.5,-0.3660254037844387 A1.0 1.0 0.0 0 1 0.0,0.5 1.0 1.0 0.0 0 1 -0.5,-0.3660254037844387 1.0 1.0 0.0 0 1 0.5,-0.3660254037844387 Z"
  ]

-- | Compound path example.
--
-- ![path test](other/path.svg)
pathExample :: ChartOptions
pathExample :: ChartOptions
pathExample =
  ChartOptions
forall a. Monoid a => a
mempty
    ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx ChartOptions ChartOptions ChartTree ChartTree
-> ChartTree -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx ChartOptions ChartOptions ChartTree ChartTree
#chartTree (Text -> [Chart] -> ChartTree
named Text
"path" [Chart
path', Chart
c0] ChartTree -> ChartTree -> ChartTree
forall a. Semigroup a => a -> a -> a
<> Text -> [Chart] -> ChartTree
named Text
"pathtext" [Chart
t0])
    ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
-> HudOptions -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
#hudOptions HudOptions
defaultHudOptions
    ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic
  A_Traversal
  (Int : NoIx)
  ChartOptions
  ChartOptions
  HudChartSection
  HudChartSection
-> HudChartSection -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
#hudOptions Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
-> Optic
     A_Lens
     NoIx
     HudOptions
     HudOptions
     [Priority AxisOptions]
     [Priority AxisOptions]
-> Optic
     A_Lens
     NoIx
     ChartOptions
     ChartOptions
     [Priority AxisOptions]
     [Priority AxisOptions]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  NoIx
  HudOptions
  HudOptions
  [Priority AxisOptions]
  [Priority AxisOptions]
#axes Optic
  A_Lens
  NoIx
  ChartOptions
  ChartOptions
  [Priority AxisOptions]
  [Priority AxisOptions]
-> Optic
     A_Traversal
     (Int : NoIx)
     [Priority AxisOptions]
     [Priority AxisOptions]
     (Priority AxisOptions)
     (Priority AxisOptions)
-> Optic
     A_Traversal
     (Int : NoIx)
     ChartOptions
     ChartOptions
     (Priority AxisOptions)
     (Priority AxisOptions)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Traversal
  (Int : NoIx)
  [Priority AxisOptions]
  [Priority AxisOptions]
  (Priority AxisOptions)
  (Priority AxisOptions)
forall i s t a b. Each i s t a b => IxTraversal i s t a b
each Optic
  A_Traversal
  (Int : NoIx)
  ChartOptions
  ChartOptions
  (Priority AxisOptions)
  (Priority AxisOptions)
-> Optic
     A_Lens
     NoIx
     (Priority AxisOptions)
     (Priority AxisOptions)
     AxisOptions
     AxisOptions
-> Optic
     A_Traversal
     (Int : NoIx)
     ChartOptions
     ChartOptions
     AxisOptions
     AxisOptions
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  NoIx
  (Priority AxisOptions)
  (Priority AxisOptions)
  AxisOptions
  AxisOptions
#item Optic
  A_Traversal
  (Int : NoIx)
  ChartOptions
  ChartOptions
  AxisOptions
  AxisOptions
-> Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
-> Optic
     A_Traversal (Int : NoIx) ChartOptions ChartOptions Ticks Ticks
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
#ticks Optic
  A_Traversal (Int : NoIx) ChartOptions ChartOptions Ticks Ticks
-> Optic
     A_Lens NoIx Ticks Ticks (Maybe TickStyle) (Maybe TickStyle)
-> Optic
     A_Traversal
     (Int : NoIx)
     ChartOptions
     ChartOptions
     (Maybe TickStyle)
     (Maybe TickStyle)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Ticks Ticks (Maybe TickStyle) (Maybe TickStyle)
#glyphTick Optic
  A_Traversal
  (Int : NoIx)
  ChartOptions
  ChartOptions
  (Maybe TickStyle)
  (Maybe TickStyle)
-> Optic
     A_Lens NoIx TickStyle TickStyle HudChartSection HudChartSection
-> Optic
     A_Traversal
     (Int : NoIx)
     ChartOptions
     ChartOptions
     HudChartSection
     HudChartSection
forall (is :: IxList) (js :: IxList) (ks :: IxList) k k' l m s t u
       v a b.
(AppendIndices is js ks, JoinKinds k A_Prism k',
 JoinKinds k' l m) =>
Optic k is s t (Maybe u) (Maybe v)
-> Optic l js u v a b -> Optic m ks s t a b
%? Optic
  A_Lens NoIx TickStyle TickStyle HudChartSection HudChartSection
#anchorTo) HudChartSection
CanvasStyleSection
    ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic
  A_Traversal
  (Int : NoIx)
  ChartOptions
  ChartOptions
  HudChartSection
  HudChartSection
-> HudChartSection -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
#hudOptions Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
-> Optic
     A_Lens
     NoIx
     HudOptions
     HudOptions
     [Priority AxisOptions]
     [Priority AxisOptions]
-> Optic
     A_Lens
     NoIx
     ChartOptions
     ChartOptions
     [Priority AxisOptions]
     [Priority AxisOptions]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  NoIx
  HudOptions
  HudOptions
  [Priority AxisOptions]
  [Priority AxisOptions]
#axes Optic
  A_Lens
  NoIx
  ChartOptions
  ChartOptions
  [Priority AxisOptions]
  [Priority AxisOptions]
-> Optic
     A_Traversal
     (Int : NoIx)
     [Priority AxisOptions]
     [Priority AxisOptions]
     (Priority AxisOptions)
     (Priority AxisOptions)
-> Optic
     A_Traversal
     (Int : NoIx)
     ChartOptions
     ChartOptions
     (Priority AxisOptions)
     (Priority AxisOptions)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Traversal
  (Int : NoIx)
  [Priority AxisOptions]
  [Priority AxisOptions]
  (Priority AxisOptions)
  (Priority AxisOptions)
forall i s t a b. Each i s t a b => IxTraversal i s t a b
each Optic
  A_Traversal
  (Int : NoIx)
  ChartOptions
  ChartOptions
  (Priority AxisOptions)
  (Priority AxisOptions)
-> Optic
     A_Lens
     NoIx
     (Priority AxisOptions)
     (Priority AxisOptions)
     AxisOptions
     AxisOptions
-> Optic
     A_Traversal
     (Int : NoIx)
     ChartOptions
     ChartOptions
     AxisOptions
     AxisOptions
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  NoIx
  (Priority AxisOptions)
  (Priority AxisOptions)
  AxisOptions
  AxisOptions
#item Optic
  A_Traversal
  (Int : NoIx)
  ChartOptions
  ChartOptions
  AxisOptions
  AxisOptions
-> Optic
     A_Lens NoIx AxisOptions AxisOptions (Maybe AxisBar) (Maybe AxisBar)
-> Optic
     A_Traversal
     (Int : NoIx)
     ChartOptions
     ChartOptions
     (Maybe AxisBar)
     (Maybe AxisBar)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens NoIx AxisOptions AxisOptions (Maybe AxisBar) (Maybe AxisBar)
#axisBar Optic
  A_Traversal
  (Int : NoIx)
  ChartOptions
  ChartOptions
  (Maybe AxisBar)
  (Maybe AxisBar)
-> Optic
     A_Lens NoIx AxisBar AxisBar HudChartSection HudChartSection
-> Optic
     A_Traversal
     (Int : NoIx)
     ChartOptions
     ChartOptions
     HudChartSection
     HudChartSection
forall (is :: IxList) (js :: IxList) (ks :: IxList) k k' l m s t u
       v a b.
(AppendIndices is js ks, JoinKinds k A_Prism k',
 JoinKinds k' l m) =>
Optic k is s t (Maybe u) (Maybe v)
-> Optic l js u v a b -> Optic m ks s t a b
%? Optic A_Lens NoIx AxisBar AxisBar HudChartSection HudChartSection
#anchorTo) HudChartSection
CanvasStyleSection
    ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx ChartOptions ChartOptions ChartAspect ChartAspect
-> ChartAspect -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (Optic
  A_Lens NoIx ChartOptions ChartOptions MarkupOptions MarkupOptions
#markupOptions Optic
  A_Lens NoIx ChartOptions ChartOptions MarkupOptions MarkupOptions
-> Optic
     A_Lens NoIx MarkupOptions MarkupOptions ChartAspect ChartAspect
-> Optic
     A_Lens NoIx ChartOptions ChartOptions ChartAspect ChartAspect
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens NoIx MarkupOptions MarkupOptions ChartAspect ChartAspect
#chartAspect) ChartAspect
ChartAspect
    ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic
  A_Lens
  NoIx
  ChartOptions
  ChartOptions
  PreferColorScheme
  PreferColorScheme
-> PreferColorScheme -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (Optic
  A_Lens NoIx ChartOptions ChartOptions MarkupOptions MarkupOptions
#markupOptions Optic
  A_Lens NoIx ChartOptions ChartOptions MarkupOptions MarkupOptions
-> Optic
     A_Lens NoIx MarkupOptions MarkupOptions CssOptions CssOptions
-> Optic
     A_Lens NoIx ChartOptions ChartOptions CssOptions CssOptions
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx MarkupOptions MarkupOptions CssOptions CssOptions
#cssOptions Optic A_Lens NoIx ChartOptions ChartOptions CssOptions CssOptions
-> Optic
     A_Lens
     NoIx
     CssOptions
     CssOptions
     PreferColorScheme
     PreferColorScheme
-> Optic
     A_Lens
     NoIx
     ChartOptions
     ChartOptions
     PreferColorScheme
     PreferColorScheme
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  NoIx
  CssOptions
  CssOptions
  PreferColorScheme
  PreferColorScheme
#preferColorScheme) PreferColorScheme
PreferHud
    ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx ChartOptions ChartOptions ByteString ByteString
-> ByteString -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (Optic
  A_Lens NoIx ChartOptions ChartOptions MarkupOptions MarkupOptions
#markupOptions Optic
  A_Lens NoIx ChartOptions ChartOptions MarkupOptions MarkupOptions
-> Optic
     A_Lens NoIx MarkupOptions MarkupOptions CssOptions CssOptions
-> Optic
     A_Lens NoIx ChartOptions ChartOptions CssOptions CssOptions
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx MarkupOptions MarkupOptions CssOptions CssOptions
#cssOptions Optic A_Lens NoIx ChartOptions ChartOptions CssOptions CssOptions
-> Optic A_Lens NoIx CssOptions CssOptions ByteString ByteString
-> Optic
     A_Lens NoIx ChartOptions ChartOptions ByteString ByteString
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx CssOptions CssOptions ByteString ByteString
#cssExtra) ((Colour, Colour) -> ByteString -> ByteString -> ByteString
fillSwitch (Colour
dark, Colour
light) ByteString
"dark" ByteString
"pathtext")
  where
    ps :: [PathData Double]
ps =
      [ Point Double -> PathData Double
forall a. Point a -> PathData a
StartP (Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
0 Double
0),
        Point Double -> PathData Double
forall a. Point a -> PathData a
LineP (Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
1 Double
0),
        Point Double -> Point Double -> Point Double -> PathData Double
forall a. Point a -> Point a -> Point a -> PathData a
CubicP (Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
0.2 Double
0) (Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
0.25 Double
1) (Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
1 Double
1),
        Point Double -> Point Double -> PathData Double
forall a. Point a -> Point a -> PathData a
QuadP (Double -> Double -> Point Double
forall a. a -> a -> Point a
Point (-Double
1) Double
2) (Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
0 Double
1),
        ArcInfo Double -> Point Double -> PathData Double
forall a. ArcInfo a -> Point a -> PathData a
ArcP (Point Double -> Double -> Bool -> Bool -> ArcInfo Double
forall a. Point a -> a -> Bool -> Bool -> ArcInfo a
ArcInfo (Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
1 Double
1) (-(Double
forall a. Floating a => a
pi Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
6)) Bool
False Bool
False) (Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
0 Double
0)
      ]
    ts :: [Text]
ts =
      [ Text
"StartP (Point 0 0)",
        Text
"LineP (Point 1 0)",
        Text
"CubicP (Point 0.2 0) (Point 0.25 1) (Point 1 1)",
        Text
"QuadP (Point (-1) 2) (Point 0 1)",
        Text
"ArcP (ArcInfo (Point 1 1) (-pi / 6) False False) (Point 0 0)"
      ]
    path' :: Chart
path' = Style -> [PathData Double] -> Chart
PathChart (Style
defaultPathStyle Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Colour Colour
-> Colour -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Colour Colour
#color (Int -> Double -> Colour
paletteO Int
0 Double
0.1) Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Colour Colour
-> Colour -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Colour Colour
#borderColor (Int -> Double -> Colour
paletteO Int
1 Double
1)) [PathData Double]
ps
    c0 :: Chart
c0 = Style -> [Point Double] -> Chart
GlyphChart (Style
defaultGlyphStyle Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style GlyphShape GlyphShape
-> GlyphShape -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style GlyphShape GlyphShape
#glyphShape GlyphShape
SquareGlyph) (PathData Double -> Point Double
forall a. PathData a -> Point a
pointPath (PathData Double -> Point Double)
-> [PathData Double] -> [Point Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PathData Double]
ps)
    midp :: [Point Double]
midp = Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
0 Double
0 Point Double -> [Point Double] -> [Point Double]
forall a. a -> [a] -> [a]
: (Point Double -> Point Double -> Point Double)
-> [Point Double] -> [Point Double] -> [Point Double]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\(Point Double
x Double
y) (Point Double
x' Double
y') -> Double -> Double -> Point Double
forall a. a -> a -> Point a
Point ((Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
x') Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2) ((Double
y Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
y') Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2)) (Int -> [Point Double] -> [Point Double]
forall a. Int -> [a] -> [a]
drop Int
1 (PathData Double -> Point Double
forall a. PathData a -> Point a
pointPath (PathData Double -> Point Double)
-> [PathData Double] -> [Point Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PathData Double]
ps)) (PathData Double -> Point Double
forall a. PathData a -> Point a
pointPath (PathData Double -> Point Double)
-> [PathData Double] -> [Point Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PathData Double]
ps)
    offp :: [Point Double]
offp = [Double -> Double -> Point Double
forall a. a -> a -> Point a
Point (-Double
0.35) Double
0.05, Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
0 Double
0.05, Double -> Double -> Point Double
forall a. a -> a -> Point a
Point (-Double
0.2) Double
0, Double -> Double -> Point Double
forall a. a -> a -> Point a
Point (-Double
0.1) Double
0.1, Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
0 (-Double
0.1)]
    t0 :: Chart
t0 = Style -> [(Text, Point Double)] -> Chart
TextChart (Style
defaultTextStyle Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Double Double
-> Double -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Double Double
#size Double
0.025) ([Text] -> [Point Double] -> [(Text, Point Double)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Text]
ts ((Point Double -> Point Double -> Point Double)
-> [Point Double] -> [Point Double] -> [Point Double]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Point Double -> Point Double -> Point Double
addp [Point Double]
offp [Point Double]
midp))

-- | ellipse example
--
-- Under scaling, angles are not invariant, and this effects the glyphShape of ellipses and thus SVG arc paths. Compare the effect of aspect changes to the axes of this ellipse:
--
-- ![ellipse example](other/ellipse.svg)
--
-- Below is the same ellipse with FixedAspect 2. Points scale exactly, but the original points that represent the end points of the axes are no longer on the new axes of the ellipse.
--
-- ![ellipse2 example](other/ellipse2.svg)
ellipseExample :: ChartAspect -> ChartOptions
ellipseExample :: ChartAspect -> ChartOptions
ellipseExample ChartAspect
a =
  ChartOptions
forall a. Monoid a => a
mempty
    ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx ChartOptions ChartOptions ChartTree ChartTree
-> ChartTree -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx ChartOptions ChartOptions ChartTree ChartTree
#chartTree (Text -> [Chart] -> ChartTree
named Text
"ellipse" [Chart
ell, Chart
ellFull, Chart
c0, Chart
c1, Chart
bbox, Chart
xradii, Chart
yradii])
    ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
-> HudOptions -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
#hudOptions HudOptions
defaultHudOptions
    ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx ChartOptions ChartOptions ChartAspect ChartAspect
-> ChartAspect -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (Optic
  A_Lens NoIx ChartOptions ChartOptions MarkupOptions MarkupOptions
#markupOptions Optic
  A_Lens NoIx ChartOptions ChartOptions MarkupOptions MarkupOptions
-> Optic
     A_Lens NoIx MarkupOptions MarkupOptions ChartAspect ChartAspect
-> Optic
     A_Lens NoIx ChartOptions ChartOptions ChartAspect ChartAspect
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens NoIx MarkupOptions MarkupOptions ChartAspect ChartAspect
#chartAspect) ChartAspect
a
    ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic
  A_Lens
  NoIx
  ChartOptions
  ChartOptions
  [Priority LegendOptions]
  [Priority LegendOptions]
-> [Priority LegendOptions] -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
#hudOptions Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
-> Optic
     A_Lens
     NoIx
     HudOptions
     HudOptions
     [Priority LegendOptions]
     [Priority LegendOptions]
-> Optic
     A_Lens
     NoIx
     ChartOptions
     ChartOptions
     [Priority LegendOptions]
     [Priority LegendOptions]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  NoIx
  HudOptions
  HudOptions
  [Priority LegendOptions]
  [Priority LegendOptions]
#legends) [Double -> LegendOptions -> Priority LegendOptions
forall a. Double -> a -> Priority a
Priority Double
10 (LegendOptions
defaultLegendOptions LegendOptions -> (LegendOptions -> LegendOptions) -> LegendOptions
forall a b. a -> (a -> b) -> b
& Optic
  A_Lens
  NoIx
  LegendOptions
  LegendOptions
  [(Text, [Chart])]
  [(Text, [Chart])]
-> [(Text, [Chart])] -> LegendOptions -> LegendOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic
  A_Lens
  NoIx
  LegendOptions
  LegendOptions
  [(Text, [Chart])]
  [(Text, [Chart])]
#legendCharts [(Text, [Chart])]
lrows LegendOptions -> (LegendOptions -> LegendOptions) -> LegendOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx LegendOptions LegendOptions Double Double
-> Double -> LegendOptions -> LegendOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (Optic A_Lens NoIx LegendOptions LegendOptions Style Style
#textStyle Optic A_Lens NoIx LegendOptions LegendOptions Style Style
-> Optic A_Lens NoIx Style Style Double Double
-> Optic A_Lens NoIx LegendOptions LegendOptions Double Double
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Style Style Double Double
#size) Double
0.2 LegendOptions -> (LegendOptions -> LegendOptions) -> LegendOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx LegendOptions LegendOptions Double Double
-> Double -> LegendOptions -> LegendOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx LegendOptions LegendOptions Double Double
#legendSize Double
0.1 LegendOptions -> (LegendOptions -> LegendOptions) -> LegendOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx LegendOptions LegendOptions Double Double
-> Double -> LegendOptions -> LegendOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx LegendOptions LegendOptions Double Double
#vgap Double
0.3)]
    ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic
  A_Lens
  NoIx
  ChartOptions
  ChartOptions
  [Priority TitleOptions]
  [Priority TitleOptions]
-> [Priority TitleOptions] -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
#hudOptions Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
-> Optic
     A_Lens
     NoIx
     HudOptions
     HudOptions
     [Priority TitleOptions]
     [Priority TitleOptions]
-> Optic
     A_Lens
     NoIx
     ChartOptions
     ChartOptions
     [Priority TitleOptions]
     [Priority TitleOptions]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  NoIx
  HudOptions
  HudOptions
  [Priority TitleOptions]
  [Priority TitleOptions]
#titles) [Double -> TitleOptions -> Priority TitleOptions
forall a. Double -> a -> Priority a
Priority Double
11 (Text -> TitleOptions
defaultTitleOptions Text
"ArcPosition (Point 1 0) (Point 0 1) (ArcInfo (Point 1.5 1) (pi / 3) True True)" TitleOptions -> (TitleOptions -> TitleOptions) -> TitleOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx TitleOptions TitleOptions Double Double
-> Double -> TitleOptions -> TitleOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (Optic A_Lens NoIx TitleOptions TitleOptions Style Style
#style Optic A_Lens NoIx TitleOptions TitleOptions Style Style
-> Optic A_Lens NoIx Style Style Double Double
-> Optic A_Lens NoIx TitleOptions TitleOptions Double Double
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Style Style Double Double
#size) Double
0.032)]
    ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic
  An_AffineTraversal NoIx ChartOptions ChartOptions Double Double
-> Double -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
#hudOptions Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
-> Optic
     A_Lens
     NoIx
     HudOptions
     HudOptions
     [Priority AxisOptions]
     [Priority AxisOptions]
-> Optic
     A_Lens
     NoIx
     ChartOptions
     ChartOptions
     [Priority AxisOptions]
     [Priority AxisOptions]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  NoIx
  HudOptions
  HudOptions
  [Priority AxisOptions]
  [Priority AxisOptions]
#axes Optic
  A_Lens
  NoIx
  ChartOptions
  ChartOptions
  [Priority AxisOptions]
  [Priority AxisOptions]
-> Optic
     (IxKind [Priority AxisOptions])
     NoIx
     [Priority AxisOptions]
     [Priority AxisOptions]
     (IxValue [Priority AxisOptions])
     (IxValue [Priority AxisOptions])
-> Optic
     An_AffineTraversal
     NoIx
     ChartOptions
     ChartOptions
     (IxValue [Priority AxisOptions])
     (IxValue [Priority AxisOptions])
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Index [Priority AxisOptions]
-> Optic
     (IxKind [Priority AxisOptions])
     NoIx
     [Priority AxisOptions]
     [Priority AxisOptions]
     (IxValue [Priority AxisOptions])
     (IxValue [Priority AxisOptions])
forall m. Ixed m => Index m -> Optic' (IxKind m) NoIx m (IxValue m)
ix Index [Priority AxisOptions]
1 Optic
  An_AffineTraversal
  NoIx
  ChartOptions
  ChartOptions
  (IxValue [Priority AxisOptions])
  (IxValue [Priority AxisOptions])
-> Optic
     A_Lens
     NoIx
     (IxValue [Priority AxisOptions])
     (IxValue [Priority AxisOptions])
     AxisOptions
     AxisOptions
-> Optic
     An_AffineTraversal
     NoIx
     ChartOptions
     ChartOptions
     AxisOptions
     AxisOptions
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  NoIx
  (IxValue [Priority AxisOptions])
  (IxValue [Priority AxisOptions])
  AxisOptions
  AxisOptions
#item Optic
  An_AffineTraversal
  NoIx
  ChartOptions
  ChartOptions
  AxisOptions
  AxisOptions
-> Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
-> Optic
     An_AffineTraversal NoIx ChartOptions ChartOptions Ticks Ticks
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
#ticks Optic An_AffineTraversal NoIx ChartOptions ChartOptions Ticks Ticks
-> Optic
     A_Lens NoIx Ticks Ticks (Maybe TickStyle) (Maybe TickStyle)
-> Optic
     An_AffineTraversal
     NoIx
     ChartOptions
     ChartOptions
     (Maybe TickStyle)
     (Maybe TickStyle)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Ticks Ticks (Maybe TickStyle) (Maybe TickStyle)
#textTick Optic
  An_AffineTraversal
  NoIx
  ChartOptions
  ChartOptions
  (Maybe TickStyle)
  (Maybe TickStyle)
-> Optic A_Lens NoIx TickStyle TickStyle Double Double
-> Optic
     An_AffineTraversal NoIx ChartOptions ChartOptions Double Double
forall (is :: IxList) (js :: IxList) (ks :: IxList) k k' l m s t u
       v a b.
(AppendIndices is js ks, JoinKinds k A_Prism k',
 JoinKinds k' l m) =>
Optic k is s t (Maybe u) (Maybe v)
-> Optic l js u v a b -> Optic m ks s t a b
%? Optic A_Lens NoIx TickStyle TickStyle Double Double
#buffer) Double
0.04
    ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic
  An_AffineTraversal NoIx ChartOptions ChartOptions Double Double
-> Double -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
#hudOptions Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
-> Optic
     A_Lens
     NoIx
     HudOptions
     HudOptions
     [Priority AxisOptions]
     [Priority AxisOptions]
-> Optic
     A_Lens
     NoIx
     ChartOptions
     ChartOptions
     [Priority AxisOptions]
     [Priority AxisOptions]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  NoIx
  HudOptions
  HudOptions
  [Priority AxisOptions]
  [Priority AxisOptions]
#axes Optic
  A_Lens
  NoIx
  ChartOptions
  ChartOptions
  [Priority AxisOptions]
  [Priority AxisOptions]
-> Optic
     (IxKind [Priority AxisOptions])
     NoIx
     [Priority AxisOptions]
     [Priority AxisOptions]
     (IxValue [Priority AxisOptions])
     (IxValue [Priority AxisOptions])
-> Optic
     An_AffineTraversal
     NoIx
     ChartOptions
     ChartOptions
     (IxValue [Priority AxisOptions])
     (IxValue [Priority AxisOptions])
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Index [Priority AxisOptions]
-> Optic
     (IxKind [Priority AxisOptions])
     NoIx
     [Priority AxisOptions]
     [Priority AxisOptions]
     (IxValue [Priority AxisOptions])
     (IxValue [Priority AxisOptions])
forall m. Ixed m => Index m -> Optic' (IxKind m) NoIx m (IxValue m)
ix Index [Priority AxisOptions]
1 Optic
  An_AffineTraversal
  NoIx
  ChartOptions
  ChartOptions
  (IxValue [Priority AxisOptions])
  (IxValue [Priority AxisOptions])
-> Optic
     A_Lens
     NoIx
     (IxValue [Priority AxisOptions])
     (IxValue [Priority AxisOptions])
     AxisOptions
     AxisOptions
-> Optic
     An_AffineTraversal
     NoIx
     ChartOptions
     ChartOptions
     AxisOptions
     AxisOptions
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  NoIx
  (IxValue [Priority AxisOptions])
  (IxValue [Priority AxisOptions])
  AxisOptions
  AxisOptions
#item Optic
  An_AffineTraversal
  NoIx
  ChartOptions
  ChartOptions
  AxisOptions
  AxisOptions
-> Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
-> Optic
     An_AffineTraversal NoIx ChartOptions ChartOptions Ticks Ticks
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
#ticks Optic An_AffineTraversal NoIx ChartOptions ChartOptions Ticks Ticks
-> Optic
     A_Lens NoIx Ticks Ticks (Maybe TickStyle) (Maybe TickStyle)
-> Optic
     An_AffineTraversal
     NoIx
     ChartOptions
     ChartOptions
     (Maybe TickStyle)
     (Maybe TickStyle)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Ticks Ticks (Maybe TickStyle) (Maybe TickStyle)
#glyphTick Optic
  An_AffineTraversal
  NoIx
  ChartOptions
  ChartOptions
  (Maybe TickStyle)
  (Maybe TickStyle)
-> Optic A_Lens NoIx TickStyle TickStyle Double Double
-> Optic
     An_AffineTraversal NoIx ChartOptions ChartOptions Double Double
forall (is :: IxList) (js :: IxList) (ks :: IxList) k k' l m s t u
       v a b.
(AppendIndices is js ks, JoinKinds k A_Prism k',
 JoinKinds k' l m) =>
Optic k is s t (Maybe u) (Maybe v)
-> Optic l js u v a b -> Optic m ks s t a b
%? Optic A_Lens NoIx TickStyle TickStyle Double Double
#buffer) Double
0.01
  where
    p :: ArcPosition Double
p@(ArcPosition Point Double
p1 Point Double
p2 ArcInfo Double
_) = Point Double
-> Point Double -> ArcInfo Double -> ArcPosition Double
forall a. Point a -> Point a -> ArcInfo a -> ArcPosition a
ArcPosition (Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
1 Double
0) (Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
0 Double
1) (Point Double -> Double -> Bool -> Bool -> ArcInfo Double
forall a. Point a -> a -> Bool -> Bool -> ArcInfo a
ArcInfo (Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
1.5 Double
1) (Double
forall a. Floating a => a
pi Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
3) Bool
True Bool
True)
    (ArcCentroid Point Double
c Point Double
r Double
phi' Double
ang0' Double
angd) = ArcPosition Double -> ArcCentroid Double
forall a.
(Ord a, FromInteger a, TrigField a, ExpField a) =>
ArcPosition a -> ArcCentroid a
arcCentroid ArcPosition Double
p
    ellFull :: Chart
ellFull = Style -> [[Point Double]] -> Chart
LineChart Style
fullels [Point Double -> Point Double -> Double -> Double -> Point Double
forall b a.
(Direction b, Dir b ~ a, Affinity b a, TrigField a) =>
b -> b -> a -> a -> b
ellipse Point Double
c Point Double
r Double
phi' (Double -> Point Double)
-> (Double -> Double) -> Double -> Point Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\Double
x -> Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
forall a. Floating a => a
pi Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
x Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
100.0) (Double -> Point Double) -> [Double] -> [Point Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Double
0 .. Double
100]]
    ell :: Chart
ell = Style -> [[Point Double]] -> Chart
LineChart Style
els [Point Double -> Point Double -> Double -> Double -> Point Double
forall b a.
(Direction b, Dir b ~ a, Affinity b a, TrigField a) =>
b -> b -> a -> a -> b
ellipse Point Double
c Point Double
r Double
phi' (Double -> Point Double)
-> (Double -> Double) -> Double -> Point Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\Double
x -> Double
ang0' Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
angd Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
x Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
100.0) (Double -> Point Double) -> [Double] -> [Point Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Double
0 .. Double
100]]
    g0 :: Style
g0 = Style
defaultGlyphStyle Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style GlyphShape GlyphShape
-> GlyphShape -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style GlyphShape GlyphShape
#glyphShape GlyphShape
CircleGlyph
    c0 :: Chart
c0 = Style -> [Point Double] -> Chart
GlyphChart Style
g0 [Point Double
c]
    g1 :: Style
g1 = Style
defaultGlyphStyle Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Colour Colour
-> Colour -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Colour Colour
#color (Int -> Double -> Colour
paletteO Int
4 Double
0.2) Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style GlyphShape GlyphShape
-> GlyphShape -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style GlyphShape GlyphShape
#glyphShape GlyphShape
CircleGlyph
    c1 :: Chart
c1 = Style -> [Point Double] -> Chart
GlyphChart Style
g1 [Point Double
p1, Point Double
p2]
    bbox :: Chart
bbox = Style -> [Rect Double] -> Chart
RectChart Style
bbs [ArcPosition Double -> Rect Double
arcBox ArcPosition Double
p]
    bbs :: Style
bbs = Style
defaultRectStyle Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Double Double
-> Double -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Double Double
#borderSize Double
0.002 Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Colour Colour
-> Colour -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Colour Colour
#color (Int -> Double -> Colour
paletteO Int
7 Double
0.005) Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Colour Colour
-> Colour -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Colour Colour
#borderColor (Double -> Double -> Colour
grey Double
0.5 Double
1)
    xradii :: Chart
xradii = Style -> [[Point Double]] -> Chart
LineChart Style
xals [[Point Double -> Point Double -> Double -> Double -> Point Double
forall b a.
(Direction b, Dir b ~ a, Affinity b a, TrigField a) =>
b -> b -> a -> a -> b
ellipse Point Double
c Point Double
r Double
phi' Double
0, Point Double -> Point Double -> Double -> Double -> Point Double
forall b a.
(Direction b, Dir b ~ a, Affinity b a, TrigField a) =>
b -> b -> a -> a -> b
ellipse Point Double
c Point Double
r Double
phi' Double
forall a. Floating a => a
pi]]
    yradii :: Chart
yradii = Style -> [[Point Double]] -> Chart
LineChart Style
yals [[Point Double -> Point Double -> Double -> Double -> Point Double
forall b a.
(Direction b, Dir b ~ a, Affinity b a, TrigField a) =>
b -> b -> a -> a -> b
ellipse Point Double
c Point Double
r Double
phi' (Double
forall a. Floating a => a
pi Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2), Point Double -> Point Double -> Double -> Double -> Point Double
forall b a.
(Direction b, Dir b ~ a, Affinity b a, TrigField a) =>
b -> b -> a -> a -> b
ellipse Point Double
c Point Double
r Double
phi' (Double
3 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
forall a. Floating a => a
pi)]]
    xals :: Style
xals = Style
defaultLineStyle Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Colour Colour
-> Colour -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Colour Colour
#color (Int -> Colour
palette Int
6) Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Double Double
-> Double -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Double Double
#size Double
0.005 Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style (Maybe [Double]) (Maybe [Double])
-> Maybe [Double] -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style (Maybe [Double]) (Maybe [Double])
#dasharray ([Double] -> Maybe [Double]
forall a. a -> Maybe a
Just [Double
0.03, Double
0.01]) Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style (Maybe LineCap) (Maybe LineCap)
-> Maybe LineCap -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style (Maybe LineCap) (Maybe LineCap)
#lineCap (LineCap -> Maybe LineCap
forall a. a -> Maybe a
Just LineCap
LineCapRound)
    yals :: Style
yals = Style
defaultLineStyle Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Colour Colour
-> Colour -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Colour Colour
#color (Int -> Colour
palette Int
5) Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Double Double
-> Double -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Double Double
#size Double
0.005 Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style (Maybe [Double]) (Maybe [Double])
-> Maybe [Double] -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style (Maybe [Double]) (Maybe [Double])
#dasharray ([Double] -> Maybe [Double]
forall a. a -> Maybe a
Just [Double
0.03, Double
0.01]) Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style (Maybe LineCap) (Maybe LineCap)
-> Maybe LineCap -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style (Maybe LineCap) (Maybe LineCap)
#lineCap (LineCap -> Maybe LineCap
forall a. a -> Maybe a
Just LineCap
LineCapRound)
    fullels :: Style
fullels = Style
defaultLineStyle Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Double Double
-> Double -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Double Double
#size Double
0.002 Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Colour Colour
-> Colour -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Colour Colour
#color (Int -> Colour
palette Int
1)
    els :: Style
els = Style
defaultLineStyle Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Double Double
-> Double -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Double Double
#size Double
0.005 Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Colour Colour
-> Colour -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Colour Colour
#color (Int -> Colour
palette Int
2)
    lrows :: [(Text, [Chart])]
lrows =
      (Chart -> [Chart]) -> (Text, Chart) -> (Text, [Chart])
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (Chart -> [Chart] -> [Chart]
forall a. a -> [a] -> [a]
: [])
        ((Text, Chart) -> (Text, [Chart]))
-> [(Text, Chart)] -> [(Text, [Chart])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ (Text
"Major Axis", Style -> [[Point Double]] -> Chart
LineChart Style
xals [[Point Double
forall a. Additive a => a
zero]]),
              (Text
"Minor Axis", Style -> [[Point Double]] -> Chart
LineChart Style
yals [[Point Double
forall a. Additive a => a
zero]]),
              (Text
"Full Ellipse", Style -> [[Point Double]] -> Chart
LineChart Style
fullels [[Point Double
forall a. Additive a => a
zero]]),
              (Text
"Arc", Style -> [[Point Double]] -> Chart
LineChart Style
els [[Point Double
forall a. Additive a => a
zero]]),
              (Text
"Centroid", Style -> [Point Double] -> Chart
GlyphChart (Style
g0 Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Double Double
-> Double -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Double Double
#size Double
0.01 Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style GlyphShape GlyphShape
-> GlyphShape -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style GlyphShape GlyphShape
#glyphShape GlyphShape
SquareGlyph) [Point Double
forall a. Additive a => a
zero]),
              (Text
"Endpoints", Style -> [Point Double] -> Chart
GlyphChart (Style
g1 Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Double Double
-> Double -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Double Double
#size Double
0.01 Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style GlyphShape GlyphShape
-> GlyphShape -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style GlyphShape GlyphShape
#glyphShape GlyphShape
SquareGlyph) [Point Double
forall a. Additive a => a
zero]),
              (Text
"Bounding Box", Style -> [Rect Double] -> Chart
RectChart (Style
bbs Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Double Double
-> Double -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Double Double
#borderSize Double
0.01) [(Double -> Double) -> Rect Double -> Rect Double
forall a b. (a -> b) -> Rect a -> Rect b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Double
2 *) Rect Double
forall a. Multiplicative a => a
one])
            ]

-- | Reproduction of the flag explanation chart in <https://developer.mozilla.org/en-US/docs/Web/SVG/Tutorial/Paths>
--
-- ![arc flags example](other/arcflags.svg)
arcFlagsExample :: ChartOptions
arcFlagsExample :: ChartOptions
arcFlagsExample =
  ChartOptions
forall a. Monoid a => a
mempty
    ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx ChartOptions ChartOptions ChartTree ChartTree
-> ChartTree -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set
      #chartTree
      ( Align -> Double -> [ChartTree] -> ChartTree
vert
          Align
AlignLeft
          Double
0.02
          [ Align -> Double -> [ChartTree] -> ChartTree
hori Align
AlignMid Double
0.02 [ChartTree
colSweep, ChartTree
colSweep2, ChartTree
colLargeFalse, ChartTree
colLargeTrue],
            ChartTree
rowLarge
          ]
      )
    ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx ChartOptions ChartOptions ChartAspect ChartAspect
-> ChartAspect -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (Optic
  A_Lens NoIx ChartOptions ChartOptions MarkupOptions MarkupOptions
#markupOptions Optic
  A_Lens NoIx ChartOptions ChartOptions MarkupOptions MarkupOptions
-> Optic
     A_Lens NoIx MarkupOptions MarkupOptions ChartAspect ChartAspect
-> Optic
     A_Lens NoIx ChartOptions ChartOptions ChartAspect ChartAspect
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens NoIx MarkupOptions MarkupOptions ChartAspect ChartAspect
#chartAspect) ChartAspect
UnscaledAspect
    ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic
  A_Lens
  NoIx
  ChartOptions
  ChartOptions
  PreferColorScheme
  PreferColorScheme
-> PreferColorScheme -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (Optic
  A_Lens NoIx ChartOptions ChartOptions MarkupOptions MarkupOptions
#markupOptions Optic
  A_Lens NoIx ChartOptions ChartOptions MarkupOptions MarkupOptions
-> Optic
     A_Lens NoIx MarkupOptions MarkupOptions CssOptions CssOptions
-> Optic
     A_Lens NoIx ChartOptions ChartOptions CssOptions CssOptions
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx MarkupOptions MarkupOptions CssOptions CssOptions
#cssOptions Optic A_Lens NoIx ChartOptions ChartOptions CssOptions CssOptions
-> Optic
     A_Lens
     NoIx
     CssOptions
     CssOptions
     PreferColorScheme
     PreferColorScheme
-> Optic
     A_Lens
     NoIx
     ChartOptions
     ChartOptions
     PreferColorScheme
     PreferColorScheme
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  NoIx
  CssOptions
  CssOptions
  PreferColorScheme
  PreferColorScheme
#preferColorScheme) PreferColorScheme
PreferHud
    ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx ChartOptions ChartOptions ByteString ByteString
-> ByteString -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set
      (Optic
  A_Lens NoIx ChartOptions ChartOptions MarkupOptions MarkupOptions
#markupOptions Optic
  A_Lens NoIx ChartOptions ChartOptions MarkupOptions MarkupOptions
-> Optic
     A_Lens NoIx MarkupOptions MarkupOptions CssOptions CssOptions
-> Optic
     A_Lens NoIx ChartOptions ChartOptions CssOptions CssOptions
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx MarkupOptions MarkupOptions CssOptions CssOptions
#cssOptions Optic A_Lens NoIx ChartOptions ChartOptions CssOptions CssOptions
-> Optic A_Lens NoIx CssOptions CssOptions ByteString ByteString
-> Optic
     A_Lens NoIx ChartOptions ChartOptions ByteString ByteString
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx CssOptions CssOptions ByteString ByteString
#cssExtra)
      [i|
{
  .chart g {
    stroke: #{showRGBA dark};
  }
  .chart g text {
    fill: #{showRGBA dark};
  }
}
@media (prefers-color-scheme:dark) {
  .chart g {
    stroke: #{showRGBA light};
  }
  .chart g text {
    fill: #{showRGBA light};
  }
}
|]
  where
    rowLarge :: ChartTree
rowLarge =
      [Chart] -> ChartTree
unnamed
        [ Rect Double -> Chart
blankChart1 (Double -> Double -> Double -> Double -> Rect Double
forall a. a -> a -> a -> a -> Rect a
Rect Double
0 Double
9 (-Double
2.75) (-Double
3.25)),
          Style -> [(Text, Point Double)] -> Chart
TextChart (Style
defaultTextStyle Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Double Double
-> Double -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Double Double
#size Double
0.6) [(Text
"Large", Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
5.5 (-Double
3.0))]
        ]
    colLargeFalse :: ChartTree
colLargeFalse =
      Align -> Double -> [ChartTree] -> ChartTree
vert
        Align
AlignLeft
        Double
0.02
        [ [Chart] -> ChartTree
unnamed (Bool -> Bool -> Colour -> [Chart]
checkFlags Bool
False Bool
True (Optic A_Lens NoIx Colour Colour Double Double
-> Double -> Colour -> Colour
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Colour Colour Double Double
opac' Double
0.3 Colour
dark)),
          [Chart] -> ChartTree
unnamed (Bool -> Bool -> Colour -> [Chart]
checkFlags Bool
False Bool
False (Optic A_Lens NoIx Colour Colour Double Double
-> Double -> Colour -> Colour
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Colour Colour Double Double
opac' Double
0.3 Colour
dark)),
          [Chart] -> ChartTree
unnamed
            [ Rect Double -> Chart
blankChart1 (Double -> Double -> Double -> Double -> Rect Double
forall a. a -> a -> a -> a -> Rect a
Rect (-Double
1) Double
2 (-Double
0.25) Double
0.25),
              Style -> [(Text, Point Double)] -> Chart
TextChart (Style
defaultTextStyle Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Double Double
-> Double -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Double Double
#size Double
0.4) [(Text
"False", Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
0.5 (-Double
0.1))]
            ]
        ]
    colLargeTrue :: ChartTree
colLargeTrue =
      Align -> Double -> [ChartTree] -> ChartTree
vert
        Align
AlignLeft
        Double
0.02
        [ [Chart] -> ChartTree
unnamed (Bool -> Bool -> Colour -> [Chart]
checkFlags Bool
True Bool
True (Optic A_Lens NoIx Colour Colour Double Double
-> Double -> Colour -> Colour
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Colour Colour Double Double
opac' Double
0.3 Colour
dark)),
          [Chart] -> ChartTree
unnamed (Bool -> Bool -> Colour -> [Chart]
checkFlags Bool
True Bool
False (Optic A_Lens NoIx Colour Colour Double Double
-> Double -> Colour -> Colour
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Colour Colour Double Double
opac' Double
0.3 Colour
dark)),
          [Chart] -> ChartTree
unnamed
            [ Rect Double -> Chart
blankChart1 (Double -> Double -> Double -> Double -> Rect Double
forall a. a -> a -> a -> a -> Rect a
Rect (-Double
1) Double
2 (-Double
0.25) Double
0.25),
              Style -> [(Text, Point Double)] -> Chart
TextChart (Style
defaultTextStyle Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Double Double
-> Double -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Double Double
#size Double
0.4) [(Text
"True", Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
0.5 (-Double
0.1))]
            ]
        ]
    colSweep :: ChartTree
colSweep =
      [Chart] -> ChartTree
unnamed
        [ Rect Double -> Chart
blankChart1 (Double -> Double -> Double -> Double -> Rect Double
forall a. a -> a -> a -> a -> Rect a
Rect (-Double
0.4) Double
0.4 (-Double
1) Double
5),
          Style -> [(Text, Point Double)] -> Chart
TextChart
            (Style
defaultTextStyle Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Double Double
-> Double -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Double Double
#size Double
0.6 Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style (Maybe Double) (Maybe Double)
-> Maybe Double -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style (Maybe Double) (Maybe Double)
#rotation (Double -> Maybe Double
forall a. a -> Maybe a
Just (Double
forall a. Floating a => a
pi Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2)))
            [(Text
"Sweep", Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
0.1 Double
2)]
        ]
    colSweep2 :: ChartTree
colSweep2 =
      Align -> Double -> [ChartTree] -> ChartTree
vert
        Align
AlignLeft
        Double
0.02
        [ [Chart] -> ChartTree
unnamed
            [ Rect Double -> Chart
blankChart1 (Double -> Double -> Double -> Double -> Rect Double
forall a. a -> a -> a -> a -> Rect a
Rect (-Double
0.25) Double
0.25 (-Double
1) Double
2),
              Style -> [(Text, Point Double)] -> Chart
TextChart
                (Style
defaultTextStyle Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Double Double
-> Double -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Double Double
#size Double
0.4 Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style (Maybe Double) (Maybe Double)
-> Maybe Double -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style (Maybe Double) (Maybe Double)
#rotation (Double -> Maybe Double
forall a. a -> Maybe a
Just (Double
forall a. Floating a => a
pi Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2)))
                [(Text
"True", Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
0.1 Double
0.5)]
            ],
          [Chart] -> ChartTree
unnamed
            [ Rect Double -> Chart
blankChart1 (Double -> Double -> Double -> Double -> Rect Double
forall a. a -> a -> a -> a -> Rect a
Rect (-Double
0.25) Double
0.25 (-Double
1) Double
2),
              Style -> [(Text, Point Double)] -> Chart
TextChart
                (Style
defaultTextStyle Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Double Double
-> Double -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Double Double
#size Double
0.4 Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style (Maybe Double) (Maybe Double)
-> Maybe Double -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style (Maybe Double) (Maybe Double)
#rotation (Double -> Maybe Double
forall a. a -> Maybe a
Just (Double
forall a. Floating a => a
pi Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2)))
                [(Text
"False", Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
0.1 Double
0.5)]
            ]
        ]

checkFlags :: Bool -> Bool -> Colour -> [Chart]
checkFlags :: Bool -> Bool -> Colour -> [Chart]
checkFlags Bool
large' Bool
sweep Colour
co = [Chart
c1, Chart
c2, Chart
ell, Chart
arc1]
  where
    c :: Point Double
c = Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
1.0 Double
1.0
    p1 :: ArcPosition Double
p1 = Point Double
-> Point Double -> ArcInfo Double -> ArcPosition Double
forall a. Point a -> Point a -> ArcInfo a -> ArcPosition a
ArcPosition (Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
0.0 Double
1.0) (Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
1.0 Double
0.0) (Point Double -> Double -> Bool -> Bool -> ArcInfo Double
forall a. Point a -> a -> Bool -> Bool -> ArcInfo a
ArcInfo (Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
1.0 Double
1.0) Double
0 Bool
large' Bool
sweep)
    ps1 :: [PathData Double]
ps1 = Point Double -> ArcPosition Double -> [PathData Double]
singletonPie Point Double
c ArcPosition Double
p1
    (ArcCentroid Point Double
c' Point Double
r Double
phi' Double
ang0' Double
angd) = ArcPosition Double -> ArcCentroid Double
forall a.
(Ord a, FromInteger a, TrigField a, ExpField a) =>
ArcPosition a -> ArcCentroid a
arcCentroid ArcPosition Double
p1
    arc1 :: Chart
arc1 = Style -> [PathData Double] -> Chart
PathChart (Style
defaultPathStyle Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Colour Colour
-> Colour -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Colour Colour
#color Colour
co Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Colour Colour
-> Colour -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Colour Colour
#borderColor (Optic A_Lens NoIx Colour Colour Double Double
-> Double -> Colour -> Colour
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Colour Colour Double Double
opac' Double
0.5 Colour
dark)) [PathData Double]
ps1
    c1 :: Chart
c1 = Style -> [[Point Double]] -> Chart
LineChart (Style
defaultLineStyle Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Double Double
-> Double -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Double Double
#size Double
0.02 Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Colour Colour
-> Colour -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Colour Colour
#color (Optic A_Lens NoIx Colour Colour Double Double
-> Double -> Colour -> Colour
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Colour Colour Double Double
opac' Double
0.2 Colour
dark)) [Point Double -> Point Double -> Double -> Double -> Point Double
forall b a.
(Direction b, Dir b ~ a, Affinity b a, TrigField a) =>
b -> b -> a -> a -> b
ellipse (Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
1.0 Double
1.0) (Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
1.0 Double
1.0) Double
0 (Double -> Point Double)
-> (Double -> Double) -> Double -> Point Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\Double
x -> Double
0 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
forall a. Floating a => a
pi Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
x Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
100.0) (Double -> Point Double) -> [Double] -> [Point Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Double
0 .. Double
100]]
    c2 :: Chart
c2 = Style -> [[Point Double]] -> Chart
LineChart (Style
defaultLineStyle Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Double Double
-> Double -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Double Double
#size Double
0.02 Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Colour Colour
-> Colour -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Colour Colour
#color (Optic A_Lens NoIx Colour Colour Double Double
-> Double -> Colour -> Colour
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Colour Colour Double Double
opac' Double
0.2 Colour
dark)) [Point Double -> Point Double -> Double -> Double -> Point Double
forall b a.
(Direction b, Dir b ~ a, Affinity b a, TrigField a) =>
b -> b -> a -> a -> b
ellipse (Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
0.0 Double
0.0) (Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
1.0 Double
1.0) Double
0 (Double -> Point Double)
-> (Double -> Double) -> Double -> Point Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\Double
x -> Double
0 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
forall a. Floating a => a
pi Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
x Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
100.0) (Double -> Point Double) -> [Double] -> [Point Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Double
0 .. Double
100]]
    ell :: Chart
ell = Style -> [[Point Double]] -> Chart
LineChart (Style
defaultLineStyle Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Double Double
-> Double -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Double Double
#size Double
0.05 Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Colour Colour
-> Colour -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Colour Colour
#color (Optic A_Lens NoIx Colour Colour Double Double
-> Double -> Colour -> Colour
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Colour Colour Double Double
opac' Double
0.5 Colour
co)) [Point Double -> Point Double -> Double -> Double -> Point Double
forall b a.
(Direction b, Dir b ~ a, Affinity b a, TrigField a) =>
b -> b -> a -> a -> b
ellipse Point Double
c' Point Double
r Double
phi' (Double -> Point Double)
-> (Double -> Double) -> Double -> Point Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\Double
x -> Double
ang0' Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
angd Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
x Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
100.0) (Double -> Point Double) -> [Double] -> [Point Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Double
0 .. Double
100]]

-- | quad example
--
-- ![quad example](other/quad.svg)
quadExample :: ChartOptions
quadExample :: ChartOptions
quadExample =
  ChartOptions
forall a. Monoid a => a
mempty
    ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx ChartOptions ChartOptions ChartTree ChartTree
-> ChartTree -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx ChartOptions ChartOptions ChartTree ChartTree
#chartTree (Text -> [Chart] -> ChartTree
named Text
"quad" [Chart
path', Chart
curve, Chart
c0, Chart
c1, Chart
bbox])
    ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
-> HudOptions -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
#hudOptions HudOptions
defaultHudOptions
    ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx ChartOptions ChartOptions ChartAspect ChartAspect
-> ChartAspect -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (Optic
  A_Lens NoIx ChartOptions ChartOptions MarkupOptions MarkupOptions
#markupOptions Optic
  A_Lens NoIx ChartOptions ChartOptions MarkupOptions MarkupOptions
-> Optic
     A_Lens NoIx MarkupOptions MarkupOptions ChartAspect ChartAspect
-> Optic
     A_Lens NoIx ChartOptions ChartOptions ChartAspect ChartAspect
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens NoIx MarkupOptions MarkupOptions ChartAspect ChartAspect
#chartAspect) (Double -> ChartAspect
FixedAspect Double
1.5)
    ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic
  A_Lens
  NoIx
  ChartOptions
  ChartOptions
  [Priority LegendOptions]
  [Priority LegendOptions]
-> [Priority LegendOptions] -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
#hudOptions Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
-> Optic
     A_Lens
     NoIx
     HudOptions
     HudOptions
     [Priority LegendOptions]
     [Priority LegendOptions]
-> Optic
     A_Lens
     NoIx
     ChartOptions
     ChartOptions
     [Priority LegendOptions]
     [Priority LegendOptions]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  NoIx
  HudOptions
  HudOptions
  [Priority LegendOptions]
  [Priority LegendOptions]
#legends) [Double -> LegendOptions -> Priority LegendOptions
forall a. Double -> a -> Priority a
Priority Double
10 (LegendOptions
defaultLegendOptions LegendOptions -> (LegendOptions -> LegendOptions) -> LegendOptions
forall a b. a -> (a -> b) -> b
& Optic
  A_Lens
  NoIx
  LegendOptions
  LegendOptions
  [(Text, [Chart])]
  [(Text, [Chart])]
-> [(Text, [Chart])] -> LegendOptions -> LegendOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic
  A_Lens
  NoIx
  LegendOptions
  LegendOptions
  [(Text, [Chart])]
  [(Text, [Chart])]
#legendCharts [(Text, [Chart])]
lrows LegendOptions -> (LegendOptions -> LegendOptions) -> LegendOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx LegendOptions LegendOptions Double Double
-> Double -> LegendOptions -> LegendOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (Optic A_Lens NoIx LegendOptions LegendOptions Style Style
#textStyle Optic A_Lens NoIx LegendOptions LegendOptions Style Style
-> Optic A_Lens NoIx Style Style Double Double
-> Optic A_Lens NoIx LegendOptions LegendOptions Double Double
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Style Style Double Double
#size) Double
0.2 LegendOptions -> (LegendOptions -> LegendOptions) -> LegendOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx LegendOptions LegendOptions Double Double
-> Double -> LegendOptions -> LegendOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx LegendOptions LegendOptions Double Double
#legendSize Double
0.2 LegendOptions -> (LegendOptions -> LegendOptions) -> LegendOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx LegendOptions LegendOptions Double Double
-> Double -> LegendOptions -> LegendOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx LegendOptions LegendOptions Double Double
#vgap Double
0.3)]
    ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic
  A_Lens
  NoIx
  ChartOptions
  ChartOptions
  [Priority TitleOptions]
  [Priority TitleOptions]
-> [Priority TitleOptions] -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
#hudOptions Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
-> Optic
     A_Lens
     NoIx
     HudOptions
     HudOptions
     [Priority TitleOptions]
     [Priority TitleOptions]
-> Optic
     A_Lens
     NoIx
     ChartOptions
     ChartOptions
     [Priority TitleOptions]
     [Priority TitleOptions]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  NoIx
  HudOptions
  HudOptions
  [Priority TitleOptions]
  [Priority TitleOptions]
#titles) [Double -> TitleOptions -> Priority TitleOptions
forall a. Double -> a -> Priority a
Priority Double
11 (Text -> TitleOptions
defaultTitleOptions Text
"QuadPosition (Point 0 0) (Point 1 1) (Point 2 (-1))" TitleOptions -> (TitleOptions -> TitleOptions) -> TitleOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx TitleOptions TitleOptions Double Double
-> Double -> TitleOptions -> TitleOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (Optic A_Lens NoIx TitleOptions TitleOptions Style Style
#style Optic A_Lens NoIx TitleOptions TitleOptions Style Style
-> Optic A_Lens NoIx Style Style Double Double
-> Optic A_Lens NoIx TitleOptions TitleOptions Double Double
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Style Style Double Double
#size) Double
0.03)]
    ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic
  An_AffineTraversal NoIx ChartOptions ChartOptions Double Double
-> Double -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
#hudOptions Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
-> Optic
     A_Lens
     NoIx
     HudOptions
     HudOptions
     [Priority AxisOptions]
     [Priority AxisOptions]
-> Optic
     A_Lens
     NoIx
     ChartOptions
     ChartOptions
     [Priority AxisOptions]
     [Priority AxisOptions]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  NoIx
  HudOptions
  HudOptions
  [Priority AxisOptions]
  [Priority AxisOptions]
#axes Optic
  A_Lens
  NoIx
  ChartOptions
  ChartOptions
  [Priority AxisOptions]
  [Priority AxisOptions]
-> Optic
     (IxKind [Priority AxisOptions])
     NoIx
     [Priority AxisOptions]
     [Priority AxisOptions]
     (IxValue [Priority AxisOptions])
     (IxValue [Priority AxisOptions])
-> Optic
     An_AffineTraversal
     NoIx
     ChartOptions
     ChartOptions
     (IxValue [Priority AxisOptions])
     (IxValue [Priority AxisOptions])
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Index [Priority AxisOptions]
-> Optic
     (IxKind [Priority AxisOptions])
     NoIx
     [Priority AxisOptions]
     [Priority AxisOptions]
     (IxValue [Priority AxisOptions])
     (IxValue [Priority AxisOptions])
forall m. Ixed m => Index m -> Optic' (IxKind m) NoIx m (IxValue m)
ix Index [Priority AxisOptions]
1 Optic
  An_AffineTraversal
  NoIx
  ChartOptions
  ChartOptions
  (IxValue [Priority AxisOptions])
  (IxValue [Priority AxisOptions])
-> Optic
     A_Lens
     NoIx
     (IxValue [Priority AxisOptions])
     (IxValue [Priority AxisOptions])
     AxisOptions
     AxisOptions
-> Optic
     An_AffineTraversal
     NoIx
     ChartOptions
     ChartOptions
     AxisOptions
     AxisOptions
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  NoIx
  (IxValue [Priority AxisOptions])
  (IxValue [Priority AxisOptions])
  AxisOptions
  AxisOptions
#item Optic
  An_AffineTraversal
  NoIx
  ChartOptions
  ChartOptions
  AxisOptions
  AxisOptions
-> Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
-> Optic
     An_AffineTraversal NoIx ChartOptions ChartOptions Ticks Ticks
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
#ticks Optic An_AffineTraversal NoIx ChartOptions ChartOptions Ticks Ticks
-> Optic
     A_Lens NoIx Ticks Ticks (Maybe TickStyle) (Maybe TickStyle)
-> Optic
     An_AffineTraversal
     NoIx
     ChartOptions
     ChartOptions
     (Maybe TickStyle)
     (Maybe TickStyle)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Ticks Ticks (Maybe TickStyle) (Maybe TickStyle)
#textTick Optic
  An_AffineTraversal
  NoIx
  ChartOptions
  ChartOptions
  (Maybe TickStyle)
  (Maybe TickStyle)
-> Optic A_Lens NoIx TickStyle TickStyle Double Double
-> Optic
     An_AffineTraversal NoIx ChartOptions ChartOptions Double Double
forall (is :: IxList) (js :: IxList) (ks :: IxList) k k' l m s t u
       v a b.
(AppendIndices is js ks, JoinKinds k A_Prism k',
 JoinKinds k' l m) =>
Optic k is s t (Maybe u) (Maybe v)
-> Optic l js u v a b -> Optic m ks s t a b
%? Optic A_Lens NoIx TickStyle TickStyle Double Double
#buffer) Double
0.04
    ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic
  An_AffineTraversal NoIx ChartOptions ChartOptions Double Double
-> Double -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
#hudOptions Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
-> Optic
     A_Lens
     NoIx
     HudOptions
     HudOptions
     [Priority AxisOptions]
     [Priority AxisOptions]
-> Optic
     A_Lens
     NoIx
     ChartOptions
     ChartOptions
     [Priority AxisOptions]
     [Priority AxisOptions]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  NoIx
  HudOptions
  HudOptions
  [Priority AxisOptions]
  [Priority AxisOptions]
#axes Optic
  A_Lens
  NoIx
  ChartOptions
  ChartOptions
  [Priority AxisOptions]
  [Priority AxisOptions]
-> Optic
     (IxKind [Priority AxisOptions])
     NoIx
     [Priority AxisOptions]
     [Priority AxisOptions]
     (IxValue [Priority AxisOptions])
     (IxValue [Priority AxisOptions])
-> Optic
     An_AffineTraversal
     NoIx
     ChartOptions
     ChartOptions
     (IxValue [Priority AxisOptions])
     (IxValue [Priority AxisOptions])
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Index [Priority AxisOptions]
-> Optic
     (IxKind [Priority AxisOptions])
     NoIx
     [Priority AxisOptions]
     [Priority AxisOptions]
     (IxValue [Priority AxisOptions])
     (IxValue [Priority AxisOptions])
forall m. Ixed m => Index m -> Optic' (IxKind m) NoIx m (IxValue m)
ix Index [Priority AxisOptions]
1 Optic
  An_AffineTraversal
  NoIx
  ChartOptions
  ChartOptions
  (IxValue [Priority AxisOptions])
  (IxValue [Priority AxisOptions])
-> Optic
     A_Lens
     NoIx
     (IxValue [Priority AxisOptions])
     (IxValue [Priority AxisOptions])
     AxisOptions
     AxisOptions
-> Optic
     An_AffineTraversal
     NoIx
     ChartOptions
     ChartOptions
     AxisOptions
     AxisOptions
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  NoIx
  (IxValue [Priority AxisOptions])
  (IxValue [Priority AxisOptions])
  AxisOptions
  AxisOptions
#item Optic
  An_AffineTraversal
  NoIx
  ChartOptions
  ChartOptions
  AxisOptions
  AxisOptions
-> Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
-> Optic
     An_AffineTraversal NoIx ChartOptions ChartOptions Ticks Ticks
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
#ticks Optic An_AffineTraversal NoIx ChartOptions ChartOptions Ticks Ticks
-> Optic
     A_Lens NoIx Ticks Ticks (Maybe TickStyle) (Maybe TickStyle)
-> Optic
     An_AffineTraversal
     NoIx
     ChartOptions
     ChartOptions
     (Maybe TickStyle)
     (Maybe TickStyle)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Ticks Ticks (Maybe TickStyle) (Maybe TickStyle)
#glyphTick Optic
  An_AffineTraversal
  NoIx
  ChartOptions
  ChartOptions
  (Maybe TickStyle)
  (Maybe TickStyle)
-> Optic A_Lens NoIx TickStyle TickStyle Double Double
-> Optic
     An_AffineTraversal NoIx ChartOptions ChartOptions Double Double
forall (is :: IxList) (js :: IxList) (ks :: IxList) k k' l m s t u
       v a b.
(AppendIndices is js ks, JoinKinds k A_Prism k',
 JoinKinds k' l m) =>
Optic k is s t (Maybe u) (Maybe v)
-> Optic l js u v a b -> Optic m ks s t a b
%? Optic A_Lens NoIx TickStyle TickStyle Double Double
#buffer) Double
0.01
  where
    p :: QuadPosition Double
p@(QuadPosition Point Double
start Point Double
end Point Double
control) = Point Double -> Point Double -> Point Double -> QuadPosition Double
forall a. Point a -> Point a -> Point a -> QuadPosition a
QuadPosition (Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
0 Double
0) (Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
1 Double
1) (Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
2 (-Double
1))
    ps :: [PathData Double]
ps = QuadPosition Double -> [PathData Double]
singletonQuad QuadPosition Double
p
    path' :: Chart
path' = Style -> [PathData Double] -> Chart
PathChart Style
pathStyle [PathData Double]
ps
    curve :: Chart
curve = Style -> [[Point Double]] -> Chart
LineChart Style
curveStyle [QuadPosition Double -> Double -> Point Double
forall a.
(FromInteger a, ExpField a) =>
QuadPosition a -> a -> Point a
quadBezier QuadPosition Double
p (Double -> Point Double)
-> (Double -> Double) -> Double -> Point Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
100.0) (Double -> Point Double) -> [Double] -> [Point Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Double
0 .. Double
100]]
    curveStyle :: Style
curveStyle = Style
defaultLineStyle Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Double Double
-> Double -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Double Double
#size Double
0.002 Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Colour Colour
-> Colour -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Colour Colour
#color (Int -> Colour
palette Int
1)
    c0 :: Chart
c0 = Style -> [Point Double] -> Chart
GlyphChart (Style
defaultGlyphStyle Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style GlyphShape GlyphShape
-> GlyphShape -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style GlyphShape GlyphShape
#glyphShape GlyphShape
SquareGlyph) [Point Double
start, Point Double
end]
    c1 :: Chart
c1 = Style -> [Point Double] -> Chart
GlyphChart (Style
controlStyle Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style GlyphShape GlyphShape
-> GlyphShape -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style GlyphShape GlyphShape
#glyphShape GlyphShape
CircleGlyph) [Point Double
control]
    bbox :: Chart
bbox = Style -> [Rect Double] -> Chart
RectChart Style
bbs [QuadPosition Double -> Rect Double
quadBox QuadPosition Double
p]
    bbs :: Style
bbs = Style
defaultRectStyle Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Double Double
-> Double -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Double Double
#borderSize Double
0.002 Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Colour Colour
-> Colour -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Colour Colour
#color (Int -> Double -> Colour
paletteO Int
0 Double
0.05) Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Colour Colour
-> Colour -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Colour Colour
#borderColor (Double -> Double -> Colour
grey Double
0.4 Double
1)
    pathStyle :: Style
pathStyle = Style
defaultPathStyle Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Colour Colour
-> Colour -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Colour Colour
#color (Int -> Double -> Colour
paletteO Int
2 Double
0.2) Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Colour Colour
-> Colour -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Colour Colour
#borderColor Colour
transparent
    controlStyle :: Style
controlStyle = Style
defaultGlyphStyle Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style GlyphShape GlyphShape
-> GlyphShape -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style GlyphShape GlyphShape
#glyphShape GlyphShape
CircleGlyph
    lrows :: [(Text, [Chart])]
lrows =
      (Chart -> [Chart]) -> (Text, Chart) -> (Text, [Chart])
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (Chart -> [Chart] -> [Chart]
forall a. a -> [a] -> [a]
: [])
        ((Text, Chart) -> (Text, [Chart]))
-> [(Text, Chart)] -> [(Text, [Chart])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ (Text
"Path Fill", Style -> [PathData Double] -> Chart
PathChart Style
pathStyle [Point Double -> PathData Double
forall a. Point a -> PathData a
StartP Point Double
forall a. Additive a => a
zero]),
              (Text
"Path Chord", Style -> [[Point Double]] -> Chart
LineChart Style
curveStyle [[Point Double
forall a. Additive a => a
zero]]),
              (Text
"Path Endpoints", Style -> [Point Double] -> Chart
GlyphChart (Style
defaultGlyphStyle Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style GlyphShape GlyphShape
-> GlyphShape -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style GlyphShape GlyphShape
#glyphShape GlyphShape
SquareGlyph) [Point Double
forall a. Additive a => a
zero]),
              (Text
"Path Control Point", Style -> [Point Double] -> Chart
GlyphChart (Style
controlStyle Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style GlyphShape GlyphShape
-> GlyphShape -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style GlyphShape GlyphShape
#glyphShape GlyphShape
CircleGlyph) [Point Double
forall a. Additive a => a
zero]),
              (Text
"Bounding Box", Style -> [Rect Double] -> Chart
RectChart (Style
bbs Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Double Double
-> Double -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Double Double
#borderSize Double
0.01) [Rect Double
forall a. Multiplicative a => a
one])
            ]

-- | cubic example
--
-- ![cubic example](other/cubic.svg)
cubicExample :: ChartOptions
cubicExample :: ChartOptions
cubicExample =
  ChartOptions
forall a. Monoid a => a
mempty
    ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx ChartOptions ChartOptions ChartTree ChartTree
-> ChartTree -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx ChartOptions ChartOptions ChartTree ChartTree
#chartTree (Text -> [Chart] -> ChartTree
named Text
"cubic" [Chart
path', Chart
curve, Chart
c0, Chart
c1, Chart
bbox])
    ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
-> HudOptions -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
#hudOptions HudOptions
forall a. Monoid a => a
mempty
    ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx ChartOptions ChartOptions ChartAspect ChartAspect
-> ChartAspect -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (Optic
  A_Lens NoIx ChartOptions ChartOptions MarkupOptions MarkupOptions
#markupOptions Optic
  A_Lens NoIx ChartOptions ChartOptions MarkupOptions MarkupOptions
-> Optic
     A_Lens NoIx MarkupOptions MarkupOptions ChartAspect ChartAspect
-> Optic
     A_Lens NoIx ChartOptions ChartOptions ChartAspect ChartAspect
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens NoIx MarkupOptions MarkupOptions ChartAspect ChartAspect
#chartAspect) (Double -> ChartAspect
FixedAspect Double
1.5)
    ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic
  A_Lens
  NoIx
  ChartOptions
  ChartOptions
  [Priority LegendOptions]
  [Priority LegendOptions]
-> [Priority LegendOptions] -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
#hudOptions Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
-> Optic
     A_Lens
     NoIx
     HudOptions
     HudOptions
     [Priority LegendOptions]
     [Priority LegendOptions]
-> Optic
     A_Lens
     NoIx
     ChartOptions
     ChartOptions
     [Priority LegendOptions]
     [Priority LegendOptions]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  NoIx
  HudOptions
  HudOptions
  [Priority LegendOptions]
  [Priority LegendOptions]
#legends) [Double -> LegendOptions -> Priority LegendOptions
forall a. Double -> a -> Priority a
Priority Double
10 (LegendOptions
defaultLegendOptions LegendOptions -> (LegendOptions -> LegendOptions) -> LegendOptions
forall a b. a -> (a -> b) -> b
& Optic
  A_Lens
  NoIx
  LegendOptions
  LegendOptions
  [(Text, [Chart])]
  [(Text, [Chart])]
-> [(Text, [Chart])] -> LegendOptions -> LegendOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic
  A_Lens
  NoIx
  LegendOptions
  LegendOptions
  [(Text, [Chart])]
  [(Text, [Chart])]
#legendCharts [(Text, [Chart])]
lrows LegendOptions -> (LegendOptions -> LegendOptions) -> LegendOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx LegendOptions LegendOptions Double Double
-> Double -> LegendOptions -> LegendOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (Optic A_Lens NoIx LegendOptions LegendOptions Style Style
#textStyle Optic A_Lens NoIx LegendOptions LegendOptions Style Style
-> Optic A_Lens NoIx Style Style Double Double
-> Optic A_Lens NoIx LegendOptions LegendOptions Double Double
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Style Style Double Double
#size) Double
0.2 LegendOptions -> (LegendOptions -> LegendOptions) -> LegendOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx LegendOptions LegendOptions Double Double
-> Double -> LegendOptions -> LegendOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx LegendOptions LegendOptions Double Double
#legendSize Double
0.2 LegendOptions -> (LegendOptions -> LegendOptions) -> LegendOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx LegendOptions LegendOptions Double Double
-> Double -> LegendOptions -> LegendOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx LegendOptions LegendOptions Double Double
#vgap Double
0.3)]
    ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic
  A_Lens
  NoIx
  ChartOptions
  ChartOptions
  [Priority TitleOptions]
  [Priority TitleOptions]
-> [Priority TitleOptions] -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
#hudOptions Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
-> Optic
     A_Lens
     NoIx
     HudOptions
     HudOptions
     [Priority TitleOptions]
     [Priority TitleOptions]
-> Optic
     A_Lens
     NoIx
     ChartOptions
     ChartOptions
     [Priority TitleOptions]
     [Priority TitleOptions]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  NoIx
  HudOptions
  HudOptions
  [Priority TitleOptions]
  [Priority TitleOptions]
#titles) [Double -> TitleOptions -> Priority TitleOptions
forall a. Double -> a -> Priority a
Priority Double
11 (Text -> TitleOptions
defaultTitleOptions Text
"CubicPosition (Point 0 0) (Point 1 1) (Point 1 0) (Point 0 1)" TitleOptions -> (TitleOptions -> TitleOptions) -> TitleOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx TitleOptions TitleOptions Double Double
-> Double -> TitleOptions -> TitleOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (Optic A_Lens NoIx TitleOptions TitleOptions Style Style
#style Optic A_Lens NoIx TitleOptions TitleOptions Style Style
-> Optic A_Lens NoIx Style Style Double Double
-> Optic A_Lens NoIx TitleOptions TitleOptions Double Double
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Style Style Double Double
#size) Double
0.03)]
  where
    p :: CubicPosition Double
p@(CubicPosition Point Double
start Point Double
end Point Double
control1 Point Double
control2) = Point Double
-> Point Double
-> Point Double
-> Point Double
-> CubicPosition Double
forall a.
Point a -> Point a -> Point a -> Point a -> CubicPosition a
CubicPosition (Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
0 Double
0) (Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
1 Double
1) (Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
1 Double
0) (Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
0 Double
1)
    ps :: [PathData Double]
ps = CubicPosition Double -> [PathData Double]
singletonCubic CubicPosition Double
p
    path' :: Chart
path' = Style -> [PathData Double] -> Chart
PathChart Style
pathStyle [PathData Double]
ps
    curve :: Chart
curve = Style -> [[Point Double]] -> Chart
LineChart Style
curveStyle [CubicPosition Double -> Double -> Point Double
forall a.
(FromInteger a, TrigField a) =>
CubicPosition a -> a -> Point a
cubicBezier CubicPosition Double
p (Double -> Point Double)
-> (Double -> Double) -> Double -> Point Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
100.0) (Double -> Point Double) -> [Double] -> [Point Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Double
0 .. Double
100]]
    c0 :: Chart
c0 = Style -> [Point Double] -> Chart
GlyphChart (Style
defaultGlyphStyle Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style GlyphShape GlyphShape
-> GlyphShape -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style GlyphShape GlyphShape
#glyphShape GlyphShape
SquareGlyph) [Point Double
start, Point Double
end]
    c1 :: Chart
c1 = Style -> [Point Double] -> Chart
GlyphChart (Style
controlStyle Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style GlyphShape GlyphShape
-> GlyphShape -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style GlyphShape GlyphShape
#glyphShape GlyphShape
CircleGlyph) [Point Double
control1, Point Double
control2]
    bbox :: Chart
bbox = Style -> [Rect Double] -> Chart
RectChart Style
bbs [CubicPosition Double -> Rect Double
cubicBox CubicPosition Double
p]
    bbs :: Style
bbs = Style
defaultRectStyle Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Double Double
-> Double -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Double Double
#borderSize Double
0.002 Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Colour Colour
-> Colour -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Colour Colour
#color (Int -> Double -> Colour
paletteO Int
0 Double
0.05) Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Colour Colour
-> Colour -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Colour Colour
#borderColor (Double -> Double -> Colour
grey Double
0.4 Double
1)
    pathStyle :: Style
pathStyle = Style
defaultPathStyle Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Colour Colour
-> Colour -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Colour Colour
#color (Int -> Double -> Colour
paletteO Int
3 Double
0.2) Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Colour Colour
-> Colour -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Colour Colour
#borderColor Colour
transparent
    controlStyle :: Style
controlStyle = Style
defaultGlyphStyle
    curveStyle :: Style
curveStyle = Style
defaultLineStyle Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Double Double
-> Double -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Double Double
#size Double
0.002 Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Colour Colour
-> Colour -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Colour Colour
#color (Int -> Colour
palette Int
7)
    lrows :: [(Text, [Chart])]
lrows =
      (Chart -> [Chart]) -> (Text, Chart) -> (Text, [Chart])
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (Chart -> [Chart] -> [Chart]
forall a. a -> [a] -> [a]
: [])
        ((Text, Chart) -> (Text, [Chart]))
-> [(Text, Chart)] -> [(Text, [Chart])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ (Text
"Path Fill", Style -> [PathData Double] -> Chart
PathChart Style
pathStyle [Point Double -> PathData Double
forall a. Point a -> PathData a
StartP Point Double
forall a. Additive a => a
zero]),
              (Text
"Path Chord", Style -> [[Point Double]] -> Chart
LineChart Style
curveStyle [[Point Double
forall a. Additive a => a
zero]]),
              (Text
"Path Endpoints", Style -> [Point Double] -> Chart
GlyphChart (Style
defaultGlyphStyle Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style GlyphShape GlyphShape
-> GlyphShape -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style GlyphShape GlyphShape
#glyphShape GlyphShape
SquareGlyph) [Point Double
forall a. Additive a => a
zero]),
              (Text
"Path Control Point", Style -> [Point Double] -> Chart
GlyphChart (Style
controlStyle Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style GlyphShape GlyphShape
-> GlyphShape -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style GlyphShape GlyphShape
#glyphShape GlyphShape
CircleGlyph) [Point Double
forall a. Additive a => a
zero]),
              (Text
"Bounding Box", Style -> [Rect Double] -> Chart
RectChart (Style
bbs Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Double Double
-> Double -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Double Double
#borderSize Double
0.01) [Rect Double
forall a. Multiplicative a => a
one])
            ]

-- | The common way to create a surface chart (or contour chart or heat map) is usually a grid over a function, a process reified in 'surfacef'.
--
-- This is also an example of 'mix' and 'mixes'. In this example, colors with the same lightness have been chosen in the gradient and the result should appear a fairly uniform lightness across the surface.
--
-- ![surface example](other/surface.svg)
surfaceExample :: ChartOptions
surfaceExample :: ChartOptions
surfaceExample = ChartOptions
forall a. Monoid a => a
mempty ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx ChartOptions ChartOptions ChartTree ChartTree
-> ChartTree -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx ChartOptions ChartOptions ChartTree ChartTree
#chartTree ChartTree
cs' ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic
  A_Lens NoIx ChartOptions ChartOptions MarkupOptions MarkupOptions
-> MarkupOptions -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic
  A_Lens NoIx ChartOptions ChartOptions MarkupOptions MarkupOptions
#markupOptions (MarkupOptions
defaultMarkupOptions MarkupOptions -> (MarkupOptions -> MarkupOptions) -> MarkupOptions
forall a b. a -> (a -> b) -> b
& Optic
  A_Lens
  NoIx
  MarkupOptions
  MarkupOptions
  ShapeRendering
  ShapeRendering
-> ShapeRendering -> MarkupOptions -> MarkupOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (Optic A_Lens NoIx MarkupOptions MarkupOptions CssOptions CssOptions
#cssOptions Optic A_Lens NoIx MarkupOptions MarkupOptions CssOptions CssOptions
-> Optic
     A_Lens NoIx CssOptions CssOptions ShapeRendering ShapeRendering
-> Optic
     A_Lens
     NoIx
     MarkupOptions
     MarkupOptions
     ShapeRendering
     ShapeRendering
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens NoIx CssOptions CssOptions ShapeRendering ShapeRendering
#shapeRendering) ShapeRendering
UseCssCrisp)
  where
    grain :: Point Int
grain = Int -> Int -> Point Int
forall a. a -> a -> Point a
Point Int
20 Int
20
    r :: Rect Double
r = Rect Double
forall a. Multiplicative a => a
one
    f :: Point Double -> Double
f = (Double, Point Double) -> Double
forall a b. (a, b) -> a
fst ((Double, Point Double) -> Double)
-> (Point Double -> (Double, Point Double))
-> Point Double
-> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Double)
-> (Point Double -> Point Double)
-> (Double, Point Double)
-> (Double, Point Double)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap ((-Double
1.0) *) ((Double -> Double) -> Point Double -> Point Double
forall a b. (a -> b) -> Point a -> Point b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((-Double
1.0) *)) ((Double, Point Double) -> (Double, Point Double))
-> (Point Double -> (Double, Point Double))
-> Point Double
-> (Double, Point Double)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Double -> Point Double -> (Double, Point Double)
rosenbrock Double
1 Double
10
    evenColors :: [Colour]
evenColors = Colour -> Colour
trimColour (Colour -> Colour) -> (Int -> Colour) -> Int -> Colour
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Optic A_Lens NoIx Colour Colour Double Double
-> (Double -> Double) -> Colour -> Colour
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over Optic A_Lens NoIx Colour Colour Double Double
lightness' (Double -> Double -> Double
forall a b. a -> b -> a
const Double
0.55) (Colour -> Colour) -> (Int -> Colour) -> Int -> Colour
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Colour
palette (Int -> Colour) -> [Int] -> [Colour]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int
0 .. Int
5]
    so :: SurfaceOptions
so = SurfaceOptions
defaultSurfaceOptions SurfaceOptions
-> (SurfaceOptions -> SurfaceOptions) -> SurfaceOptions
forall a b. a -> (a -> b) -> b
& Optic
  A_Lens NoIx SurfaceOptions SurfaceOptions (Point Int) (Point Int)
-> Point Int -> SurfaceOptions -> SurfaceOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic
  A_Lens NoIx SurfaceOptions SurfaceOptions (Point Int) (Point Int)
#soGrain Point Int
grain SurfaceOptions
-> (SurfaceOptions -> SurfaceOptions) -> SurfaceOptions
forall a b. a -> (a -> b) -> b
& Optic
  A_Lens
  NoIx
  SurfaceOptions
  SurfaceOptions
  (Rect Double)
  (Rect Double)
-> Rect Double -> SurfaceOptions -> SurfaceOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic
  A_Lens
  NoIx
  SurfaceOptions
  SurfaceOptions
  (Rect Double)
  (Rect Double)
#soRange Rect Double
r SurfaceOptions
-> (SurfaceOptions -> SurfaceOptions) -> SurfaceOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx SurfaceOptions SurfaceOptions [Colour] [Colour]
-> [Colour] -> SurfaceOptions -> SurfaceOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (Optic
  A_Lens NoIx SurfaceOptions SurfaceOptions SurfaceStyle SurfaceStyle
#soStyle Optic
  A_Lens NoIx SurfaceOptions SurfaceOptions SurfaceStyle SurfaceStyle
-> Optic A_Lens NoIx SurfaceStyle SurfaceStyle [Colour] [Colour]
-> Optic
     A_Lens NoIx SurfaceOptions SurfaceOptions [Colour] [Colour]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx SurfaceStyle SurfaceStyle [Colour] [Colour]
#surfaceColors) [Colour]
evenColors
    ([Chart]
cs, Range Double
rangef) = (Point Double -> Double)
-> SurfaceOptions -> ([Chart], Range Double)
surfacef Point Double -> Double
f SurfaceOptions
so
    slo :: SurfaceLegendOptions
slo = SurfaceLegendOptions
defaultSurfaceLegendOptions SurfaceLegendOptions
-> (SurfaceLegendOptions -> SurfaceLegendOptions)
-> SurfaceLegendOptions
forall a b. a -> (a -> b) -> b
& Optic
  A_Lens
  NoIx
  SurfaceLegendOptions
  SurfaceLegendOptions
  [Colour]
  [Colour]
-> [Colour] -> SurfaceLegendOptions -> SurfaceLegendOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (Optic
  A_Lens
  NoIx
  SurfaceLegendOptions
  SurfaceLegendOptions
  SurfaceStyle
  SurfaceStyle
#sloSurfaceStyle Optic
  A_Lens
  NoIx
  SurfaceLegendOptions
  SurfaceLegendOptions
  SurfaceStyle
  SurfaceStyle
-> Optic A_Lens NoIx SurfaceStyle SurfaceStyle [Colour] [Colour]
-> Optic
     A_Lens
     NoIx
     SurfaceLegendOptions
     SurfaceLegendOptions
     [Colour]
     [Colour]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx SurfaceStyle SurfaceStyle [Colour] [Colour]
#surfaceColors) [Colour]
evenColors SurfaceLegendOptions
-> (SurfaceLegendOptions -> SurfaceLegendOptions)
-> SurfaceLegendOptions
forall a b. a -> (a -> b) -> b
& Optic
  A_Lens
  NoIx
  SurfaceLegendOptions
  SurfaceLegendOptions
  (Range Double)
  (Range Double)
-> Range Double -> SurfaceLegendOptions -> SurfaceLegendOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic
  A_Lens
  NoIx
  SurfaceLegendOptions
  SurfaceLegendOptions
  (Range Double)
  (Range Double)
#sloDataRange Range Double
rangef
    cs' :: ChartTree
cs' = SurfaceLegendOptions -> ChartTree -> ChartTree
addSurfaceLegend SurfaceLegendOptions
slo ([Chart] -> ChartTree
unnamed [Chart]
cs)

-- | arrow example
--
-- Which happens to be the gradient of the surface example.
--
-- ![arrow example](other/arrow.svg)
arrowExample :: ChartOptions
arrowExample :: ChartOptions
arrowExample =
  ChartOptions
forall a. Monoid a => a
mempty
    ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
-> HudOptions -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
#hudOptions (HudOptions
defaultHudOptions HudOptions -> (HudOptions -> HudOptions) -> HudOptions
forall a b. a -> (a -> b) -> b
& Optic
  A_Traversal
  (Int : NoIx)
  HudOptions
  HudOptions
  (Maybe TickStyle)
  (Maybe TickStyle)
-> Maybe TickStyle -> HudOptions -> HudOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (Optic
  A_Lens
  NoIx
  HudOptions
  HudOptions
  [Priority AxisOptions]
  [Priority AxisOptions]
#axes Optic
  A_Lens
  NoIx
  HudOptions
  HudOptions
  [Priority AxisOptions]
  [Priority AxisOptions]
-> Optic
     A_Traversal
     (Int : NoIx)
     [Priority AxisOptions]
     [Priority AxisOptions]
     (Priority AxisOptions)
     (Priority AxisOptions)
-> Optic
     A_Traversal
     (Int : NoIx)
     HudOptions
     HudOptions
     (Priority AxisOptions)
     (Priority AxisOptions)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Traversal
  (Int : NoIx)
  [Priority AxisOptions]
  [Priority AxisOptions]
  (Priority AxisOptions)
  (Priority AxisOptions)
forall i s t a b. Each i s t a b => IxTraversal i s t a b
each Optic
  A_Traversal
  (Int : NoIx)
  HudOptions
  HudOptions
  (Priority AxisOptions)
  (Priority AxisOptions)
-> Optic
     A_Lens
     NoIx
     (Priority AxisOptions)
     (Priority AxisOptions)
     AxisOptions
     AxisOptions
-> Optic
     A_Traversal
     (Int : NoIx)
     HudOptions
     HudOptions
     AxisOptions
     AxisOptions
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  NoIx
  (Priority AxisOptions)
  (Priority AxisOptions)
  AxisOptions
  AxisOptions
#item Optic
  A_Traversal
  (Int : NoIx)
  HudOptions
  HudOptions
  AxisOptions
  AxisOptions
-> Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
-> Optic A_Traversal (Int : NoIx) HudOptions HudOptions Ticks Ticks
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
#ticks Optic A_Traversal (Int : NoIx) HudOptions HudOptions Ticks Ticks
-> Optic
     A_Lens NoIx Ticks Ticks (Maybe TickStyle) (Maybe TickStyle)
-> Optic
     A_Traversal
     (Int : NoIx)
     HudOptions
     HudOptions
     (Maybe TickStyle)
     (Maybe TickStyle)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Ticks Ticks (Maybe TickStyle) (Maybe TickStyle)
#lineTick) Maybe TickStyle
forall a. Maybe a
Nothing)
    ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx ChartOptions ChartOptions ChartTree ChartTree
-> ChartTree -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx ChartOptions ChartOptions ChartTree ChartTree
#chartTree (Text -> [Chart] -> ChartTree
named Text
"arrow" ((\Point Double
p -> Double -> Double -> Point Double -> Chart
gchart (Point Double -> Double
tail' (Point Double -> Double)
-> (Point Double -> Point Double) -> Point Double -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point Double -> Point Double
f (Point Double -> Double) -> Point Double -> Double
forall a b. (a -> b) -> a -> b
$ Point Double
p) (Point Double -> Double
Point Double -> Dir (Point Double)
forall coord. Direction coord => coord -> Dir coord
angle (Point Double -> Double)
-> (Point Double -> Point Double) -> Point Double -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point Double -> Point Double
f (Point Double -> Double) -> Point Double -> Double
forall a b. (a -> b) -> a -> b
$ Point Double
p) Point Double
p) (Point Double -> Chart) -> [Point Double] -> [Chart]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Point Double]
ps))
    ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic
  A_Lens
  NoIx
  ChartOptions
  ChartOptions
  PreferColorScheme
  PreferColorScheme
-> PreferColorScheme -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (Optic
  A_Lens NoIx ChartOptions ChartOptions MarkupOptions MarkupOptions
#markupOptions Optic
  A_Lens NoIx ChartOptions ChartOptions MarkupOptions MarkupOptions
-> Optic
     A_Lens NoIx MarkupOptions MarkupOptions CssOptions CssOptions
-> Optic
     A_Lens NoIx ChartOptions ChartOptions CssOptions CssOptions
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx MarkupOptions MarkupOptions CssOptions CssOptions
#cssOptions Optic A_Lens NoIx ChartOptions ChartOptions CssOptions CssOptions
-> Optic
     A_Lens
     NoIx
     CssOptions
     CssOptions
     PreferColorScheme
     PreferColorScheme
-> Optic
     A_Lens
     NoIx
     ChartOptions
     ChartOptions
     PreferColorScheme
     PreferColorScheme
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  NoIx
  CssOptions
  CssOptions
  PreferColorScheme
  PreferColorScheme
#preferColorScheme) PreferColorScheme
PreferHud
    ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx ChartOptions ChartOptions ByteString ByteString
-> ByteString -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set
      (Optic
  A_Lens NoIx ChartOptions ChartOptions MarkupOptions MarkupOptions
#markupOptions Optic
  A_Lens NoIx ChartOptions ChartOptions MarkupOptions MarkupOptions
-> Optic
     A_Lens NoIx MarkupOptions MarkupOptions CssOptions CssOptions
-> Optic
     A_Lens NoIx ChartOptions ChartOptions CssOptions CssOptions
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx MarkupOptions MarkupOptions CssOptions CssOptions
#cssOptions Optic A_Lens NoIx ChartOptions ChartOptions CssOptions CssOptions
-> Optic A_Lens NoIx CssOptions CssOptions ByteString ByteString
-> Optic
     A_Lens NoIx ChartOptions ChartOptions ByteString ByteString
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx CssOptions CssOptions ByteString ByteString
#cssExtra)
      [i|
{
  .arrow g {
    fill: #{showRGBA dark};
    stroke: #{showRGBA dark};
  }
}
@media (prefers-color-scheme:dark) {
  .arrow g {
    fill: #{showRGBA light};
    stroke: #{showRGBA light};
  }
}
|]
  where
    f :: Point Double -> Point Double
f = (Double, Point Double) -> Point Double
forall a b. (a, b) -> b
snd ((Double, Point Double) -> Point Double)
-> (Point Double -> (Double, Point Double))
-> Point Double
-> Point Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Double)
-> (Point Double -> Point Double)
-> (Double, Point Double)
-> (Double, Point Double)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap ((-Double
1.0) *) ((Double -> Double) -> Point Double -> Point Double
forall a b. (a -> b) -> Point a -> Point b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((-Double
1.0) *)) ((Double, Point Double) -> (Double, Point Double))
-> (Point Double -> (Double, Point Double))
-> Point Double
-> (Double, Point Double)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Double -> Point Double -> (Double, Point Double)
rosenbrock Double
1 Double
10
    ps :: [Point Double]
ps = Pos -> Rect Double -> Grid (Rect Double) -> [Element (Rect Double)]
forall s. FieldSpace s => Pos -> s -> Grid s -> [Element s]
grid Pos
MidPos (Rect Double
forall a. Multiplicative a => a
one :: Rect Double) (Int -> Int -> Point Int
forall a. a -> a -> Point a
Point Int
10 Int
10 :: Point Int) :: [Point Double]
    arrow :: GlyphShape
arrow = ByteString -> GlyphShape
PathGlyph ByteString
"M -1 0 L 1 0 M 1 0 L 0.4 0.3 M 1 0 L 0.4 -0.3"
    gs :: Double -> Double -> Style
gs Double
s Double
r' =
      Style
defaultGlyphStyle
        Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Double Double
-> Double -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Double Double
#borderSize Double
0.05
        Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Double Double
-> Double -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Double Double
#size Double
s
        Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Colour Colour
-> Colour -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Colour Colour
#borderColor Colour
dark
        Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style (Maybe Double) (Maybe Double)
-> Maybe Double -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style (Maybe Double) (Maybe Double)
#rotation (Double -> Maybe Double
forall a. a -> Maybe a
Just Double
r')
        Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style GlyphShape GlyphShape
-> GlyphShape -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style GlyphShape GlyphShape
#glyphShape GlyphShape
arrow
    gchart :: Double -> Double -> Point Double -> Chart
gchart Double
s Double
r' Point Double
p = Style -> [Point Double] -> Chart
GlyphChart (Double -> Double -> Style
gs Double
s Double
r') [Point Double
p]

    tail' :: Point Double -> Double
    tail' :: Point Double -> Double
tail' = Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
0.05 (Double -> Double)
-> (Point Double -> Double) -> Point Double -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Double -> Double
forall a. Ord a => a -> a -> a
min Double
0.02 (Double -> Double)
-> (Point Double -> Double) -> Point Double -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
0.01) (Double -> Double)
-> (Point Double -> Double) -> Point Double -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
avmag) (Double -> Double)
-> (Point Double -> Double) -> Point Double -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point Double -> Double
Point Double -> Mag (Point Double)
forall a. Basis a => a -> Mag a
magnitude

    avmag :: Double
avmag = [Double] -> Double
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (Point Double -> Double
Point Double -> Mag (Point Double)
forall a. Basis a => a -> Mag a
magnitude (Point Double -> Double)
-> (Point Double -> Point Double) -> Point Double -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point Double -> Point Double
f (Point Double -> Double) -> [Point Double] -> [Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Point Double]
ps) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Point Double] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Point Double]
ps)

-- | function for testing
--
-- > f(x,y) = (a-x)^2 + b * (y - x^2)^2
-- >        = a^2 - 2ax + x^2 + b * y^2 - b * 2 * y * x^2 + b * x ^ 4
-- > f'x = -2a + 2 * x - b * 4 * y * x + 4 * b * x ^ 3
-- > f'y = 2 * b * y - 2 * b * x^2
-- > f a b (Point x y) = (a^2 - 2ax + x^2 + b * y^2 - b * 2 * y * x^2 + b * x^4, Point (-2a + 2 * x - b * 4 * y * x + 4 * b * x ^ 3), 2 * b * y - 2 * b * x^2)
rosenbrock :: Double -> Double -> Point Double -> (Double, Point Double)
rosenbrock :: Double -> Double -> Point Double -> (Double, Point Double)
rosenbrock Double
a Double
b (Point Double
x Double
y) = (Double
a Double -> Double -> Double
forall a. Floating a => a -> a -> a
** Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
a Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
x Double -> Double -> Double
forall a. Floating a => a -> a -> a
** Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
b Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
y Double -> Double -> Double
forall a. Floating a => a -> a -> a
** Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
b Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
y Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
x Double -> Double -> Double
forall a. Floating a => a -> a -> a
** Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
b Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
x Double -> Double -> Double
forall a. Floating a => a -> a -> a
** Double
4, Double -> Double -> Point Double
forall a. a -> a -> Point a
Point ((-Double
2) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
a Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
b Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
4 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
y Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
4 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
b Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
x Double -> Double -> Double
forall a. Floating a => a -> a -> a
** Double
3) (Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
b Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
y Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
b Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
x Double -> Double -> Double
forall a. Floating a => a -> a -> a
** Double
2))

-- | date example
--
-- A hud that has date as the x-axis, and time as the y-axis. See 'placedTimeLabelContinuous'.
--
-- ![date example](other/date.svg)
dateExample :: ChartOptions
dateExample :: ChartOptions
dateExample =
  ChartOptions
forall a. Monoid a => a
mempty
    ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx ChartOptions ChartOptions ChartTree ChartTree
-> ChartTree -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx ChartOptions ChartOptions ChartTree ChartTree
#chartTree (Rect Double -> ChartTree
blank (Double -> Double -> Double -> Double -> Rect Double
forall a. a -> a -> a -> a -> Rect a
Rect Double
0 Double
1 Double
0 Double
1))
    ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx ChartOptions ChartOptions ChartAspect ChartAspect
-> ChartAspect -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (Optic
  A_Lens NoIx ChartOptions ChartOptions MarkupOptions MarkupOptions
#markupOptions Optic
  A_Lens NoIx ChartOptions ChartOptions MarkupOptions MarkupOptions
-> Optic
     A_Lens NoIx MarkupOptions MarkupOptions ChartAspect ChartAspect
-> Optic
     A_Lens NoIx ChartOptions ChartOptions ChartAspect ChartAspect
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens NoIx MarkupOptions MarkupOptions ChartAspect ChartAspect
#chartAspect) (Double -> ChartAspect
FixedAspect Double
1.5)
    ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic
  A_Lens
  NoIx
  ChartOptions
  ChartOptions
  [Priority FrameOptions]
  [Priority FrameOptions]
-> ([Priority FrameOptions] -> [Priority FrameOptions])
-> ChartOptions
-> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over (Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
#hudOptions Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
-> Optic
     A_Lens
     NoIx
     HudOptions
     HudOptions
     [Priority FrameOptions]
     [Priority FrameOptions]
-> Optic
     A_Lens
     NoIx
     ChartOptions
     ChartOptions
     [Priority FrameOptions]
     [Priority FrameOptions]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  NoIx
  HudOptions
  HudOptions
  [Priority FrameOptions]
  [Priority FrameOptions]
#frames) ([Priority FrameOptions]
-> [Priority FrameOptions] -> [Priority FrameOptions]
forall a. Semigroup a => a -> a -> a
<> [Double -> FrameOptions -> Priority FrameOptions
forall a. Double -> a -> Priority a
Priority Double
100 (FrameOptions
defaultFrameOptions FrameOptions -> (FrameOptions -> FrameOptions) -> FrameOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx FrameOptions FrameOptions Double Double
-> Double -> FrameOptions -> FrameOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx FrameOptions FrameOptions Double Double
#buffer Double
0.05)])
    ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic
  A_Lens
  NoIx
  ChartOptions
  ChartOptions
  [Priority AxisOptions]
  [Priority AxisOptions]
-> [Priority AxisOptions] -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
#hudOptions Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
-> Optic
     A_Lens
     NoIx
     HudOptions
     HudOptions
     [Priority AxisOptions]
     [Priority AxisOptions]
-> Optic
     A_Lens
     NoIx
     ChartOptions
     ChartOptions
     [Priority AxisOptions]
     [Priority AxisOptions]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  NoIx
  HudOptions
  HudOptions
  [Priority AxisOptions]
  [Priority AxisOptions]
#axes) [Double -> AxisOptions -> Priority AxisOptions
forall a. Double -> a -> Priority a
Priority Double
5 (AxisOptions
defaultYAxisOptions AxisOptions -> (AxisOptions -> AxisOptions) -> AxisOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx AxisOptions AxisOptions Tick Tick
-> Tick -> AxisOptions -> AxisOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
#ticks Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
-> Optic A_Lens NoIx Ticks Ticks Tick Tick
-> Optic A_Lens NoIx AxisOptions AxisOptions Tick Tick
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Ticks Ticks Tick Tick
#tick) ([(Double, Text)] -> Tick
TickPlaced [(Double, Text)]
tsTime)), Double -> AxisOptions -> Priority AxisOptions
forall a. Double -> a -> Priority a
Priority Double
6 (AxisOptions
defaultXAxisOptions AxisOptions -> (AxisOptions -> AxisOptions) -> AxisOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx AxisOptions AxisOptions Tick Tick
-> Tick -> AxisOptions -> AxisOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
#ticks Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
-> Optic A_Lens NoIx Ticks Ticks Tick Tick
-> Optic A_Lens NoIx AxisOptions AxisOptions Tick Tick
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Ticks Ticks Tick Tick
#tick) ([(Double, Text)] -> Tick
TickPlaced [(Double, Text)]
tsDate))]
  where
    tsTime :: [(Double, Text)]
tsTime = PosDiscontinuous
-> Maybe Text -> Int -> Range UTCTime -> [(Double, Text)]
placedTimeLabelContinuous PosDiscontinuous
PosIncludeBoundaries Maybe Text
forall a. Maybe a
Nothing Int
12 (UTCTime -> UTCTime -> Range UTCTime
forall a. a -> a -> Range a
Range (Day -> DiffTime -> UTCTime
UTCTime (Year -> Int -> Int -> Day
fromGregorian Year
2021 Int
12 Int
6) (Double -> DiffTime
toDiffTime Double
0)) (Day -> DiffTime -> UTCTime
UTCTime (Year -> Int -> Int -> Day
fromGregorian Year
2021 Int
12 Int
7) (Double -> DiffTime
toDiffTime Double
0)))
    tsDate :: [(Double, Text)]
tsDate = PosDiscontinuous
-> Maybe Text -> Int -> Range UTCTime -> [(Double, Text)]
placedTimeLabelContinuous PosDiscontinuous
PosIncludeBoundaries (Text -> Maybe Text
forall a. a -> Maybe a
Just (FilePath -> Text
Text.pack FilePath
"%d %b")) Int
2 (UTCTime -> UTCTime -> Range UTCTime
forall a. a -> a -> Range a
Range (Day -> DiffTime -> UTCTime
UTCTime (Year -> Int -> Int -> Day
fromGregorian Year
2021 Int
12 Int
6) (Double -> DiffTime
toDiffTime Double
0)) (Day -> DiffTime -> UTCTime
UTCTime (Year -> Int -> Int -> Day
fromGregorian Year
2022 Int
3 Int
13) (Double -> DiffTime
toDiffTime Double
0)))

-- | gradient example
--
-- Mixing Colours using the <https://bottosson.github.io/posts/oklab/ oklch> color model.
--
-- ![gradient example](other/gradient.svg)
gradientExample :: ChartOptions
gradientExample :: ChartOptions
gradientExample = Maybe Double
-> Double -> Double -> Int -> LCHA -> LCHA -> ChartOptions
gradient (Double -> Maybe Double
forall a. a -> Maybe a
Just (Double
orig Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
360)) Double
100 Double
6 Int
100 LCHA
c0 LCHA
c1
  where
    ok :: LCHA
ok = Double -> Double -> Double -> Double -> LCHA
LCHA Double
0.5 Double
0.12 Double
127 Double
1
    c0 :: LCHA
c0 = LCHA
ok LCHA -> (LCHA -> LCHA) -> LCHA
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx LCHA LCHA Double Double -> Double -> LCHA -> LCHA
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (Lens' LCHA (LCH Double)
lch' Lens' LCHA (LCH Double)
-> Optic A_Lens NoIx (LCH Double) (LCH Double) Double Double
-> Optic A_Lens NoIx LCHA LCHA Double Double
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx (LCH Double) (LCH Double) Double Double
hLCH') Double
0.001
    c1 :: LCHA
c1 = LCHA
ok LCHA -> (LCHA -> LCHA) -> LCHA
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx LCHA LCHA Double Double -> Double -> LCHA -> LCHA
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (Lens' LCHA (LCH Double)
lch' Lens' LCHA (LCH Double)
-> Optic A_Lens NoIx (LCH Double) (LCH Double) Double Double
-> Optic A_Lens NoIx LCHA LCHA Double Double
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx (LCH Double) (LCH Double) Double Double
hLCH') Double
360
    orig :: Double
orig = Optic A_Lens NoIx LCHA LCHA Double Double -> LCHA -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view (Lens' LCHA (LCH Double)
lch' Lens' LCHA (LCH Double)
-> Optic A_Lens NoIx (LCH Double) (LCH Double) Double Double
-> Optic A_Lens NoIx LCHA LCHA Double Double
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx (LCH Double) (LCH Double) Double Double
hLCH') LCHA
ok

gradientChart_ :: Int -> LCHA -> LCHA -> [Chart]
gradientChart_ :: Int -> LCHA -> LCHA -> [Chart]
gradientChart_ Int
grain LCHA
c0 LCHA
c1 =
  (\(Rect Double
r, Colour
c) -> Style -> [Rect Double] -> Chart
RectChart (Style
defaultRectStyle Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Colour Colour
-> Colour -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Colour Colour
#color Colour
c Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Double Double
-> Double -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Double Double
#borderSize Double
0) [Rect Double
r])
    ((Rect Double, Colour) -> Chart)
-> (Double -> (Rect Double, Colour)) -> Double -> Chart
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\Double
x -> (Double -> Double -> Double -> Double -> Rect Double
forall a. a -> a -> a -> a -> Rect a
Rect Double
x (Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
d) Double
0 Double
1, Optic' An_Iso NoIx LCHA Colour -> LCHA -> Colour
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' An_Iso NoIx LCHA Colour
lcha2colour' (Double -> LCHA -> LCHA -> LCHA
mixLCHA Double
x LCHA
c0 LCHA
c1)))
    (Double -> Chart) -> [Double] -> [Chart]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pos
-> Range Double -> Grid (Range Double) -> [Element (Range Double)]
forall s. FieldSpace s => Pos -> s -> Grid s -> [Element s]
grid Pos
LowerPos (Double -> Double -> Range Double
forall a. a -> a -> Range a
Range Double
0 Double
1) Int
Grid (Range Double)
grain
  where
    d :: Double
d = Double
1 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
grain

gradient :: Maybe Double -> Double -> Double -> Int -> LCHA -> LCHA -> ChartOptions
gradient :: Maybe Double
-> Double -> Double -> Int -> LCHA -> LCHA -> ChartOptions
gradient Maybe Double
marker Double
h Double
fa Int
grain LCHA
ok0 LCHA
ok1 =
  ChartOptions
forall a. Monoid a => a
mempty
    ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic
  A_Lens NoIx ChartOptions ChartOptions (Maybe Double) (Maybe Double)
-> Maybe Double -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (Optic
  A_Lens NoIx ChartOptions ChartOptions MarkupOptions MarkupOptions
#markupOptions Optic
  A_Lens NoIx ChartOptions ChartOptions MarkupOptions MarkupOptions
-> Optic
     A_Lens
     NoIx
     MarkupOptions
     MarkupOptions
     (Maybe Double)
     (Maybe Double)
-> Optic
     A_Lens NoIx ChartOptions ChartOptions (Maybe Double) (Maybe Double)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  NoIx
  MarkupOptions
  MarkupOptions
  (Maybe Double)
  (Maybe Double)
#markupHeight) (Double -> Maybe Double
forall a. a -> Maybe a
Just Double
h)
    ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic
  A_Lens NoIx ChartOptions ChartOptions ShapeRendering ShapeRendering
-> ShapeRendering -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (Optic
  A_Lens NoIx ChartOptions ChartOptions MarkupOptions MarkupOptions
#markupOptions Optic
  A_Lens NoIx ChartOptions ChartOptions MarkupOptions MarkupOptions
-> Optic
     A_Lens NoIx MarkupOptions MarkupOptions CssOptions CssOptions
-> Optic
     A_Lens NoIx ChartOptions ChartOptions CssOptions CssOptions
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx MarkupOptions MarkupOptions CssOptions CssOptions
#cssOptions Optic A_Lens NoIx ChartOptions ChartOptions CssOptions CssOptions
-> Optic
     A_Lens NoIx CssOptions CssOptions ShapeRendering ShapeRendering
-> Optic
     A_Lens NoIx ChartOptions ChartOptions ShapeRendering ShapeRendering
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens NoIx CssOptions CssOptions ShapeRendering ShapeRendering
#shapeRendering) ShapeRendering
UseCssCrisp
    ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx ChartOptions ChartOptions ChartAspect ChartAspect
-> ChartAspect -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (Optic
  A_Lens NoIx ChartOptions ChartOptions MarkupOptions MarkupOptions
#markupOptions Optic
  A_Lens NoIx ChartOptions ChartOptions MarkupOptions MarkupOptions
-> Optic
     A_Lens NoIx MarkupOptions MarkupOptions ChartAspect ChartAspect
-> Optic
     A_Lens NoIx ChartOptions ChartOptions ChartAspect ChartAspect
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens NoIx MarkupOptions MarkupOptions ChartAspect ChartAspect
#chartAspect) (Double -> ChartAspect
FixedAspect Double
fa)
    ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
-> HudOptions -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set
      #hudOptions
      ( HudOptions
forall a. Monoid a => a
mempty
          HudOptions -> (HudOptions -> HudOptions) -> HudOptions
forall a b. a -> (a -> b) -> b
& Optic
  A_Lens
  NoIx
  HudOptions
  HudOptions
  [Priority FrameOptions]
  [Priority FrameOptions]
-> [Priority FrameOptions] -> HudOptions -> HudOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic
  A_Lens
  NoIx
  HudOptions
  HudOptions
  [Priority FrameOptions]
  [Priority FrameOptions]
#frames [Double -> FrameOptions -> Priority FrameOptions
forall a. Double -> a -> Priority a
Priority Double
1 (Maybe Style -> HudChartSection -> Double -> FrameOptions
FrameOptions (Style -> Maybe Style
forall a. a -> Maybe a
Just (Double -> Colour -> Style
border Double
0.004 Colour
white)) HudChartSection
CanvasStyleSection Double
0.1)]
      )
    ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx ChartOptions ChartOptions ChartTree ChartTree
-> ChartTree -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx ChartOptions ChartOptions ChartTree ChartTree
#chartTree (Text -> [Chart] -> ChartTree
named Text
"gradient" (Int -> LCHA -> LCHA -> [Chart]
gradientChart_ Int
grain LCHA
ok0 LCHA
ok1) ChartTree -> ChartTree -> ChartTree
forall a. Semigroup a => a -> a -> a
<> ChartTree
strip)
  where
    strip :: ChartTree
strip = case Maybe Double
marker of
      Maybe Double
Nothing -> ChartTree
forall a. Monoid a => a
mempty
      Just Double
marker' ->
        Text -> [Chart] -> ChartTree
named
          Text
"border"
          [Double -> Colour -> Rect Double -> Chart
borderStrip Double
0.02 Colour
light (Double -> Double -> Double -> Double -> Rect Double
forall a. a -> a -> a -> a -> Rect a
Rect (Double
marker' Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
0.02) (Double
marker' Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
0.02) (-Double
0.1) Double
1.1)]

borderStrip :: Double -> Colour -> Rect Double -> Chart
borderStrip :: Double -> Colour -> Rect Double -> Chart
borderStrip Double
w Colour
c Rect Double
r = Style -> [Rect Double] -> Chart
RectChart (Style
defaultRectStyle Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Colour Colour
-> Colour -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Colour Colour
#color Colour
transparent Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Double Double
-> Double -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Double Double
#borderSize Double
w Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Colour Colour
-> Colour -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Colour Colour
#borderColor Colour
c) [Rect Double
r]

-- | Color wheel displaying palette choices
--
-- ![wheel example](other/wheel.svg)
wheelExample :: ChartOptions
wheelExample :: ChartOptions
wheelExample = Double -> Int -> Double -> Double -> [Colour] -> ChartOptions
dotMap Double
0.01 Int
50 Double
0.5 Double
0.5 (Int -> Colour
palette (Int -> Colour) -> [Int] -> [Colour]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int
0 .. Int
7])

-- | The dotMap
--
-- > dotMap 0.01 20 0.8 0.3
dotMap :: Double -> Int -> Double -> Double -> [Colour] -> ChartOptions
dotMap :: Double -> Int -> Double -> Double -> [Colour] -> ChartOptions
dotMap Double
s Int
grain Double
l Double
maxchroma [Colour]
cs =
  ChartOptions
forall a. Monoid a => a
mempty
    ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
-> HudOptions -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
#hudOptions HudOptions
defaultHudOptions
    ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx ChartOptions ChartOptions ChartTree ChartTree
-> ChartTree -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx ChartOptions ChartOptions ChartTree ChartTree
#chartTree (Text -> [Chart] -> ChartTree
named Text
"dots" (Colour -> Chart
dot_ (Colour -> Chart) -> [Colour] -> [Chart]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Colour]
cs) ChartTree -> ChartTree -> ChartTree
forall a. Semigroup a => a -> a -> a
<> Text -> [Chart] -> ChartTree
named Text
"wheel" ((\(Point Double
p, Colour
c) -> Style -> [Point Double] -> Chart
GlyphChart (Style
defaultGlyphStyle Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Double Double
-> Double -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Double Double
#size Double
s Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Colour Colour
-> Colour -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Colour Colour
#color Colour
c Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Double Double
-> Double -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Double Double
#borderSize Double
0 Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style GlyphShape GlyphShape
-> GlyphShape -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style GlyphShape GlyphShape
#glyphShape GlyphShape
CircleGlyph) [Point Double
p]) ((Point Double, Colour) -> Chart)
-> [(Point Double, Colour)] -> [Chart]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Point Double, Colour) -> Bool)
-> [(Point Double, Colour)] -> [(Point Double, Colour)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Colour -> Bool
validColour (Colour -> Bool)
-> ((Point Double, Colour) -> Colour)
-> (Point Double, Colour)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Point Double, Colour) -> Colour
forall a b. (a, b) -> b
snd) (Int -> Double -> Double -> [(Point Double, Colour)]
wheelPoints Int
grain Double
l Double
maxchroma)))

dot_ :: Colour -> Chart
dot_ :: Colour -> Chart
dot_ Colour
x = (\(Point Double
p, Colour
c) -> Style -> [Point Double] -> Chart
GlyphChart (Style
defaultGlyphStyle Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Double Double
-> Double -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Double Double
#size Double
0.08 Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Colour Colour
-> Colour -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Colour Colour
#color Colour
c Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Colour Colour
-> Colour -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Colour Colour
#borderColor (Double -> Double -> Double -> Double -> Colour
Colour Double
0.5 Double
0.5 Double
0.5 Double
1) Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style GlyphShape GlyphShape
-> GlyphShape -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style GlyphShape GlyphShape
#glyphShape GlyphShape
CircleGlyph) [Point Double
p]) (Colour -> Point Double
colour2Point Colour
x, Colour
x)
  where
    colour2Point :: Colour -> Point Double
colour2Point Colour
c = Optic' An_Iso NoIx LCHA Colour -> Colour -> LCHA
forall k (is :: IxList) t b.
Is k A_Review =>
Optic' k is t b -> b -> t
review Optic' An_Iso NoIx LCHA Colour
lcha2colour' Colour
c LCHA -> (LCHA -> Point Double) -> Point Double
forall a b. a -> (a -> b) -> b
& (\(LCHA Double
_ Double
ch Double
h Double
_) -> (Double -> Double -> Point Double)
-> (Double, Double) -> Point Double
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Double -> Double -> Point Double
forall a. a -> a -> Point a
Point (Optic' An_Iso NoIx (Double, Double) (Double, Double)
-> (Double, Double) -> (Double, Double)
forall k (is :: IxList) t b.
Is k A_Review =>
Optic' k is t b -> b -> t
review Optic' An_Iso NoIx (Double, Double) (Double, Double)
xy2ch' (Double
ch, Double
h)))

wheelPoints :: Int -> Double -> Double -> [(Point Double, Colour)]
wheelPoints :: Int -> Double -> Double -> [(Point Double, Colour)]
wheelPoints Int
grain Double
l Double
maxchroma =
  (\(Point Double
c Double
h) -> ((Double -> Double -> Point Double)
-> (Double, Double) -> Point Double
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Double -> Double -> Point Double
forall a. a -> a -> Point a
Point ((Double, Double) -> Point Double)
-> (Double, Double) -> Point Double
forall a b. (a -> b) -> a -> b
$ Optic' An_Iso NoIx (Double, Double) (Double, Double)
-> (Double, Double) -> (Double, Double)
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view (Optic' An_Iso NoIx (Double, Double) (Double, Double)
-> Optic
     (ReversedOptic An_Iso)
     NoIx
     (Double, Double)
     (Double, Double)
     (Double, Double)
     (Double, Double)
forall (is :: IxList) s t a b.
AcceptsEmptyIndices "re" is =>
Optic An_Iso is s t a b -> Optic (ReversedOptic An_Iso) is b a t s
forall k (is :: IxList) s t a b.
(ReversibleOptic k, AcceptsEmptyIndices "re" is) =>
Optic k is s t a b -> Optic (ReversedOptic k) is b a t s
re Optic' An_Iso NoIx (Double, Double) (Double, Double)
xy2ch') (Double
c, Double
h), Optic' An_Iso NoIx LCHA Colour -> LCHA -> Colour
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' An_Iso NoIx LCHA Colour
lcha2colour' (Double -> Double -> Double -> Double -> LCHA
LCHA Double
l Double
c Double
h Double
1)))
    (Point Double -> (Point Double, Colour))
-> [Point Double] -> [(Point Double, Colour)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pos -> Rect Double -> Grid (Rect Double) -> [Element (Rect Double)]
forall s. FieldSpace s => Pos -> s -> Grid s -> [Element s]
grid Pos
LowerPos (Double -> Double -> Double -> Double -> Rect Double
forall a. a -> a -> a -> a -> Rect a
Rect Double
0 Double
maxchroma Double
0 Double
360) (Int -> Int -> Point Int
forall a. a -> a -> Point a
Point Int
grain Int
grain)

-- | Adding reference points and bounding boxes to visualize chart alignment for use in debugging charts.
--
-- ![debug example](other/debug.svg)
debugExample :: ChartOptions -> ChartOptions
debugExample :: ChartOptions -> ChartOptions
debugExample ChartOptions
cs =
  ChartOptions
forall a. Monoid a => a
mempty
    ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic
  A_Lens NoIx ChartOptions ChartOptions MarkupOptions MarkupOptions
-> MarkupOptions -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic
  A_Lens NoIx ChartOptions ChartOptions MarkupOptions MarkupOptions
#markupOptions (Optic
  A_Lens NoIx ChartOptions ChartOptions MarkupOptions MarkupOptions
-> ChartOptions -> MarkupOptions
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic
  A_Lens NoIx ChartOptions ChartOptions MarkupOptions MarkupOptions
#markupOptions ChartOptions
cs)
    ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx ChartOptions ChartOptions ChartAspect ChartAspect
-> ChartAspect -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (Optic
  A_Lens NoIx ChartOptions ChartOptions MarkupOptions MarkupOptions
#markupOptions Optic
  A_Lens NoIx ChartOptions ChartOptions MarkupOptions MarkupOptions
-> Optic
     A_Lens NoIx MarkupOptions MarkupOptions ChartAspect ChartAspect
-> Optic
     A_Lens NoIx ChartOptions ChartOptions ChartAspect ChartAspect
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens NoIx MarkupOptions MarkupOptions ChartAspect ChartAspect
#chartAspect) ChartAspect
asp
    ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx ChartOptions ChartOptions ChartTree ChartTree
-> ChartTree -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx ChartOptions ChartOptions ChartTree ChartTree
#chartTree (ChartTree
e1 ChartTree -> ChartTree -> ChartTree
forall a. Semigroup a => a -> a -> a
<> ChartTree
e2 ChartTree -> ChartTree -> ChartTree
forall a. Semigroup a => a -> a -> a
<> ChartTree
e3)
  where
    asp :: ChartAspect
asp = Optic A_Lens NoIx ChartOptions ChartOptions ChartAspect ChartAspect
-> ChartOptions -> ChartAspect
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view (Optic
  A_Lens NoIx ChartOptions ChartOptions MarkupOptions MarkupOptions
#markupOptions Optic
  A_Lens NoIx ChartOptions ChartOptions MarkupOptions MarkupOptions
-> Optic
     A_Lens NoIx MarkupOptions MarkupOptions ChartAspect ChartAspect
-> Optic
     A_Lens NoIx ChartOptions ChartOptions ChartAspect ChartAspect
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens NoIx MarkupOptions MarkupOptions ChartAspect ChartAspect
#chartAspect) ChartOptions
cs
    e1 :: ChartTree
e1 = Optic A_Lens NoIx ChartOptions ChartOptions ChartTree ChartTree
-> ChartOptions -> ChartTree
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic A_Lens NoIx ChartOptions ChartOptions ChartTree ChartTree
#chartTree (ChartOptions -> ChartOptions
forgetHud ChartOptions
cs)
    e2 :: ChartTree
e2 = Style -> ChartTree -> ChartTree
glyphize (Style
defaultGlyphStyle Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Double Double
-> Double -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Double Double
#size Double
0.01 Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style GlyphShape GlyphShape
-> GlyphShape -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style GlyphShape GlyphShape
#glyphShape GlyphShape
CircleGlyph) ChartTree
e1
    e3 :: ChartTree
e3 = Style -> ChartTree -> ChartTree
rectangularize (Style
defaultRectStyle Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Colour Colour
-> Colour -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Colour Colour
#borderColor Colour
dark Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Double Double
-> Double -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Double Double
#borderSize Double
0.001 Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Double Double
-> Double -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (Optic A_Lens NoIx Style Style Colour Colour
#color Optic A_Lens NoIx Style Style Colour Colour
-> Optic A_Lens NoIx Colour Colour Double Double
-> Optic A_Lens NoIx Style Style Double Double
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Colour Colour Double Double
opac') Double
0.05) ChartTree
e1

-- | A merge of two rect charts with different data ranges.
--
-- ![compound example](other/compound.svg)
compoundExample :: ChartOptions
compoundExample :: ChartOptions
compoundExample = [ChartOptions] -> ChartOptions
compoundMerge [ChartOptions
c1, ChartOptions
c2]
  where
    ho1 :: HudOptions
ho1 = (HudOptions
forall a. Monoid a => a
mempty :: HudOptions) HudOptions -> (HudOptions -> HudOptions) -> HudOptions
forall a b. a -> (a -> b) -> b
& Optic
  A_Lens
  NoIx
  HudOptions
  HudOptions
  [Priority TitleOptions]
  [Priority TitleOptions]
-> [Priority TitleOptions] -> HudOptions -> HudOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic
  A_Lens
  NoIx
  HudOptions
  HudOptions
  [Priority TitleOptions]
  [Priority TitleOptions]
#titles [Double -> TitleOptions -> Priority TitleOptions
forall a. Double -> a -> Priority a
Priority Double
3 (Text -> TitleOptions
defaultTitleOptions Text
"chart1")] HudOptions -> (HudOptions -> HudOptions) -> HudOptions
forall a b. a -> (a -> b) -> b
& Optic
  A_Lens
  NoIx
  HudOptions
  HudOptions
  [Priority AxisOptions]
  [Priority AxisOptions]
-> [Priority AxisOptions] -> HudOptions -> HudOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic
  A_Lens
  NoIx
  HudOptions
  HudOptions
  [Priority AxisOptions]
  [Priority AxisOptions]
#axes [Double -> AxisOptions -> Priority AxisOptions
forall a. Double -> a -> Priority a
Priority Double
2 AxisOptions
defaultXAxisOptions, Double -> AxisOptions -> Priority AxisOptions
forall a. Double -> a -> Priority a
Priority Double
2 AxisOptions
defaultYAxisOptions] HudOptions -> (HudOptions -> HudOptions) -> HudOptions
forall a b. a -> (a -> b) -> b
& (Colour -> Colour) -> HudOptions -> HudOptions
colourHudOptions (Colour -> Colour -> Colour
forall a b. a -> b -> a
const (Int -> Colour
palette Int
0))
    c1 :: ChartOptions
c1 = (ChartOptions
forall a. Monoid a => a
mempty :: ChartOptions) ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
-> HudOptions -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
#hudOptions HudOptions
ho1 ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx ChartOptions ChartOptions ChartTree ChartTree
-> ChartTree -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx ChartOptions ChartOptions ChartTree ChartTree
#chartTree (Text -> [Chart] -> ChartTree
named Text
"c1" [Style -> ChartData -> Chart
Chart Style
defaultRectStyle ([Rect Double] -> ChartData
RectData [(Double -> Double) -> Rect Double -> Rect Double
forall a b. (a -> b) -> Rect a -> Rect b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Double
2 *) Rect Double
forall a. Multiplicative a => a
one])])
    ho2 :: HudOptions
ho2 = (HudOptions
forall a. Monoid a => a
mempty :: HudOptions) HudOptions -> (HudOptions -> HudOptions) -> HudOptions
forall a b. a -> (a -> b) -> b
& Optic
  A_Lens
  NoIx
  HudOptions
  HudOptions
  [Priority TitleOptions]
  [Priority TitleOptions]
-> [Priority TitleOptions] -> HudOptions -> HudOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic
  A_Lens
  NoIx
  HudOptions
  HudOptions
  [Priority TitleOptions]
  [Priority TitleOptions]
#titles [Double -> TitleOptions -> Priority TitleOptions
forall a. Double -> a -> Priority a
Priority Double
3.1 (Text -> TitleOptions
defaultTitleOptions Text
"chart2")] HudOptions -> (HudOptions -> HudOptions) -> HudOptions
forall a b. a -> (a -> b) -> b
& Optic
  A_Lens
  NoIx
  HudOptions
  HudOptions
  [Priority AxisOptions]
  [Priority AxisOptions]
-> [Priority AxisOptions] -> HudOptions -> HudOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic
  A_Lens
  NoIx
  HudOptions
  HudOptions
  [Priority AxisOptions]
  [Priority AxisOptions]
#axes [Double -> AxisOptions -> Priority AxisOptions
forall a. Double -> a -> Priority a
Priority Double
2 (AxisOptions
defaultXAxisOptions AxisOptions -> (AxisOptions -> AxisOptions) -> AxisOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx AxisOptions AxisOptions Place Place
-> Place -> AxisOptions -> AxisOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx AxisOptions AxisOptions Place Place
#place Place
PlaceTop), Double -> AxisOptions -> Priority AxisOptions
forall a. Double -> a -> Priority a
Priority Double
2 (AxisOptions
defaultYAxisOptions AxisOptions -> (AxisOptions -> AxisOptions) -> AxisOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx AxisOptions AxisOptions Place Place
-> Place -> AxisOptions -> AxisOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx AxisOptions AxisOptions Place Place
#place Place
PlaceRight)] HudOptions -> (HudOptions -> HudOptions) -> HudOptions
forall a b. a -> (a -> b) -> b
& (Colour -> Colour) -> HudOptions -> HudOptions
colourHudOptions (Colour -> Colour -> Colour
forall a b. a -> b -> a
const (Int -> Colour
palette Int
3))
    c2 :: ChartOptions
c2 = (ChartOptions
forall a. Monoid a => a
mempty :: ChartOptions) ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
-> HudOptions -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
#hudOptions HudOptions
ho2 ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx ChartOptions ChartOptions ChartTree ChartTree
-> ChartTree -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx ChartOptions ChartOptions ChartTree ChartTree
#chartTree (Text -> [Chart] -> ChartTree
named Text
"c2" [Style -> ChartData -> Chart
Chart (Colour -> Style
blob (Optic A_Lens NoIx Colour Colour Double Double
-> Double -> Colour -> Colour
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Colour Colour Double Double
opac' Double
0.3 (Colour -> Colour) -> Colour -> Colour
forall a b. (a -> b) -> a -> b
$ Int -> Colour
palette Int
3)) ([Rect Double] -> ChartData
RectData [(Double -> Double) -> Rect Double -> Rect Double
forall a b. (a -> b) -> Rect a -> Rect b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
0.8) Rect Double
forall a. Multiplicative a => a
one]), Style -> [Rect Double] -> Chart
BlankChart Style
defaultStyle [Rect Double
forall a. Multiplicative a => a
one]])

-- | Usage of stack.
--
-- ![stack example](other/stack.svg)
stackExample :: ChartOptions
stackExample :: ChartOptions
stackExample = ChartOptions
forall a. Monoid a => a
mempty ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx ChartOptions ChartOptions ChartTree ChartTree
-> ChartTree -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx ChartOptions ChartOptions ChartTree ChartTree
#chartTree (Int -> Align -> Align -> Double -> [ChartTree] -> ChartTree
stack Int
5 Align
AlignLeft Align
AlignMid Double
0.1 (Int -> ChartTree -> [ChartTree]
forall a. Int -> a -> [a]
replicate Int
25 (ChartOptions -> ChartTree
asChartTree ChartOptions
lineExample)))

-- | All the examples and the associated filepaths
pathChartOptions :: [(FilePath, ChartOptions)]
pathChartOptions :: [(FilePath, ChartOptions)]
pathChartOptions =
  [ (FilePath
"other/unit.svg", ChartOptions
unitExample),
    (FilePath
"other/rect.svg", ChartOptions
rectExample),
    (FilePath
"other/text.svg", ChartOptions
textExample),
    (FilePath
"other/glyphs.svg", ChartOptions
glyphsExample),
    (FilePath
"other/line.svg", ChartOptions
lineExample),
    (FilePath
"other/hudoptions.svg", ChartOptions
hudOptionsExample),
    (FilePath
"other/bar.svg", ChartOptions
barExample),
    (FilePath
"other/sbar.svg", ChartOptions
sbarExample),
    (FilePath
"other/surface.svg", ChartOptions
surfaceExample),
    (FilePath
"other/wave.svg", ChartOptions
waveExample),
    (FilePath
"other/venn.svg", ChartOptions
vennExample),
    (FilePath
"other/path.svg", ChartOptions
pathExample),
    (FilePath
"other/arcflags.svg", ChartOptions
arcFlagsExample),
    (FilePath
"other/ellipse.svg", ChartAspect -> ChartOptions
ellipseExample (Double -> ChartAspect
FixedAspect Double
1.5)),
    (FilePath
"other/ellipse2.svg", ChartAspect -> ChartOptions
ellipseExample (Double -> ChartAspect
FixedAspect Double
2)),
    (FilePath
"other/quad.svg", ChartOptions
quadExample),
    (FilePath
"other/cubic.svg", ChartOptions
cubicExample),
    (FilePath
"other/arrow.svg", ChartOptions
arrowExample),
    (FilePath
"other/date.svg", ChartOptions
dateExample),
    (FilePath
"other/gradient.svg", ChartOptions
gradientExample),
    (FilePath
"other/wheel.svg", ChartOptions
wheelExample),
    (FilePath
"other/debug.svg", ChartOptions -> ChartOptions
debugExample ChartOptions
lineExample),
    (FilePath
"other/priorityv1.svg", ChartOptions
priorityv1Example),
    (FilePath
"other/priorityv2.svg", ChartOptions
priorityv2Example),
    (FilePath
"other/compound.svg", ChartOptions
compoundExample),
    (FilePath
"other/stack.svg", ChartOptions
stackExample)
  ]

-- | Run this to refresh example SVG's.
writeAllExamples :: IO ()
writeAllExamples :: IO ()
writeAllExamples = do
  ((FilePath, ChartOptions) -> IO ())
-> [(FilePath, ChartOptions)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((FilePath -> ChartOptions -> IO ())
-> (FilePath, ChartOptions) -> IO ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry FilePath -> ChartOptions -> IO ()
writeChartOptions) [(FilePath, ChartOptions)]
pathChartOptions
  FilePath -> IO ()
putStrLn FilePath
"ok"

-- | Version of charts with a dark-friendly hud
writeAllExamplesDark :: IO ()
writeAllExamplesDark :: IO ()
writeAllExamplesDark = do
  ((FilePath, ChartOptions) -> IO ())
-> [(FilePath, ChartOptions)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_
    ( (FilePath -> ChartOptions -> IO ())
-> (FilePath, ChartOptions) -> IO ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry FilePath -> ChartOptions -> IO ()
writeChartOptions
        ((FilePath, ChartOptions) -> IO ())
-> ((FilePath, ChartOptions) -> (FilePath, ChartOptions))
-> (FilePath, ChartOptions)
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> FilePath)
-> (ChartOptions -> ChartOptions)
-> (FilePath, ChartOptions)
-> (FilePath, ChartOptions)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap
          ((FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"d.svg") (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
forall a. [a] -> [a]
reverse (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
drop Int
4 (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
forall a. [a] -> [a]
reverse)
          ( \ChartOptions
x ->
              ChartOptions
x
                ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
-> (HudOptions -> HudOptions) -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
#hudOptions ((Colour -> Colour) -> HudOptions -> HudOptions
colourHudOptions (Colour -> Colour -> Colour
rgb Colour
light))
                ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic
  A_Lens
  NoIx
  ChartOptions
  ChartOptions
  PreferColorScheme
  PreferColorScheme
-> PreferColorScheme -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (Optic
  A_Lens NoIx ChartOptions ChartOptions MarkupOptions MarkupOptions
#markupOptions Optic
  A_Lens NoIx ChartOptions ChartOptions MarkupOptions MarkupOptions
-> Optic
     A_Lens NoIx MarkupOptions MarkupOptions CssOptions CssOptions
-> Optic
     A_Lens NoIx ChartOptions ChartOptions CssOptions CssOptions
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx MarkupOptions MarkupOptions CssOptions CssOptions
#cssOptions Optic A_Lens NoIx ChartOptions ChartOptions CssOptions CssOptions
-> Optic
     A_Lens
     NoIx
     CssOptions
     CssOptions
     PreferColorScheme
     PreferColorScheme
-> Optic
     A_Lens
     NoIx
     ChartOptions
     ChartOptions
     PreferColorScheme
     PreferColorScheme
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  NoIx
  CssOptions
  CssOptions
  PreferColorScheme
  PreferColorScheme
#preferColorScheme) PreferColorScheme
PreferDark
          )
    )
    [(FilePath, ChartOptions)]
pathChartOptions
  FilePath -> IO ()
putStrLn FilePath
"dark version, ok"