{-# 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 = forall a. Monoid a => a
mempty forall a b. a -> (a -> b) -> b
& forall a. IsLabel "charts" a => a
#charts 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 [forall a. Multiplicative a => a
one]] forall a b. a -> (a -> b) -> b
& forall a. IsLabel "hudOptions" a => a
#hudOptions 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 =
  forall a. Monoid a => a
mempty
    forall a b. a -> (a -> b) -> b
& forall a. IsLabel "hudOptions" a => a
#hudOptions 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
    forall a b. a -> (a -> b) -> b
& forall a. IsLabel "charts" a => a
#charts 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 forall a. Multiplicative a => a
one

-- | rect example
--
-- ![rect example](other/rect.svg)
rectExample :: ChartSvg
rectExample :: ChartSvg
rectExample =
  forall a. Monoid a => a
mempty
    forall a b. a -> (a -> b) -> b
& forall a. IsLabel "hudOptions" a => a
#hudOptions
      forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ ( forall a. Monoid a => a
mempty
             forall a b. a -> (a -> b) -> b
& 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 forall a b. a -> (a -> b) -> b
& forall a. IsLabel "ticks" a => a
#ticks forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a. IsLabel "ltick" a => a
#ltick forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ forall a. Maybe a
Nothing)]
         )
    forall a b. a -> (a -> b) -> b
& forall a. IsLabel "charts" a => a
#charts 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" (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 =
  [ forall a.
(Field a, FromIntegral a Int, Ord a) =>
(a -> a) -> Range a -> Int -> [Rect a]
gridR (\Double
x -> forall a. Floating a => a -> a
exp (-Double
x forall a. Floating a => a -> a -> a
** Double
2 forall a. Fractional a => a -> a -> a
/ Double
2)) (forall a. a -> a -> Range a
Range (-Double
5) Double
5) Int
50,
    forall a.
(Field a, FromIntegral a Int, Ord a) =>
(a -> a) -> Range a -> Int -> [Rect a]
gridR (\Double
x -> Double
0.5 forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
exp (-Double
x forall a. Floating a => a -> a -> a
** Double
2 forall a. Fractional a => a -> a -> a
/ Double
8)) (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 =
  forall a. Monoid a => a
mempty forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set forall a. IsLabel "hudOptions" a => a
#hudOptions HudOptions
ho forall a b. a -> (a -> b) -> b
& forall a. IsLabel "charts" a => a
#charts 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
        forall a b. a -> (a -> b) -> b
& 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" forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (forall a. IsLabel "style" a => a
#style forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a. IsLabel "size" a => a
#size) Double
0.1),
            ( Double
11,
              Text -> Title
defaultTitle Text
"Made with love and chart-svg"
                forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (forall a. IsLabel "style" a => a
#style forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a. IsLabel "size" a => a
#size) Double
0.06
                forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set forall a. IsLabel "place" a => a
#place Place
PlaceBottom
                forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set forall a. IsLabel "anchor" a => a
#anchor Anchor
AnchorEnd
            )
          ]
        forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over forall a. IsLabel "frames" a => a
#frames (forall a. Semigroup a => a -> a -> a
<> [(Double
20, FrameOptions
defaultFrameOptions forall a b. a -> (a -> b) -> b
& forall a. IsLabel "buffer" a => a
#buffer 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)])
        forall a b. a -> (a -> b) -> b
& 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
                forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over forall a. IsLabel "frame" a => a
#frame (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set forall a. IsLabel "color" a => a
#color Colour
white))
                forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set forall a. IsLabel "place" a => a
#place (Point Double -> Place
PlaceAbsolute (forall a. a -> a -> Point a
Point Double
0.45 (-Double
0.35)))
                forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (forall a. IsLabel "textStyle" a => a
#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
% forall a. IsLabel "size" a => a
#size) Double
0.20
                forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set forall a. IsLabel "content" a => a
#content (forall a b. [a] -> [b] -> [(a, b)]
zip [Text
"palette1 0", Text
"palette1 1", Text
"palette1 2"] [Chart]
cs)
            )
          ]
    cs :: [Chart]
cs =
      forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith
        ( \Int
c [Point Double]
l ->
            LineStyle -> [[Point Double]] -> Chart
LineChart
              ( LineStyle
defaultLineStyle
                  forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set forall a. IsLabel "color" a => a
#color (Int -> Colour
palette1 Int
c)
                  forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set forall a. IsLabel "size" a => a
#size Double
0.015
              )
              [[Point Double]
l]
        )
        [Int
0 ..]
        [[Point Double]]
ls
    ls :: [[Point Double]]
ls =
      [ [forall a. a -> a -> Point a
Point Double
0.0 Double
1.0, forall a. a -> a -> Point a
Point Double
1.0 Double
1.0, forall a. a -> a -> Point a
Point Double
2.0 Double
5.0],
        [forall a. a -> a -> Point a
Point Double
0.0 Double
0.0, forall a. a -> a -> Point a
Point Double
2.8 Double
3.0],
        [forall a. a -> a -> Point a
Point Double
0.5 Double
4.0, forall a. a -> a -> Point a
Point Double
0.5 Double
0]
      ]

-- | text example
--
-- ![text example](other/text.svg)
textExample :: ChartSvg
textExample :: ChartSvg
textExample =
  forall a. Monoid a => a
mempty
    forall a b. a -> (a -> b) -> b
& forall a. IsLabel "charts" a => a
#charts
      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 forall a b. a -> (a -> b) -> b
& forall a. IsLabel "color" a => a
#color forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Colour
dark forall a b. a -> (a -> b) -> b
& forall a. IsLabel "size" a => a
#size 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 forall a b. a -> (a -> b) -> b
& forall a. IsLabel "vshift" a => a
#vshift 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
        ]
    forall a b. a -> (a -> b) -> b
& forall a. IsLabel "hudOptions" a => a
#hudOptions forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ HudOptions
defaultHudOptions
    forall a b. a -> (a -> b) -> b
& forall a. IsLabel "svgOptions" a => a
#svgOptions 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
% forall a. IsLabel "cssOptions" a => a
#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
% forall a. IsLabel "preferColorScheme" a => a
#preferColorScheme forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ CssPreferColorScheme
PreferHud
    forall a b. a -> (a -> b) -> b
& forall a. IsLabel "svgOptions" a => a
#svgOptions 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
% forall a. IsLabel "cssOptions" a => a
#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
% forall a. IsLabel "cssExtra" a => a
#cssExtra 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 =
      forall a b. [a] -> [b] -> [(a, b)]
zip
        (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Text
Text.singleton [Char
'a' .. Char
'z'])
        ((\Double
x -> forall a. a -> a -> Point a
Point (forall a. Floating a => a -> a
sin (Double
x forall a. Num a => a -> a -> a
* Double
0.1)) Double
x) 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 =
  forall a. Monoid a => a
mempty
    forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (forall a. IsLabel "svgOptions" a => a
#svgOptions 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
% forall a. IsLabel "svgHeight" a => a
#svgHeight) Double
400
    forall a b. a -> (a -> b) -> b
& 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" forall a b. (a -> b) -> a -> b
$
          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
                      forall a b. a -> (a -> b) -> b
& forall a. IsLabel "size" a => a
#size 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)
                      forall a b. a -> (a -> b) -> b
& forall a. IsLabel "borderSize" a => a
#borderSize forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Double
bs
                      forall a b. a -> (a -> b) -> b
& forall a. IsLabel "shape" a => a
#shape 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 (forall a. a -> a -> Point a
Point Double
0.0 (Double
0.5 forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
sqrt Double
2)) (forall a. a -> a -> Point a
Point (-forall a. Floating a => a -> a
cos (forall a. Floating a => a
pi forall a. Fractional a => a -> a -> a
/ Double
3)) (-forall a. Floating a => a -> a
sin (forall a. Floating a => a
pi forall a. Fractional a => a -> a -> a
/ Double
3) forall a. Fractional a => a -> a -> a
/ Double
2)) (forall a. a -> a -> Point a
Point (forall a. Floating a => a -> a
cos (forall a. Floating a => a
pi forall a. Fractional a => a -> a -> a
/ Double
3)) (-forall a. Floating a => a -> a
sin (forall a. Floating a => a
pi forall a. Fractional a => a -> a -> a
/ Double
3) 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)
            ]
            [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 " forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> FilePath
show forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int
1 .. Int
11 :: Int])
    ((Text
"column " forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> FilePath
show 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 forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set forall a. IsLabel "barOrientation" a => a
#barOrientation Orientation
Vert forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set forall a. IsLabel "barStacked" a => a
#barStacked Stacked
Stacked forall a b. a -> (a -> b) -> b
& forall a. IsLabel "displayValues" a => a
#displayValues forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Bool
False forall a b. a -> (a -> b) -> b
& forall a. IsLabel "barRectStyles" a => a
#barRectStyles forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. IsLabel "borderSize" a => a
#borderSize 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 = forall a. Monoid a => a
mempty forall a b. a -> (a -> b) -> b
& forall a. IsLabel "charts" a => a
#charts 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 forall a b. (a -> b) -> a -> b
$ forall a.
FieldSpace (Range a) =>
(a -> a) -> Range a -> Grid (Range a) -> [Point a]
gridP forall a. Floating a => a -> a
sin (forall a. a -> a -> Range a
Range Double
0 (Double
2 forall a. Num a => a -> a -> a
* forall a. Floating a => a
pi)) Int
30] forall a b. a -> (a -> b) -> b
& forall a. IsLabel "hudOptions" a => a
#hudOptions 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 =
  forall a. Monoid a => a
mempty
    forall a b. a -> (a -> b) -> b
& forall a. IsLabel "charts" a => a
#charts 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" (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Int
c [PathData Double]
x -> PathStyle -> [PathData Double] -> Chart
PathChart (PathStyle
defaultPathStyle forall a b. a -> (a -> b) -> b
& forall a. IsLabel "borderSize" a => a
#borderSize 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 forall a b. a -> (a -> b) -> b
& forall a. IsLabel "color" a => a
#color 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 forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over forall a. IsLabel "borderColor" a => a
#borderColor (forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Lens' Colour Double
opac' Double
1)) [PathData Double]
x) [Int
0 ..] (Text -> [PathData Double]
svgToPathData forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
vennSegs))
    forall a b. a -> (a -> b) -> b
& forall a. IsLabel "hudOptions" a => a
#hudOptions forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ HudOptions
defaultHudOptions
    forall a b. a -> (a -> b) -> b
& forall a. IsLabel "hudOptions" a => a
#hudOptions 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
% forall a. IsLabel "chartAspect" a => a
#chartAspect 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 =
  forall a. Monoid a => a
mempty
    forall a b. a -> (a -> b) -> b
& forall a. IsLabel "charts" a => a
#charts 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] forall a. Semigroup a => a -> a -> a
<> Text -> [Chart] -> ChartTree
named Text
"pathtext" [Chart
t0]
    forall a b. a -> (a -> b) -> b
& forall a. IsLabel "hudOptions" a => a
#hudOptions forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ HudOptions
defaultHudOptions
    forall a b. a -> (a -> b) -> b
& forall a. IsLabel "hudOptions" a => a
#hudOptions 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
% forall a. IsLabel "chartAspect" a => a
#chartAspect forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ ChartAspect
ChartAspect
    forall a b. a -> (a -> b) -> b
& forall a. IsLabel "svgOptions" a => a
#svgOptions 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
% forall a. IsLabel "cssOptions" a => a
#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
% forall a. IsLabel "preferColorScheme" a => a
#preferColorScheme forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ CssPreferColorScheme
PreferHud
    forall a b. a -> (a -> b) -> b
& forall a. IsLabel "svgOptions" a => a
#svgOptions 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
% forall a. IsLabel "cssOptions" a => a
#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
% forall a. IsLabel "cssExtra" a => a
#cssExtra 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 =
      [ forall a. Point a -> PathData a
StartP (forall a. a -> a -> Point a
Point Double
0 Double
0),
        forall a. Point a -> PathData a
LineP (forall a. a -> a -> Point a
Point Double
1 Double
0),
        forall a. Point a -> Point a -> Point a -> PathData a
CubicP (forall a. a -> a -> Point a
Point Double
0.2 Double
0) (forall a. a -> a -> Point a
Point Double
0.25 Double
1) (forall a. a -> a -> Point a
Point Double
1 Double
1),
        forall a. Point a -> Point a -> PathData a
QuadP (forall a. a -> a -> Point a
Point (-Double
1) Double
2) (forall a. a -> a -> Point a
Point Double
0 Double
1),
        forall a. ArcInfo a -> Point a -> PathData a
ArcP (forall a. Point a -> a -> Bool -> Bool -> ArcInfo a
ArcInfo (forall a. a -> a -> Point a
Point Double
1 Double
1) (-forall a. Floating a => a
pi forall a. Fractional a => a -> a -> a
/ Double
6) Bool
False Bool
False) (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 forall a b. a -> (a -> b) -> b
& forall a. IsLabel "color" a => a
#color 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 forall a b. a -> (a -> b) -> b
& forall a. IsLabel "borderColor" a => a
#borderColor 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 (forall a. PathData a -> Point a
pointPath forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PathData Double]
ps)
    midp :: [Point Double]
midp = forall a. a -> a -> Point a
Point Double
0 Double
0 forall a. a -> [a] -> [a]
: forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\(Point Double
x Double
y) (Point Double
x' Double
y') -> forall a. a -> a -> Point a
Point ((Double
x forall a. Num a => a -> a -> a
+ Double
x') forall a. Fractional a => a -> a -> a
/ Double
2) ((Double
y forall a. Num a => a -> a -> a
+ Double
y') forall a. Fractional a => a -> a -> a
/ Double
2)) (forall a. Int -> [a] -> [a]
drop Int
1 (forall a. PathData a -> Point a
pointPath forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PathData Double]
ps)) (forall a. PathData a -> Point a
pointPath forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PathData Double]
ps)
    offp :: [Point Double]
offp = [forall a. a -> a -> Point a
Point Double
0 Double
0.05, forall a. a -> a -> Point a
Point Double
0 Double
0, forall a. a -> a -> Point a
Point (-Double
0.2) Double
0, forall a. a -> a -> Point a
Point (-Double
0.1) Double
0.1, forall a. a -> a -> Point a
Point Double
0 (-Double
0.1)]
    t0 :: Chart
t0 = TextStyle -> [(Text, Point Double)] -> Chart
TextChart (TextStyle
defaultTextStyle forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set forall a. IsLabel "size" a => a
#size Double
0.05) (forall a b. [a] -> [b] -> [(a, b)]
zip [Text]
ts (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 =
  forall a. Monoid a => a
mempty
    forall a b. a -> (a -> b) -> b
& forall a. IsLabel "charts" a => a
#charts 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]
    forall a b. a -> (a -> b) -> b
& forall a. IsLabel "hudOptions" a => a
#hudOptions forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ HudOptions
defaultHudOptions
    forall a b. a -> (a -> b) -> b
& forall a. IsLabel "hudOptions" a => a
#hudOptions 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
% forall a. IsLabel "chartAspect" a => a
#chartAspect forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ ChartAspect
a
    forall a b. a -> (a -> b) -> b
& forall a. IsLabel "hudOptions" a => a
#hudOptions 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
% forall a. IsLabel "legends" a => a
#legends 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 forall a b. a -> (a -> b) -> b
& forall a. IsLabel "content" a => a
#content 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 forall a b. a -> (a -> b) -> b
& forall a. IsLabel "textStyle" a => a
#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
% forall a. IsLabel "size" a => a
#size 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 forall a b. a -> (a -> b) -> b
& forall a. IsLabel "size" a => a
#size 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)]
    forall a b. a -> (a -> b) -> b
& forall a. IsLabel "hudOptions" a => a
#hudOptions 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
% forall a. IsLabel "titles" a => a
#titles 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)" forall a b. a -> (a -> b) -> b
& forall a. IsLabel "style" a => a
#style forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a. IsLabel "size" a => a
#size 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
_) = forall a. Point a -> Point a -> ArcInfo a -> ArcPosition a
ArcPosition (forall a. a -> a -> Point a
Point Double
1 Double
0) (forall a. a -> a -> Point a
Point Double
0 Double
1) (forall a. Point a -> a -> Bool -> Bool -> ArcInfo a
ArcInfo (forall a. a -> a -> Point a
Point Double
1.5 Double
1) (forall a. Floating a => a
pi 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) = 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 [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' forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\Double
x -> Double
2 forall a. Num a => a -> a -> a
* forall a. Floating a => a
pi forall a. Num a => a -> a -> a
* Double
x forall a. Fractional a => a -> a -> a
/ Double
100.0) 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 [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' forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\Double
x -> Double
ang0' forall a. Num a => a -> a -> a
+ Double
angd forall a. Num a => a -> a -> a
* Double
x forall a. Fractional a => a -> a -> a
/ Double
100.0) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Double
0 .. Double
100]]
    g0 :: GlyphStyle
g0 = GlyphStyle
defaultGlyphStyle forall a b. a -> (a -> b) -> b
& forall a. IsLabel "shape" a => a
#shape 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 forall a b. a -> (a -> b) -> b
& forall a. IsLabel "color" a => a
#color 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 forall a b. a -> (a -> b) -> b
& forall a. IsLabel "borderSize" a => a
#borderSize 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 forall a b. a -> (a -> b) -> b
& forall a. IsLabel "color" a => a
#color 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 forall a b. a -> (a -> b) -> b
& forall a. IsLabel "borderColor" a => a
#borderColor 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 [[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, 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' forall a. Floating a => a
pi]]
    yradii :: Chart
yradii = LineStyle -> [[Point Double]] -> Chart
LineChart LineStyle
yals [[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' (forall a. Floating a => a
pi forall a. Fractional a => a -> a -> a
/ Double
2), 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 forall a. Fractional a => a -> a -> a
/ Double
2 forall a. Num a => a -> a -> a
* forall a. Floating a => a
pi)]]
    xals :: LineStyle
xals = LineStyle
defaultLineStyle forall a b. a -> (a -> b) -> b
& forall a. IsLabel "color" a => a
#color 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 forall a b. a -> (a -> b) -> b
& forall a. IsLabel "size" a => a
#size 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 forall a b. a -> (a -> b) -> b
& forall a. IsLabel "dasharray" a => a
#dasharray forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ forall a. a -> Maybe a
Just [Double
0.03, Double
0.01] forall a b. a -> (a -> b) -> b
& forall a. IsLabel "linecap" a => a
#linecap forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ forall a. a -> Maybe a
Just LineCap
LineCapRound
    yals :: LineStyle
yals = LineStyle
defaultLineStyle forall a b. a -> (a -> b) -> b
& forall a. IsLabel "color" a => a
#color 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 forall a b. a -> (a -> b) -> b
& forall a. IsLabel "size" a => a
#size 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 forall a b. a -> (a -> b) -> b
& forall a. IsLabel "dasharray" a => a
#dasharray forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ forall a. a -> Maybe a
Just [Double
0.03, Double
0.01] forall a b. a -> (a -> b) -> b
& forall a. IsLabel "linecap" a => a
#linecap forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ forall a. a -> Maybe a
Just LineCap
LineCapRound
    fullels :: LineStyle
fullels = LineStyle
defaultLineStyle forall a b. a -> (a -> b) -> b
& forall a. IsLabel "size" a => a
#size 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 forall a b. a -> (a -> b) -> b
& forall a. IsLabel "color" a => a
#color 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 forall a b. a -> (a -> b) -> b
& forall a. IsLabel "size" a => a
#size 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 forall a b. a -> (a -> b) -> b
& forall a. IsLabel "color" a => a
#color 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 [[forall a. Additive a => a
zero]]),
        (Text
"Minor Axis", LineStyle -> [[Point Double]] -> Chart
LineChart LineStyle
yals [[forall a. Additive a => a
zero]]),
        (Text
"Full Ellipse", LineStyle -> [[Point Double]] -> Chart
LineChart LineStyle
fullels [[forall a. Additive a => a
zero]]),
        (Text
"Arc", LineStyle -> [[Point Double]] -> Chart
LineChart LineStyle
els [[forall a. Additive a => a
zero]]),
        (Text
"Centroid", GlyphStyle -> [Point Double] -> Chart
GlyphChart (GlyphStyle
g0 forall a b. a -> (a -> b) -> b
& forall a. IsLabel "size" a => a
#size 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) [forall a. Additive a => a
zero]),
        (Text
"Endpoints", GlyphStyle -> [Point Double] -> Chart
GlyphChart (GlyphStyle
g1 forall a b. a -> (a -> b) -> b
& forall a. IsLabel "size" a => a
#size 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) [forall a. Additive a => a
zero]),
        (Text
"Bounding Box", RectStyle -> [Rect Double] -> Chart
RectChart (RectStyle
bbs forall a b. a -> (a -> b) -> b
& forall a. IsLabel "borderSize" a => a
#borderSize 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) [forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Double
2 forall a. Num a => a -> a -> a
*) 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 =
  forall a. Monoid a => a
mempty
    forall a b. a -> (a -> b) -> b
& 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
          ]
      )
    forall a b. a -> (a -> b) -> b
& forall a. IsLabel "hudOptions" a => a
#hudOptions 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
% forall a. IsLabel "chartAspect" a => a
#chartAspect forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ ChartAspect
ChartAspect
    forall a b. a -> (a -> b) -> b
& forall a. IsLabel "svgOptions" a => a
#svgOptions 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
% forall a. IsLabel "cssOptions" a => a
#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
% forall a. IsLabel "preferColorScheme" a => a
#preferColorScheme forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ CssPreferColorScheme
PreferHud
    forall a b. a -> (a -> b) -> b
& forall a. IsLabel "svgOptions" a => a
#svgOptions 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
% forall a. IsLabel "cssOptions" a => a
#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
% forall a. IsLabel "cssExtra" a => a
#cssExtra
      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 [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 forall a b. a -> (a -> b) -> b
& forall a. IsLabel "size" a => a
#size 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", 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 (forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Lens' Colour Double
opac' Double
0.3 Colour
dark)),
          [Chart] -> ChartTree
unnamed (Bool -> Bool -> Colour -> [Chart]
checkFlags Bool
False Bool
False (forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Lens' Colour Double
opac' Double
0.3 Colour
dark)),
          [Chart] -> ChartTree
unnamed
            [ [Rect Double] -> Chart
BlankChart [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 forall a b. a -> (a -> b) -> b
& forall a. IsLabel "size" a => a
#size 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", 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 (forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Lens' Colour Double
opac' Double
0.3 Colour
dark)),
          [Chart] -> ChartTree
unnamed (Bool -> Bool -> Colour -> [Chart]
checkFlags Bool
True Bool
False (forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Lens' Colour Double
opac' Double
0.3 Colour
dark)),
          [Chart] -> ChartTree
unnamed
            [ [Rect Double] -> Chart
BlankChart [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 forall a b. a -> (a -> b) -> b
& forall a. IsLabel "size" a => a
#size 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", forall a. a -> a -> Point a
Point Double
0.5 (-Double
0.1))]
            ]
        ]
    colSweep :: ChartTree
colSweep =
      [Chart] -> ChartTree
unnamed
        [ [Rect Double] -> Chart
BlankChart [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 forall a b. a -> (a -> b) -> b
& forall a. IsLabel "size" a => a
#size 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 forall a b. a -> (a -> b) -> b
& forall a. IsLabel "rotation" a => a
#rotation forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ forall a. a -> Maybe a
Just (forall a. Floating a => a
pi forall a. Fractional a => a -> a -> a
/ Double
2))
            [(Text
"Sweep", 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 [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 forall a b. a -> (a -> b) -> b
& forall a. IsLabel "size" a => a
#size 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 forall a b. a -> (a -> b) -> b
& forall a. IsLabel "rotation" a => a
#rotation forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ forall a. a -> Maybe a
Just (forall a. Floating a => a
pi forall a. Fractional a => a -> a -> a
/ Double
2))
                [(Text
"True", forall a. a -> a -> Point a
Point Double
0.1 Double
0.5)]
            ],
          [Chart] -> ChartTree
unnamed
            [ [Rect Double] -> Chart
BlankChart [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 forall a b. a -> (a -> b) -> b
& forall a. IsLabel "size" a => a
#size 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 forall a b. a -> (a -> b) -> b
& forall a. IsLabel "rotation" a => a
#rotation forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ forall a. a -> Maybe a
Just (forall a. Floating a => a
pi forall a. Fractional a => a -> a -> a
/ Double
2))
                [(Text
"False", 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 = forall a. a -> a -> Point a
Point Double
1.0 Double
1.0
    p1 :: ArcPosition Double
p1 = forall a. Point a -> Point a -> ArcInfo a -> ArcPosition a
ArcPosition (forall a. a -> a -> Point a
Point Double
0.0 Double
1.0) (forall a. a -> a -> Point a
Point Double
1.0 Double
0.0) (forall a. Point a -> a -> Bool -> Bool -> ArcInfo a
ArcInfo (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) = 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 forall a b. a -> (a -> b) -> b
& forall a. IsLabel "color" a => a
#color forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Colour
co forall a b. a -> (a -> b) -> b
& forall a. IsLabel "borderColor" a => a
#borderColor forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Lens' Colour Double
opac' Double
0.5 Colour
dark) [PathData Double]
ps1
    c1 :: Chart
c1 = LineStyle -> [[Point Double]] -> Chart
LineChart (LineStyle
defaultLineStyle forall a b. a -> (a -> b) -> b
& forall a. IsLabel "size" a => a
#size 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 forall a b. a -> (a -> b) -> b
& forall a. IsLabel "color" a => a
#color forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Lens' Colour Double
opac' Double
0.2 Colour
dark) [forall b a.
(Direction b a, Affinity b a, TrigField a) =>
b -> b -> a -> a -> b
ellipse (forall a. a -> a -> Point a
Point Double
1.0 Double
1.0) (forall a. a -> a -> Point a
Point Double
1.0 Double
1.0) Double
0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\Double
x -> Double
0 forall a. Num a => a -> a -> a
+ Double
2 forall a. Num a => a -> a -> a
* forall a. Floating a => a
pi forall a. Num a => a -> a -> a
* Double
x forall a. Fractional a => a -> a -> a
/ Double
100.0) 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 forall a b. a -> (a -> b) -> b
& forall a. IsLabel "size" a => a
#size 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 forall a b. a -> (a -> b) -> b
& forall a. IsLabel "color" a => a
#color forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Lens' Colour Double
opac' Double
0.2 Colour
dark) [forall b a.
(Direction b a, Affinity b a, TrigField a) =>
b -> b -> a -> a -> b
ellipse (forall a. a -> a -> Point a
Point Double
0.0 Double
0.0) (forall a. a -> a -> Point a
Point Double
1.0 Double
1.0) Double
0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\Double
x -> Double
0 forall a. Num a => a -> a -> a
+ Double
2 forall a. Num a => a -> a -> a
* forall a. Floating a => a
pi forall a. Num a => a -> a -> a
* Double
x forall a. Fractional a => a -> a -> a
/ Double
100.0) 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 forall a b. a -> (a -> b) -> b
& forall a. IsLabel "size" a => a
#size 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 forall a b. a -> (a -> b) -> b
& forall a. IsLabel "color" a => a
#color forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Lens' Colour Double
opac' Double
0.5 Colour
co) [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' forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\Double
x -> Double
ang0' forall a. Num a => a -> a -> a
+ Double
angd forall a. Num a => a -> a -> a
* Double
x forall a. Fractional a => a -> a -> a
/ Double
100.0) 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 =
  forall a. Monoid a => a
mempty
    forall a b. a -> (a -> b) -> b
& forall a. IsLabel "charts" a => a
#charts 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]
    forall a b. a -> (a -> b) -> b
& forall a. IsLabel "hudOptions" a => a
#hudOptions forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ HudOptions
defaultHudOptions
    forall a b. a -> (a -> b) -> b
& forall a. IsLabel "hudOptions" a => a
#hudOptions 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
% forall a. IsLabel "chartAspect" a => a
#chartAspect 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
    forall a b. a -> (a -> b) -> b
& forall a. IsLabel "hudOptions" a => a
#hudOptions 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
% forall a. IsLabel "legends" a => a
#legends 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 forall a b. a -> (a -> b) -> b
& forall a. IsLabel "content" a => a
#content 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 forall a b. a -> (a -> b) -> b
& forall a. IsLabel "textStyle" a => a
#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
% forall a. IsLabel "size" a => a
#size 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 forall a b. a -> (a -> b) -> b
& forall a. IsLabel "size" a => a
#size 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)]
    forall a b. a -> (a -> b) -> b
& forall a. IsLabel "hudOptions" a => a
#hudOptions 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
% forall a. IsLabel "titles" a => a
#titles 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))" forall a b. a -> (a -> b) -> b
& forall a. IsLabel "style" a => a
#style forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a. IsLabel "size" a => a
#size 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) = forall a. Point a -> Point a -> Point a -> QuadPosition a
QuadPosition (forall a. a -> a -> Point a
Point Double
0 Double
0) (forall a. a -> a -> Point a
Point Double
1 Double
1) (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 [forall a.
(FromInteger a, ExpField a) =>
QuadPosition a -> a -> Point a
quadBezier QuadPosition Double
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Fractional a => a -> a -> a
/ Double
100.0) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Double
0 .. Double
100]]
    curveStyle :: LineStyle
curveStyle = LineStyle
defaultLineStyle forall a b. a -> (a -> b) -> b
& forall a. IsLabel "size" a => a
#size 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 forall a b. a -> (a -> b) -> b
& forall a. IsLabel "color" a => a
#color 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 forall a b. a -> (a -> b) -> b
& forall a. IsLabel "borderSize" a => a
#borderSize 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 forall a b. a -> (a -> b) -> b
& forall a. IsLabel "color" a => a
#color 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 forall a b. a -> (a -> b) -> b
& forall a. IsLabel "borderColor" a => a
#borderColor 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 forall a b. a -> (a -> b) -> b
& forall a. IsLabel "color" a => a
#color 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 forall a b. a -> (a -> b) -> b
& forall a. IsLabel "borderColor" a => a
#borderColor 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 forall a b. a -> (a -> b) -> b
& forall a. IsLabel "shape" a => a
#shape 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 [forall a. Point a -> PathData a
StartP forall a. Additive a => a
zero]),
        (Text
"Path Chord", LineStyle -> [[Point Double]] -> Chart
LineChart LineStyle
curveStyle [[forall a. Additive a => a
zero]]),
        (Text
"Path Endpoints", GlyphStyle -> [Point Double] -> Chart
GlyphChart GlyphStyle
defaultGlyphStyle [forall a. Additive a => a
zero]),
        (Text
"Path Control Point", GlyphStyle -> [Point Double] -> Chart
GlyphChart GlyphStyle
controlStyle [forall a. Additive a => a
zero]),
        (Text
"Bounding Box", RectStyle -> [Rect Double] -> Chart
RectChart (RectStyle
bbs forall a b. a -> (a -> b) -> b
& forall a. IsLabel "borderSize" a => a
#borderSize 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) [forall a. Multiplicative a => a
one])
      ]

-- | cubic example
--
-- ![cubic example](other/cubic.svg)
cubicExample :: ChartSvg
cubicExample :: ChartSvg
cubicExample =
  forall a. Monoid a => a
mempty
    forall a b. a -> (a -> b) -> b
& forall a. IsLabel "charts" a => a
#charts 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]
    forall a b. a -> (a -> b) -> b
& forall a. IsLabel "hudOptions" a => a
#hudOptions forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ forall a. Monoid a => a
mempty
    forall a b. a -> (a -> b) -> b
& forall a. IsLabel "hudOptions" a => a
#hudOptions 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
% forall a. IsLabel "chartAspect" a => a
#chartAspect 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
    forall a b. a -> (a -> b) -> b
& forall a. IsLabel "hudOptions" a => a
#hudOptions 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
% forall a. IsLabel "legends" a => a
#legends 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 forall a b. a -> (a -> b) -> b
& forall a. IsLabel "content" a => a
#content 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 forall a b. a -> (a -> b) -> b
& forall a. IsLabel "textStyle" a => a
#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
% forall a. IsLabel "size" a => a
#size 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 forall a b. a -> (a -> b) -> b
& forall a. IsLabel "size" a => a
#size 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)]
    forall a b. a -> (a -> b) -> b
& forall a. IsLabel "hudOptions" a => a
#hudOptions 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
% forall a. IsLabel "titles" a => a
#titles 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)" forall a b. a -> (a -> b) -> b
& forall a. IsLabel "style" a => a
#style forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a. IsLabel "size" a => a
#size 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) = forall a.
Point a -> Point a -> Point a -> Point a -> CubicPosition a
CubicPosition (forall a. a -> a -> Point a
Point Double
0 Double
0) (forall a. a -> a -> Point a
Point Double
1 Double
1) (forall a. a -> a -> Point a
Point Double
1 Double
0) (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 [forall a.
(FromInteger a, TrigField a) =>
CubicPosition a -> a -> Point a
cubicBezier CubicPosition Double
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Fractional a => a -> a -> a
/ Double
100.0) 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 forall a b. a -> (a -> b) -> b
& forall a. IsLabel "borderSize" a => a
#borderSize 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 forall a b. a -> (a -> b) -> b
& forall a. IsLabel "color" a => a
#color 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 forall a b. a -> (a -> b) -> b
& forall a. IsLabel "borderColor" a => a
#borderColor 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 forall a b. a -> (a -> b) -> b
& forall a. IsLabel "color" a => a
#color 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 forall a b. a -> (a -> b) -> b
& forall a. IsLabel "borderColor" a => a
#borderColor 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 forall a b. a -> (a -> b) -> b
& forall a. IsLabel "shape" a => a
#shape 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 forall a b. a -> (a -> b) -> b
& forall a. IsLabel "size" a => a
#size 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 forall a b. a -> (a -> b) -> b
& forall a. IsLabel "color" a => a
#color 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 [forall a. Point a -> PathData a
StartP forall a. Additive a => a
zero]),
        (Text
"Path Chord", LineStyle -> [[Point Double]] -> Chart
LineChart LineStyle
curveStyle [[forall a. Additive a => a
zero]]),
        (Text
"Path Endpoints", GlyphStyle -> [Point Double] -> Chart
GlyphChart GlyphStyle
defaultGlyphStyle [forall a. Additive a => a
zero]),
        (Text
"Path Control Point", GlyphStyle -> [Point Double] -> Chart
GlyphChart GlyphStyle
controlStyle [forall a. Additive a => a
zero]),
        (Text
"Bounding Box", RectStyle -> [Rect Double] -> Chart
RectChart (RectStyle
bbs forall a b. a -> (a -> b) -> b
& forall a. IsLabel "borderSize" a => a
#borderSize 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) [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 =
  forall a. Monoid a => a
mempty
    forall a b. a -> (a -> b) -> b
& forall a. IsLabel "extraHuds" a => a
#extraHuds forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ [Hud]
h
    forall a b. a -> (a -> b) -> b
& forall a. IsLabel "charts" a => a
#charts 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
    forall a b. a -> (a -> b) -> b
& forall a. IsLabel "svgOptions" a => a
#svgOptions forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ (SvgOptions
defaultSvgOptions forall a b. a -> (a -> b) -> b
& forall a. IsLabel "cssOptions" a => a
#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
% forall a. IsLabel "shapeRendering" a => a
#shapeRendering 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 = forall a. a -> a -> Point a
Point Int
100 Int
100
    r :: Rect Double
r = forall a. Multiplicative a => a
one
    f :: Point Double -> Double
f = forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap ((-Double
1.0) forall a. Num a => a -> a -> a
*) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((-Double
1.0) forall a. Num a => a -> a -> a
*)) 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over Lens' Colour Double
lightness' (forall a b. a -> b -> a
const Double
0.55) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Colour
palette1 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
            forall a b. a -> (a -> b) -> b
& forall a. IsLabel "soGrain" a => a
#soGrain 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
            forall a b. a -> (a -> b) -> b
& forall a. IsLabel "soRange" a => a
#soRange 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
            forall a b. a -> (a -> b) -> b
& forall a. IsLabel "soStyle" a => a
#soStyle 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
% forall a. IsLabel "surfaceColors" a => a
#surfaceColors 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
            forall a b. a -> (a -> b) -> b
& forall a. IsLabel "sloStyle" a => a
#sloStyle 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
% forall a. IsLabel "surfaceColors" a => a
#surfaceColors forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ [Colour]
evenColors
            forall a b. a -> (a -> b) -> b
& forall a. IsLabel "sloLegendOptions" a => a
#sloLegendOptions 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
% forall a. IsLabel "textStyle" a => a
#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
% forall a. IsLabel "color" a => a
#color forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Colour
dark
            forall a b. a -> (a -> b) -> b
& forall a. IsLabel "sloAxisOptions" a => a
#sloAxisOptions 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
            forall a b. a -> (a -> b) -> b
& forall a. IsLabel "sloLegendOptions" a => a
#sloLegendOptions 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
% forall a. IsLabel "frame" a => a
#frame forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. IsLabel "borderColor" a => a
#borderColor 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 =
  forall a. Monoid a => a
mempty
    forall a b. a -> (a -> b) -> b
& forall a. IsLabel "hudOptions" a => a
#hudOptions forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ (HudOptions
defaultHudOptions forall a b. a -> (a -> b) -> b
& forall a. IsLabel "axes" a => a
#axes forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (forall a. IsLabel "ticks" a => a
#ticks forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a. IsLabel "ltick" a => a
#ltick forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ forall a. Maybe a
Nothing)))
    forall a b. a -> (a -> b) -> b
& forall a. IsLabel "charts" a => a
#charts 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' forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point Double -> Point Double
f forall a b. (a -> b) -> a -> b
$ Point Double
p) (forall coord dir. Direction coord dir => coord -> dir
angle forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point Double -> Point Double
f forall a b. (a -> b) -> a -> b
$ Point Double
p) Point Double
p) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Point Double]
ps)
    forall a b. a -> (a -> b) -> b
& forall a. IsLabel "svgOptions" a => a
#svgOptions 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
% forall a. IsLabel "cssOptions" a => a
#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
% forall a. IsLabel "preferColorScheme" a => a
#preferColorScheme forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ CssPreferColorScheme
PreferHud
    forall a b. a -> (a -> b) -> b
& forall a. IsLabel "svgOptions" a => a
#svgOptions 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
% forall a. IsLabel "cssOptions" a => a
#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
% forall a. IsLabel "cssExtra" a => a
#cssExtra
      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 = forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap ((-Double
1.0) forall a. Num a => a -> a -> a
*) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((-Double
1.0) forall a. Num a => a -> a -> a
*)) 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 = forall s. FieldSpace s => Pos -> s -> Grid s -> [Element s]
grid Pos
MidPos (forall a. Multiplicative a => a
one :: Rect Double) (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
        forall a b. a -> (a -> b) -> b
& forall a. IsLabel "borderSize" a => a
#borderSize 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
        forall a b. a -> (a -> b) -> b
& forall a. IsLabel "size" a => a
#size forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Double
s
        forall a b. a -> (a -> b) -> b
& forall a. IsLabel "borderColor" a => a
#borderColor forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Colour
dark
        forall a b. a -> (a -> b) -> b
& forall a. IsLabel "rotation" a => a
#rotation forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ forall a. a -> Maybe a
Just Double
r'
        forall a b. a -> (a -> b) -> b
& forall a. IsLabel "shape" a => a
#shape 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' = forall a. Ord a => a -> a -> a
max Double
0.05 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => a -> a -> a
min Double
0.02 forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Num a => a -> a -> a
* Double
0.01) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Fractional a => a -> a -> a
/ Double
avmag) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Norm a b => a -> b
norm

    avmag :: Double
avmag = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (forall a b. Norm a b => a -> b
norm forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point Double -> Point Double
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Point Double]
ps) forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral (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 forall a. Floating a => a -> a -> a
** Double
2 forall a. Num a => a -> a -> a
- Double
2 forall a. Num a => a -> a -> a
* Double
a forall a. Num a => a -> a -> a
* Double
x forall a. Num a => a -> a -> a
+ Double
x forall a. Floating a => a -> a -> a
** Double
2 forall a. Num a => a -> a -> a
+ Double
b forall a. Num a => a -> a -> a
* Double
y forall a. Floating a => a -> a -> a
** Double
2 forall a. Num a => a -> a -> a
- Double
b forall a. Num a => a -> a -> a
* Double
2 forall a. Num a => a -> a -> a
* Double
y forall a. Num a => a -> a -> a
* Double
x forall a. Floating a => a -> a -> a
** Double
2 forall a. Num a => a -> a -> a
+ Double
b forall a. Num a => a -> a -> a
* Double
x forall a. Floating a => a -> a -> a
** Double
4, forall a. a -> a -> Point a
Point (-Double
2 forall a. Num a => a -> a -> a
* Double
a forall a. Num a => a -> a -> a
+ Double
2 forall a. Num a => a -> a -> a
* Double
x forall a. Num a => a -> a -> a
- Double
b forall a. Num a => a -> a -> a
* Double
4 forall a. Num a => a -> a -> a
* Double
y forall a. Num a => a -> a -> a
* Double
x forall a. Num a => a -> a -> a
+ Double
4 forall a. Num a => a -> a -> a
* Double
b forall a. Num a => a -> a -> a
* Double
x forall a. Floating a => a -> a -> a
** Double
3) (Double
2 forall a. Num a => a -> a -> a
* Double
b forall a. Num a => a -> a -> a
* Double
y forall a. Num a => a -> a -> a
- Double
2 forall a. Num a => a -> a -> a
* Double
b forall a. Num a => a -> a -> a
* Double
x 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 =
  forall a. Monoid a => a
mempty
    forall a b. a -> (a -> b) -> b
& forall a. IsLabel "charts" a => a
#charts 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 (forall a. a -> a -> a -> a -> Rect a
Rect Double
0 Double
1 Double
0 Double
1)
    forall a b. a -> (a -> b) -> b
& forall a. IsLabel "hudOptions" a => a
#hudOptions
      forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ ( forall a. Monoid a => a
mempty
             forall a b. a -> (a -> b) -> b
& forall a. IsLabel "chartAspect" a => a
#chartAspect 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
             forall a b. a -> (a -> b) -> b
& forall a. IsLabel "axes" a => a
#axes
               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 forall a b. a -> (a -> b) -> b
& forall a. IsLabel "place" a => a
#place forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Place
PlaceLeft forall a b. a -> (a -> b) -> b
& forall a. IsLabel "ticks" a => a
#ticks forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a. IsLabel "style" a => a
#style 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 forall a b. a -> (a -> b) -> b
& forall a. IsLabel "ticks" a => a
#ticks forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a. IsLabel "style" a => a
#style 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 forall a. Maybe a
Nothing Int
12 (forall a. a -> a -> Range a
Range (Day -> DiffTime -> UTCTime
UTCTime (Year -> Int -> Int -> Day
fromGregorian Year
2021 Int
12 Int
6) (Double -> DiffTime
toDiffTime Double
0)) (Day -> DiffTime -> UTCTime
UTCTime (Year -> Int -> Int -> Day
fromGregorian Year
2021 Int
12 Int
7) (Double -> DiffTime
toDiffTime Double
0)))
    tsDate :: [(Double, Text)]
tsDate = PosDiscontinuous
-> Maybe Text -> Int -> Range UTCTime -> [(Double, Text)]
placedTimeLabelContinuous PosDiscontinuous
PosIncludeBoundaries (forall a. a -> Maybe a
Just (FilePath -> Text
pack FilePath
"%d %b")) Int
2 (forall a. a -> a -> Range a
Range (Day -> DiffTime -> UTCTime
UTCTime (Year -> Int -> Int -> Day
fromGregorian Year
2021 Int
12 Int
6) (Double -> DiffTime
toDiffTime Double
0)) (Day -> DiffTime -> UTCTime
UTCTime (Year -> Int -> Int -> Day
fromGregorian Year
2022 Int
3 Int
13) (Double -> DiffTime
toDiffTime Double
0)))

-- | gradient example
--
-- Mixing Colours using the <https://bottosson.github.io/posts/oklab/ oklch> color model.
--
-- ![gradient example](other/gradient.svg)
gradientExample :: ChartSvg
gradientExample :: ChartSvg
gradientExample = Maybe Double -> Double -> Double -> Int -> LCHA -> LCHA -> ChartSvg
gradient (forall a. a -> Maybe a
Just (Double
orig 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 forall a b. a -> (a -> b) -> b
& Lens' LCHA (LCH Double)
lch' 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
% Lens' (LCH Double) Double
hLCH' 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 forall a b. a -> (a -> b) -> b
& Lens' LCHA (LCH Double)
lch' 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
% Lens' (LCH Double) Double
hLCH' 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 = forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view (Lens' LCHA (LCH Double)
lch' 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
% Lens' (LCH 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 forall a b. a -> (a -> b) -> b
& forall a. IsLabel "color" a => a
#color forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Colour
c forall a b. a -> (a -> b) -> b
& forall a. IsLabel "borderSize" a => a
#borderSize 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])
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\Double
x -> (forall a. a -> a -> a -> a -> Rect a
Rect Double
x (Double
x forall a. Num a => a -> a -> a
+ Double
d) Double
0 Double
1, forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Iso' LCHA Colour
lcha2colour' (Double -> LCHA -> LCHA -> LCHA
mixLCHA Double
x LCHA
c0 LCHA
c1)))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. FieldSpace s => Pos -> s -> Grid s -> [Element s]
grid Pos
LowerPos (forall a. a -> a -> Range a
Range Double
0 Double
1) Int
grain
  where
    d :: Double
d = Double
1 forall a. Fractional a => a -> a -> a
/ 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 =
  forall a. Monoid a => a
mempty
    forall a b. a -> (a -> b) -> b
& forall a. IsLabel "svgOptions" a => a
#svgOptions 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
% forall a. IsLabel "svgHeight" a => a
#svgHeight
      forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Double
h
    forall a b. a -> (a -> b) -> b
& forall a. IsLabel "svgOptions" a => a
#svgOptions 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
% forall a. IsLabel "cssOptions" a => a
#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
% forall a. IsLabel "shapeRendering" a => a
#shapeRendering
      forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ CssShapeRendering
UseCssCrisp
    forall a b. a -> (a -> b) -> b
& forall a. IsLabel "hudOptions" a => a
#hudOptions
      forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ ( forall a. Monoid a => a
mempty
             forall a b. a -> (a -> b) -> b
& forall a. IsLabel "chartAspect" a => a
#chartAspect 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
             forall a b. a -> (a -> b) -> b
& forall a. IsLabel "frames" a => a
#frames 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 (forall a. a -> Maybe a
Just (Double -> Colour -> RectStyle
border Double
0.004 Colour
white)) Double
0.1)]
         )
    forall a b. a -> (a -> b) -> b
& forall a. IsLabel "charts" a => a
#charts
      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) forall a. Semigroup a => a -> a -> a
<> ChartTree
strip
  where
    strip :: ChartTree
strip = case Maybe Double
marker of
      Maybe Double
Nothing -> 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 (forall a. a -> a -> a -> a -> Rect a
Rect (Double
marker' forall a. Num a => a -> a -> a
- Double
0.02) (Double
marker' 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 forall a b. a -> (a -> b) -> b
& forall a. IsLabel "color" a => a
#color forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Colour
transparent forall a b. a -> (a -> b) -> b
& forall a. IsLabel "borderSize" a => a
#borderSize forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Double
w forall a b. a -> (a -> b) -> b
& forall a. IsLabel "borderColor" a => a
#borderColor 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 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 =
  forall a. Monoid a => a
mempty
    forall a b. a -> (a -> b) -> b
& forall a. IsLabel "hudOptions" a => a
#hudOptions
      forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ HudOptions
defaultHudOptions
    forall a b. a -> (a -> b) -> b
& forall a. IsLabel "charts" a => a
#charts
      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_ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Colour]
cs)
        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
                      forall a b. a -> (a -> b) -> b
& forall a. IsLabel "size" a => a
#size forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Double
s
                      forall a b. a -> (a -> b) -> b
& forall a. IsLabel "color" a => a
#color forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Colour
c
                      forall a b. a -> (a -> b) -> b
& forall a. IsLabel "borderSize" a => a
#borderSize 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]
            )
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. (a -> Bool) -> [a] -> [a]
filter (Colour -> Bool
validColour forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall a b. a -> (a -> b) -> b
& forall a. IsLabel "size" a => a
#size 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 forall a b. a -> (a -> b) -> b
& forall a. IsLabel "color" a => a
#color forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Colour
c forall a b. a -> (a -> b) -> b
& forall a. IsLabel "borderColor" a => a
#borderColor 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 forall a b. a -> (a -> b) -> b
& forall a. IsLabel "shape" a => a
#shape 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 = forall k (is :: IxList) t b.
Is k A_Review =>
Optic' k is t b -> b -> t
review Iso' LCHA Colour
lcha2colour' Colour
c forall a b. a -> (a -> b) -> b
& (\(LCHA Double
_ Double
ch Double
h Double
_) -> forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. a -> a -> Point a
Point (forall k (is :: IxList) t b.
Is k A_Review =>
Optic' k is t b -> b -> t
review Iso' (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) -> (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. a -> a -> Point a
Point forall a b. (a -> b) -> a -> b
$ forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view (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 Iso' (Double, Double) (Double, Double)
xy2ch') (Double
c, Double
h), forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Iso' LCHA Colour
lcha2colour' (Double -> Double -> Double -> Double -> LCHA
LCHA Double
l Double
c Double
h Double
1)))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. FieldSpace s => Pos -> s -> Grid s -> [Element s]
grid Pos
LowerPos (forall a. a -> a -> a -> a -> Rect a
Rect Double
0 Double
maxchroma Double
0 Double
360) (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 =
  forall a. Monoid a => a
mempty
    forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set forall a. IsLabel "charts" a => a
#charts (ChartTree
e1 forall a. Semigroup a => a -> a -> a
<> ChartTree
e2 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 forall a b. a -> (a -> b) -> b
& forall a. IsLabel "size" a => a
#size 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 forall a b. a -> (a -> b) -> b
& forall a. IsLabel "shape" a => a
#shape 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 forall a b. a -> (a -> b) -> b
& forall a. IsLabel "borderColor" a => a
#borderColor forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Colour
dark forall a b. a -> (a -> b) -> b
& forall a. IsLabel "borderSize" a => a
#borderSize 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 forall a b. a -> (a -> b) -> b
& forall a. IsLabel "color" a => a
#color 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
% Lens' Colour Double
opac' 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 :: [(FilePath, ChartSvg)]
pathChartSvg =
  [ (FilePath
"other/unit.svg", ChartSvg
unitExample),
    (FilePath
"other/rect.svg", ChartSvg
rectExample),
    (FilePath
"other/text.svg", ChartSvg
textExample),
    (FilePath
"other/glyphs.svg", ChartSvg
glyphsExample),
    (FilePath
"other/line.svg", ChartSvg
lineExample),
    (FilePath
"other/hudoptions.svg", ChartSvg
hudOptionsExample),
    (FilePath
"other/bar.svg", ChartSvg
barExample),
    (FilePath
"other/sbar.svg", ChartSvg
sbarExample),
    (FilePath
"other/surface.svg", ChartSvg
surfaceExample),
    (FilePath
"other/wave.svg", ChartSvg
waveExample),
    (FilePath
"other/venn.svg", ChartSvg
vennExample),
    (FilePath
"other/path.svg", ChartSvg
pathExample),
    (FilePath
"other/arcflags.svg", ChartSvg
arcFlagsExample),
    (FilePath
"other/ellipse.svg", ChartAspect -> ChartSvg
ellipseExample (Double -> ChartAspect
FixedAspect Double
1.7)),
    (FilePath
"other/ellipse2.svg", ChartAspect -> ChartSvg
ellipseExample (Double -> ChartAspect
FixedAspect Double
2)),
    (FilePath
"other/quad.svg", ChartSvg
quadExample),
    (FilePath
"other/cubic.svg", ChartSvg
cubicExample),
    (FilePath
"other/arrow.svg", ChartSvg
arrowExample),
    (FilePath
"other/date.svg", ChartSvg
dateExample),
    (FilePath
"other/gradient.svg", ChartSvg
gradientExample),
    (FilePath
"other/wheel.svg", ChartSvg
wheelExample),
    (FilePath
"other/debug.svg", ChartSvg -> ChartSvg
debugExample ChartSvg
lineExample)
  ]

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

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