{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TupleSections #-}
{-# OPTIONS_GHC -Wall #-}

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

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

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

    -- * Colour
    gradientExample,
    wheelExample,

    -- * Debugging
    debugExample,
    writeAllExamples,
    writeAllExamplesDark,
  )
where

import Chart
import Data.Bifunctor
import Data.Bool
import Data.Function
import Data.Text (Text, pack)
import qualified Data.Text as Text
import Data.Time
import NeatInterpolation
import Optics.Core
import Prelude hiding (abs)

-- | unit example
--
-- ![unit example](other/unit.svg)
unitExample :: ChartSvg
unitExample :: ChartSvg
unitExample = ChartSvg
forall a. Monoid a => a
mempty ChartSvg -> (ChartSvg -> ChartSvg) -> ChartSvg
forall a b. a -> (a -> b) -> b
& IsLabel
  "charts" (Optic A_Lens NoIx ChartSvg ChartSvg ChartTree ChartTree)
Optic A_Lens NoIx ChartSvg ChartSvg ChartTree ChartTree
#charts Optic A_Lens NoIx ChartSvg ChartSvg ChartTree ChartTree
-> ChartTree -> ChartSvg -> ChartSvg
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Text -> [Chart] -> ChartTree
named Text
"unit" [RectStyle -> [Rect Double] -> Chart
RectChart RectStyle
defaultRectStyle [Rect Double
forall a. Multiplicative a => a
one]] ChartSvg -> (ChartSvg -> ChartSvg) -> ChartSvg
forall a b. a -> (a -> b) -> b
& IsLabel
  "hudOptions"
  (Optic A_Lens NoIx ChartSvg ChartSvg HudOptions HudOptions)
Optic A_Lens NoIx ChartSvg ChartSvg HudOptions HudOptions
#hudOptions Optic A_Lens NoIx ChartSvg ChartSvg HudOptions HudOptions
-> HudOptions -> ChartSvg -> ChartSvg
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ HudOptions
defaultHudOptions

-- | A 'BlankChart', 'defaultHudOptions' example.
--
-- ![hudoptions example](other/hudoptions.svg)
hudOptionsExample :: ChartSvg
hudOptionsExample :: ChartSvg
hudOptionsExample =
  ChartSvg
forall a. Monoid a => a
mempty
    ChartSvg -> (ChartSvg -> ChartSvg) -> ChartSvg
forall a b. a -> (a -> b) -> b
& IsLabel
  "hudOptions"
  (Optic A_Lens NoIx ChartSvg ChartSvg HudOptions HudOptions)
Optic A_Lens NoIx ChartSvg ChartSvg HudOptions HudOptions
#hudOptions Optic A_Lens NoIx ChartSvg ChartSvg HudOptions HudOptions
-> HudOptions -> ChartSvg -> ChartSvg
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ (Colour -> Colour) -> HudOptions -> HudOptions
colourHudOptions (Colour -> Colour -> Colour
rgb Colour
dark) HudOptions
defaultHudOptions
    ChartSvg -> (ChartSvg -> ChartSvg) -> ChartSvg
forall a b. a -> (a -> b) -> b
& IsLabel
  "charts" (Optic A_Lens NoIx ChartSvg ChartSvg ChartTree ChartTree)
Optic A_Lens NoIx ChartSvg ChartSvg ChartTree ChartTree
#charts Optic A_Lens NoIx ChartSvg ChartSvg ChartTree ChartTree
-> ChartTree -> ChartSvg -> ChartSvg
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Rect Double -> ChartTree
blank Rect Double
forall a. Multiplicative a => a
one

-- | rect example
--
-- ![rect example](other/rect.svg)
rectExample :: ChartSvg
rectExample :: ChartSvg
rectExample =
  ChartSvg
forall a. Monoid a => a
mempty
    ChartSvg -> (ChartSvg -> ChartSvg) -> ChartSvg
forall a b. a -> (a -> b) -> b
& IsLabel
  "hudOptions"
  (Optic A_Lens NoIx ChartSvg ChartSvg HudOptions HudOptions)
Optic A_Lens NoIx ChartSvg ChartSvg HudOptions HudOptions
#hudOptions
      Optic A_Lens NoIx ChartSvg ChartSvg HudOptions HudOptions
-> HudOptions -> ChartSvg -> ChartSvg
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ ( HudOptions
forall a. Monoid a => a
mempty
             HudOptions -> (HudOptions -> HudOptions) -> HudOptions
forall a b. a -> (a -> b) -> b
& Optic
  A_Lens
  NoIx
  HudOptions
  HudOptions
  [(Double, AxisOptions)]
  [(Double, AxisOptions)]
-> [(Double, 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
               #axes
               [(Double
1, AxisOptions
defaultAxisOptions AxisOptions -> (AxisOptions -> AxisOptions) -> AxisOptions
forall a b. a -> (a -> b) -> b
& IsLabel
  "ticks" (Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks)
Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
#ticks Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
-> Optic
     A_Lens
     NoIx
     Ticks
     Ticks
     (Maybe (LineStyle, Double))
     (Maybe (LineStyle, Double))
-> Optic
     A_Lens
     NoIx
     AxisOptions
     AxisOptions
     (Maybe (LineStyle, Double))
     (Maybe (LineStyle, 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
% IsLabel
  "ltick"
  (Optic
     A_Lens
     NoIx
     Ticks
     Ticks
     (Maybe (LineStyle, Double))
     (Maybe (LineStyle, Double)))
Optic
  A_Lens
  NoIx
  Ticks
  Ticks
  (Maybe (LineStyle, Double))
  (Maybe (LineStyle, Double))
#ltick Optic
  A_Lens
  NoIx
  AxisOptions
  AxisOptions
  (Maybe (LineStyle, Double))
  (Maybe (LineStyle, Double))
-> Maybe (LineStyle, Double) -> AxisOptions -> AxisOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Maybe (LineStyle, Double)
forall a. Maybe a
Nothing)]
         )
    ChartSvg -> (ChartSvg -> ChartSvg) -> ChartSvg
forall a b. a -> (a -> b) -> b
& IsLabel
  "charts" (Optic A_Lens NoIx ChartSvg ChartSvg ChartTree ChartTree)
Optic A_Lens NoIx ChartSvg ChartSvg ChartTree ChartTree
#charts Optic A_Lens NoIx ChartSvg ChartSvg ChartTree ChartTree
-> ChartTree -> ChartSvg -> ChartSvg
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Text -> [Chart] -> ChartTree
named Text
"rect" ((RectStyle -> [Rect Double] -> Chart)
-> [RectStyle] -> [[Rect Double]] -> [Chart]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith RectStyle -> [Rect Double] -> Chart
RectChart [RectStyle]
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 :: [RectStyle]
ropts :: [RectStyle]
ropts =
  [ Colour -> RectStyle
blob (Int -> Double -> Colour
palette1a Int
1 Double
0.4),
    Colour -> RectStyle
blob (Int -> Double -> Colour
palette1a Int
2 Double
0.4)
  ]

-- | line example
--
-- ![line example](other/line.svg)
lineExample :: ChartSvg
lineExample :: ChartSvg
lineExample =
  ChartSvg
forall a. Monoid a => a
mempty ChartSvg -> (ChartSvg -> ChartSvg) -> ChartSvg
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx ChartSvg ChartSvg HudOptions HudOptions
-> HudOptions -> ChartSvg -> ChartSvg
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set IsLabel
  "hudOptions"
  (Optic A_Lens NoIx ChartSvg ChartSvg HudOptions HudOptions)
Optic A_Lens NoIx ChartSvg ChartSvg HudOptions HudOptions
#hudOptions HudOptions
ho ChartSvg -> (ChartSvg -> ChartSvg) -> ChartSvg
forall a b. a -> (a -> b) -> b
& IsLabel
  "charts" (Optic A_Lens NoIx ChartSvg ChartSvg ChartTree ChartTree)
Optic A_Lens NoIx ChartSvg ChartSvg ChartTree ChartTree
#charts Optic A_Lens NoIx ChartSvg ChartSvg ChartTree ChartTree
-> ChartTree -> ChartSvg -> ChartSvg
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ 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
  [(Double, Title)]
  [(Double, Title)]
-> [(Double, Title)] -> 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
6, Text -> Title
defaultTitle Text
"Line Chart" Title -> (Title -> Title) -> Title
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Title Title Double Double
-> Double -> Title -> Title
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (IsLabel "style" (Optic A_Lens NoIx Title Title TextStyle TextStyle)
Optic A_Lens NoIx Title Title TextStyle TextStyle
#style Optic A_Lens NoIx Title Title TextStyle TextStyle
-> Optic A_Lens NoIx TextStyle TextStyle Double Double
-> Optic A_Lens NoIx Title Title 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
% IsLabel
  "size" (Optic A_Lens NoIx TextStyle TextStyle Double Double)
Optic A_Lens NoIx TextStyle TextStyle Double Double
#size) Double
0.1),
            ( Double
11,
              Text -> Title
defaultTitle Text
"Made with love and chart-svg"
                Title -> (Title -> Title) -> Title
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Title Title Double Double
-> Double -> Title -> Title
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (IsLabel "style" (Optic A_Lens NoIx Title Title TextStyle TextStyle)
Optic A_Lens NoIx Title Title TextStyle TextStyle
#style Optic A_Lens NoIx Title Title TextStyle TextStyle
-> Optic A_Lens NoIx TextStyle TextStyle Double Double
-> Optic A_Lens NoIx Title Title 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
% IsLabel
  "size" (Optic A_Lens NoIx TextStyle TextStyle Double Double)
Optic A_Lens NoIx TextStyle TextStyle Double Double
#size) Double
0.06
                Title -> (Title -> Title) -> Title
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Title Title Place Place
-> Place -> Title -> Title
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set IsLabel "place" (Optic A_Lens NoIx Title Title Place Place)
Optic A_Lens NoIx Title Title Place Place
#place Place
PlaceBottom
                Title -> (Title -> Title) -> Title
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Title Title Anchor Anchor
-> Anchor -> Title -> Title
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set IsLabel "anchor" (Optic A_Lens NoIx Title Title Anchor Anchor)
Optic A_Lens NoIx Title Title Anchor Anchor
#anchor Anchor
AnchorEnd
            )
          ]
        HudOptions -> (HudOptions -> HudOptions) -> HudOptions
forall a b. a -> (a -> b) -> b
& Optic
  A_Lens
  NoIx
  HudOptions
  HudOptions
  [(Double, FrameOptions)]
  [(Double, FrameOptions)]
-> ([(Double, FrameOptions)] -> [(Double, FrameOptions)])
-> HudOptions
-> HudOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over IsLabel
  "frames"
  (Optic
     A_Lens
     NoIx
     HudOptions
     HudOptions
     [(Double, FrameOptions)]
     [(Double, FrameOptions)])
Optic
  A_Lens
  NoIx
  HudOptions
  HudOptions
  [(Double, FrameOptions)]
  [(Double, FrameOptions)]
#frames ([(Double, FrameOptions)]
-> [(Double, FrameOptions)] -> [(Double, FrameOptions)]
forall a. Semigroup a => a -> a -> a
<> [(Double
20, FrameOptions
defaultFrameOptions FrameOptions -> (FrameOptions -> FrameOptions) -> FrameOptions
forall a b. a -> (a -> b) -> b
& IsLabel
  "buffer"
  (Optic A_Lens NoIx FrameOptions FrameOptions Double Double)
Optic A_Lens NoIx FrameOptions FrameOptions Double Double
#buffer 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
.~ Double
0.04)])
        HudOptions -> (HudOptions -> HudOptions) -> HudOptions
forall a b. a -> (a -> b) -> b
& Optic
  A_Lens
  NoIx
  HudOptions
  HudOptions
  [(Double, LegendOptions)]
  [(Double, LegendOptions)]
-> [(Double, 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
12,
              LegendOptions
defaultLegendOptions
                LegendOptions -> (LegendOptions -> LegendOptions) -> LegendOptions
forall a b. a -> (a -> b) -> b
& Optic
  A_Lens
  NoIx
  LegendOptions
  LegendOptions
  (Maybe RectStyle)
  (Maybe RectStyle)
-> (Maybe RectStyle -> Maybe RectStyle)
-> LegendOptions
-> LegendOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over IsLabel
  "frame"
  (Optic
     A_Lens
     NoIx
     LegendOptions
     LegendOptions
     (Maybe RectStyle)
     (Maybe RectStyle))
Optic
  A_Lens
  NoIx
  LegendOptions
  LegendOptions
  (Maybe RectStyle)
  (Maybe RectStyle)
#frame ((RectStyle -> RectStyle) -> Maybe RectStyle -> Maybe RectStyle
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Optic A_Lens NoIx RectStyle RectStyle Colour Colour
-> Colour -> RectStyle -> RectStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set IsLabel
  "color" (Optic A_Lens NoIx RectStyle RectStyle Colour Colour)
Optic A_Lens NoIx RectStyle RectStyle Colour Colour
#color Colour
white))
                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 IsLabel
  "place" (Optic A_Lens NoIx LegendOptions LegendOptions Place Place)
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.45 (-Double
0.35)))
                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 (IsLabel
  "textStyle"
  (Optic A_Lens NoIx LegendOptions LegendOptions TextStyle TextStyle)
Optic A_Lens NoIx LegendOptions LegendOptions TextStyle TextStyle
#textStyle Optic A_Lens NoIx LegendOptions LegendOptions TextStyle TextStyle
-> Optic A_Lens NoIx TextStyle TextStyle 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
% IsLabel
  "size" (Optic A_Lens NoIx TextStyle TextStyle Double Double)
Optic A_Lens NoIx TextStyle TextStyle Double Double
#size) Double
0.20
                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 IsLabel
  "content"
  (Optic
     A_Lens
     NoIx
     LegendOptions
     LegendOptions
     [(Text, Chart)]
     [(Text, Chart)])
Optic
  A_Lens
  NoIx
  LegendOptions
  LegendOptions
  [(Text, Chart)]
  [(Text, Chart)]
#content ([Text] -> [Chart] -> [(Text, Chart)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Text
"palette1 0", Text
"palette1 1", Text
"palette1 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 ->
            LineStyle -> [[Point Double]] -> Chart
LineChart
              ( LineStyle
defaultLineStyle
                  LineStyle -> (LineStyle -> LineStyle) -> LineStyle
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx LineStyle LineStyle Colour Colour
-> Colour -> LineStyle -> LineStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set IsLabel
  "color" (Optic A_Lens NoIx LineStyle LineStyle Colour Colour)
Optic A_Lens NoIx LineStyle LineStyle Colour Colour
#color (Int -> Colour
palette1 Int
c)
                  LineStyle -> (LineStyle -> LineStyle) -> LineStyle
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx LineStyle LineStyle Double Double
-> Double -> LineStyle -> LineStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set IsLabel
  "size" (Optic A_Lens NoIx LineStyle LineStyle Double Double)
Optic A_Lens NoIx LineStyle LineStyle 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]
      ]

-- | text example
--
-- ![text example](other/text.svg)
textExample :: ChartSvg
textExample :: ChartSvg
textExample =
  ChartSvg
forall a. Monoid a => a
mempty
    ChartSvg -> (ChartSvg -> ChartSvg) -> ChartSvg
forall a b. a -> (a -> b) -> b
& IsLabel
  "charts" (Optic A_Lens NoIx ChartSvg ChartSvg ChartTree ChartTree)
Optic A_Lens NoIx ChartSvg ChartSvg ChartTree ChartTree
#charts
      Optic A_Lens NoIx ChartSvg ChartSvg ChartTree ChartTree
-> ChartTree -> ChartSvg -> ChartSvg
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Text -> [Chart] -> ChartTree
named
        Text
"text"
        [ TextStyle -> [(Text, Point Double)] -> Chart
TextChart
            (TextStyle
defaultTextStyle TextStyle -> (TextStyle -> TextStyle) -> TextStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "color" (Optic A_Lens NoIx TextStyle TextStyle Colour Colour)
Optic A_Lens NoIx TextStyle TextStyle Colour Colour
#color Optic A_Lens NoIx TextStyle TextStyle Colour Colour
-> Colour -> TextStyle -> TextStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Colour
dark TextStyle -> (TextStyle -> TextStyle) -> TextStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "size" (Optic A_Lens NoIx TextStyle TextStyle Double Double)
Optic A_Lens NoIx TextStyle TextStyle Double Double
#size Optic A_Lens NoIx TextStyle TextStyle Double Double
-> Double -> TextStyle -> TextStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Double
0.05 TextStyle -> (TextStyle -> TextStyle) -> TextStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "vshift" (Optic A_Lens NoIx TextStyle TextStyle Double Double)
Optic A_Lens NoIx TextStyle TextStyle Double Double
#vshift Optic A_Lens NoIx TextStyle TextStyle Double Double
-> Double -> TextStyle -> TextStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Double
0)
            [(Text, Point Double)]
ts
        ]
    ChartSvg -> (ChartSvg -> ChartSvg) -> ChartSvg
forall a b. a -> (a -> b) -> b
& IsLabel
  "hudOptions"
  (Optic A_Lens NoIx ChartSvg ChartSvg HudOptions HudOptions)
Optic A_Lens NoIx ChartSvg ChartSvg HudOptions HudOptions
#hudOptions Optic A_Lens NoIx ChartSvg ChartSvg HudOptions HudOptions
-> HudOptions -> ChartSvg -> ChartSvg
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ HudOptions
defaultHudOptions
    ChartSvg -> (ChartSvg -> ChartSvg) -> ChartSvg
forall a b. a -> (a -> b) -> b
& IsLabel
  "svgOptions"
  (Optic A_Lens NoIx ChartSvg ChartSvg SvgOptions SvgOptions)
Optic A_Lens NoIx ChartSvg ChartSvg SvgOptions SvgOptions
#svgOptions Optic A_Lens NoIx ChartSvg ChartSvg SvgOptions SvgOptions
-> Optic A_Lens NoIx SvgOptions SvgOptions CssOptions CssOptions
-> Optic A_Lens NoIx ChartSvg ChartSvg 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
% IsLabel
  "cssOptions"
  (Optic A_Lens NoIx SvgOptions SvgOptions CssOptions CssOptions)
Optic A_Lens NoIx SvgOptions SvgOptions CssOptions CssOptions
#cssOptions Optic A_Lens NoIx ChartSvg ChartSvg CssOptions CssOptions
-> Optic
     A_Lens
     NoIx
     CssOptions
     CssOptions
     CssPreferColorScheme
     CssPreferColorScheme
-> Optic
     A_Lens
     NoIx
     ChartSvg
     ChartSvg
     CssPreferColorScheme
     CssPreferColorScheme
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
% IsLabel
  "preferColorScheme"
  (Optic
     A_Lens
     NoIx
     CssOptions
     CssOptions
     CssPreferColorScheme
     CssPreferColorScheme)
Optic
  A_Lens
  NoIx
  CssOptions
  CssOptions
  CssPreferColorScheme
  CssPreferColorScheme
#preferColorScheme Optic
  A_Lens
  NoIx
  ChartSvg
  ChartSvg
  CssPreferColorScheme
  CssPreferColorScheme
-> CssPreferColorScheme -> ChartSvg -> ChartSvg
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ CssPreferColorScheme
PreferHud
    ChartSvg -> (ChartSvg -> ChartSvg) -> ChartSvg
forall a b. a -> (a -> b) -> b
& IsLabel
  "svgOptions"
  (Optic A_Lens NoIx ChartSvg ChartSvg SvgOptions SvgOptions)
Optic A_Lens NoIx ChartSvg ChartSvg SvgOptions SvgOptions
#svgOptions Optic A_Lens NoIx ChartSvg ChartSvg SvgOptions SvgOptions
-> Optic A_Lens NoIx SvgOptions SvgOptions CssOptions CssOptions
-> Optic A_Lens NoIx ChartSvg ChartSvg 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
% IsLabel
  "cssOptions"
  (Optic A_Lens NoIx SvgOptions SvgOptions CssOptions CssOptions)
Optic A_Lens NoIx SvgOptions SvgOptions CssOptions CssOptions
#cssOptions Optic A_Lens NoIx ChartSvg ChartSvg CssOptions CssOptions
-> Optic A_Lens NoIx CssOptions CssOptions Text Text
-> Optic A_Lens NoIx ChartSvg ChartSvg Text Text
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
% IsLabel
  "cssExtra" (Optic A_Lens NoIx CssOptions CssOptions Text Text)
Optic A_Lens NoIx CssOptions CssOptions Text Text
#cssExtra Optic A_Lens NoIx ChartSvg ChartSvg Text Text
-> Text -> ChartSvg -> ChartSvg
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ (Colour, Colour) -> Text
textSwitch (Colour
light, Colour
dark)
  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) -> [Char] -> [Text]
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])

    textSwitch :: (Colour, Colour) -> Text
    textSwitch :: (Colour, Colour) -> Text
textSwitch (Colour
cl, Colour
cd) =
      [trimming|
{
  .text g {
    fill: $hexDark;
  }
}
@media (prefers-color-scheme:dark) {
  .text g {
    fill: $hexLight;
  }
}
|]
      where
        hexLight :: Text
hexLight = Colour -> Text
hex Colour
cl
        hexDark :: Text
hexDark = Colour -> Text
hex Colour
cd

-- | glyphs example
--
-- ![glyphs example](other/glyphs.svg)
glyphsExample :: ChartSvg
glyphsExample :: ChartSvg
glyphsExample =
  ChartSvg
forall a. Monoid a => a
mempty
    ChartSvg -> (ChartSvg -> ChartSvg) -> ChartSvg
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx ChartSvg ChartSvg Double Double
-> Double -> ChartSvg -> ChartSvg
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (IsLabel
  "svgOptions"
  (Optic A_Lens NoIx ChartSvg ChartSvg SvgOptions SvgOptions)
Optic A_Lens NoIx ChartSvg ChartSvg SvgOptions SvgOptions
#svgOptions Optic A_Lens NoIx ChartSvg ChartSvg SvgOptions SvgOptions
-> Optic A_Lens NoIx SvgOptions SvgOptions Double Double
-> Optic A_Lens NoIx ChartSvg ChartSvg 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
% IsLabel
  "svgHeight" (Optic A_Lens NoIx SvgOptions SvgOptions Double Double)
Optic A_Lens NoIx SvgOptions SvgOptions Double Double
#svgHeight) Double
400
    ChartSvg -> (ChartSvg -> ChartSvg) -> ChartSvg
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx ChartSvg ChartSvg ChartTree ChartTree
-> ChartTree -> ChartSvg -> ChartSvg
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set
      #charts
      ( 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 ->
                GlyphStyle -> [Point Double] -> Chart
GlyphChart
                  ( GlyphStyle
defaultGlyphStyle
                      GlyphStyle -> (GlyphStyle -> GlyphStyle) -> GlyphStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "size" (Optic A_Lens NoIx GlyphStyle GlyphStyle Double Double)
Optic A_Lens NoIx GlyphStyle GlyphStyle Double Double
#size Optic A_Lens NoIx GlyphStyle GlyphStyle Double Double
-> Double -> GlyphStyle -> GlyphStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ (Double
0.1 :: Double)
                      GlyphStyle -> (GlyphStyle -> GlyphStyle) -> GlyphStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "borderSize"
  (Optic A_Lens NoIx GlyphStyle GlyphStyle Double Double)
Optic A_Lens NoIx GlyphStyle GlyphStyle Double Double
#borderSize Optic A_Lens NoIx GlyphStyle GlyphStyle Double Double
-> Double -> GlyphStyle -> GlyphStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Double
bs
                      GlyphStyle -> (GlyphStyle -> GlyphStyle) -> GlyphStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "shape"
  (Optic A_Lens NoIx GlyphStyle GlyphStyle GlyphShape GlyphShape)
Optic A_Lens NoIx GlyphStyle GlyphStyle GlyphShape GlyphShape
#shape Optic A_Lens NoIx GlyphStyle GlyphStyle GlyphShape GlyphShape
-> GlyphShape -> GlyphStyle -> GlyphStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ GlyphShape
sh
                  )
                  [Point Double
p]
            )
            [ (GlyphShape
CircleGlyph, Double
0.01 :: Double),
              (GlyphShape
SquareGlyph, Double
0.01),
              (Double -> GlyphShape
RectSharpGlyph Double
0.75, Double
0.01),
              (Double -> Double -> Double -> GlyphShape
RectRoundedGlyph Double
0.75 Double
0.01 Double
0.01, Double
0.01),
              (Double -> GlyphShape
EllipseGlyph Double
0.75, Double
0.01),
              (GlyphShape
VLineGlyph, Double
0.01),
              (GlyphShape
HLineGlyph, Double
0.01),
              (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.01),
              (Text -> ScaleBorder -> GlyphShape
PathGlyph Text
"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" ScaleBorder
ScaleBorder, Double
0.01)
            ]
            [Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
x Double
0 | Double
x <- [Double
0 .. (Double
8 :: Double)]]
      )

-- | 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 -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> (Int -> Text) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
pack ([Char] -> Text) -> (Int -> [Char]) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Char]
forall a. Show a => a -> [Char]
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 -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> (Int -> Text) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
pack ([Char] -> Text) -> (Int -> [Char]) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Char]
forall a. Show a => a -> [Char]
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 :: ChartSvg
barExample :: ChartSvg
barExample = BarOptions -> BarData -> ChartSvg
barChart BarOptions
defaultBarOptions BarData
barDataExample

-- | Stacked bar chart example.
--
-- ![sbar example](other/sbar.svg)
sbarExample :: ChartSvg
sbarExample :: ChartSvg
sbarExample = BarOptions -> BarData -> ChartSvg
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 IsLabel
  "barOrientation"
  (Optic A_Lens NoIx BarOptions BarOptions Orientation Orientation)
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 IsLabel
  "barStacked"
  (Optic A_Lens NoIx BarOptions BarOptions Stacked Stacked)
Optic A_Lens NoIx BarOptions BarOptions Stacked Stacked
#barStacked Stacked
Stacked BarOptions -> (BarOptions -> BarOptions) -> BarOptions
forall a b. a -> (a -> b) -> b
& IsLabel
  "displayValues" (Optic A_Lens NoIx BarOptions BarOptions Bool Bool)
Optic A_Lens NoIx BarOptions BarOptions Bool Bool
#displayValues 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
.~ Bool
False BarOptions -> (BarOptions -> BarOptions) -> BarOptions
forall a b. a -> (a -> b) -> b
& IsLabel
  "barRectStyles"
  (Optic A_Lens NoIx BarOptions BarOptions [RectStyle] [RectStyle])
Optic A_Lens NoIx BarOptions BarOptions [RectStyle] [RectStyle]
#barRectStyles Optic A_Lens NoIx BarOptions BarOptions [RectStyle] [RectStyle]
-> ([RectStyle] -> [RectStyle]) -> BarOptions -> BarOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ (RectStyle -> RectStyle) -> [RectStyle] -> [RectStyle]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (IsLabel
  "borderSize" (Optic A_Lens NoIx RectStyle RectStyle Double Double)
Optic A_Lens NoIx RectStyle RectStyle Double Double
#borderSize Optic A_Lens NoIx RectStyle RectStyle Double Double
-> Double -> RectStyle -> RectStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Double
0)) BarData
barDataExample

-- | wave example
--
-- ![wave example](other/wave.svg)
waveExample :: ChartSvg
waveExample :: ChartSvg
waveExample = ChartSvg
forall a. Monoid a => a
mempty ChartSvg -> (ChartSvg -> ChartSvg) -> ChartSvg
forall a b. a -> (a -> b) -> b
& IsLabel
  "charts" (Optic A_Lens NoIx ChartSvg ChartSvg ChartTree ChartTree)
Optic A_Lens NoIx ChartSvg ChartSvg ChartTree ChartTree
#charts Optic A_Lens NoIx ChartSvg ChartSvg ChartTree ChartTree
-> ChartTree -> ChartSvg -> ChartSvg
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Text -> [Chart] -> ChartTree
named Text
"wave" [GlyphStyle -> [Point Double] -> Chart
GlyphChart GlyphStyle
defaultGlyphStyle ([Point Double] -> Chart) -> [Point Double] -> Chart
forall a b. (a -> b) -> a -> b
$ (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)) Grid (Range Double)
30] ChartSvg -> (ChartSvg -> ChartSvg) -> ChartSvg
forall a b. a -> (a -> b) -> b
& IsLabel
  "hudOptions"
  (Optic A_Lens NoIx ChartSvg ChartSvg HudOptions HudOptions)
Optic A_Lens NoIx ChartSvg ChartSvg HudOptions HudOptions
#hudOptions Optic A_Lens NoIx ChartSvg ChartSvg HudOptions HudOptions
-> HudOptions -> ChartSvg -> ChartSvg
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ HudOptions
defaultHudOptions

-- | venn diagram
--
-- ![venn diagram](other/venn.svg)
vennExample :: ChartSvg
vennExample :: ChartSvg
vennExample =
  ChartSvg
forall a. Monoid a => a
mempty
    ChartSvg -> (ChartSvg -> ChartSvg) -> ChartSvg
forall a b. a -> (a -> b) -> b
& IsLabel
  "charts" (Optic A_Lens NoIx ChartSvg ChartSvg ChartTree ChartTree)
Optic A_Lens NoIx ChartSvg ChartSvg ChartTree ChartTree
#charts Optic A_Lens NoIx ChartSvg ChartSvg ChartTree ChartTree
-> ChartTree -> ChartSvg -> ChartSvg
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ 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 -> PathStyle -> [PathData Double] -> Chart
PathChart (PathStyle
defaultPathStyle PathStyle -> (PathStyle -> PathStyle) -> PathStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "borderSize" (Optic A_Lens NoIx PathStyle PathStyle Double Double)
Optic A_Lens NoIx PathStyle PathStyle Double Double
#borderSize Optic A_Lens NoIx PathStyle PathStyle Double Double
-> Double -> PathStyle -> PathStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Double
0.005 PathStyle -> (PathStyle -> PathStyle) -> PathStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "color" (Optic A_Lens NoIx PathStyle PathStyle Colour Colour)
Optic A_Lens NoIx PathStyle PathStyle Colour Colour
#color Optic A_Lens NoIx PathStyle PathStyle Colour Colour
-> Colour -> PathStyle -> PathStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Int -> Double -> Colour
palette1a Int
c Double
0.2 PathStyle -> (PathStyle -> PathStyle) -> PathStyle
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx PathStyle PathStyle Colour Colour
-> (Colour -> Colour) -> PathStyle -> PathStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over IsLabel
  "borderColor" (Optic A_Lens NoIx PathStyle PathStyle Colour Colour)
Optic A_Lens NoIx PathStyle PathStyle 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 ..] (Text -> [PathData Double]
svgToPathData (Text -> [PathData Double]) -> [Text] -> [[PathData Double]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
vennSegs))
    ChartSvg -> (ChartSvg -> ChartSvg) -> ChartSvg
forall a b. a -> (a -> b) -> b
& IsLabel
  "hudOptions"
  (Optic A_Lens NoIx ChartSvg ChartSvg HudOptions HudOptions)
Optic A_Lens NoIx ChartSvg ChartSvg HudOptions HudOptions
#hudOptions Optic A_Lens NoIx ChartSvg ChartSvg HudOptions HudOptions
-> HudOptions -> ChartSvg -> ChartSvg
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ HudOptions
defaultHudOptions
    ChartSvg -> (ChartSvg -> ChartSvg) -> ChartSvg
forall a b. a -> (a -> b) -> b
& IsLabel
  "hudOptions"
  (Optic A_Lens NoIx ChartSvg ChartSvg HudOptions HudOptions)
Optic A_Lens NoIx ChartSvg ChartSvg HudOptions HudOptions
#hudOptions Optic A_Lens NoIx ChartSvg ChartSvg HudOptions HudOptions
-> Optic A_Lens NoIx HudOptions HudOptions ChartAspect ChartAspect
-> Optic A_Lens NoIx ChartSvg ChartSvg 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
% IsLabel
  "chartAspect"
  (Optic A_Lens NoIx HudOptions HudOptions ChartAspect ChartAspect)
Optic A_Lens NoIx HudOptions HudOptions ChartAspect ChartAspect
#chartAspect Optic A_Lens NoIx ChartSvg ChartSvg ChartAspect ChartAspect
-> ChartAspect -> ChartSvg -> ChartSvg
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ 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 :: [Text]
vennSegs :: [Text]
vennSegs =
  [ Text
"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",
    Text
"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",
    Text
"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",
    Text
"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",
    Text
"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",
    Text
"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",
    Text
"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 :: ChartSvg
pathExample :: ChartSvg
pathExample =
  ChartSvg
forall a. Monoid a => a
mempty
    ChartSvg -> (ChartSvg -> ChartSvg) -> ChartSvg
forall a b. a -> (a -> b) -> b
& IsLabel
  "charts" (Optic A_Lens NoIx ChartSvg ChartSvg ChartTree ChartTree)
Optic A_Lens NoIx ChartSvg ChartSvg ChartTree ChartTree
#charts Optic A_Lens NoIx ChartSvg ChartSvg ChartTree ChartTree
-> ChartTree -> ChartSvg -> ChartSvg
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ 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]
    ChartSvg -> (ChartSvg -> ChartSvg) -> ChartSvg
forall a b. a -> (a -> b) -> b
& IsLabel
  "hudOptions"
  (Optic A_Lens NoIx ChartSvg ChartSvg HudOptions HudOptions)
Optic A_Lens NoIx ChartSvg ChartSvg HudOptions HudOptions
#hudOptions Optic A_Lens NoIx ChartSvg ChartSvg HudOptions HudOptions
-> HudOptions -> ChartSvg -> ChartSvg
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ HudOptions
defaultHudOptions
    ChartSvg -> (ChartSvg -> ChartSvg) -> ChartSvg
forall a b. a -> (a -> b) -> b
& IsLabel
  "hudOptions"
  (Optic A_Lens NoIx ChartSvg ChartSvg HudOptions HudOptions)
Optic A_Lens NoIx ChartSvg ChartSvg HudOptions HudOptions
#hudOptions Optic A_Lens NoIx ChartSvg ChartSvg HudOptions HudOptions
-> Optic A_Lens NoIx HudOptions HudOptions ChartAspect ChartAspect
-> Optic A_Lens NoIx ChartSvg ChartSvg 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
% IsLabel
  "chartAspect"
  (Optic A_Lens NoIx HudOptions HudOptions ChartAspect ChartAspect)
Optic A_Lens NoIx HudOptions HudOptions ChartAspect ChartAspect
#chartAspect Optic A_Lens NoIx ChartSvg ChartSvg ChartAspect ChartAspect
-> ChartAspect -> ChartSvg -> ChartSvg
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ ChartAspect
ChartAspect
    ChartSvg -> (ChartSvg -> ChartSvg) -> ChartSvg
forall a b. a -> (a -> b) -> b
& IsLabel
  "svgOptions"
  (Optic A_Lens NoIx ChartSvg ChartSvg SvgOptions SvgOptions)
Optic A_Lens NoIx ChartSvg ChartSvg SvgOptions SvgOptions
#svgOptions Optic A_Lens NoIx ChartSvg ChartSvg SvgOptions SvgOptions
-> Optic A_Lens NoIx SvgOptions SvgOptions CssOptions CssOptions
-> Optic A_Lens NoIx ChartSvg ChartSvg 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
% IsLabel
  "cssOptions"
  (Optic A_Lens NoIx SvgOptions SvgOptions CssOptions CssOptions)
Optic A_Lens NoIx SvgOptions SvgOptions CssOptions CssOptions
#cssOptions Optic A_Lens NoIx ChartSvg ChartSvg CssOptions CssOptions
-> Optic
     A_Lens
     NoIx
     CssOptions
     CssOptions
     CssPreferColorScheme
     CssPreferColorScheme
-> Optic
     A_Lens
     NoIx
     ChartSvg
     ChartSvg
     CssPreferColorScheme
     CssPreferColorScheme
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
% IsLabel
  "preferColorScheme"
  (Optic
     A_Lens
     NoIx
     CssOptions
     CssOptions
     CssPreferColorScheme
     CssPreferColorScheme)
Optic
  A_Lens
  NoIx
  CssOptions
  CssOptions
  CssPreferColorScheme
  CssPreferColorScheme
#preferColorScheme Optic
  A_Lens
  NoIx
  ChartSvg
  ChartSvg
  CssPreferColorScheme
  CssPreferColorScheme
-> CssPreferColorScheme -> ChartSvg -> ChartSvg
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ CssPreferColorScheme
PreferHud
    ChartSvg -> (ChartSvg -> ChartSvg) -> ChartSvg
forall a b. a -> (a -> b) -> b
& IsLabel
  "svgOptions"
  (Optic A_Lens NoIx ChartSvg ChartSvg SvgOptions SvgOptions)
Optic A_Lens NoIx ChartSvg ChartSvg SvgOptions SvgOptions
#svgOptions Optic A_Lens NoIx ChartSvg ChartSvg SvgOptions SvgOptions
-> Optic A_Lens NoIx SvgOptions SvgOptions CssOptions CssOptions
-> Optic A_Lens NoIx ChartSvg ChartSvg 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
% IsLabel
  "cssOptions"
  (Optic A_Lens NoIx SvgOptions SvgOptions CssOptions CssOptions)
Optic A_Lens NoIx SvgOptions SvgOptions CssOptions CssOptions
#cssOptions Optic A_Lens NoIx ChartSvg ChartSvg CssOptions CssOptions
-> Optic A_Lens NoIx CssOptions CssOptions Text Text
-> Optic A_Lens NoIx ChartSvg ChartSvg Text Text
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
% IsLabel
  "cssExtra" (Optic A_Lens NoIx CssOptions CssOptions Text Text)
Optic A_Lens NoIx CssOptions CssOptions Text Text
#cssExtra Optic A_Lens NoIx ChartSvg ChartSvg Text Text
-> Text -> ChartSvg -> ChartSvg
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ (Colour, Colour) -> Text -> Text
classSwitch (Colour
light, Colour
dark) Text
"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' = PathStyle -> [PathData Double] -> Chart
PathChart (PathStyle
defaultPathStyle PathStyle -> (PathStyle -> PathStyle) -> PathStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "color" (Optic A_Lens NoIx PathStyle PathStyle Colour Colour)
Optic A_Lens NoIx PathStyle PathStyle Colour Colour
#color Optic A_Lens NoIx PathStyle PathStyle Colour Colour
-> Colour -> PathStyle -> PathStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Int -> Double -> Colour
palette1a Int
0 Double
0.1 PathStyle -> (PathStyle -> PathStyle) -> PathStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "borderColor" (Optic A_Lens NoIx PathStyle PathStyle Colour Colour)
Optic A_Lens NoIx PathStyle PathStyle Colour Colour
#borderColor Optic A_Lens NoIx PathStyle PathStyle Colour Colour
-> Colour -> PathStyle -> PathStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Int -> Double -> Colour
palette1a Int
1 Double
1) [PathData Double]
ps
    c0 :: Chart
c0 = GlyphStyle -> [Point Double] -> Chart
GlyphChart GlyphStyle
defaultGlyphStyle (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 Double
0.05, 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
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 = TextStyle -> [(Text, Point Double)] -> Chart
TextChart (TextStyle
defaultTextStyle TextStyle -> (TextStyle -> TextStyle) -> TextStyle
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx TextStyle TextStyle Double Double
-> Double -> TextStyle -> TextStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set IsLabel
  "size" (Optic A_Lens NoIx TextStyle TextStyle Double Double)
Optic A_Lens NoIx TextStyle TextStyle Double Double
#size Double
0.05) ([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))

classSwitch :: (Colour, Colour) -> Text -> Text
classSwitch :: (Colour, Colour) -> Text -> Text
classSwitch (Colour
cl, Colour
cd) Text
class' =
  [trimming|
{
  .$class' g {
    fill: $hexDark;
  }
}
@media (prefers-color-scheme:dark) {
  .$class' g {
    fill: $hexLight;
  }
}
|]
  where
    hexLight :: Text
hexLight = Colour -> Text
hex Colour
cl
    hexDark :: Text
hexDark = Colour -> Text
hex Colour
cd

-- | ellipse example
--
-- Under scaling, angles are not invariant, and this effects the shape 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 -> ChartSvg
ellipseExample :: ChartAspect -> ChartSvg
ellipseExample ChartAspect
a =
  ChartSvg
forall a. Monoid a => a
mempty
    ChartSvg -> (ChartSvg -> ChartSvg) -> ChartSvg
forall a b. a -> (a -> b) -> b
& IsLabel
  "charts" (Optic A_Lens NoIx ChartSvg ChartSvg ChartTree ChartTree)
Optic A_Lens NoIx ChartSvg ChartSvg ChartTree ChartTree
#charts Optic A_Lens NoIx ChartSvg ChartSvg ChartTree ChartTree
-> ChartTree -> ChartSvg -> ChartSvg
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Text -> [Chart] -> ChartTree
named Text
"ellipse" [Chart
ell, Chart
ellFull, Chart
c0, Chart
c1, Chart
bbox, Chart
xradii, Chart
yradii]
    ChartSvg -> (ChartSvg -> ChartSvg) -> ChartSvg
forall a b. a -> (a -> b) -> b
& IsLabel
  "hudOptions"
  (Optic A_Lens NoIx ChartSvg ChartSvg HudOptions HudOptions)
Optic A_Lens NoIx ChartSvg ChartSvg HudOptions HudOptions
#hudOptions Optic A_Lens NoIx ChartSvg ChartSvg HudOptions HudOptions
-> HudOptions -> ChartSvg -> ChartSvg
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ HudOptions
defaultHudOptions
    ChartSvg -> (ChartSvg -> ChartSvg) -> ChartSvg
forall a b. a -> (a -> b) -> b
& IsLabel
  "hudOptions"
  (Optic A_Lens NoIx ChartSvg ChartSvg HudOptions HudOptions)
Optic A_Lens NoIx ChartSvg ChartSvg HudOptions HudOptions
#hudOptions Optic A_Lens NoIx ChartSvg ChartSvg HudOptions HudOptions
-> Optic A_Lens NoIx HudOptions HudOptions ChartAspect ChartAspect
-> Optic A_Lens NoIx ChartSvg ChartSvg 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
% IsLabel
  "chartAspect"
  (Optic A_Lens NoIx HudOptions HudOptions ChartAspect ChartAspect)
Optic A_Lens NoIx HudOptions HudOptions ChartAspect ChartAspect
#chartAspect Optic A_Lens NoIx ChartSvg ChartSvg ChartAspect ChartAspect
-> ChartAspect -> ChartSvg -> ChartSvg
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ ChartAspect
a
    ChartSvg -> (ChartSvg -> ChartSvg) -> ChartSvg
forall a b. a -> (a -> b) -> b
& IsLabel
  "hudOptions"
  (Optic A_Lens NoIx ChartSvg ChartSvg HudOptions HudOptions)
Optic A_Lens NoIx ChartSvg ChartSvg HudOptions HudOptions
#hudOptions Optic A_Lens NoIx ChartSvg ChartSvg HudOptions HudOptions
-> Optic
     A_Lens
     NoIx
     HudOptions
     HudOptions
     [(Double, LegendOptions)]
     [(Double, LegendOptions)]
-> Optic
     A_Lens
     NoIx
     ChartSvg
     ChartSvg
     [(Double, LegendOptions)]
     [(Double, 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
% IsLabel
  "legends"
  (Optic
     A_Lens
     NoIx
     HudOptions
     HudOptions
     [(Double, LegendOptions)]
     [(Double, LegendOptions)])
Optic
  A_Lens
  NoIx
  HudOptions
  HudOptions
  [(Double, LegendOptions)]
  [(Double, LegendOptions)]
#legends Optic
  A_Lens
  NoIx
  ChartSvg
  ChartSvg
  [(Double, LegendOptions)]
  [(Double, LegendOptions)]
-> [(Double, LegendOptions)] -> ChartSvg -> ChartSvg
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ [(Double
10, LegendOptions
defaultLegendOptions LegendOptions -> (LegendOptions -> LegendOptions) -> LegendOptions
forall a b. a -> (a -> b) -> b
& IsLabel
  "content"
  (Optic
     A_Lens
     NoIx
     LegendOptions
     LegendOptions
     [(Text, Chart)]
     [(Text, Chart)])
Optic
  A_Lens
  NoIx
  LegendOptions
  LegendOptions
  [(Text, Chart)]
  [(Text, Chart)]
#content 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
.~ [(Text, Chart)]
lrows LegendOptions -> (LegendOptions -> LegendOptions) -> LegendOptions
forall a b. a -> (a -> b) -> b
& IsLabel
  "textStyle"
  (Optic A_Lens NoIx LegendOptions LegendOptions TextStyle TextStyle)
Optic A_Lens NoIx LegendOptions LegendOptions TextStyle TextStyle
#textStyle Optic A_Lens NoIx LegendOptions LegendOptions TextStyle TextStyle
-> Optic A_Lens NoIx TextStyle TextStyle 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
% IsLabel
  "size" (Optic A_Lens NoIx TextStyle TextStyle Double Double)
Optic A_Lens NoIx TextStyle TextStyle Double Double
#size 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
.~ Double
0.2 LegendOptions -> (LegendOptions -> LegendOptions) -> LegendOptions
forall a b. a -> (a -> b) -> b
& IsLabel
  "size"
  (Optic A_Lens NoIx LegendOptions LegendOptions Double Double)
Optic A_Lens NoIx LegendOptions LegendOptions Double Double
#size 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
.~ Double
0.1)]
    ChartSvg -> (ChartSvg -> ChartSvg) -> ChartSvg
forall a b. a -> (a -> b) -> b
& IsLabel
  "hudOptions"
  (Optic A_Lens NoIx ChartSvg ChartSvg HudOptions HudOptions)
Optic A_Lens NoIx ChartSvg ChartSvg HudOptions HudOptions
#hudOptions Optic A_Lens NoIx ChartSvg ChartSvg HudOptions HudOptions
-> Optic
     A_Lens
     NoIx
     HudOptions
     HudOptions
     [(Double, Title)]
     [(Double, Title)]
-> Optic
     A_Lens NoIx ChartSvg ChartSvg [(Double, Title)] [(Double, Title)]
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
% IsLabel
  "titles"
  (Optic
     A_Lens
     NoIx
     HudOptions
     HudOptions
     [(Double, Title)]
     [(Double, Title)])
Optic
  A_Lens
  NoIx
  HudOptions
  HudOptions
  [(Double, Title)]
  [(Double, Title)]
#titles Optic
  A_Lens NoIx ChartSvg ChartSvg [(Double, Title)] [(Double, Title)]
-> [(Double, Title)] -> ChartSvg -> ChartSvg
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ [(Double
11, Text -> Title
defaultTitle Text
"ArcPosition (Point 1 0) (Point 0 1) (ArcInfo (Point 1.5 1) (pi / 3) True True)" Title -> (Title -> Title) -> Title
forall a b. a -> (a -> b) -> b
& IsLabel "style" (Optic A_Lens NoIx Title Title TextStyle TextStyle)
Optic A_Lens NoIx Title Title TextStyle TextStyle
#style Optic A_Lens NoIx Title Title TextStyle TextStyle
-> Optic A_Lens NoIx TextStyle TextStyle Double Double
-> Optic A_Lens NoIx Title Title 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
% IsLabel
  "size" (Optic A_Lens NoIx TextStyle TextStyle Double Double)
Optic A_Lens NoIx TextStyle TextStyle Double Double
#size Optic A_Lens NoIx Title Title Double Double
-> Double -> Title -> Title
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Double
0.08)]
  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 = LineStyle -> [[Point Double]] -> Chart
LineChart LineStyle
fullels [Point Double -> Point Double -> Double -> Double -> Point Double
forall b a.
(Direction 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 = LineStyle -> [[Point Double]] -> Chart
LineChart LineStyle
els [Point Double -> Point Double -> Double -> Double -> Point Double
forall b a.
(Direction 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 :: GlyphStyle
g0 = GlyphStyle
defaultGlyphStyle GlyphStyle -> (GlyphStyle -> GlyphStyle) -> GlyphStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "shape"
  (Optic A_Lens NoIx GlyphStyle GlyphStyle GlyphShape GlyphShape)
Optic A_Lens NoIx GlyphStyle GlyphStyle GlyphShape GlyphShape
#shape Optic A_Lens NoIx GlyphStyle GlyphStyle GlyphShape GlyphShape
-> GlyphShape -> GlyphStyle -> GlyphStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ GlyphShape
CircleGlyph
    c0 :: Chart
c0 = GlyphStyle -> [Point Double] -> Chart
GlyphChart GlyphStyle
g0 [Point Double
c]
    g1 :: GlyphStyle
g1 = GlyphStyle
defaultGlyphStyle GlyphStyle -> (GlyphStyle -> GlyphStyle) -> GlyphStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "color" (Optic A_Lens NoIx GlyphStyle GlyphStyle Colour Colour)
Optic A_Lens NoIx GlyphStyle GlyphStyle Colour Colour
#color Optic A_Lens NoIx GlyphStyle GlyphStyle Colour Colour
-> Colour -> GlyphStyle -> GlyphStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Int -> Double -> Colour
palette1a Int
4 Double
0.2
    c1 :: Chart
c1 = GlyphStyle -> [Point Double] -> Chart
GlyphChart GlyphStyle
g1 [Point Double
p1, Point Double
p2]
    bbox :: Chart
bbox = RectStyle -> [Rect Double] -> Chart
RectChart RectStyle
bbs [ArcPosition Double -> Rect Double
arcBox ArcPosition Double
p]
    bbs :: RectStyle
bbs = RectStyle
defaultRectStyle RectStyle -> (RectStyle -> RectStyle) -> RectStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "borderSize" (Optic A_Lens NoIx RectStyle RectStyle Double Double)
Optic A_Lens NoIx RectStyle RectStyle Double Double
#borderSize Optic A_Lens NoIx RectStyle RectStyle Double Double
-> Double -> RectStyle -> RectStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Double
0.002 RectStyle -> (RectStyle -> RectStyle) -> RectStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "color" (Optic A_Lens NoIx RectStyle RectStyle Colour Colour)
Optic A_Lens NoIx RectStyle RectStyle Colour Colour
#color Optic A_Lens NoIx RectStyle RectStyle Colour Colour
-> Colour -> RectStyle -> RectStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Int -> Double -> Colour
palette1a Int
7 Double
0.005 RectStyle -> (RectStyle -> RectStyle) -> RectStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "borderColor" (Optic A_Lens NoIx RectStyle RectStyle Colour Colour)
Optic A_Lens NoIx RectStyle RectStyle Colour Colour
#borderColor Optic A_Lens NoIx RectStyle RectStyle Colour Colour
-> Colour -> RectStyle -> RectStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Double -> Double -> Colour
grey Double
0.5 Double
1
    xradii :: Chart
xradii = LineStyle -> [[Point Double]] -> Chart
LineChart LineStyle
xals [[Point Double -> Point Double -> Double -> Double -> Point Double
forall b a.
(Direction 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 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 = LineStyle -> [[Point Double]] -> Chart
LineChart LineStyle
yals [[Point Double -> Point Double -> Double -> Double -> Point Double
forall b a.
(Direction 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 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 :: LineStyle
xals = LineStyle
defaultLineStyle LineStyle -> (LineStyle -> LineStyle) -> LineStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "color" (Optic A_Lens NoIx LineStyle LineStyle Colour Colour)
Optic A_Lens NoIx LineStyle LineStyle Colour Colour
#color Optic A_Lens NoIx LineStyle LineStyle Colour Colour
-> Colour -> LineStyle -> LineStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Int -> Colour
palette1 Int
6 LineStyle -> (LineStyle -> LineStyle) -> LineStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "size" (Optic A_Lens NoIx LineStyle LineStyle Double Double)
Optic A_Lens NoIx LineStyle LineStyle Double Double
#size Optic A_Lens NoIx LineStyle LineStyle Double Double
-> Double -> LineStyle -> LineStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Double
0.005 LineStyle -> (LineStyle -> LineStyle) -> LineStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "dasharray"
  (Optic
     A_Lens NoIx LineStyle LineStyle (Maybe [Double]) (Maybe [Double]))
Optic
  A_Lens NoIx LineStyle LineStyle (Maybe [Double]) (Maybe [Double])
#dasharray Optic
  A_Lens NoIx LineStyle LineStyle (Maybe [Double]) (Maybe [Double])
-> Maybe [Double] -> LineStyle -> LineStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ [Double] -> Maybe [Double]
forall a. a -> Maybe a
Just [Double
0.03, Double
0.01] LineStyle -> (LineStyle -> LineStyle) -> LineStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "linecap"
  (Optic
     A_Lens NoIx LineStyle LineStyle (Maybe LineCap) (Maybe LineCap))
Optic
  A_Lens NoIx LineStyle LineStyle (Maybe LineCap) (Maybe LineCap)
#linecap Optic
  A_Lens NoIx LineStyle LineStyle (Maybe LineCap) (Maybe LineCap)
-> Maybe LineCap -> LineStyle -> LineStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ LineCap -> Maybe LineCap
forall a. a -> Maybe a
Just LineCap
LineCapRound
    yals :: LineStyle
yals = LineStyle
defaultLineStyle LineStyle -> (LineStyle -> LineStyle) -> LineStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "color" (Optic A_Lens NoIx LineStyle LineStyle Colour Colour)
Optic A_Lens NoIx LineStyle LineStyle Colour Colour
#color Optic A_Lens NoIx LineStyle LineStyle Colour Colour
-> Colour -> LineStyle -> LineStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Int -> Colour
palette1 Int
5 LineStyle -> (LineStyle -> LineStyle) -> LineStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "size" (Optic A_Lens NoIx LineStyle LineStyle Double Double)
Optic A_Lens NoIx LineStyle LineStyle Double Double
#size Optic A_Lens NoIx LineStyle LineStyle Double Double
-> Double -> LineStyle -> LineStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Double
0.005 LineStyle -> (LineStyle -> LineStyle) -> LineStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "dasharray"
  (Optic
     A_Lens NoIx LineStyle LineStyle (Maybe [Double]) (Maybe [Double]))
Optic
  A_Lens NoIx LineStyle LineStyle (Maybe [Double]) (Maybe [Double])
#dasharray Optic
  A_Lens NoIx LineStyle LineStyle (Maybe [Double]) (Maybe [Double])
-> Maybe [Double] -> LineStyle -> LineStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ [Double] -> Maybe [Double]
forall a. a -> Maybe a
Just [Double
0.03, Double
0.01] LineStyle -> (LineStyle -> LineStyle) -> LineStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "linecap"
  (Optic
     A_Lens NoIx LineStyle LineStyle (Maybe LineCap) (Maybe LineCap))
Optic
  A_Lens NoIx LineStyle LineStyle (Maybe LineCap) (Maybe LineCap)
#linecap Optic
  A_Lens NoIx LineStyle LineStyle (Maybe LineCap) (Maybe LineCap)
-> Maybe LineCap -> LineStyle -> LineStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ LineCap -> Maybe LineCap
forall a. a -> Maybe a
Just LineCap
LineCapRound
    fullels :: LineStyle
fullels = LineStyle
defaultLineStyle LineStyle -> (LineStyle -> LineStyle) -> LineStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "size" (Optic A_Lens NoIx LineStyle LineStyle Double Double)
Optic A_Lens NoIx LineStyle LineStyle Double Double
#size Optic A_Lens NoIx LineStyle LineStyle Double Double
-> Double -> LineStyle -> LineStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Double
0.002 LineStyle -> (LineStyle -> LineStyle) -> LineStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "color" (Optic A_Lens NoIx LineStyle LineStyle Colour Colour)
Optic A_Lens NoIx LineStyle LineStyle Colour Colour
#color Optic A_Lens NoIx LineStyle LineStyle Colour Colour
-> Colour -> LineStyle -> LineStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Int -> Colour
palette1 Int
1
    els :: LineStyle
els = LineStyle
defaultLineStyle LineStyle -> (LineStyle -> LineStyle) -> LineStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "size" (Optic A_Lens NoIx LineStyle LineStyle Double Double)
Optic A_Lens NoIx LineStyle LineStyle Double Double
#size Optic A_Lens NoIx LineStyle LineStyle Double Double
-> Double -> LineStyle -> LineStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Double
0.005 LineStyle -> (LineStyle -> LineStyle) -> LineStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "color" (Optic A_Lens NoIx LineStyle LineStyle Colour Colour)
Optic A_Lens NoIx LineStyle LineStyle Colour Colour
#color Optic A_Lens NoIx LineStyle LineStyle Colour Colour
-> Colour -> LineStyle -> LineStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Int -> Colour
palette1 Int
2
    lrows :: [(Text, Chart)]
lrows =
      [ (Text
"Major Axis", LineStyle -> [[Point Double]] -> Chart
LineChart LineStyle
xals [[Point Double
forall a. Additive a => a
zero]]),
        (Text
"Minor Axis", LineStyle -> [[Point Double]] -> Chart
LineChart LineStyle
yals [[Point Double
forall a. Additive a => a
zero]]),
        (Text
"Full Ellipse", LineStyle -> [[Point Double]] -> Chart
LineChart LineStyle
fullels [[Point Double
forall a. Additive a => a
zero]]),
        (Text
"Arc", LineStyle -> [[Point Double]] -> Chart
LineChart LineStyle
els [[Point Double
forall a. Additive a => a
zero]]),
        (Text
"Centroid", GlyphStyle -> [Point Double] -> Chart
GlyphChart (GlyphStyle
g0 GlyphStyle -> (GlyphStyle -> GlyphStyle) -> GlyphStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "size" (Optic A_Lens NoIx GlyphStyle GlyphStyle Double Double)
Optic A_Lens NoIx GlyphStyle GlyphStyle Double Double
#size Optic A_Lens NoIx GlyphStyle GlyphStyle Double Double
-> Double -> GlyphStyle -> GlyphStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Double
0.01) [Point Double
forall a. Additive a => a
zero]),
        (Text
"Endpoints", GlyphStyle -> [Point Double] -> Chart
GlyphChart (GlyphStyle
g1 GlyphStyle -> (GlyphStyle -> GlyphStyle) -> GlyphStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "size" (Optic A_Lens NoIx GlyphStyle GlyphStyle Double Double)
Optic A_Lens NoIx GlyphStyle GlyphStyle Double Double
#size Optic A_Lens NoIx GlyphStyle GlyphStyle Double Double
-> Double -> GlyphStyle -> GlyphStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Double
0.01) [Point Double
forall a. Additive a => a
zero]),
        (Text
"Bounding Box", RectStyle -> [Rect Double] -> Chart
RectChart (RectStyle
bbs RectStyle -> (RectStyle -> RectStyle) -> RectStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "borderSize" (Optic A_Lens NoIx RectStyle RectStyle Double Double)
Optic A_Lens NoIx RectStyle RectStyle Double Double
#borderSize Optic A_Lens NoIx RectStyle RectStyle Double Double
-> Double -> RectStyle -> RectStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Double
0.01) [(Double -> Double) -> Rect Double -> Rect Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
*) 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 :: ChartSvg
arcFlagsExample :: ChartSvg
arcFlagsExample =
  ChartSvg
forall a. Monoid a => a
mempty
    ChartSvg -> (ChartSvg -> ChartSvg) -> ChartSvg
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx ChartSvg ChartSvg ChartTree ChartTree
-> ChartTree -> ChartSvg -> ChartSvg
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set
      #charts
      ( Double -> [ChartTree] -> ChartTree
vert
          Double
0.02
          [ Double -> [ChartTree] -> ChartTree
hori Double
0.02 [ChartTree
colSweep, ChartTree
colSweep2, ChartTree
colLargeFalse, ChartTree
colLargeTrue],
            ChartTree
rowLarge
          ]
      )
    ChartSvg -> (ChartSvg -> ChartSvg) -> ChartSvg
forall a b. a -> (a -> b) -> b
& IsLabel
  "hudOptions"
  (Optic A_Lens NoIx ChartSvg ChartSvg HudOptions HudOptions)
Optic A_Lens NoIx ChartSvg ChartSvg HudOptions HudOptions
#hudOptions Optic A_Lens NoIx ChartSvg ChartSvg HudOptions HudOptions
-> Optic A_Lens NoIx HudOptions HudOptions ChartAspect ChartAspect
-> Optic A_Lens NoIx ChartSvg ChartSvg 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
% IsLabel
  "chartAspect"
  (Optic A_Lens NoIx HudOptions HudOptions ChartAspect ChartAspect)
Optic A_Lens NoIx HudOptions HudOptions ChartAspect ChartAspect
#chartAspect Optic A_Lens NoIx ChartSvg ChartSvg ChartAspect ChartAspect
-> ChartAspect -> ChartSvg -> ChartSvg
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ ChartAspect
ChartAspect
    ChartSvg -> (ChartSvg -> ChartSvg) -> ChartSvg
forall a b. a -> (a -> b) -> b
& IsLabel
  "svgOptions"
  (Optic A_Lens NoIx ChartSvg ChartSvg SvgOptions SvgOptions)
Optic A_Lens NoIx ChartSvg ChartSvg SvgOptions SvgOptions
#svgOptions Optic A_Lens NoIx ChartSvg ChartSvg SvgOptions SvgOptions
-> Optic A_Lens NoIx SvgOptions SvgOptions CssOptions CssOptions
-> Optic A_Lens NoIx ChartSvg ChartSvg 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
% IsLabel
  "cssOptions"
  (Optic A_Lens NoIx SvgOptions SvgOptions CssOptions CssOptions)
Optic A_Lens NoIx SvgOptions SvgOptions CssOptions CssOptions
#cssOptions Optic A_Lens NoIx ChartSvg ChartSvg CssOptions CssOptions
-> Optic
     A_Lens
     NoIx
     CssOptions
     CssOptions
     CssPreferColorScheme
     CssPreferColorScheme
-> Optic
     A_Lens
     NoIx
     ChartSvg
     ChartSvg
     CssPreferColorScheme
     CssPreferColorScheme
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
% IsLabel
  "preferColorScheme"
  (Optic
     A_Lens
     NoIx
     CssOptions
     CssOptions
     CssPreferColorScheme
     CssPreferColorScheme)
Optic
  A_Lens
  NoIx
  CssOptions
  CssOptions
  CssPreferColorScheme
  CssPreferColorScheme
#preferColorScheme Optic
  A_Lens
  NoIx
  ChartSvg
  ChartSvg
  CssPreferColorScheme
  CssPreferColorScheme
-> CssPreferColorScheme -> ChartSvg -> ChartSvg
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ CssPreferColorScheme
PreferHud
    ChartSvg -> (ChartSvg -> ChartSvg) -> ChartSvg
forall a b. a -> (a -> b) -> b
& IsLabel
  "svgOptions"
  (Optic A_Lens NoIx ChartSvg ChartSvg SvgOptions SvgOptions)
Optic A_Lens NoIx ChartSvg ChartSvg SvgOptions SvgOptions
#svgOptions Optic A_Lens NoIx ChartSvg ChartSvg SvgOptions SvgOptions
-> Optic A_Lens NoIx SvgOptions SvgOptions CssOptions CssOptions
-> Optic A_Lens NoIx ChartSvg ChartSvg 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
% IsLabel
  "cssOptions"
  (Optic A_Lens NoIx SvgOptions SvgOptions CssOptions CssOptions)
Optic A_Lens NoIx SvgOptions SvgOptions CssOptions CssOptions
#cssOptions Optic A_Lens NoIx ChartSvg ChartSvg CssOptions CssOptions
-> Optic A_Lens NoIx CssOptions CssOptions Text Text
-> Optic A_Lens NoIx ChartSvg ChartSvg Text Text
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
% IsLabel
  "cssExtra" (Optic A_Lens NoIx CssOptions CssOptions Text Text)
Optic A_Lens NoIx CssOptions CssOptions Text Text
#cssExtra
      Optic A_Lens NoIx ChartSvg ChartSvg Text Text
-> Text -> ChartSvg -> ChartSvg
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ [trimming|
{
  .chart g {
    stroke: $hexDark;
  }
  .chart g text {
    fill: $hexDark;
  }
}
@media (prefers-color-scheme:dark) {
  .chart g {
    stroke: $hexLight;
  }
  .chart g text {
    fill: $hexLight;
  }
}
|]
  where
    hexDark :: Text
hexDark = Colour -> Text
hex Colour
dark
    hexLight :: Text
hexLight = Colour -> Text
hex Colour
light
    rowLarge :: ChartTree
rowLarge =
      [Chart] -> ChartTree
unnamed
        [ [Rect Double] -> Chart
BlankChart [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)],
          TextStyle -> [(Text, Point Double)] -> Chart
TextChart (TextStyle
defaultTextStyle TextStyle -> (TextStyle -> TextStyle) -> TextStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "size" (Optic A_Lens NoIx TextStyle TextStyle Double Double)
Optic A_Lens NoIx TextStyle TextStyle Double Double
#size Optic A_Lens NoIx TextStyle TextStyle Double Double
-> Double -> TextStyle -> TextStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ 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 =
      Double -> [ChartTree] -> ChartTree
vert
        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
BlankChart [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],
              TextStyle -> [(Text, Point Double)] -> Chart
TextChart (TextStyle
defaultTextStyle TextStyle -> (TextStyle -> TextStyle) -> TextStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "size" (Optic A_Lens NoIx TextStyle TextStyle Double Double)
Optic A_Lens NoIx TextStyle TextStyle Double Double
#size Optic A_Lens NoIx TextStyle TextStyle Double Double
-> Double -> TextStyle -> TextStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ 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 =
      Double -> [ChartTree] -> ChartTree
vert
        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
BlankChart [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],
              TextStyle -> [(Text, Point Double)] -> Chart
TextChart (TextStyle
defaultTextStyle TextStyle -> (TextStyle -> TextStyle) -> TextStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "size" (Optic A_Lens NoIx TextStyle TextStyle Double Double)
Optic A_Lens NoIx TextStyle TextStyle Double Double
#size Optic A_Lens NoIx TextStyle TextStyle Double Double
-> Double -> TextStyle -> TextStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ 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
BlankChart [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],
          TextStyle -> [(Text, Point Double)] -> Chart
TextChart
            (TextStyle
defaultTextStyle TextStyle -> (TextStyle -> TextStyle) -> TextStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "size" (Optic A_Lens NoIx TextStyle TextStyle Double Double)
Optic A_Lens NoIx TextStyle TextStyle Double Double
#size Optic A_Lens NoIx TextStyle TextStyle Double Double
-> Double -> TextStyle -> TextStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Double
0.6 TextStyle -> (TextStyle -> TextStyle) -> TextStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "rotation"
  (Optic
     A_Lens NoIx TextStyle TextStyle (Maybe Double) (Maybe Double))
Optic A_Lens NoIx TextStyle TextStyle (Maybe Double) (Maybe Double)
#rotation Optic A_Lens NoIx TextStyle TextStyle (Maybe Double) (Maybe Double)
-> Maybe Double -> TextStyle -> TextStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ 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 =
      Double -> [ChartTree] -> ChartTree
vert
        Double
0.02
        [ [Chart] -> ChartTree
unnamed
            [ [Rect Double] -> Chart
BlankChart [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],
              TextStyle -> [(Text, Point Double)] -> Chart
TextChart
                (TextStyle
defaultTextStyle TextStyle -> (TextStyle -> TextStyle) -> TextStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "size" (Optic A_Lens NoIx TextStyle TextStyle Double Double)
Optic A_Lens NoIx TextStyle TextStyle Double Double
#size Optic A_Lens NoIx TextStyle TextStyle Double Double
-> Double -> TextStyle -> TextStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Double
0.4 TextStyle -> (TextStyle -> TextStyle) -> TextStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "rotation"
  (Optic
     A_Lens NoIx TextStyle TextStyle (Maybe Double) (Maybe Double))
Optic A_Lens NoIx TextStyle TextStyle (Maybe Double) (Maybe Double)
#rotation Optic A_Lens NoIx TextStyle TextStyle (Maybe Double) (Maybe Double)
-> Maybe Double -> TextStyle -> TextStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ 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
BlankChart [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],
              TextStyle -> [(Text, Point Double)] -> Chart
TextChart
                (TextStyle
defaultTextStyle TextStyle -> (TextStyle -> TextStyle) -> TextStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "size" (Optic A_Lens NoIx TextStyle TextStyle Double Double)
Optic A_Lens NoIx TextStyle TextStyle Double Double
#size Optic A_Lens NoIx TextStyle TextStyle Double Double
-> Double -> TextStyle -> TextStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Double
0.4 TextStyle -> (TextStyle -> TextStyle) -> TextStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "rotation"
  (Optic
     A_Lens NoIx TextStyle TextStyle (Maybe Double) (Maybe Double))
Optic A_Lens NoIx TextStyle TextStyle (Maybe Double) (Maybe Double)
#rotation Optic A_Lens NoIx TextStyle TextStyle (Maybe Double) (Maybe Double)
-> Maybe Double -> TextStyle -> TextStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ 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 = PathStyle -> [PathData Double] -> Chart
PathChart (PathStyle
defaultPathStyle PathStyle -> (PathStyle -> PathStyle) -> PathStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "color" (Optic A_Lens NoIx PathStyle PathStyle Colour Colour)
Optic A_Lens NoIx PathStyle PathStyle Colour Colour
#color Optic A_Lens NoIx PathStyle PathStyle Colour Colour
-> Colour -> PathStyle -> PathStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Colour
co PathStyle -> (PathStyle -> PathStyle) -> PathStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "borderColor" (Optic A_Lens NoIx PathStyle PathStyle Colour Colour)
Optic A_Lens NoIx PathStyle PathStyle Colour Colour
#borderColor Optic A_Lens NoIx PathStyle PathStyle Colour Colour
-> Colour -> PathStyle -> PathStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ 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 = LineStyle -> [[Point Double]] -> Chart
LineChart (LineStyle
defaultLineStyle LineStyle -> (LineStyle -> LineStyle) -> LineStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "size" (Optic A_Lens NoIx LineStyle LineStyle Double Double)
Optic A_Lens NoIx LineStyle LineStyle Double Double
#size Optic A_Lens NoIx LineStyle LineStyle Double Double
-> Double -> LineStyle -> LineStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Double
0.02 LineStyle -> (LineStyle -> LineStyle) -> LineStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "color" (Optic A_Lens NoIx LineStyle LineStyle Colour Colour)
Optic A_Lens NoIx LineStyle LineStyle Colour Colour
#color Optic A_Lens NoIx LineStyle LineStyle Colour Colour
-> Colour -> LineStyle -> LineStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ 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 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 = LineStyle -> [[Point Double]] -> Chart
LineChart (LineStyle
defaultLineStyle LineStyle -> (LineStyle -> LineStyle) -> LineStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "size" (Optic A_Lens NoIx LineStyle LineStyle Double Double)
Optic A_Lens NoIx LineStyle LineStyle Double Double
#size Optic A_Lens NoIx LineStyle LineStyle Double Double
-> Double -> LineStyle -> LineStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Double
0.02 LineStyle -> (LineStyle -> LineStyle) -> LineStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "color" (Optic A_Lens NoIx LineStyle LineStyle Colour Colour)
Optic A_Lens NoIx LineStyle LineStyle Colour Colour
#color Optic A_Lens NoIx LineStyle LineStyle Colour Colour
-> Colour -> LineStyle -> LineStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ 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 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 = LineStyle -> [[Point Double]] -> Chart
LineChart (LineStyle
defaultLineStyle LineStyle -> (LineStyle -> LineStyle) -> LineStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "size" (Optic A_Lens NoIx LineStyle LineStyle Double Double)
Optic A_Lens NoIx LineStyle LineStyle Double Double
#size Optic A_Lens NoIx LineStyle LineStyle Double Double
-> Double -> LineStyle -> LineStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Double
0.05 LineStyle -> (LineStyle -> LineStyle) -> LineStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "color" (Optic A_Lens NoIx LineStyle LineStyle Colour Colour)
Optic A_Lens NoIx LineStyle LineStyle Colour Colour
#color Optic A_Lens NoIx LineStyle LineStyle Colour Colour
-> Colour -> LineStyle -> LineStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ 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 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 :: ChartSvg
quadExample :: ChartSvg
quadExample =
  ChartSvg
forall a. Monoid a => a
mempty
    ChartSvg -> (ChartSvg -> ChartSvg) -> ChartSvg
forall a b. a -> (a -> b) -> b
& IsLabel
  "charts" (Optic A_Lens NoIx ChartSvg ChartSvg ChartTree ChartTree)
Optic A_Lens NoIx ChartSvg ChartSvg ChartTree ChartTree
#charts Optic A_Lens NoIx ChartSvg ChartSvg ChartTree ChartTree
-> ChartTree -> ChartSvg -> ChartSvg
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Text -> [Chart] -> ChartTree
named Text
"quad" [Chart
path', Chart
curve, Chart
c0, Chart
c1, Chart
bbox]
    ChartSvg -> (ChartSvg -> ChartSvg) -> ChartSvg
forall a b. a -> (a -> b) -> b
& IsLabel
  "hudOptions"
  (Optic A_Lens NoIx ChartSvg ChartSvg HudOptions HudOptions)
Optic A_Lens NoIx ChartSvg ChartSvg HudOptions HudOptions
#hudOptions Optic A_Lens NoIx ChartSvg ChartSvg HudOptions HudOptions
-> HudOptions -> ChartSvg -> ChartSvg
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ HudOptions
defaultHudOptions
    ChartSvg -> (ChartSvg -> ChartSvg) -> ChartSvg
forall a b. a -> (a -> b) -> b
& IsLabel
  "hudOptions"
  (Optic A_Lens NoIx ChartSvg ChartSvg HudOptions HudOptions)
Optic A_Lens NoIx ChartSvg ChartSvg HudOptions HudOptions
#hudOptions Optic A_Lens NoIx ChartSvg ChartSvg HudOptions HudOptions
-> Optic A_Lens NoIx HudOptions HudOptions ChartAspect ChartAspect
-> Optic A_Lens NoIx ChartSvg ChartSvg 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
% IsLabel
  "chartAspect"
  (Optic A_Lens NoIx HudOptions HudOptions ChartAspect ChartAspect)
Optic A_Lens NoIx HudOptions HudOptions ChartAspect ChartAspect
#chartAspect Optic A_Lens NoIx ChartSvg ChartSvg ChartAspect ChartAspect
-> ChartAspect -> ChartSvg -> ChartSvg
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Double -> ChartAspect
FixedAspect Double
1.5
    ChartSvg -> (ChartSvg -> ChartSvg) -> ChartSvg
forall a b. a -> (a -> b) -> b
& IsLabel
  "hudOptions"
  (Optic A_Lens NoIx ChartSvg ChartSvg HudOptions HudOptions)
Optic A_Lens NoIx ChartSvg ChartSvg HudOptions HudOptions
#hudOptions Optic A_Lens NoIx ChartSvg ChartSvg HudOptions HudOptions
-> Optic
     A_Lens
     NoIx
     HudOptions
     HudOptions
     [(Double, LegendOptions)]
     [(Double, LegendOptions)]
-> Optic
     A_Lens
     NoIx
     ChartSvg
     ChartSvg
     [(Double, LegendOptions)]
     [(Double, 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
% IsLabel
  "legends"
  (Optic
     A_Lens
     NoIx
     HudOptions
     HudOptions
     [(Double, LegendOptions)]
     [(Double, LegendOptions)])
Optic
  A_Lens
  NoIx
  HudOptions
  HudOptions
  [(Double, LegendOptions)]
  [(Double, LegendOptions)]
#legends Optic
  A_Lens
  NoIx
  ChartSvg
  ChartSvg
  [(Double, LegendOptions)]
  [(Double, LegendOptions)]
-> [(Double, LegendOptions)] -> ChartSvg -> ChartSvg
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ [(Double
10, LegendOptions
defaultLegendOptions LegendOptions -> (LegendOptions -> LegendOptions) -> LegendOptions
forall a b. a -> (a -> b) -> b
& IsLabel
  "content"
  (Optic
     A_Lens
     NoIx
     LegendOptions
     LegendOptions
     [(Text, Chart)]
     [(Text, Chart)])
Optic
  A_Lens
  NoIx
  LegendOptions
  LegendOptions
  [(Text, Chart)]
  [(Text, Chart)]
#content 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
.~ [(Text, Chart)]
lrows LegendOptions -> (LegendOptions -> LegendOptions) -> LegendOptions
forall a b. a -> (a -> b) -> b
& IsLabel
  "textStyle"
  (Optic A_Lens NoIx LegendOptions LegendOptions TextStyle TextStyle)
Optic A_Lens NoIx LegendOptions LegendOptions TextStyle TextStyle
#textStyle Optic A_Lens NoIx LegendOptions LegendOptions TextStyle TextStyle
-> Optic A_Lens NoIx TextStyle TextStyle 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
% IsLabel
  "size" (Optic A_Lens NoIx TextStyle TextStyle Double Double)
Optic A_Lens NoIx TextStyle TextStyle Double Double
#size 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
.~ Double
0.2 LegendOptions -> (LegendOptions -> LegendOptions) -> LegendOptions
forall a b. a -> (a -> b) -> b
& IsLabel
  "size"
  (Optic A_Lens NoIx LegendOptions LegendOptions Double Double)
Optic A_Lens NoIx LegendOptions LegendOptions Double Double
#size 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
.~ Double
0.2)]
    ChartSvg -> (ChartSvg -> ChartSvg) -> ChartSvg
forall a b. a -> (a -> b) -> b
& IsLabel
  "hudOptions"
  (Optic A_Lens NoIx ChartSvg ChartSvg HudOptions HudOptions)
Optic A_Lens NoIx ChartSvg ChartSvg HudOptions HudOptions
#hudOptions Optic A_Lens NoIx ChartSvg ChartSvg HudOptions HudOptions
-> Optic
     A_Lens
     NoIx
     HudOptions
     HudOptions
     [(Double, Title)]
     [(Double, Title)]
-> Optic
     A_Lens NoIx ChartSvg ChartSvg [(Double, Title)] [(Double, Title)]
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
% IsLabel
  "titles"
  (Optic
     A_Lens
     NoIx
     HudOptions
     HudOptions
     [(Double, Title)]
     [(Double, Title)])
Optic
  A_Lens
  NoIx
  HudOptions
  HudOptions
  [(Double, Title)]
  [(Double, Title)]
#titles Optic
  A_Lens NoIx ChartSvg ChartSvg [(Double, Title)] [(Double, Title)]
-> [(Double, Title)] -> ChartSvg -> ChartSvg
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ [(Double
11, Text -> Title
defaultTitle Text
"QuadPosition (Point 0 0) (Point 1 1) (Point 2 (-1))" Title -> (Title -> Title) -> Title
forall a b. a -> (a -> b) -> b
& IsLabel "style" (Optic A_Lens NoIx Title Title TextStyle TextStyle)
Optic A_Lens NoIx Title Title TextStyle TextStyle
#style Optic A_Lens NoIx Title Title TextStyle TextStyle
-> Optic A_Lens NoIx TextStyle TextStyle Double Double
-> Optic A_Lens NoIx Title Title 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
% IsLabel
  "size" (Optic A_Lens NoIx TextStyle TextStyle Double Double)
Optic A_Lens NoIx TextStyle TextStyle Double Double
#size Optic A_Lens NoIx Title Title Double Double
-> Double -> Title -> Title
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Double
0.08)]
  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' = PathStyle -> [PathData Double] -> Chart
PathChart PathStyle
pathStyle [PathData Double]
ps
    curve :: Chart
curve = LineStyle -> [[Point Double]] -> Chart
LineChart LineStyle
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 :: LineStyle
curveStyle = LineStyle
defaultLineStyle LineStyle -> (LineStyle -> LineStyle) -> LineStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "size" (Optic A_Lens NoIx LineStyle LineStyle Double Double)
Optic A_Lens NoIx LineStyle LineStyle Double Double
#size Optic A_Lens NoIx LineStyle LineStyle Double Double
-> Double -> LineStyle -> LineStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Double
0.002 LineStyle -> (LineStyle -> LineStyle) -> LineStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "color" (Optic A_Lens NoIx LineStyle LineStyle Colour Colour)
Optic A_Lens NoIx LineStyle LineStyle Colour Colour
#color Optic A_Lens NoIx LineStyle LineStyle Colour Colour
-> Colour -> LineStyle -> LineStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Int -> Colour
palette1 Int
1
    c0 :: Chart
c0 = GlyphStyle -> [Point Double] -> Chart
GlyphChart GlyphStyle
defaultGlyphStyle [Point Double
start, Point Double
end]
    c1 :: Chart
c1 = GlyphStyle -> [Point Double] -> Chart
GlyphChart GlyphStyle
controlStyle [Point Double
control]
    bbox :: Chart
bbox = RectStyle -> [Rect Double] -> Chart
RectChart RectStyle
bbs [QuadPosition Double -> Rect Double
quadBox QuadPosition Double
p]
    bbs :: RectStyle
bbs = RectStyle
defaultRectStyle RectStyle -> (RectStyle -> RectStyle) -> RectStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "borderSize" (Optic A_Lens NoIx RectStyle RectStyle Double Double)
Optic A_Lens NoIx RectStyle RectStyle Double Double
#borderSize Optic A_Lens NoIx RectStyle RectStyle Double Double
-> Double -> RectStyle -> RectStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Double
0.002 RectStyle -> (RectStyle -> RectStyle) -> RectStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "color" (Optic A_Lens NoIx RectStyle RectStyle Colour Colour)
Optic A_Lens NoIx RectStyle RectStyle Colour Colour
#color Optic A_Lens NoIx RectStyle RectStyle Colour Colour
-> Colour -> RectStyle -> RectStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Int -> Double -> Colour
palette1a Int
0 Double
0.05 RectStyle -> (RectStyle -> RectStyle) -> RectStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "borderColor" (Optic A_Lens NoIx RectStyle RectStyle Colour Colour)
Optic A_Lens NoIx RectStyle RectStyle Colour Colour
#borderColor Optic A_Lens NoIx RectStyle RectStyle Colour Colour
-> Colour -> RectStyle -> RectStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Double -> Double -> Colour
grey Double
0.4 Double
1
    pathStyle :: PathStyle
pathStyle = PathStyle
defaultPathStyle PathStyle -> (PathStyle -> PathStyle) -> PathStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "color" (Optic A_Lens NoIx PathStyle PathStyle Colour Colour)
Optic A_Lens NoIx PathStyle PathStyle Colour Colour
#color Optic A_Lens NoIx PathStyle PathStyle Colour Colour
-> Colour -> PathStyle -> PathStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Int -> Double -> Colour
palette1a Int
2 Double
0.2 PathStyle -> (PathStyle -> PathStyle) -> PathStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "borderColor" (Optic A_Lens NoIx PathStyle PathStyle Colour Colour)
Optic A_Lens NoIx PathStyle PathStyle Colour Colour
#borderColor Optic A_Lens NoIx PathStyle PathStyle Colour Colour
-> Colour -> PathStyle -> PathStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Colour
transparent
    controlStyle :: GlyphStyle
controlStyle = GlyphStyle
defaultGlyphStyle GlyphStyle -> (GlyphStyle -> GlyphStyle) -> GlyphStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "shape"
  (Optic A_Lens NoIx GlyphStyle GlyphStyle GlyphShape GlyphShape)
Optic A_Lens NoIx GlyphStyle GlyphStyle GlyphShape GlyphShape
#shape Optic A_Lens NoIx GlyphStyle GlyphStyle GlyphShape GlyphShape
-> GlyphShape -> GlyphStyle -> GlyphStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ GlyphShape
CircleGlyph
    lrows :: [(Text, Chart)]
lrows =
      [ (Text
"Path Fill", PathStyle -> [PathData Double] -> Chart
PathChart PathStyle
pathStyle [Point Double -> PathData Double
forall a. Point a -> PathData a
StartP Point Double
forall a. Additive a => a
zero]),
        (Text
"Path Chord", LineStyle -> [[Point Double]] -> Chart
LineChart LineStyle
curveStyle [[Point Double
forall a. Additive a => a
zero]]),
        (Text
"Path Endpoints", GlyphStyle -> [Point Double] -> Chart
GlyphChart GlyphStyle
defaultGlyphStyle [Point Double
forall a. Additive a => a
zero]),
        (Text
"Path Control Point", GlyphStyle -> [Point Double] -> Chart
GlyphChart GlyphStyle
controlStyle [Point Double
forall a. Additive a => a
zero]),
        (Text
"Bounding Box", RectStyle -> [Rect Double] -> Chart
RectChart (RectStyle
bbs RectStyle -> (RectStyle -> RectStyle) -> RectStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "borderSize" (Optic A_Lens NoIx RectStyle RectStyle Double Double)
Optic A_Lens NoIx RectStyle RectStyle Double Double
#borderSize Optic A_Lens NoIx RectStyle RectStyle Double Double
-> Double -> RectStyle -> RectStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Double
0.01) [Rect Double
forall a. Multiplicative a => a
one])
      ]

-- | cubic example
--
-- ![cubic example](other/cubic.svg)
cubicExample :: ChartSvg
cubicExample :: ChartSvg
cubicExample =
  ChartSvg
forall a. Monoid a => a
mempty
    ChartSvg -> (ChartSvg -> ChartSvg) -> ChartSvg
forall a b. a -> (a -> b) -> b
& IsLabel
  "charts" (Optic A_Lens NoIx ChartSvg ChartSvg ChartTree ChartTree)
Optic A_Lens NoIx ChartSvg ChartSvg ChartTree ChartTree
#charts Optic A_Lens NoIx ChartSvg ChartSvg ChartTree ChartTree
-> ChartTree -> ChartSvg -> ChartSvg
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Text -> [Chart] -> ChartTree
named Text
"cubic" [Chart
path', Chart
curve, Chart
c0, Chart
c1, Chart
bbox]
    ChartSvg -> (ChartSvg -> ChartSvg) -> ChartSvg
forall a b. a -> (a -> b) -> b
& IsLabel
  "hudOptions"
  (Optic A_Lens NoIx ChartSvg ChartSvg HudOptions HudOptions)
Optic A_Lens NoIx ChartSvg ChartSvg HudOptions HudOptions
#hudOptions Optic A_Lens NoIx ChartSvg ChartSvg HudOptions HudOptions
-> HudOptions -> ChartSvg -> ChartSvg
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ HudOptions
forall a. Monoid a => a
mempty
    ChartSvg -> (ChartSvg -> ChartSvg) -> ChartSvg
forall a b. a -> (a -> b) -> b
& IsLabel
  "hudOptions"
  (Optic A_Lens NoIx ChartSvg ChartSvg HudOptions HudOptions)
Optic A_Lens NoIx ChartSvg ChartSvg HudOptions HudOptions
#hudOptions Optic A_Lens NoIx ChartSvg ChartSvg HudOptions HudOptions
-> Optic A_Lens NoIx HudOptions HudOptions ChartAspect ChartAspect
-> Optic A_Lens NoIx ChartSvg ChartSvg 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
% IsLabel
  "chartAspect"
  (Optic A_Lens NoIx HudOptions HudOptions ChartAspect ChartAspect)
Optic A_Lens NoIx HudOptions HudOptions ChartAspect ChartAspect
#chartAspect Optic A_Lens NoIx ChartSvg ChartSvg ChartAspect ChartAspect
-> ChartAspect -> ChartSvg -> ChartSvg
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Double -> ChartAspect
FixedAspect Double
1.5
    ChartSvg -> (ChartSvg -> ChartSvg) -> ChartSvg
forall a b. a -> (a -> b) -> b
& IsLabel
  "hudOptions"
  (Optic A_Lens NoIx ChartSvg ChartSvg HudOptions HudOptions)
Optic A_Lens NoIx ChartSvg ChartSvg HudOptions HudOptions
#hudOptions Optic A_Lens NoIx ChartSvg ChartSvg HudOptions HudOptions
-> Optic
     A_Lens
     NoIx
     HudOptions
     HudOptions
     [(Double, LegendOptions)]
     [(Double, LegendOptions)]
-> Optic
     A_Lens
     NoIx
     ChartSvg
     ChartSvg
     [(Double, LegendOptions)]
     [(Double, 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
% IsLabel
  "legends"
  (Optic
     A_Lens
     NoIx
     HudOptions
     HudOptions
     [(Double, LegendOptions)]
     [(Double, LegendOptions)])
Optic
  A_Lens
  NoIx
  HudOptions
  HudOptions
  [(Double, LegendOptions)]
  [(Double, LegendOptions)]
#legends Optic
  A_Lens
  NoIx
  ChartSvg
  ChartSvg
  [(Double, LegendOptions)]
  [(Double, LegendOptions)]
-> [(Double, LegendOptions)] -> ChartSvg -> ChartSvg
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ [(Double
10, LegendOptions
defaultLegendOptions LegendOptions -> (LegendOptions -> LegendOptions) -> LegendOptions
forall a b. a -> (a -> b) -> b
& IsLabel
  "content"
  (Optic
     A_Lens
     NoIx
     LegendOptions
     LegendOptions
     [(Text, Chart)]
     [(Text, Chart)])
Optic
  A_Lens
  NoIx
  LegendOptions
  LegendOptions
  [(Text, Chart)]
  [(Text, Chart)]
#content 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
.~ [(Text, Chart)]
lrows LegendOptions -> (LegendOptions -> LegendOptions) -> LegendOptions
forall a b. a -> (a -> b) -> b
& IsLabel
  "textStyle"
  (Optic A_Lens NoIx LegendOptions LegendOptions TextStyle TextStyle)
Optic A_Lens NoIx LegendOptions LegendOptions TextStyle TextStyle
#textStyle Optic A_Lens NoIx LegendOptions LegendOptions TextStyle TextStyle
-> Optic A_Lens NoIx TextStyle TextStyle 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
% IsLabel
  "size" (Optic A_Lens NoIx TextStyle TextStyle Double Double)
Optic A_Lens NoIx TextStyle TextStyle Double Double
#size 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
.~ Double
0.2 LegendOptions -> (LegendOptions -> LegendOptions) -> LegendOptions
forall a b. a -> (a -> b) -> b
& IsLabel
  "size"
  (Optic A_Lens NoIx LegendOptions LegendOptions Double Double)
Optic A_Lens NoIx LegendOptions LegendOptions Double Double
#size 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
.~ Double
0.2)]
    ChartSvg -> (ChartSvg -> ChartSvg) -> ChartSvg
forall a b. a -> (a -> b) -> b
& IsLabel
  "hudOptions"
  (Optic A_Lens NoIx ChartSvg ChartSvg HudOptions HudOptions)
Optic A_Lens NoIx ChartSvg ChartSvg HudOptions HudOptions
#hudOptions Optic A_Lens NoIx ChartSvg ChartSvg HudOptions HudOptions
-> Optic
     A_Lens
     NoIx
     HudOptions
     HudOptions
     [(Double, Title)]
     [(Double, Title)]
-> Optic
     A_Lens NoIx ChartSvg ChartSvg [(Double, Title)] [(Double, Title)]
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
% IsLabel
  "titles"
  (Optic
     A_Lens
     NoIx
     HudOptions
     HudOptions
     [(Double, Title)]
     [(Double, Title)])
Optic
  A_Lens
  NoIx
  HudOptions
  HudOptions
  [(Double, Title)]
  [(Double, Title)]
#titles Optic
  A_Lens NoIx ChartSvg ChartSvg [(Double, Title)] [(Double, Title)]
-> [(Double, Title)] -> ChartSvg -> ChartSvg
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ [(Double
11, Text -> Title
defaultTitle Text
"CubicPosition (Point 0 0) (Point 1 1) (Point 1 0) (Point 0 1)" Title -> (Title -> Title) -> Title
forall a b. a -> (a -> b) -> b
& IsLabel "style" (Optic A_Lens NoIx Title Title TextStyle TextStyle)
Optic A_Lens NoIx Title Title TextStyle TextStyle
#style Optic A_Lens NoIx Title Title TextStyle TextStyle
-> Optic A_Lens NoIx TextStyle TextStyle Double Double
-> Optic A_Lens NoIx Title Title 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
% IsLabel
  "size" (Optic A_Lens NoIx TextStyle TextStyle Double Double)
Optic A_Lens NoIx TextStyle TextStyle Double Double
#size Optic A_Lens NoIx Title Title Double Double
-> Double -> Title -> Title
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Double
0.08)]
  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' = PathStyle -> [PathData Double] -> Chart
PathChart PathStyle
pathStyle [PathData Double]
ps
    curve :: Chart
curve = LineStyle -> [[Point Double]] -> Chart
LineChart LineStyle
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 = GlyphStyle -> [Point Double] -> Chart
GlyphChart GlyphStyle
defaultGlyphStyle [Point Double
start, Point Double
end]
    c1 :: Chart
c1 = GlyphStyle -> [Point Double] -> Chart
GlyphChart GlyphStyle
controlStyle [Point Double
control1, Point Double
control2]
    bbox :: Chart
bbox = RectStyle -> [Rect Double] -> Chart
RectChart RectStyle
bbs [CubicPosition Double -> Rect Double
cubicBox CubicPosition Double
p]
    bbs :: RectStyle
bbs = RectStyle
defaultRectStyle RectStyle -> (RectStyle -> RectStyle) -> RectStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "borderSize" (Optic A_Lens NoIx RectStyle RectStyle Double Double)
Optic A_Lens NoIx RectStyle RectStyle Double Double
#borderSize Optic A_Lens NoIx RectStyle RectStyle Double Double
-> Double -> RectStyle -> RectStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Double
0.002 RectStyle -> (RectStyle -> RectStyle) -> RectStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "color" (Optic A_Lens NoIx RectStyle RectStyle Colour Colour)
Optic A_Lens NoIx RectStyle RectStyle Colour Colour
#color Optic A_Lens NoIx RectStyle RectStyle Colour Colour
-> Colour -> RectStyle -> RectStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Int -> Double -> Colour
palette1a Int
0 Double
0.05 RectStyle -> (RectStyle -> RectStyle) -> RectStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "borderColor" (Optic A_Lens NoIx RectStyle RectStyle Colour Colour)
Optic A_Lens NoIx RectStyle RectStyle Colour Colour
#borderColor Optic A_Lens NoIx RectStyle RectStyle Colour Colour
-> Colour -> RectStyle -> RectStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Double -> Double -> Colour
grey Double
0.4 Double
1
    pathStyle :: PathStyle
pathStyle = PathStyle
defaultPathStyle PathStyle -> (PathStyle -> PathStyle) -> PathStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "color" (Optic A_Lens NoIx PathStyle PathStyle Colour Colour)
Optic A_Lens NoIx PathStyle PathStyle Colour Colour
#color Optic A_Lens NoIx PathStyle PathStyle Colour Colour
-> Colour -> PathStyle -> PathStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Int -> Double -> Colour
palette1a Int
3 Double
0.2 PathStyle -> (PathStyle -> PathStyle) -> PathStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "borderColor" (Optic A_Lens NoIx PathStyle PathStyle Colour Colour)
Optic A_Lens NoIx PathStyle PathStyle Colour Colour
#borderColor Optic A_Lens NoIx PathStyle PathStyle Colour Colour
-> Colour -> PathStyle -> PathStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Colour
transparent
    controlStyle :: GlyphStyle
controlStyle = GlyphStyle
defaultGlyphStyle GlyphStyle -> (GlyphStyle -> GlyphStyle) -> GlyphStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "shape"
  (Optic A_Lens NoIx GlyphStyle GlyphStyle GlyphShape GlyphShape)
Optic A_Lens NoIx GlyphStyle GlyphStyle GlyphShape GlyphShape
#shape Optic A_Lens NoIx GlyphStyle GlyphStyle GlyphShape GlyphShape
-> GlyphShape -> GlyphStyle -> GlyphStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ GlyphShape
CircleGlyph
    curveStyle :: LineStyle
curveStyle = LineStyle
defaultLineStyle LineStyle -> (LineStyle -> LineStyle) -> LineStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "size" (Optic A_Lens NoIx LineStyle LineStyle Double Double)
Optic A_Lens NoIx LineStyle LineStyle Double Double
#size Optic A_Lens NoIx LineStyle LineStyle Double Double
-> Double -> LineStyle -> LineStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Double
0.002 LineStyle -> (LineStyle -> LineStyle) -> LineStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "color" (Optic A_Lens NoIx LineStyle LineStyle Colour Colour)
Optic A_Lens NoIx LineStyle LineStyle Colour Colour
#color Optic A_Lens NoIx LineStyle LineStyle Colour Colour
-> Colour -> LineStyle -> LineStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Int -> Colour
palette1 Int
7
    lrows :: [(Text, Chart)]
lrows =
      [ (Text
"Path Fill", PathStyle -> [PathData Double] -> Chart
PathChart PathStyle
pathStyle [Point Double -> PathData Double
forall a. Point a -> PathData a
StartP Point Double
forall a. Additive a => a
zero]),
        (Text
"Path Chord", LineStyle -> [[Point Double]] -> Chart
LineChart LineStyle
curveStyle [[Point Double
forall a. Additive a => a
zero]]),
        (Text
"Path Endpoints", GlyphStyle -> [Point Double] -> Chart
GlyphChart GlyphStyle
defaultGlyphStyle [Point Double
forall a. Additive a => a
zero]),
        (Text
"Path Control Point", GlyphStyle -> [Point Double] -> Chart
GlyphChart GlyphStyle
controlStyle [Point Double
forall a. Additive a => a
zero]),
        (Text
"Bounding Box", RectStyle -> [Rect Double] -> Chart
RectChart (RectStyle
bbs RectStyle -> (RectStyle -> RectStyle) -> RectStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "borderSize" (Optic A_Lens NoIx RectStyle RectStyle Double Double)
Optic A_Lens NoIx RectStyle RectStyle Double Double
#borderSize Optic A_Lens NoIx RectStyle RectStyle Double Double
-> Double -> RectStyle -> RectStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ 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 :: ChartSvg
surfaceExample :: ChartSvg
surfaceExample =
  ChartSvg
forall a. Monoid a => a
mempty
    ChartSvg -> (ChartSvg -> ChartSvg) -> ChartSvg
forall a b. a -> (a -> b) -> b
& IsLabel
  "extraHuds" (Optic A_Lens NoIx ChartSvg ChartSvg [Hud] [Hud])
Optic A_Lens NoIx ChartSvg ChartSvg [Hud] [Hud]
#extraHuds Optic A_Lens NoIx ChartSvg ChartSvg [Hud] [Hud]
-> [Hud] -> ChartSvg -> ChartSvg
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ [Hud]
h
    ChartSvg -> (ChartSvg -> ChartSvg) -> ChartSvg
forall a b. a -> (a -> b) -> b
& IsLabel
  "charts" (Optic A_Lens NoIx ChartSvg ChartSvg ChartTree ChartTree)
Optic A_Lens NoIx ChartSvg ChartSvg ChartTree ChartTree
#charts Optic A_Lens NoIx ChartSvg ChartSvg ChartTree ChartTree
-> ChartTree -> ChartSvg -> ChartSvg
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Text -> [Chart] -> ChartTree
named Text
"surface" [Chart]
cs
    ChartSvg -> (ChartSvg -> ChartSvg) -> ChartSvg
forall a b. a -> (a -> b) -> b
& IsLabel
  "svgOptions"
  (Optic A_Lens NoIx ChartSvg ChartSvg SvgOptions SvgOptions)
Optic A_Lens NoIx ChartSvg ChartSvg SvgOptions SvgOptions
#svgOptions Optic A_Lens NoIx ChartSvg ChartSvg SvgOptions SvgOptions
-> SvgOptions -> ChartSvg -> ChartSvg
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ (SvgOptions
defaultSvgOptions SvgOptions -> (SvgOptions -> SvgOptions) -> SvgOptions
forall a b. a -> (a -> b) -> b
& IsLabel
  "cssOptions"
  (Optic A_Lens NoIx SvgOptions SvgOptions CssOptions CssOptions)
Optic A_Lens NoIx SvgOptions SvgOptions CssOptions CssOptions
#cssOptions Optic A_Lens NoIx SvgOptions SvgOptions CssOptions CssOptions
-> Optic
     A_Lens
     NoIx
     CssOptions
     CssOptions
     CssShapeRendering
     CssShapeRendering
-> Optic
     A_Lens
     NoIx
     SvgOptions
     SvgOptions
     CssShapeRendering
     CssShapeRendering
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
% IsLabel
  "shapeRendering"
  (Optic
     A_Lens
     NoIx
     CssOptions
     CssOptions
     CssShapeRendering
     CssShapeRendering)
Optic
  A_Lens
  NoIx
  CssOptions
  CssOptions
  CssShapeRendering
  CssShapeRendering
#shapeRendering Optic
  A_Lens
  NoIx
  SvgOptions
  SvgOptions
  CssShapeRendering
  CssShapeRendering
-> CssShapeRendering -> SvgOptions -> SvgOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ CssShapeRendering
UseCssCrisp)
  where
    t :: Text
t = Text
"rosenbrock"
    grain :: Point Int
grain = Int -> Int -> Point Int
forall a. a -> a -> Point a
Point Int
100 Int
100
    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 (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap ((-Double
1.0) Double -> Double -> Double
forall a. Num a => a -> a -> a
*) ((Double -> Double) -> Point Double -> Point Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((-Double
1.0) Double -> Double -> Double
forall a. Num a => a -> a -> a
*)) ((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
palette1 (Int -> Colour) -> [Int] -> [Colour]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int
0 .. Int
5]
    ([Chart]
cs, [Hud]
h) =
      (Point Double -> Double)
-> SurfaceOptions -> SurfaceLegendOptions -> ([Chart], [Hud])
surfacefl
        Point Double -> Double
f
        ( SurfaceOptions
defaultSurfaceOptions
            SurfaceOptions
-> (SurfaceOptions -> SurfaceOptions) -> SurfaceOptions
forall a b. a -> (a -> b) -> b
& IsLabel
  "soGrain"
  (Optic
     A_Lens NoIx SurfaceOptions SurfaceOptions (Point Int) (Point Int))
Optic
  A_Lens NoIx SurfaceOptions SurfaceOptions (Point Int) (Point Int)
#soGrain 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
.~ Point Int
grain
            SurfaceOptions
-> (SurfaceOptions -> SurfaceOptions) -> SurfaceOptions
forall a b. a -> (a -> b) -> b
& IsLabel
  "soRange"
  (Optic
     A_Lens
     NoIx
     SurfaceOptions
     SurfaceOptions
     (Rect Double)
     (Rect Double))
Optic
  A_Lens
  NoIx
  SurfaceOptions
  SurfaceOptions
  (Rect Double)
  (Rect Double)
#soRange 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
.~ Rect Double
r
            SurfaceOptions
-> (SurfaceOptions -> SurfaceOptions) -> SurfaceOptions
forall a b. a -> (a -> b) -> b
& IsLabel
  "soStyle"
  (Optic
     A_Lens
     NoIx
     SurfaceOptions
     SurfaceOptions
     SurfaceStyle
     SurfaceStyle)
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
% IsLabel
  "surfaceColors"
  (Optic A_Lens NoIx SurfaceStyle SurfaceStyle [Colour] [Colour])
Optic A_Lens NoIx SurfaceStyle SurfaceStyle [Colour] [Colour]
#surfaceColors 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
.~ [Colour]
evenColors
        )
        ( Colour -> Text -> SurfaceLegendOptions
defaultSurfaceLegendOptions Colour
dark Text
t
            SurfaceLegendOptions
-> (SurfaceLegendOptions -> SurfaceLegendOptions)
-> SurfaceLegendOptions
forall a b. a -> (a -> b) -> b
& IsLabel
  "sloStyle"
  (Optic
     A_Lens
     NoIx
     SurfaceLegendOptions
     SurfaceLegendOptions
     SurfaceStyle
     SurfaceStyle)
Optic
  A_Lens
  NoIx
  SurfaceLegendOptions
  SurfaceLegendOptions
  SurfaceStyle
  SurfaceStyle
#sloStyle 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
% IsLabel
  "surfaceColors"
  (Optic A_Lens NoIx SurfaceStyle SurfaceStyle [Colour] [Colour])
Optic A_Lens NoIx SurfaceStyle SurfaceStyle [Colour] [Colour]
#surfaceColors 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
.~ [Colour]
evenColors
            SurfaceLegendOptions
-> (SurfaceLegendOptions -> SurfaceLegendOptions)
-> SurfaceLegendOptions
forall a b. a -> (a -> b) -> b
& IsLabel
  "sloLegendOptions"
  (Optic
     A_Lens
     NoIx
     SurfaceLegendOptions
     SurfaceLegendOptions
     LegendOptions
     LegendOptions)
Optic
  A_Lens
  NoIx
  SurfaceLegendOptions
  SurfaceLegendOptions
  LegendOptions
  LegendOptions
#sloLegendOptions Optic
  A_Lens
  NoIx
  SurfaceLegendOptions
  SurfaceLegendOptions
  LegendOptions
  LegendOptions
-> Optic
     A_Lens NoIx LegendOptions LegendOptions TextStyle TextStyle
-> Optic
     A_Lens
     NoIx
     SurfaceLegendOptions
     SurfaceLegendOptions
     TextStyle
     TextStyle
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
% IsLabel
  "textStyle"
  (Optic A_Lens NoIx LegendOptions LegendOptions TextStyle TextStyle)
Optic A_Lens NoIx LegendOptions LegendOptions TextStyle TextStyle
#textStyle Optic
  A_Lens
  NoIx
  SurfaceLegendOptions
  SurfaceLegendOptions
  TextStyle
  TextStyle
-> Optic A_Lens NoIx TextStyle TextStyle 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
% IsLabel
  "color" (Optic A_Lens NoIx TextStyle TextStyle Colour Colour)
Optic A_Lens NoIx TextStyle TextStyle Colour Colour
#color 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
.~ Colour
dark
            SurfaceLegendOptions
-> (SurfaceLegendOptions -> SurfaceLegendOptions)
-> SurfaceLegendOptions
forall a b. a -> (a -> b) -> b
& IsLabel
  "sloAxisOptions"
  (Optic
     A_Lens
     NoIx
     SurfaceLegendOptions
     SurfaceLegendOptions
     AxisOptions
     AxisOptions)
Optic
  A_Lens
  NoIx
  SurfaceLegendOptions
  SurfaceLegendOptions
  AxisOptions
  AxisOptions
#sloAxisOptions Optic
  A_Lens
  NoIx
  SurfaceLegendOptions
  SurfaceLegendOptions
  AxisOptions
  AxisOptions
-> AxisOptions -> SurfaceLegendOptions -> SurfaceLegendOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Colour -> AxisOptions
surfaceAxisOptions Colour
dark
            SurfaceLegendOptions
-> (SurfaceLegendOptions -> SurfaceLegendOptions)
-> SurfaceLegendOptions
forall a b. a -> (a -> b) -> b
& IsLabel
  "sloLegendOptions"
  (Optic
     A_Lens
     NoIx
     SurfaceLegendOptions
     SurfaceLegendOptions
     LegendOptions
     LegendOptions)
Optic
  A_Lens
  NoIx
  SurfaceLegendOptions
  SurfaceLegendOptions
  LegendOptions
  LegendOptions
#sloLegendOptions Optic
  A_Lens
  NoIx
  SurfaceLegendOptions
  SurfaceLegendOptions
  LegendOptions
  LegendOptions
-> Optic
     A_Lens
     NoIx
     LegendOptions
     LegendOptions
     (Maybe RectStyle)
     (Maybe RectStyle)
-> Optic
     A_Lens
     NoIx
     SurfaceLegendOptions
     SurfaceLegendOptions
     (Maybe RectStyle)
     (Maybe RectStyle)
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
% IsLabel
  "frame"
  (Optic
     A_Lens
     NoIx
     LegendOptions
     LegendOptions
     (Maybe RectStyle)
     (Maybe RectStyle))
Optic
  A_Lens
  NoIx
  LegendOptions
  LegendOptions
  (Maybe RectStyle)
  (Maybe RectStyle)
#frame Optic
  A_Lens
  NoIx
  SurfaceLegendOptions
  SurfaceLegendOptions
  (Maybe RectStyle)
  (Maybe RectStyle)
-> (Maybe RectStyle -> Maybe RectStyle)
-> SurfaceLegendOptions
-> SurfaceLegendOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ (RectStyle -> RectStyle) -> Maybe RectStyle -> Maybe RectStyle
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (IsLabel
  "borderColor" (Optic A_Lens NoIx RectStyle RectStyle Colour Colour)
Optic A_Lens NoIx RectStyle RectStyle Colour Colour
#borderColor Optic A_Lens NoIx RectStyle RectStyle Colour Colour
-> Colour -> RectStyle -> RectStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Colour
dark)
        )

-- | arrow example
--
-- Which happens to be the gradient of the surface example.
--
-- ![arrow example](other/arrow.svg)
arrowExample :: ChartSvg
arrowExample :: ChartSvg
arrowExample =
  ChartSvg
forall a. Monoid a => a
mempty
    ChartSvg -> (ChartSvg -> ChartSvg) -> ChartSvg
forall a b. a -> (a -> b) -> b
& IsLabel
  "hudOptions"
  (Optic A_Lens NoIx ChartSvg ChartSvg HudOptions HudOptions)
Optic A_Lens NoIx ChartSvg ChartSvg HudOptions HudOptions
#hudOptions Optic A_Lens NoIx ChartSvg ChartSvg HudOptions HudOptions
-> HudOptions -> ChartSvg -> ChartSvg
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ (HudOptions
defaultHudOptions HudOptions -> (HudOptions -> HudOptions) -> HudOptions
forall a b. a -> (a -> b) -> b
& IsLabel
  "axes"
  (Optic
     A_Lens
     NoIx
     HudOptions
     HudOptions
     [(Double, AxisOptions)]
     [(Double, AxisOptions)])
Optic
  A_Lens
  NoIx
  HudOptions
  HudOptions
  [(Double, AxisOptions)]
  [(Double, AxisOptions)]
#axes Optic
  A_Lens
  NoIx
  HudOptions
  HudOptions
  [(Double, AxisOptions)]
  [(Double, AxisOptions)]
-> ([(Double, AxisOptions)] -> [(Double, AxisOptions)])
-> HudOptions
-> HudOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ ((Double, AxisOptions) -> (Double, AxisOptions))
-> [(Double, AxisOptions)] -> [(Double, AxisOptions)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((AxisOptions -> AxisOptions)
-> (Double, AxisOptions) -> (Double, AxisOptions)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (IsLabel
  "ticks" (Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks)
Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
#ticks Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
-> Optic
     A_Lens
     NoIx
     Ticks
     Ticks
     (Maybe (LineStyle, Double))
     (Maybe (LineStyle, Double))
-> Optic
     A_Lens
     NoIx
     AxisOptions
     AxisOptions
     (Maybe (LineStyle, Double))
     (Maybe (LineStyle, 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
% IsLabel
  "ltick"
  (Optic
     A_Lens
     NoIx
     Ticks
     Ticks
     (Maybe (LineStyle, Double))
     (Maybe (LineStyle, Double)))
Optic
  A_Lens
  NoIx
  Ticks
  Ticks
  (Maybe (LineStyle, Double))
  (Maybe (LineStyle, Double))
#ltick Optic
  A_Lens
  NoIx
  AxisOptions
  AxisOptions
  (Maybe (LineStyle, Double))
  (Maybe (LineStyle, Double))
-> Maybe (LineStyle, Double) -> AxisOptions -> AxisOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Maybe (LineStyle, Double)
forall a. Maybe a
Nothing)))
    ChartSvg -> (ChartSvg -> ChartSvg) -> ChartSvg
forall a b. a -> (a -> b) -> b
& IsLabel
  "charts" (Optic A_Lens NoIx ChartSvg ChartSvg ChartTree ChartTree)
Optic A_Lens NoIx ChartSvg ChartSvg ChartTree ChartTree
#charts Optic A_Lens NoIx ChartSvg ChartSvg ChartTree ChartTree
-> ChartTree -> ChartSvg -> ChartSvg
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ 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
forall coord dir. Direction coord dir => coord -> dir
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)
    ChartSvg -> (ChartSvg -> ChartSvg) -> ChartSvg
forall a b. a -> (a -> b) -> b
& IsLabel
  "svgOptions"
  (Optic A_Lens NoIx ChartSvg ChartSvg SvgOptions SvgOptions)
Optic A_Lens NoIx ChartSvg ChartSvg SvgOptions SvgOptions
#svgOptions Optic A_Lens NoIx ChartSvg ChartSvg SvgOptions SvgOptions
-> Optic A_Lens NoIx SvgOptions SvgOptions CssOptions CssOptions
-> Optic A_Lens NoIx ChartSvg ChartSvg 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
% IsLabel
  "cssOptions"
  (Optic A_Lens NoIx SvgOptions SvgOptions CssOptions CssOptions)
Optic A_Lens NoIx SvgOptions SvgOptions CssOptions CssOptions
#cssOptions Optic A_Lens NoIx ChartSvg ChartSvg CssOptions CssOptions
-> Optic
     A_Lens
     NoIx
     CssOptions
     CssOptions
     CssPreferColorScheme
     CssPreferColorScheme
-> Optic
     A_Lens
     NoIx
     ChartSvg
     ChartSvg
     CssPreferColorScheme
     CssPreferColorScheme
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
% IsLabel
  "preferColorScheme"
  (Optic
     A_Lens
     NoIx
     CssOptions
     CssOptions
     CssPreferColorScheme
     CssPreferColorScheme)
Optic
  A_Lens
  NoIx
  CssOptions
  CssOptions
  CssPreferColorScheme
  CssPreferColorScheme
#preferColorScheme Optic
  A_Lens
  NoIx
  ChartSvg
  ChartSvg
  CssPreferColorScheme
  CssPreferColorScheme
-> CssPreferColorScheme -> ChartSvg -> ChartSvg
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ CssPreferColorScheme
PreferHud
    ChartSvg -> (ChartSvg -> ChartSvg) -> ChartSvg
forall a b. a -> (a -> b) -> b
& IsLabel
  "svgOptions"
  (Optic A_Lens NoIx ChartSvg ChartSvg SvgOptions SvgOptions)
Optic A_Lens NoIx ChartSvg ChartSvg SvgOptions SvgOptions
#svgOptions Optic A_Lens NoIx ChartSvg ChartSvg SvgOptions SvgOptions
-> Optic A_Lens NoIx SvgOptions SvgOptions CssOptions CssOptions
-> Optic A_Lens NoIx ChartSvg ChartSvg 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
% IsLabel
  "cssOptions"
  (Optic A_Lens NoIx SvgOptions SvgOptions CssOptions CssOptions)
Optic A_Lens NoIx SvgOptions SvgOptions CssOptions CssOptions
#cssOptions Optic A_Lens NoIx ChartSvg ChartSvg CssOptions CssOptions
-> Optic A_Lens NoIx CssOptions CssOptions Text Text
-> Optic A_Lens NoIx ChartSvg ChartSvg Text Text
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
% IsLabel
  "cssExtra" (Optic A_Lens NoIx CssOptions CssOptions Text Text)
Optic A_Lens NoIx CssOptions CssOptions Text Text
#cssExtra
      Optic A_Lens NoIx ChartSvg ChartSvg Text Text
-> Text -> ChartSvg -> ChartSvg
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ [trimming|
{
  .arrow g {
    fill: $hexDark;
    stroke: $hexDark;
  }
}
@media (prefers-color-scheme:dark) {
  .arrow g {
    fill: $hexLight;
    stroke: $hexLight;
  }
}
|]
  where
    hexLight :: Text
hexLight = Colour -> Text
hex Colour
light
    hexDark :: Text
hexDark = Colour -> Text
hex Colour
dark
    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 (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap ((-Double
1.0) Double -> Double -> Double
forall a. Num a => a -> a -> a
*) ((Double -> Double) -> Point Double -> Point Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((-Double
1.0) Double -> Double -> Double
forall a. Num a => a -> a -> a
*)) ((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 = Text -> ScaleBorder -> GlyphShape
PathGlyph Text
"M -1 0 L 1 0 M 1 0 L 0.4 0.3 M 1 0 L 0.4 -0.3" ScaleBorder
NoScaleBorder
    gs :: Double -> Double -> GlyphStyle
gs Double
s Double
r' =
      GlyphStyle
defaultGlyphStyle
        GlyphStyle -> (GlyphStyle -> GlyphStyle) -> GlyphStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "borderSize"
  (Optic A_Lens NoIx GlyphStyle GlyphStyle Double Double)
Optic A_Lens NoIx GlyphStyle GlyphStyle Double Double
#borderSize Optic A_Lens NoIx GlyphStyle GlyphStyle Double Double
-> Double -> GlyphStyle -> GlyphStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Double
0.05
        GlyphStyle -> (GlyphStyle -> GlyphStyle) -> GlyphStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "size" (Optic A_Lens NoIx GlyphStyle GlyphStyle Double Double)
Optic A_Lens NoIx GlyphStyle GlyphStyle Double Double
#size Optic A_Lens NoIx GlyphStyle GlyphStyle Double Double
-> Double -> GlyphStyle -> GlyphStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Double
s
        GlyphStyle -> (GlyphStyle -> GlyphStyle) -> GlyphStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "borderColor"
  (Optic A_Lens NoIx GlyphStyle GlyphStyle Colour Colour)
Optic A_Lens NoIx GlyphStyle GlyphStyle Colour Colour
#borderColor Optic A_Lens NoIx GlyphStyle GlyphStyle Colour Colour
-> Colour -> GlyphStyle -> GlyphStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Colour
dark
        GlyphStyle -> (GlyphStyle -> GlyphStyle) -> GlyphStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "rotation"
  (Optic
     A_Lens NoIx GlyphStyle GlyphStyle (Maybe Double) (Maybe Double))
Optic
  A_Lens NoIx GlyphStyle GlyphStyle (Maybe Double) (Maybe Double)
#rotation Optic
  A_Lens NoIx GlyphStyle GlyphStyle (Maybe Double) (Maybe Double)
-> Maybe Double -> GlyphStyle -> GlyphStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Double -> Maybe Double
forall a. a -> Maybe a
Just Double
r'
        GlyphStyle -> (GlyphStyle -> GlyphStyle) -> GlyphStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "shape"
  (Optic A_Lens NoIx GlyphStyle GlyphStyle GlyphShape GlyphShape)
Optic A_Lens NoIx GlyphStyle GlyphStyle GlyphShape GlyphShape
#shape Optic A_Lens NoIx GlyphStyle GlyphStyle GlyphShape GlyphShape
-> GlyphShape -> GlyphStyle -> GlyphStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ GlyphShape
arrow
    gchart :: Double -> Double -> Point Double -> Chart
gchart Double
s Double
r' Point Double
p = GlyphStyle -> [Point Double] -> Chart
GlyphChart (Double -> Double -> GlyphStyle
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
forall a b. Norm a b => a -> b
norm

    avmag :: Double
avmag = [Double] -> Double
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (Point Double -> Double
forall a b. Norm a b => a -> b
norm (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 (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 :: ChartSvg
dateExample :: ChartSvg
dateExample =
  ChartSvg
forall a. Monoid a => a
mempty
    ChartSvg -> (ChartSvg -> ChartSvg) -> ChartSvg
forall a b. a -> (a -> b) -> b
& IsLabel
  "charts" (Optic A_Lens NoIx ChartSvg ChartSvg ChartTree ChartTree)
Optic A_Lens NoIx ChartSvg ChartSvg ChartTree ChartTree
#charts Optic A_Lens NoIx ChartSvg ChartSvg ChartTree ChartTree
-> ChartTree -> ChartSvg -> ChartSvg
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ 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)
    ChartSvg -> (ChartSvg -> ChartSvg) -> ChartSvg
forall a b. a -> (a -> b) -> b
& IsLabel
  "hudOptions"
  (Optic A_Lens NoIx ChartSvg ChartSvg HudOptions HudOptions)
Optic A_Lens NoIx ChartSvg ChartSvg HudOptions HudOptions
#hudOptions
      Optic A_Lens NoIx ChartSvg ChartSvg HudOptions HudOptions
-> HudOptions -> ChartSvg -> ChartSvg
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ ( HudOptions
forall a. Monoid a => a
mempty HudOptions -> (HudOptions -> HudOptions) -> HudOptions
forall a b. a -> (a -> b) -> b
& IsLabel
  "chartAspect"
  (Optic A_Lens NoIx HudOptions HudOptions ChartAspect ChartAspect)
Optic A_Lens NoIx HudOptions HudOptions ChartAspect ChartAspect
#chartAspect Optic A_Lens NoIx HudOptions HudOptions ChartAspect ChartAspect
-> ChartAspect -> HudOptions -> HudOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Double -> ChartAspect
FixedAspect Double
1.5 HudOptions -> (HudOptions -> HudOptions) -> HudOptions
forall a b. a -> (a -> b) -> b
& IsLabel
  "axes"
  (Optic
     A_Lens
     NoIx
     HudOptions
     HudOptions
     [(Double, AxisOptions)]
     [(Double, AxisOptions)])
Optic
  A_Lens
  NoIx
  HudOptions
  HudOptions
  [(Double, AxisOptions)]
  [(Double, AxisOptions)]
#axes
             Optic
  A_Lens
  NoIx
  HudOptions
  HudOptions
  [(Double, AxisOptions)]
  [(Double, AxisOptions)]
-> [(Double, 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
.~ [ (Double
1, AxisOptions
defaultAxisOptions AxisOptions -> (AxisOptions -> AxisOptions) -> AxisOptions
forall a b. a -> (a -> b) -> b
& IsLabel
  "place" (Optic A_Lens NoIx AxisOptions AxisOptions Place Place)
Optic A_Lens NoIx AxisOptions AxisOptions Place Place
#place 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
.~ Place
PlaceLeft AxisOptions -> (AxisOptions -> AxisOptions) -> AxisOptions
forall a b. a -> (a -> b) -> b
& IsLabel
  "ticks" (Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks)
Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
#ticks Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
-> Optic A_Lens NoIx Ticks Ticks TickStyle TickStyle
-> Optic A_Lens NoIx AxisOptions AxisOptions TickStyle 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
% IsLabel "style" (Optic A_Lens NoIx Ticks Ticks TickStyle TickStyle)
Optic A_Lens NoIx Ticks Ticks TickStyle TickStyle
#style Optic A_Lens NoIx AxisOptions AxisOptions TickStyle TickStyle
-> 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
.~ [(Double, Text)] -> TickStyle
TickPlaced [(Double, Text)]
tsTime),
                  (Double
1, AxisOptions
defaultAxisOptions AxisOptions -> (AxisOptions -> AxisOptions) -> AxisOptions
forall a b. a -> (a -> b) -> b
& IsLabel
  "ticks" (Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks)
Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
#ticks Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
-> Optic A_Lens NoIx Ticks Ticks TickStyle TickStyle
-> Optic A_Lens NoIx AxisOptions AxisOptions TickStyle 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
% IsLabel "style" (Optic A_Lens NoIx Ticks Ticks TickStyle TickStyle)
Optic A_Lens NoIx Ticks Ticks TickStyle TickStyle
#style Optic A_Lens NoIx AxisOptions AxisOptions TickStyle TickStyle
-> 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
.~ [(Double, Text)] -> TickStyle
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 (Integer -> Int -> Int -> Day
fromGregorian Integer
2021 Int
12 Int
6) (Double -> DiffTime
toDiffTime Double
0)) (Day -> DiffTime -> UTCTime
UTCTime (Integer -> Int -> Int -> Day
fromGregorian Integer
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 ([Char] -> Text
pack [Char]
"%d %b")) Int
2 (UTCTime -> UTCTime -> Range UTCTime
forall a. a -> a -> Range a
Range (Day -> DiffTime -> UTCTime
UTCTime (Integer -> Int -> Int -> Day
fromGregorian Integer
2021 Int
12 Int
6) (Double -> DiffTime
toDiffTime Double
0)) (Day -> DiffTime -> UTCTime
UTCTime (Integer -> Int -> Int -> Day
fromGregorian Integer
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 :: ChartSvg
gradientExample :: ChartSvg
gradientExample = Maybe Double -> Double -> Double -> Int -> LCHA -> LCHA -> ChartSvg
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
& 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' 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
.~ Double
0.001
    c1 :: LCHA
c1 = LCHA
ok LCHA -> (LCHA -> LCHA) -> LCHA
forall a b. a -> (a -> b) -> b
& 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' 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
.~ 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) -> RectStyle -> [Rect Double] -> Chart
RectChart (RectStyle
defaultRectStyle RectStyle -> (RectStyle -> RectStyle) -> RectStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "color" (Optic A_Lens NoIx RectStyle RectStyle Colour Colour)
Optic A_Lens NoIx RectStyle RectStyle Colour Colour
#color Optic A_Lens NoIx RectStyle RectStyle Colour Colour
-> Colour -> RectStyle -> RectStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Colour
c RectStyle -> (RectStyle -> RectStyle) -> RectStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "borderSize" (Optic A_Lens NoIx RectStyle RectStyle Double Double)
Optic A_Lens NoIx RectStyle RectStyle Double Double
#borderSize Optic A_Lens NoIx RectStyle RectStyle Double Double
-> Double -> RectStyle -> RectStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ 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 -> ChartSvg
gradient :: Maybe Double -> Double -> Double -> Int -> LCHA -> LCHA -> ChartSvg
gradient Maybe Double
marker Double
h Double
fa Int
grain LCHA
ok0 LCHA
ok1 =
  ChartSvg
forall a. Monoid a => a
mempty
    ChartSvg -> (ChartSvg -> ChartSvg) -> ChartSvg
forall a b. a -> (a -> b) -> b
& IsLabel
  "svgOptions"
  (Optic A_Lens NoIx ChartSvg ChartSvg SvgOptions SvgOptions)
Optic A_Lens NoIx ChartSvg ChartSvg SvgOptions SvgOptions
#svgOptions Optic A_Lens NoIx ChartSvg ChartSvg SvgOptions SvgOptions
-> Optic A_Lens NoIx SvgOptions SvgOptions Double Double
-> Optic A_Lens NoIx ChartSvg ChartSvg 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
% IsLabel
  "svgHeight" (Optic A_Lens NoIx SvgOptions SvgOptions Double Double)
Optic A_Lens NoIx SvgOptions SvgOptions Double Double
#svgHeight
    Optic A_Lens NoIx ChartSvg ChartSvg Double Double
-> Double -> ChartSvg -> ChartSvg
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Double
h
    ChartSvg -> (ChartSvg -> ChartSvg) -> ChartSvg
forall a b. a -> (a -> b) -> b
& IsLabel
  "svgOptions"
  (Optic A_Lens NoIx ChartSvg ChartSvg SvgOptions SvgOptions)
Optic A_Lens NoIx ChartSvg ChartSvg SvgOptions SvgOptions
#svgOptions Optic A_Lens NoIx ChartSvg ChartSvg SvgOptions SvgOptions
-> Optic A_Lens NoIx SvgOptions SvgOptions CssOptions CssOptions
-> Optic A_Lens NoIx ChartSvg ChartSvg 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
% IsLabel
  "cssOptions"
  (Optic A_Lens NoIx SvgOptions SvgOptions CssOptions CssOptions)
Optic A_Lens NoIx SvgOptions SvgOptions CssOptions CssOptions
#cssOptions Optic A_Lens NoIx ChartSvg ChartSvg CssOptions CssOptions
-> Optic
     A_Lens
     NoIx
     CssOptions
     CssOptions
     CssShapeRendering
     CssShapeRendering
-> Optic
     A_Lens NoIx ChartSvg ChartSvg CssShapeRendering CssShapeRendering
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
% IsLabel
  "shapeRendering"
  (Optic
     A_Lens
     NoIx
     CssOptions
     CssOptions
     CssShapeRendering
     CssShapeRendering)
Optic
  A_Lens
  NoIx
  CssOptions
  CssOptions
  CssShapeRendering
  CssShapeRendering
#shapeRendering
    Optic
  A_Lens NoIx ChartSvg ChartSvg CssShapeRendering CssShapeRendering
-> CssShapeRendering -> ChartSvg -> ChartSvg
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ CssShapeRendering
UseCssCrisp
    ChartSvg -> (ChartSvg -> ChartSvg) -> ChartSvg
forall a b. a -> (a -> b) -> b
& IsLabel
  "hudOptions"
  (Optic A_Lens NoIx ChartSvg ChartSvg HudOptions HudOptions)
Optic A_Lens NoIx ChartSvg ChartSvg HudOptions HudOptions
#hudOptions
    Optic A_Lens NoIx ChartSvg ChartSvg HudOptions HudOptions
-> HudOptions -> ChartSvg -> ChartSvg
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ ( HudOptions
forall a. Monoid a => a
mempty
           HudOptions -> (HudOptions -> HudOptions) -> HudOptions
forall a b. a -> (a -> b) -> b
& IsLabel
  "chartAspect"
  (Optic A_Lens NoIx HudOptions HudOptions ChartAspect ChartAspect)
Optic A_Lens NoIx HudOptions HudOptions ChartAspect ChartAspect
#chartAspect Optic A_Lens NoIx HudOptions HudOptions ChartAspect ChartAspect
-> ChartAspect -> HudOptions -> HudOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Double -> ChartAspect
FixedAspect Double
fa
           HudOptions -> (HudOptions -> HudOptions) -> HudOptions
forall a b. a -> (a -> b) -> b
& IsLabel
  "frames"
  (Optic
     A_Lens
     NoIx
     HudOptions
     HudOptions
     [(Double, FrameOptions)]
     [(Double, FrameOptions)])
Optic
  A_Lens
  NoIx
  HudOptions
  HudOptions
  [(Double, FrameOptions)]
  [(Double, FrameOptions)]
#frames Optic
  A_Lens
  NoIx
  HudOptions
  HudOptions
  [(Double, FrameOptions)]
  [(Double, FrameOptions)]
-> [(Double, 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
.~ [(Double
20, Maybe RectStyle -> Double -> FrameOptions
FrameOptions (RectStyle -> Maybe RectStyle
forall a. a -> Maybe a
Just (Double -> Colour -> RectStyle
border Double
0.004 Colour
white)) Double
0.1)]
       )
    ChartSvg -> (ChartSvg -> ChartSvg) -> ChartSvg
forall a b. a -> (a -> b) -> b
& IsLabel
  "charts" (Optic A_Lens NoIx ChartSvg ChartSvg ChartTree ChartTree)
Optic A_Lens NoIx ChartSvg ChartSvg ChartTree ChartTree
#charts
    Optic A_Lens NoIx ChartSvg ChartSvg ChartTree ChartTree
-> ChartTree -> ChartSvg -> ChartSvg
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ 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 = RectStyle -> [Rect Double] -> Chart
RectChart (RectStyle
defaultRectStyle RectStyle -> (RectStyle -> RectStyle) -> RectStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "color" (Optic A_Lens NoIx RectStyle RectStyle Colour Colour)
Optic A_Lens NoIx RectStyle RectStyle Colour Colour
#color Optic A_Lens NoIx RectStyle RectStyle Colour Colour
-> Colour -> RectStyle -> RectStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Colour
transparent RectStyle -> (RectStyle -> RectStyle) -> RectStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "borderSize" (Optic A_Lens NoIx RectStyle RectStyle Double Double)
Optic A_Lens NoIx RectStyle RectStyle Double Double
#borderSize Optic A_Lens NoIx RectStyle RectStyle Double Double
-> Double -> RectStyle -> RectStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Double
w RectStyle -> (RectStyle -> RectStyle) -> RectStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "borderColor" (Optic A_Lens NoIx RectStyle RectStyle Colour Colour)
Optic A_Lens NoIx RectStyle RectStyle Colour Colour
#borderColor Optic A_Lens NoIx RectStyle RectStyle Colour Colour
-> Colour -> RectStyle -> RectStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Colour
c) [Rect Double
r]

-- | Color wheel displaying palette1 choices
--
-- -- ![wheel example](other/wheel.svg)
wheelExample :: ChartSvg
wheelExample :: ChartSvg
wheelExample = Double -> Int -> Double -> Double -> [Colour] -> ChartSvg
dotMap Double
0.01 Int
50 Double
0.5 Double
0.5 (Int -> Colour
palette1 (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] -> ChartSvg
dotMap :: Double -> Int -> Double -> Double -> [Colour] -> ChartSvg
dotMap Double
s Int
grain Double
l Double
maxchroma [Colour]
cs =
  ChartSvg
forall a. Monoid a => a
mempty
    ChartSvg -> (ChartSvg -> ChartSvg) -> ChartSvg
forall a b. a -> (a -> b) -> b
& IsLabel
  "hudOptions"
  (Optic A_Lens NoIx ChartSvg ChartSvg HudOptions HudOptions)
Optic A_Lens NoIx ChartSvg ChartSvg HudOptions HudOptions
#hudOptions
    Optic A_Lens NoIx ChartSvg ChartSvg HudOptions HudOptions
-> HudOptions -> ChartSvg -> ChartSvg
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ HudOptions
defaultHudOptions
    ChartSvg -> (ChartSvg -> ChartSvg) -> ChartSvg
forall a b. a -> (a -> b) -> b
& IsLabel
  "charts" (Optic A_Lens NoIx ChartSvg ChartSvg ChartTree ChartTree)
Optic A_Lens NoIx ChartSvg ChartSvg ChartTree ChartTree
#charts
    Optic A_Lens NoIx ChartSvg ChartSvg ChartTree ChartTree
-> ChartTree -> ChartSvg -> ChartSvg
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ 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) ->
            GlyphStyle -> [Point Double] -> Chart
GlyphChart
              ( GlyphStyle
defaultGlyphStyle
                  GlyphStyle -> (GlyphStyle -> GlyphStyle) -> GlyphStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "size" (Optic A_Lens NoIx GlyphStyle GlyphStyle Double Double)
Optic A_Lens NoIx GlyphStyle GlyphStyle Double Double
#size Optic A_Lens NoIx GlyphStyle GlyphStyle Double Double
-> Double -> GlyphStyle -> GlyphStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Double
s
                  GlyphStyle -> (GlyphStyle -> GlyphStyle) -> GlyphStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "color" (Optic A_Lens NoIx GlyphStyle GlyphStyle Colour Colour)
Optic A_Lens NoIx GlyphStyle GlyphStyle Colour Colour
#color Optic A_Lens NoIx GlyphStyle GlyphStyle Colour Colour
-> Colour -> GlyphStyle -> GlyphStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Colour
c
                  GlyphStyle -> (GlyphStyle -> GlyphStyle) -> GlyphStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "borderSize"
  (Optic A_Lens NoIx GlyphStyle GlyphStyle Double Double)
Optic A_Lens NoIx GlyphStyle GlyphStyle Double Double
#borderSize Optic A_Lens NoIx GlyphStyle GlyphStyle Double Double
-> Double -> GlyphStyle -> GlyphStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Double
0
              )
              [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) -> GlyphStyle -> [Point Double] -> Chart
GlyphChart (GlyphStyle
defaultGlyphStyle GlyphStyle -> (GlyphStyle -> GlyphStyle) -> GlyphStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "size" (Optic A_Lens NoIx GlyphStyle GlyphStyle Double Double)
Optic A_Lens NoIx GlyphStyle GlyphStyle Double Double
#size Optic A_Lens NoIx GlyphStyle GlyphStyle Double Double
-> Double -> GlyphStyle -> GlyphStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Double
0.08 GlyphStyle -> (GlyphStyle -> GlyphStyle) -> GlyphStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "color" (Optic A_Lens NoIx GlyphStyle GlyphStyle Colour Colour)
Optic A_Lens NoIx GlyphStyle GlyphStyle Colour Colour
#color Optic A_Lens NoIx GlyphStyle GlyphStyle Colour Colour
-> Colour -> GlyphStyle -> GlyphStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Colour
c GlyphStyle -> (GlyphStyle -> GlyphStyle) -> GlyphStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "borderColor"
  (Optic A_Lens NoIx GlyphStyle GlyphStyle Colour Colour)
Optic A_Lens NoIx GlyphStyle GlyphStyle Colour Colour
#borderColor Optic A_Lens NoIx GlyphStyle GlyphStyle Colour Colour
-> Colour -> GlyphStyle -> GlyphStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Double -> Double -> Double -> Double -> Colour
Colour Double
0.5 Double
0.5 Double
0.5 Double
1 GlyphStyle -> (GlyphStyle -> GlyphStyle) -> GlyphStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "shape"
  (Optic A_Lens NoIx GlyphStyle GlyphStyle GlyphShape GlyphShape)
Optic A_Lens NoIx GlyphStyle GlyphStyle GlyphShape GlyphShape
#shape Optic A_Lens NoIx GlyphStyle GlyphStyle GlyphShape GlyphShape
-> GlyphShape -> GlyphStyle -> GlyphStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ 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 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 :: ChartSvg -> ChartSvg
debugExample :: ChartSvg -> ChartSvg
debugExample ChartSvg
cs =
  ChartSvg
forall a. Monoid a => a
mempty
    ChartSvg -> (ChartSvg -> ChartSvg) -> ChartSvg
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx ChartSvg ChartSvg ChartTree ChartTree
-> ChartTree -> ChartSvg -> ChartSvg
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set IsLabel
  "charts" (Optic A_Lens NoIx ChartSvg ChartSvg ChartTree ChartTree)
Optic A_Lens NoIx ChartSvg ChartSvg ChartTree ChartTree
#charts (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
    e1 :: ChartTree
e1 = ChartSvg -> ChartTree
toChartTree ChartSvg
cs
    e2 :: ChartTree
e2 = GlyphStyle -> ChartTree -> ChartTree
glyphize (GlyphStyle
defaultGlyphStyle GlyphStyle -> (GlyphStyle -> GlyphStyle) -> GlyphStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "size" (Optic A_Lens NoIx GlyphStyle GlyphStyle Double Double)
Optic A_Lens NoIx GlyphStyle GlyphStyle Double Double
#size Optic A_Lens NoIx GlyphStyle GlyphStyle Double Double
-> Double -> GlyphStyle -> GlyphStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Double
0.01 GlyphStyle -> (GlyphStyle -> GlyphStyle) -> GlyphStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "shape"
  (Optic A_Lens NoIx GlyphStyle GlyphStyle GlyphShape GlyphShape)
Optic A_Lens NoIx GlyphStyle GlyphStyle GlyphShape GlyphShape
#shape Optic A_Lens NoIx GlyphStyle GlyphStyle GlyphShape GlyphShape
-> GlyphShape -> GlyphStyle -> GlyphStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ GlyphShape
CircleGlyph) ChartTree
e1
    e3 :: ChartTree
e3 = RectStyle -> ChartTree -> ChartTree
rectangularize (RectStyle
defaultRectStyle RectStyle -> (RectStyle -> RectStyle) -> RectStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "borderColor" (Optic A_Lens NoIx RectStyle RectStyle Colour Colour)
Optic A_Lens NoIx RectStyle RectStyle Colour Colour
#borderColor Optic A_Lens NoIx RectStyle RectStyle Colour Colour
-> Colour -> RectStyle -> RectStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Colour
dark RectStyle -> (RectStyle -> RectStyle) -> RectStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "borderSize" (Optic A_Lens NoIx RectStyle RectStyle Double Double)
Optic A_Lens NoIx RectStyle RectStyle Double Double
#borderSize Optic A_Lens NoIx RectStyle RectStyle Double Double
-> Double -> RectStyle -> RectStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Double
0.001 RectStyle -> (RectStyle -> RectStyle) -> RectStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "color" (Optic A_Lens NoIx RectStyle RectStyle Colour Colour)
Optic A_Lens NoIx RectStyle RectStyle Colour Colour
#color Optic A_Lens NoIx RectStyle RectStyle Colour Colour
-> Optic A_Lens NoIx Colour Colour Double Double
-> Optic A_Lens NoIx RectStyle RectStyle 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' Optic A_Lens NoIx RectStyle RectStyle Double Double
-> Double -> RectStyle -> RectStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Double
0.05) ChartTree
e1

pathChartSvg :: [(FilePath, ChartSvg)]
pathChartSvg :: [([Char], ChartSvg)]
pathChartSvg =
  [ ([Char]
"other/unit.svg", ChartSvg
unitExample),
    ([Char]
"other/rect.svg", ChartSvg
rectExample),
    ([Char]
"other/text.svg", ChartSvg
textExample),
    ([Char]
"other/glyphs.svg", ChartSvg
glyphsExample),
    ([Char]
"other/line.svg", ChartSvg
lineExample),
    ([Char]
"other/hudoptions.svg", ChartSvg
hudOptionsExample),
    ([Char]
"other/bar.svg", ChartSvg
barExample),
    ([Char]
"other/sbar.svg", ChartSvg
sbarExample),
    ([Char]
"other/surface.svg", ChartSvg
surfaceExample),
    ([Char]
"other/wave.svg", ChartSvg
waveExample),
    ([Char]
"other/venn.svg", ChartSvg
vennExample),
    ([Char]
"other/path.svg", ChartSvg
pathExample),
    ([Char]
"other/arcflags.svg", ChartSvg
arcFlagsExample),
    ([Char]
"other/ellipse.svg", ChartAspect -> ChartSvg
ellipseExample (Double -> ChartAspect
FixedAspect Double
1.7)),
    ([Char]
"other/ellipse2.svg", ChartAspect -> ChartSvg
ellipseExample (Double -> ChartAspect
FixedAspect Double
2)),
    ([Char]
"other/quad.svg", ChartSvg
quadExample),
    ([Char]
"other/cubic.svg", ChartSvg
cubicExample),
    ([Char]
"other/arrow.svg", ChartSvg
arrowExample),
    ([Char]
"other/date.svg", ChartSvg
dateExample),
    ([Char]
"other/gradient.svg", ChartSvg
gradientExample),
    ([Char]
"other/wheel.svg", ChartSvg
wheelExample),
    ([Char]
"other/debug.svg", ChartSvg -> ChartSvg
debugExample ChartSvg
lineExample)
  ]

-- | Run this to refresh example SVG's.
writeAllExamples :: IO ()
writeAllExamples :: IO ()
writeAllExamples = do
  [IO ()] -> IO ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ ([IO ()] -> IO ()) -> [IO ()] -> IO ()
forall a b. (a -> b) -> a -> b
$ ([Char] -> ChartSvg -> IO ()) -> ([Char], ChartSvg) -> IO ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [Char] -> ChartSvg -> IO ()
writeChartSvg (([Char], ChartSvg) -> IO ()) -> [([Char], ChartSvg)] -> [IO ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [([Char], ChartSvg)]
pathChartSvg
  [Char] -> IO ()
putStrLn [Char]
"ok"

-- | Version of charts with a dark-friendly hud
writeAllExamplesDark :: IO ()
writeAllExamplesDark :: IO ()
writeAllExamplesDark = do
  [IO ()] -> IO ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ ([IO ()] -> IO ()) -> [IO ()] -> IO ()
forall a b. (a -> b) -> a -> b
$
    ([Char] -> ChartSvg -> IO ()) -> ([Char], ChartSvg) -> IO ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [Char] -> ChartSvg -> IO ()
writeChartSvg
      (([Char], ChartSvg) -> IO ())
-> (([Char], ChartSvg) -> ([Char], ChartSvg))
-> ([Char], ChartSvg)
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> [Char])
-> (ChartSvg -> ChartSvg)
-> ([Char], ChartSvg)
-> ([Char], ChartSvg)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap
        (([Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
"d.svg") ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
forall a. [a] -> [a]
reverse ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
drop Int
4 ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
forall a. [a] -> [a]
reverse)
        ( \ChartSvg
x ->
            ChartSvg
x
              ChartSvg -> (ChartSvg -> ChartSvg) -> ChartSvg
forall a b. a -> (a -> b) -> b
& IsLabel
  "hudOptions"
  (Optic A_Lens NoIx ChartSvg ChartSvg HudOptions HudOptions)
Optic A_Lens NoIx ChartSvg ChartSvg HudOptions HudOptions
#hudOptions Optic A_Lens NoIx ChartSvg ChartSvg HudOptions HudOptions
-> (HudOptions -> HudOptions) -> ChartSvg -> ChartSvg
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ (Colour -> Colour) -> HudOptions -> HudOptions
colourHudOptions (Colour -> Colour -> Colour
rgb Colour
light)
              ChartSvg -> (ChartSvg -> ChartSvg) -> ChartSvg
forall a b. a -> (a -> b) -> b
& IsLabel
  "svgOptions"
  (Optic A_Lens NoIx ChartSvg ChartSvg SvgOptions SvgOptions)
Optic A_Lens NoIx ChartSvg ChartSvg SvgOptions SvgOptions
#svgOptions Optic A_Lens NoIx ChartSvg ChartSvg SvgOptions SvgOptions
-> Optic A_Lens NoIx SvgOptions SvgOptions CssOptions CssOptions
-> Optic A_Lens NoIx ChartSvg ChartSvg 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
% IsLabel
  "cssOptions"
  (Optic A_Lens NoIx SvgOptions SvgOptions CssOptions CssOptions)
Optic A_Lens NoIx SvgOptions SvgOptions CssOptions CssOptions
#cssOptions Optic A_Lens NoIx ChartSvg ChartSvg CssOptions CssOptions
-> Optic
     A_Lens
     NoIx
     CssOptions
     CssOptions
     CssPreferColorScheme
     CssPreferColorScheme
-> Optic
     A_Lens
     NoIx
     ChartSvg
     ChartSvg
     CssPreferColorScheme
     CssPreferColorScheme
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
% IsLabel
  "preferColorScheme"
  (Optic
     A_Lens
     NoIx
     CssOptions
     CssOptions
     CssPreferColorScheme
     CssPreferColorScheme)
Optic
  A_Lens
  NoIx
  CssOptions
  CssOptions
  CssPreferColorScheme
  CssPreferColorScheme
#preferColorScheme Optic
  A_Lens
  NoIx
  ChartSvg
  ChartSvg
  CssPreferColorScheme
  CssPreferColorScheme
-> CssPreferColorScheme -> ChartSvg -> ChartSvg
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ CssPreferColorScheme
PreferDark
        )
      (([Char], ChartSvg) -> IO ()) -> [([Char], ChartSvg)] -> [IO ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [([Char], ChartSvg)]
pathChartSvg
  [Char] -> IO ()
putStrLn [Char]
"dark version, ok"