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

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

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

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

    -- * Colour
    gradientExample,
    wheelExample,

    -- * Debugging
    debugExample,

    -- * Compound Charts
    compoundExample,
    stackExample,

    -- * Priority
    priorityv1Example,
    priorityv2Example,

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

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

-- | unit example
--
-- ![unit example](other/unit.svg)
unitExample :: ChartOptions
unitExample :: ChartOptions
unitExample =
  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 "chartTree" a => a
#chartTree (Text -> [Chart] -> ChartTree
named Text
"unit" [Style -> ChartData -> Chart
Chart Style
defaultRectStyle ([Rect Double] -> ChartData
RectData [forall a. Multiplicative a => a
one])])
    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
defaultHudOptions

-- | A 'BlankChart', 'defaultHudOptions' example.
--
-- ![hudoptions example](other/hudoptions.svg)
hudOptionsExample :: ChartOptions
hudOptionsExample :: ChartOptions
hudOptionsExample =
  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
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 forall a. IsLabel "chartTree" a => a
#chartTree (Rect Double -> ChartTree
blank forall a. Multiplicative a => a
one)

-- | rect example
--
-- ![rect example](other/rect.svg)
rectExample :: ChartOptions
rectExample :: ChartOptions
rectExample =
  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 (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 "axes" a => a
#axes [forall a. Double -> a -> Priority a
Priority Double
5 (AxisOptions
defaultXAxisOptions 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 "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 "lineTick" a => a
#lineTick) forall a. Maybe a
Nothing)])
    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 "chartTree" a => a
#chartTree (Text -> [Chart] -> ChartTree
named Text
"rect" (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Style
s [Rect Double]
x -> Style -> ChartData -> Chart
Chart Style
s ([Rect Double] -> ChartData
RectData [Rect Double]
x)) [Style]
ropts [[Rect Double]]
rss))

rss :: [[Rect Double]]
rss :: [[Rect Double]]
rss =
  [ 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 :: [Style]
ropts :: [Style]
ropts =
  [ Colour -> Style
blob (Int -> Double -> Colour
paletteO Int
1 Double
0.4),
    Colour -> Style
blob (Int -> Double -> Colour
paletteO Int
2 Double
0.4)
  ]

-- | line example
--
-- ![line example](other/line.svg)
lineExample :: ChartOptions
lineExample :: ChartOptions
lineExample =
  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 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 "chartTree" a => a
#chartTree (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
          [ forall a. Double -> a -> Priority a
Priority Double
6 (Text -> TitleOptions
defaultTitleOptions 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.08),
            forall a. Double -> a -> Priority a
Priority Double
13 forall a b. (a -> b) -> a -> b
$
              Text -> TitleOptions
defaultTitleOptions Text
"Made with 🧡 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.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 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 -> b -> s -> t
set
          #legends
          [ forall a. Double -> a -> Priority a
Priority Double
12 forall a b. (a -> b) -> a -> b
$
              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 -> b -> s -> t
set forall a. IsLabel "scaleP" a => a
#scaleP ScaleP
ScalePX
                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.35 (-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 "legendCharts" a => a
#legendCharts (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Text
t Chart
c -> (Text
t, [Chart
c])) [Text
"palette #0", Text
"palette #1", Text
"palette #2"] [Chart]
cs)
          ]
    cs :: [Chart]
cs =
      forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith
        ( \Int
c [Point Double]
l ->
            Style -> [[Point Double]] -> Chart
LineChart
              ( Style
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
palette 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]
      ]

-- | priority Version 1 example
--
-- ![priorityv1 example](other/priorityv1.svg)
priorityv1Example :: ChartOptions
priorityv1Example :: ChartOptions
priorityv1Example =
  ChartOptions
lineExample
    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 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 "frames" a => a
#frames)
      [ forall a. Double -> a -> Priority a
Priority Double
1 (Maybe Style -> HudChartSection -> Double -> FrameOptions
FrameOptions (forall a. a -> Maybe a
Just Style
defaultRectStyle) HudChartSection
CanvasStyleSection Double
0),
        forall a. Double -> a -> Priority a
Priority Double
100 (Maybe Style -> HudChartSection -> Double -> FrameOptions
FrameOptions (forall a. a -> Maybe a
Just (Style
defaultRectStyle 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
palette Int
4 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 Lens' Colour Double
opac' Double
0.05) 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 "borderColor" a => a
#borderColor (Int -> Colour
palette Int
4))) HudChartSection
HudStyleSection Double
0.1)
      ]
    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 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 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 i s t a b. Each i s t a b => IxTraversal i s t a b
each 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 "priority" a => a
#priority) Double
50
    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 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 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 i s t a b. Each i s t a b => IxTraversal i s t a b
each 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 "item" a => a
#item 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 "place" a => a
#place) Place
PlaceRight

-- | priority Version 2 example
--
-- ![priorityv2 example](other/priorityv2.svg)
priorityv2Example :: ChartOptions
priorityv2Example :: ChartOptions
priorityv2Example =
  ChartOptions
priorityv1Example
    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 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 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 i s t a b. Each i s t a b => IxTraversal i s t a b
each 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 "priority" a => a
#priority) Double
51

-- | text example
--
-- ![text example](other/text.svg)
textExample :: ChartOptions
textExample :: ChartOptions
textExample =
  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 "chartTree" a => a
#chartTree (Text -> [Chart] -> ChartTree
named Text
"text" [Style -> [(Text, Point Double)] -> Chart
TextChart (Style
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 "color" a => a
#color Colour
dark 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.1) [(Text, Point Double)]
ts])
    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
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 (forall a. IsLabel "markupOptions" a => a
#markupOptions 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) PreferColorScheme
PreferHud
    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 "markupOptions" a => a
#markupOptions 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) ((Colour, Colour) -> ByteString -> ByteString -> ByteString
fillSwitch (Colour
dark, Colour
light) ByteString
"dark" ByteString
"text")
  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])

-- | glyphs example
--
-- ![glyphs example](other/glyphs.svg)
glyphsExample :: ChartOptions
glyphsExample :: ChartOptions
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 "markupOptions" a => a
#markupOptions 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 "markupHeight" a => a
#markupHeight) (forall a. a -> Maybe a
Just Double
50)
    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 "markupOptions" a => a
#markupOptions 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) (Double -> ChartAspect
FixedAspect Double
12)
    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
      #chartTree
      ( 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 ->
                Style -> [Point Double] -> Chart
GlyphChart
                  ( Style
defaultGlyphStyle
                      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 "glyphShape" a => a
#glyphShape GlyphShape
sh
                      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.8 :: Double)
                      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 "borderSize" a => a
#borderSize Double
bs
                  )
                  [Point Double
p]
            )
            [ (GlyphShape
CircleGlyph, Double
0.02 :: Double),
              (GlyphShape
SquareGlyph, Double
0.02),
              (Double -> GlyphShape
RectSharpGlyph Double
0.75, Double
0.02),
              (Double -> Double -> Double -> GlyphShape
RectRoundedGlyph Double
0.75 Double
0.01 Double
0.01, Double
0.02),
              (Double -> GlyphShape
EllipseGlyph Double
0.75, Double
0.02),
              (GlyphShape
VLineGlyph, Double
0.02),
              (GlyphShape
HLineGlyph, Double
0.02),
              (Point Double -> Point Double -> Point Double -> GlyphShape
TriangleGlyph (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.02),
              (ByteString -> GlyphShape
PathGlyph ByteString
"M 0.5,-0.3660 A 1.0 1.0 -0.0 0 1 0,0.5 A 1.0 1.0 -0.0 0 1 -0.5,-0.3660 A 1.0 1.0 -0.0 0 1 0.5,-0.3660 L 0.5,-0.3660 Z", Double
0.02)
            ]
            (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Double
x -> forall a. a -> a -> Point a
Point Double
x Double
0) [Double
0 ..])
      )

-- | Example data for Bar chart
barDataExample :: BarData
barDataExample :: BarData
barDataExample =
  [[Double]] -> [Text] -> [Text] -> BarData
BarData
    [[Double
1, Double
2, Double
3, Double
5, Double
8, Double
0, -Double
2, Double
11, Double
2, Double
1], [Double
1 .. Double
10]]
    ((Text
"row " <>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
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 b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
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 :: ChartOptions
barExample :: ChartOptions
barExample =
  BarOptions -> BarData -> ChartOptions
barChart BarOptions
defaultBarOptions BarData
barDataExample
    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 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 "frames" a => a
#frames) [forall a. Double -> a -> Priority a
Priority Double
101 (FrameOptions
defaultFrameOptions 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 "buffer" a => a
#buffer Double
0.02)]

-- | Stacked bar chart example.
--
-- ![sbar example](other/sbar.svg)
sbarExample :: ChartOptions
sbarExample :: ChartOptions
sbarExample = BarOptions -> BarData -> ChartOptions
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 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 "displayValues" a => a
#displayValues Bool
False 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 "barRectStyles" a => a
#barRectStyles 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 i s t a b. Each i s t a b => IxTraversal i s t a b
each 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 "borderSize" a => a
#borderSize) Double
0) BarData
barDataExample

-- | wave example
--
-- ![wave example](other/wave.svg)
waveExample :: ChartOptions
waveExample :: ChartOptions
waveExample = 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 "chartTree" a => a
#chartTree (Text -> [Chart] -> ChartTree
named Text
"wave" [Style -> [Point Double] -> Chart
GlyphChart (Style
defaultGlyphStyle 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 "glyphShape" a => a
#glyphShape GlyphShape
SquareGlyph) (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 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
defaultHudOptions

-- | venn diagram
--
-- ![venn diagram](other/venn.svg)
vennExample :: ChartOptions
vennExample :: ChartOptions
vennExample =
  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 "chartTree" a => a
#chartTree (Text -> [Chart] -> ChartTree
named Text
"venn" (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Int
c [PathData Double]
x -> Style -> [PathData Double] -> Chart
PathChart (Style
defaultPathStyle 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 "borderSize" a => a
#borderSize Double
0.005 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 -> Double -> Colour
paletteO 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 ..] (ByteString -> [PathData Double]
svgToPathData forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ByteString]
vennSegs)))
    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
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 (forall a. IsLabel "markupOptions" a => a
#markupOptions 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) (Double -> ChartAspect
FixedAspect Double
1)

{-
These were originally based on:

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

-- | Compound path example.
--
-- ![path test](other/path.svg)
pathExample :: ChartOptions
pathExample :: ChartOptions
pathExample =
  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 "chartTree" a => a
#chartTree (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 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
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 (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 "axes" a => a
#axes 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 i s t a b. Each i s t a b => IxTraversal i s t a b
each 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 "item" a => a
#item 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 "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 "glyphTick" a => a
#glyphTick forall (is :: IxList) (js :: IxList) (ks :: IxList) k k' l m s t u
       v a b.
(AppendIndices is js ks, JoinKinds k A_Prism k',
 JoinKinds k' l m) =>
Optic k is s t (Maybe u) (Maybe v)
-> Optic l js u v a b -> Optic m ks s t a b
%? forall a. IsLabel "anchorTo" a => a
#anchorTo) HudChartSection
CanvasStyleSection
    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 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 "axes" a => a
#axes 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 i s t a b. Each i s t a b => IxTraversal i s t a b
each 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 "item" a => a
#item 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 "axisBar" a => a
#axisBar forall (is :: IxList) (js :: IxList) (ks :: IxList) k k' l m s t u
       v a b.
(AppendIndices is js ks, JoinKinds k A_Prism k',
 JoinKinds k' l m) =>
Optic k is s t (Maybe u) (Maybe v)
-> Optic l js u v a b -> Optic m ks s t a b
%? forall a. IsLabel "anchorTo" a => a
#anchorTo) HudChartSection
CanvasStyleSection
    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 "markupOptions" a => a
#markupOptions 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) ChartAspect
ChartAspect
    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 "markupOptions" a => a
#markupOptions 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) PreferColorScheme
PreferHud
    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 "markupOptions" a => a
#markupOptions 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) ((Colour, Colour) -> ByteString -> ByteString -> ByteString
fillSwitch (Colour
dark, Colour
light) ByteString
"dark" ByteString
"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' = Style -> [PathData Double] -> Chart
PathChart (Style
defaultPathStyle 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 -> Double -> Colour
paletteO Int
0 Double
0.1) 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 "borderColor" a => a
#borderColor (Int -> Double -> Colour
paletteO Int
1 Double
1)) [PathData Double]
ps
    c0 :: Chart
c0 = Style -> [Point Double] -> Chart
GlyphChart (Style
defaultGlyphStyle 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 "glyphShape" a => a
#glyphShape GlyphShape
SquareGlyph) (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.35) Double
0.05, forall a. a -> a -> Point a
Point Double
0 Double
0.05, 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 = Style -> [(Text, Point Double)] -> Chart
TextChart (Style
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.025) (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))

-- | ellipse example
--
-- Under scaling, angles are not invariant, and this effects the glyphShape of ellipses and thus SVG arc paths. Compare the effect of aspect changes to the axes of this ellipse:
--
-- ![ellipse example](other/ellipse.svg)
--
-- Below is the same ellipse with FixedAspect 2. Points scale exactly, but the original points that represent the end points of the axes are no longer on the new axes of the ellipse.
--
-- ![ellipse2 example](other/ellipse2.svg)
ellipseExample :: ChartAspect -> ChartOptions
ellipseExample :: ChartAspect -> ChartOptions
ellipseExample ChartAspect
a =
  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 "chartTree" a => a
#chartTree (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 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
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 (forall a. IsLabel "markupOptions" a => a
#markupOptions 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) ChartAspect
a
    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 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 a. Double -> a -> Priority a
Priority Double
10 (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 -> b -> s -> t
set forall a. IsLabel "legendCharts" a => a
#legendCharts [(Text, [Chart])]
lrows 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.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 -> b -> s -> t
set forall a. IsLabel "legendSize" a => a
#legendSize Double
0.1 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 "vgap" a => a
#vgap Double
0.3)]
    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 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 a. Double -> a -> Priority a
Priority Double
11 (Text -> TitleOptions
defaultTitleOptions Text
"ArcPosition (Point 1 0) (Point 0 1) (ArcInfo (Point 1.5 1) (pi / 3) True True)" 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.032)]
    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 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 "axes" a => a
#axes 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 m. Ixed m => Index m -> Optic' (IxKind m) NoIx m (IxValue m)
ix Index [Priority AxisOptions]
1 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 "item" a => a
#item 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 "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 "textTick" a => a
#textTick forall (is :: IxList) (js :: IxList) (ks :: IxList) k k' l m s t u
       v a b.
(AppendIndices is js ks, JoinKinds k A_Prism k',
 JoinKinds k' l m) =>
Optic k is s t (Maybe u) (Maybe v)
-> Optic l js u v a b -> Optic m ks s t a b
%? forall a. IsLabel "buffer" a => a
#buffer) 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 (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 "axes" a => a
#axes 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 m. Ixed m => Index m -> Optic' (IxKind m) NoIx m (IxValue m)
ix Index [Priority AxisOptions]
1 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 "item" a => a
#item 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 "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 "glyphTick" a => a
#glyphTick forall (is :: IxList) (js :: IxList) (ks :: IxList) k k' l m s t u
       v a b.
(AppendIndices is js ks, JoinKinds k A_Prism k',
 JoinKinds k' l m) =>
Optic k is s t (Maybe u) (Maybe v)
-> Optic l js u v a b -> Optic m ks s t a b
%? forall a. IsLabel "buffer" a => a
#buffer) Double
0.01
  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 = Style -> [[Point Double]] -> Chart
LineChart Style
fullels [forall b a.
(Direction b, Dir b ~ a, Affinity b a, TrigField a) =>
b -> b -> a -> a -> b
ellipse Point Double
c Point Double
r Double
phi' 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 = Style -> [[Point Double]] -> Chart
LineChart Style
els [forall b a.
(Direction b, Dir b ~ a, Affinity b a, TrigField a) =>
b -> b -> a -> a -> b
ellipse Point Double
c Point Double
r Double
phi' 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 :: Style
g0 = Style
defaultGlyphStyle 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 "glyphShape" a => a
#glyphShape GlyphShape
CircleGlyph
    c0 :: Chart
c0 = Style -> [Point Double] -> Chart
GlyphChart Style
g0 [Point Double
c]
    g1 :: Style
g1 = Style
defaultGlyphStyle 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 -> Double -> Colour
paletteO Int
4 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 -> b -> s -> t
set forall a. IsLabel "glyphShape" a => a
#glyphShape GlyphShape
CircleGlyph
    c1 :: Chart
c1 = Style -> [Point Double] -> Chart
GlyphChart Style
g1 [Point Double
p1, Point Double
p2]
    bbox :: Chart
bbox = Style -> [Rect Double] -> Chart
RectChart Style
bbs [ArcPosition Double -> Rect Double
arcBox ArcPosition Double
p]
    bbs :: Style
bbs = Style
defaultRectStyle 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 "borderSize" a => a
#borderSize Double
0.002 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 -> Double -> Colour
paletteO Int
7 Double
0.005) 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 "borderColor" a => a
#borderColor (Double -> Double -> Colour
grey Double
0.5 Double
1)
    xradii :: Chart
xradii = Style -> [[Point Double]] -> Chart
LineChart Style
xals [[forall b a.
(Direction b, Dir b ~ a, Affinity b a, TrigField a) =>
b -> b -> a -> a -> b
ellipse Point Double
c Point Double
r Double
phi' Double
0, forall b a.
(Direction b, Dir b ~ a, Affinity b a, TrigField a) =>
b -> b -> a -> a -> b
ellipse Point Double
c Point Double
r Double
phi' forall a. Floating a => a
pi]]
    yradii :: Chart
yradii = Style -> [[Point Double]] -> Chart
LineChart Style
yals [[forall b a.
(Direction b, Dir b ~ a, Affinity b a, TrigField a) =>
b -> b -> a -> a -> b
ellipse Point Double
c Point Double
r Double
phi' (forall a. Floating a => a
pi forall a. Fractional a => a -> a -> a
/ Double
2), forall b a.
(Direction b, Dir b ~ a, Affinity b a, TrigField a) =>
b -> b -> a -> a -> b
ellipse Point Double
c Point Double
r Double
phi' (Double
3 forall a. Fractional a => a -> a -> a
/ Double
2 forall a. Num a => a -> a -> a
* forall a. Floating a => a
pi)]]
    xals :: Style
xals = Style
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
palette Int
6) 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.005 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 "dasharray" a => a
#dasharray (forall a. a -> Maybe a
Just [Double
0.03, Double
0.01]) 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 "lineCap" a => a
#lineCap (forall a. a -> Maybe a
Just LineCap
LineCapRound)
    yals :: Style
yals = Style
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
palette Int
5) 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.005 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 "dasharray" a => a
#dasharray (forall a. a -> Maybe a
Just [Double
0.03, Double
0.01]) 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 "lineCap" a => a
#lineCap (forall a. a -> Maybe a
Just LineCap
LineCapRound)
    fullels :: Style
fullels = Style
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 "size" a => a
#size Double
0.002 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
palette Int
1)
    els :: Style
els = Style
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 "size" a => a
#size Double
0.005 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
palette Int
2)
    lrows :: [(Text, [Chart])]
lrows =
      forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (forall a. a -> [a] -> [a]
: [])
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ (Text
"Major Axis", Style -> [[Point Double]] -> Chart
LineChart Style
xals [[forall a. Additive a => a
zero]]),
              (Text
"Minor Axis", Style -> [[Point Double]] -> Chart
LineChart Style
yals [[forall a. Additive a => a
zero]]),
              (Text
"Full Ellipse", Style -> [[Point Double]] -> Chart
LineChart Style
fullels [[forall a. Additive a => a
zero]]),
              (Text
"Arc", Style -> [[Point Double]] -> Chart
LineChart Style
els [[forall a. Additive a => a
zero]]),
              (Text
"Centroid", Style -> [Point Double] -> Chart
GlyphChart (Style
g0 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.01 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 "glyphShape" a => a
#glyphShape GlyphShape
SquareGlyph) [forall a. Additive a => a
zero]),
              (Text
"Endpoints", Style -> [Point Double] -> Chart
GlyphChart (Style
g1 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.01 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 "glyphShape" a => a
#glyphShape GlyphShape
SquareGlyph) [forall a. Additive a => a
zero]),
              (Text
"Bounding Box", Style -> [Rect Double] -> Chart
RectChart (Style
bbs 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 "borderSize" a => a
#borderSize Double
0.01) [forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Double
2 *) forall a. Multiplicative a => a
one])
            ]

-- | Reproduction of the flag explanation chart in <https://developer.mozilla.org/en-US/docs/Web/SVG/Tutorial/Paths>
--
-- ![arc flags example](other/arcflags.svg)
arcFlagsExample :: ChartOptions
arcFlagsExample :: ChartOptions
arcFlagsExample =
  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
      #chartTree
      ( 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 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 "markupOptions" a => a
#markupOptions 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) ChartAspect
UnscaledAspect
    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 "markupOptions" a => a
#markupOptions 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) PreferColorScheme
PreferHud
    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 "markupOptions" a => a
#markupOptions 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)
      [i|
{
  .chart g {
    stroke: #{showRGBA dark};
  }
  .chart g text {
    fill: #{showRGBA dark};
  }
}
@media (prefers-color-scheme:dark) {
  .chart g {
    stroke: #{showRGBA light};
  }
  .chart g text {
    fill: #{showRGBA light};
  }
}
|]
  where
    rowLarge :: ChartTree
rowLarge =
      [Chart] -> ChartTree
unnamed
        [ Rect Double -> Chart
blankChart1 (forall a. a -> a -> a -> a -> Rect a
Rect Double
0 Double
9 (-Double
2.75) (-Double
3.25)),
          Style -> [(Text, Point Double)] -> Chart
TextChart (Style
defaultTextStyle 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.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
blankChart1 (forall a. a -> a -> a -> a -> Rect a
Rect (-Double
1) Double
2 (-Double
0.25) Double
0.25),
              Style -> [(Text, Point Double)] -> Chart
TextChart (Style
defaultTextStyle 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.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
blankChart1 (forall a. a -> a -> a -> a -> Rect a
Rect (-Double
1) Double
2 (-Double
0.25) Double
0.25),
              Style -> [(Text, Point Double)] -> Chart
TextChart (Style
defaultTextStyle 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.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
blankChart1 (forall a. a -> a -> a -> a -> Rect a
Rect (-Double
0.4) Double
0.4 (-Double
1) Double
5),
          Style -> [(Text, Point Double)] -> Chart
TextChart
            (Style
defaultTextStyle 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.6 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 "rotation" a => a
#rotation (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
blankChart1 (forall a. a -> a -> a -> a -> Rect a
Rect (-Double
0.25) Double
0.25 (-Double
1) Double
2),
              Style -> [(Text, Point Double)] -> Chart
TextChart
                (Style
defaultTextStyle 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.4 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 "rotation" a => a
#rotation (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
blankChart1 (forall a. a -> a -> a -> a -> Rect a
Rect (-Double
0.25) Double
0.25 (-Double
1) Double
2),
              Style -> [(Text, Point Double)] -> Chart
TextChart
                (Style
defaultTextStyle 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.4 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 "rotation" a => a
#rotation (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 = Style -> [PathData Double] -> Chart
PathChart (Style
defaultPathStyle 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 Colour
co 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 "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
0.5 Colour
dark)) [PathData Double]
ps1
    c1 :: Chart
c1 = Style -> [[Point Double]] -> Chart
LineChart (Style
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 "size" a => a
#size Double
0.02 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 (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, Dir 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 = Style -> [[Point Double]] -> Chart
LineChart (Style
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 "size" a => a
#size Double
0.02 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 (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, Dir 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 = Style -> [[Point Double]] -> Chart
LineChart (Style
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 "size" a => a
#size Double
0.05 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 (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, Dir 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 :: ChartOptions
quadExample :: ChartOptions
quadExample =
  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 "chartTree" a => a
#chartTree (Text -> [Chart] -> ChartTree
named Text
"quad" [Chart
path', Chart
curve, Chart
c0, Chart
c1, Chart
bbox])
    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
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 (forall a. IsLabel "markupOptions" a => a
#markupOptions 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) (Double -> ChartAspect
FixedAspect Double
1.5)
    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 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 a. Double -> a -> Priority a
Priority Double
10 (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 -> b -> s -> t
set forall a. IsLabel "legendCharts" a => a
#legendCharts [(Text, [Chart])]
lrows 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.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 -> b -> s -> t
set forall a. IsLabel "legendSize" a => a
#legendSize 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 -> b -> s -> t
set forall a. IsLabel "vgap" a => a
#vgap Double
0.3)]
    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 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 a. Double -> a -> Priority a
Priority Double
11 (Text -> TitleOptions
defaultTitleOptions Text
"QuadPosition (Point 0 0) (Point 1 1) (Point 2 (-1))" 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.03)]
    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 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 "axes" a => a
#axes 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 m. Ixed m => Index m -> Optic' (IxKind m) NoIx m (IxValue m)
ix Index [Priority AxisOptions]
1 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 "item" a => a
#item 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 "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 "textTick" a => a
#textTick forall (is :: IxList) (js :: IxList) (ks :: IxList) k k' l m s t u
       v a b.
(AppendIndices is js ks, JoinKinds k A_Prism k',
 JoinKinds k' l m) =>
Optic k is s t (Maybe u) (Maybe v)
-> Optic l js u v a b -> Optic m ks s t a b
%? forall a. IsLabel "buffer" a => a
#buffer) 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 (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 "axes" a => a
#axes 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 m. Ixed m => Index m -> Optic' (IxKind m) NoIx m (IxValue m)
ix Index [Priority AxisOptions]
1 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 "item" a => a
#item 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 "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 "glyphTick" a => a
#glyphTick forall (is :: IxList) (js :: IxList) (ks :: IxList) k k' l m s t u
       v a b.
(AppendIndices is js ks, JoinKinds k A_Prism k',
 JoinKinds k' l m) =>
Optic k is s t (Maybe u) (Maybe v)
-> Optic l js u v a b -> Optic m ks s t a b
%? forall a. IsLabel "buffer" a => a
#buffer) Double
0.01
  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' = Style -> [PathData Double] -> Chart
PathChart Style
pathStyle [PathData Double]
ps
    curve :: Chart
curve = Style -> [[Point Double]] -> Chart
LineChart Style
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 :: Style
curveStyle = Style
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 "size" a => a
#size Double
0.002 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
palette Int
1)
    c0 :: Chart
c0 = Style -> [Point Double] -> Chart
GlyphChart (Style
defaultGlyphStyle 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 "glyphShape" a => a
#glyphShape GlyphShape
SquareGlyph) [Point Double
start, Point Double
end]
    c1 :: Chart
c1 = Style -> [Point Double] -> Chart
GlyphChart (Style
controlStyle 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 "glyphShape" a => a
#glyphShape GlyphShape
CircleGlyph) [Point Double
control]
    bbox :: Chart
bbox = Style -> [Rect Double] -> Chart
RectChart Style
bbs [QuadPosition Double -> Rect Double
quadBox QuadPosition Double
p]
    bbs :: Style
bbs = Style
defaultRectStyle 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 "borderSize" a => a
#borderSize Double
0.002 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 -> Double -> Colour
paletteO Int
0 Double
0.05) 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 "borderColor" a => a
#borderColor (Double -> Double -> Colour
grey Double
0.4 Double
1)
    pathStyle :: Style
pathStyle = Style
defaultPathStyle 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 -> Double -> Colour
paletteO Int
2 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 -> b -> s -> t
set forall a. IsLabel "borderColor" a => a
#borderColor Colour
transparent
    controlStyle :: Style
controlStyle = Style
defaultGlyphStyle 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 "glyphShape" a => a
#glyphShape GlyphShape
CircleGlyph
    lrows :: [(Text, [Chart])]
lrows =
      forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (forall a. a -> [a] -> [a]
: [])
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ (Text
"Path Fill", Style -> [PathData Double] -> Chart
PathChart Style
pathStyle [forall a. Point a -> PathData a
StartP forall a. Additive a => a
zero]),
              (Text
"Path Chord", Style -> [[Point Double]] -> Chart
LineChart Style
curveStyle [[forall a. Additive a => a
zero]]),
              (Text
"Path Endpoints", Style -> [Point Double] -> Chart
GlyphChart (Style
defaultGlyphStyle 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 "glyphShape" a => a
#glyphShape GlyphShape
SquareGlyph) [forall a. Additive a => a
zero]),
              (Text
"Path Control Point", Style -> [Point Double] -> Chart
GlyphChart (Style
controlStyle 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 "glyphShape" a => a
#glyphShape GlyphShape
CircleGlyph) [forall a. Additive a => a
zero]),
              (Text
"Bounding Box", Style -> [Rect Double] -> Chart
RectChart (Style
bbs 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 "borderSize" a => a
#borderSize Double
0.01) [forall a. Multiplicative a => a
one])
            ]

-- | cubic example
--
-- ![cubic example](other/cubic.svg)
cubicExample :: ChartOptions
cubicExample :: ChartOptions
cubicExample =
  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 "chartTree" a => a
#chartTree (Text -> [Chart] -> ChartTree
named Text
"cubic" [Chart
path', Chart
curve, Chart
c0, Chart
c1, Chart
bbox])
    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 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 "markupOptions" a => a
#markupOptions 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) (Double -> ChartAspect
FixedAspect Double
1.5)
    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 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 a. Double -> a -> Priority a
Priority Double
10 (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 -> b -> s -> t
set forall a. IsLabel "legendCharts" a => a
#legendCharts [(Text, [Chart])]
lrows 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.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 -> b -> s -> t
set forall a. IsLabel "legendSize" a => a
#legendSize 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 -> b -> s -> t
set forall a. IsLabel "vgap" a => a
#vgap Double
0.3)]
    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 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 a. Double -> a -> Priority a
Priority Double
11 (Text -> TitleOptions
defaultTitleOptions Text
"CubicPosition (Point 0 0) (Point 1 1) (Point 1 0) (Point 0 1)" 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.03)]
  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' = Style -> [PathData Double] -> Chart
PathChart Style
pathStyle [PathData Double]
ps
    curve :: Chart
curve = Style -> [[Point Double]] -> Chart
LineChart Style
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 = Style -> [Point Double] -> Chart
GlyphChart (Style
defaultGlyphStyle 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 "glyphShape" a => a
#glyphShape GlyphShape
SquareGlyph) [Point Double
start, Point Double
end]
    c1 :: Chart
c1 = Style -> [Point Double] -> Chart
GlyphChart (Style
controlStyle 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 "glyphShape" a => a
#glyphShape GlyphShape
CircleGlyph) [Point Double
control1, Point Double
control2]
    bbox :: Chart
bbox = Style -> [Rect Double] -> Chart
RectChart Style
bbs [CubicPosition Double -> Rect Double
cubicBox CubicPosition Double
p]
    bbs :: Style
bbs = Style
defaultRectStyle 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 "borderSize" a => a
#borderSize Double
0.002 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 -> Double -> Colour
paletteO Int
0 Double
0.05) 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 "borderColor" a => a
#borderColor (Double -> Double -> Colour
grey Double
0.4 Double
1)
    pathStyle :: Style
pathStyle = Style
defaultPathStyle 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 -> Double -> Colour
paletteO Int
3 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 -> b -> s -> t
set forall a. IsLabel "borderColor" a => a
#borderColor Colour
transparent
    controlStyle :: Style
controlStyle = Style
defaultGlyphStyle
    curveStyle :: Style
curveStyle = Style
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 "size" a => a
#size Double
0.002 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
palette Int
7)
    lrows :: [(Text, [Chart])]
lrows =
      forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (forall a. a -> [a] -> [a]
: [])
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ (Text
"Path Fill", Style -> [PathData Double] -> Chart
PathChart Style
pathStyle [forall a. Point a -> PathData a
StartP forall a. Additive a => a
zero]),
              (Text
"Path Chord", Style -> [[Point Double]] -> Chart
LineChart Style
curveStyle [[forall a. Additive a => a
zero]]),
              (Text
"Path Endpoints", Style -> [Point Double] -> Chart
GlyphChart (Style
defaultGlyphStyle 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 "glyphShape" a => a
#glyphShape GlyphShape
SquareGlyph) [forall a. Additive a => a
zero]),
              (Text
"Path Control Point", Style -> [Point Double] -> Chart
GlyphChart (Style
controlStyle 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 "glyphShape" a => a
#glyphShape GlyphShape
CircleGlyph) [forall a. Additive a => a
zero]),
              (Text
"Bounding Box", Style -> [Rect Double] -> Chart
RectChart (Style
bbs 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 "borderSize" a => a
#borderSize 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 :: ChartOptions
surfaceExample :: ChartOptions
surfaceExample = 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 "chartTree" a => a
#chartTree ChartTree
cs' 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 "markupOptions" a => a
#markupOptions (MarkupOptions
defaultMarkupOptions 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 "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) ShapeRendering
UseCssCrisp)
  where
    grain :: Point Int
grain = forall a. a -> a -> Point a
Point Int
20 Int
20
    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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((-Double
1.0) *)) 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
palette forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int
0 .. Int
5]
    so :: SurfaceOptions
so = SurfaceOptions
defaultSurfaceOptions 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 "soGrain" a => a
#soGrain Point Int
grain 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 "soRange" a => a
#soRange Rect Double
r 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 "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) [Colour]
evenColors
    ([Chart]
cs, Range Double
rangef) = (Point Double -> Double)
-> SurfaceOptions -> ([Chart], Range Double)
surfacef Point Double -> Double
f SurfaceOptions
so
    slo :: SurfaceLegendOptions
slo = SurfaceLegendOptions
defaultSurfaceLegendOptions 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 "sloSurfaceStyle" a => a
#sloSurfaceStyle 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) [Colour]
evenColors 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 "sloDataRange" a => a
#sloDataRange Range Double
rangef
    cs' :: ChartTree
cs' = SurfaceLegendOptions -> ChartTree -> ChartTree
addSurfaceLegend SurfaceLegendOptions
slo ([Chart] -> ChartTree
unnamed [Chart]
cs)

-- | arrow example
--
-- Which happens to be the gradient of the surface example.
--
-- ![arrow example](other/arrow.svg)
arrowExample :: ChartOptions
arrowExample :: ChartOptions
arrowExample =
  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
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 (forall a. IsLabel "axes" a => a
#axes 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 i s t a b. Each i s t a b => IxTraversal i s t a b
each 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 "item" a => a
#item 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 "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 "lineTick" a => a
#lineTick) forall a. Maybe a
Nothing)
    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 "chartTree" a => a
#chartTree (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. Direction coord => coord -> Dir coord
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 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 "markupOptions" a => a
#markupOptions 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) PreferColorScheme
PreferHud
    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 "markupOptions" a => a
#markupOptions 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)
      [i|
{
  .arrow g {
    fill: #{showRGBA dark};
    stroke: #{showRGBA dark};
  }
}
@media (prefers-color-scheme:dark) {
  .arrow g {
    fill: #{showRGBA light};
    stroke: #{showRGBA light};
  }
}
|]
  where
    f :: Point Double -> Point Double
f = 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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((-Double
1.0) *)) 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 = ByteString -> GlyphShape
PathGlyph ByteString
"M -1 0 L 1 0 M 1 0 L 0.4 0.3 M 1 0 L 0.4 -0.3"
    gs :: Double -> Double -> Style
gs Double
s Double
r' =
      Style
defaultGlyphStyle
        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 "borderSize" a => a
#borderSize Double
0.05
        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
s
        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 "borderColor" a => a
#borderColor Colour
dark
        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 "rotation" a => a
#rotation (forall a. a -> Maybe a
Just Double
r')
        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 "glyphShape" a => a
#glyphShape GlyphShape
arrow
    gchart :: Double -> Double -> Point Double -> Chart
gchart Double
s Double
r' Point Double
p = Style -> [Point Double] -> Chart
GlyphChart (Double -> Double -> Style
gs Double
s Double
r') [Point Double
p]

    tail' :: Point Double -> Double
    tail' :: Point Double -> Double
tail' = 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. Basis a => a -> Mag a
magnitude

    avmag :: Double
avmag = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (forall a. Basis a => a -> Mag a
magnitude 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 :: ChartOptions
dateExample :: ChartOptions
dateExample =
  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 "chartTree" a => a
#chartTree (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 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 "markupOptions" a => a
#markupOptions 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) (Double -> ChartAspect
FixedAspect Double
1.5)
    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 "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 "frames" a => a
#frames) (forall a. Semigroup a => a -> a -> a
<> [forall a. Double -> a -> Priority a
Priority Double
100 (FrameOptions
defaultFrameOptions 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 "buffer" a => a
#buffer Double
0.05)])
    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 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 "axes" a => a
#axes) [forall a. Double -> a -> Priority a
Priority Double
5 (AxisOptions
defaultYAxisOptions 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 "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 "tick" a => a
#tick) ([(Double, Text)] -> Tick
TickPlaced [(Double, Text)]
tsTime)), forall a. Double -> a -> Priority a
Priority Double
6 (AxisOptions
defaultXAxisOptions 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 "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 "tick" a => a
#tick) ([(Double, Text)] -> Tick
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
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 :: ChartOptions
gradientExample :: ChartOptions
gradientExample = Maybe Double
-> Double -> Double -> Int -> LCHA -> LCHA -> ChartOptions
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
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (Lens' LCHA (LCH Double)
lch' 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') Double
0.001
    c1 :: LCHA
c1 = LCHA
ok 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 (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') 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) -> Style -> [Rect Double] -> Chart
RectChart (Style
defaultRectStyle 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 Colour
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 "borderSize" a => a
#borderSize 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 -> ChartOptions
gradient :: Maybe Double
-> Double -> Double -> Int -> LCHA -> LCHA -> ChartOptions
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 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 "markupOptions" a => a
#markupOptions 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 "markupHeight" a => a
#markupHeight) (forall a. a -> Maybe a
Just Double
h)
    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 "markupOptions" a => a
#markupOptions 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) ShapeRendering
UseCssCrisp
    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 "markupOptions" a => a
#markupOptions 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) (Double -> ChartAspect
FixedAspect Double
fa)
    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
      #hudOptions
      ( 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 "frames" a => a
#frames [forall a. Double -> a -> Priority a
Priority Double
1 (Maybe Style -> HudChartSection -> Double -> FrameOptions
FrameOptions (forall a. a -> Maybe a
Just (Double -> Colour -> Style
border Double
0.004 Colour
white)) HudChartSection
CanvasStyleSection Double
0.1)]
      )
    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 "chartTree" a => a
#chartTree (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 = Style -> [Rect Double] -> Chart
RectChart (Style
defaultRectStyle 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 Colour
transparent 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 "borderSize" a => a
#borderSize Double
w 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 "borderColor" a => a
#borderColor Colour
c) [Rect Double
r]

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

-- | The dotMap
--
-- > dotMap 0.01 20 0.8 0.3
dotMap :: Double -> Int -> Double -> Double -> [Colour] -> ChartOptions
dotMap :: Double -> Int -> Double -> Double -> [Colour] -> ChartOptions
dotMap Double
s Int
grain Double
l Double
maxchroma [Colour]
cs =
  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
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 forall a. IsLabel "chartTree" a => a
#chartTree (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) -> Style -> [Point Double] -> Chart
GlyphChart (Style
defaultGlyphStyle 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
s 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 Colour
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 "borderSize" a => a
#borderSize Double
0 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 "glyphShape" a => a
#glyphShape GlyphShape
CircleGlyph) [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) -> Style -> [Point Double] -> Chart
GlyphChart (Style
defaultGlyphStyle 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.08 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 Colour
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 "borderColor" a => a
#borderColor (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 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 "glyphShape" a => a
#glyphShape 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 :: ChartOptions -> ChartOptions
debugExample :: ChartOptions -> ChartOptions
debugExample ChartOptions
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 "markupOptions" a => a
#markupOptions (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "markupOptions" a => a
#markupOptions ChartOptions
cs)
    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 "markupOptions" a => a
#markupOptions 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) ChartAspect
asp
    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 "chartTree" a => a
#chartTree (ChartTree
e1 forall a. Semigroup a => a -> a -> a
<> ChartTree
e2 forall a. Semigroup a => a -> a -> a
<> ChartTree
e3)
  where
    asp :: ChartAspect
asp = forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view (forall a. IsLabel "markupOptions" a => a
#markupOptions 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) ChartOptions
cs
    e1 :: ChartTree
e1 = forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "chartTree" a => a
#chartTree (ChartOptions -> ChartOptions
forgetHud ChartOptions
cs)
    e2 :: ChartTree
e2 = Style -> ChartTree -> ChartTree
glyphize (Style
defaultGlyphStyle 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.01 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 "glyphShape" a => a
#glyphShape GlyphShape
CircleGlyph) ChartTree
e1
    e3 :: ChartTree
e3 = Style -> ChartTree -> ChartTree
rectangularize (Style
defaultRectStyle 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 "borderColor" a => a
#borderColor Colour
dark 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 "borderSize" a => a
#borderSize Double
0.001 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 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') Double
0.05) ChartTree
e1

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

-- | Usage of stack.
--
-- ![stack example](other/stack.svg)
stackExample :: ChartOptions
stackExample :: ChartOptions
stackExample = 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 "chartTree" a => a
#chartTree (Int -> Double -> [ChartTree] -> ChartTree
stack Int
5 Double
0.1 (forall a. Int -> a -> [a]
replicate Int
25 (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "chartTree" a => a
#chartTree forall a b. (a -> b) -> a -> b
$ ChartOptions -> ChartOptions
forgetHud ChartOptions
lineExample)))

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

-- | Run this to refresh example SVG's.
writeAllExamples :: IO ()
writeAllExamples :: IO ()
writeAllExamples = do
  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 -> ChartOptions -> IO ()
writeChartOptions) [(FilePath, ChartOptions)]
pathChartOptions
  FilePath -> IO ()
putStrLn FilePath
"ok"

-- | Version of charts with a dark-friendly hud
writeAllExamplesDark :: IO ()
writeAllExamplesDark :: IO ()
writeAllExamplesDark = do
  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 -> ChartOptions -> IO ()
writeChartOptions
        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)
          ( \ChartOptions
x ->
              ChartOptions
x
                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 "hudOptions" a => a
#hudOptions ((Colour -> Colour) -> HudOptions -> HudOptions
colourHudOptions (Colour -> Colour -> Colour
rgb Colour
light))
                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 "markupOptions" a => a
#markupOptions 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) PreferColorScheme
PreferDark
          )
    )
    [(FilePath, ChartOptions)]
pathChartOptions
  FilePath -> IO ()
putStrLn FilePath
"dark version, ok"