{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RebindableSyntax #-}

-- | A hud stands for <https://en.wikipedia.org/wiki/Head-up_display head-up display>, and is a collective noun used to name chart elements that assist in data interpretation or otherwise annotate and decorate data.
--
-- This includes axes, titles, borders, frames, background canvaii, tick marks and tick value labels.
module Chart.Hud
  ( -- * Hud
    Hud (..),
    Priority (..),
    ChartBox,
    DataBox,
    HudChart (..),
    HudChartSection (..),
    hudChartBox',

    -- * HudOptions
    HudOptions (..),
    defaultHudOptions,
    colourHudOptions,

    -- * Hud Processing
    toHuds,
    appendHud,
    makeHuds,
    fromHudChart,
    runHudWith,
    projectChartTreeWith,
    projectWithAspect,
    addHud,
    initialCanvas,
    finalCanvas,

    -- * Hud options
    AxisOptions (..),
    defaultXAxisOptions,
    defaultYAxisOptions,
    FrameOptions (..),
    defaultFrameOptions,
    Place (..),
    flipPlace,
    AxisBar (..),
    defaultAxisBar,
    TitleOptions (..),
    defaultTitleOptions,
    Ticks (..),
    TickStyle (..),
    defaultGlyphTickStyleX,
    defaultGlyphTickStyleY,
    defaultTextTick,
    defaultLineTick,
    defaultXTicks,
    defaultYTicks,
    Tick (..),
    defaultTick,
    TickExtend (..),
    formatN',
    numTicks',
    tickExtend',
    adjustTicks,
    Adjustments (..),
    defaultAdjustments,
    computeRangeTick,
    LegendOptions (..),
    defaultLegendOptions,

    -- * Convert Hud elements to charts
    axisHud,
    titleHud,
    frameHud,
    legendHud,
    legendChart,
    legendEntry,
    legendFrame,
    freezeAxes,
    freezeTicks,
  )
where

import Chart.Data
import Chart.Primitive
import Chart.Style
import Data.Bifunctor
import Data.Bool
import Data.Colour
import Data.Foldable hiding (sum)
import Data.FormatN
import Data.List qualified as List
import Data.Maybe
import Data.Path
import Data.Text (Text)
import Data.Text qualified as Text
import Data.Tuple
import GHC.Generics hiding (to)
import NumHask.Prelude hiding (to)
import NumHask.Space
import Optics.Core

-- $setup
--
-- >>> :set -XOverloadedLabels
-- >>> :set -XOverloadedStrings
-- >>> import Chart
-- >>> import Optics.Core

-- * Hud

-- | The priority of a Hud element or transformation, lower value means higher priority.
--
-- Lower priority (higher values) huds will tend to be placed on the outside of a chart.
--
-- Hud elements are rendered in order from high to low priority and the positioning of hud elements can depend on the positioning of elements that have already been included. Equal priority values will be placed in the same process step.
--
-- The first example below, based in 'Chart.Examples.lineExample' but with the legend placed on the right and coloured frames to help accentuate effects, includes (in order of priority):
--
-- - an inner frame, representing the core data area of the chart (Priority 1)
--
-- - the axes (5)
--
-- - the titles (Priority 12)
--
-- - the legend (Priority 50)
--
-- - an outer frame which is transparent and used to pad out the chart (Priority 100).
--
-- > priorityv1Example = lineExample & (#hudOptions % #frames) .~ [(1, FrameOptions (Just defaultRectStyle) 0), (100, FrameOptions (Just (defaultRectStyle & #color .~ (palette1 4 & opac' .~ 0.05) & #borderColor .~ palette1 4)) 0.1)] & over (#hudOptions % #legends) (fmap (first (const (Priority 50)))) & #hudOptions % #legends %~ fmap (second (set #place PlaceRight))
--
-- ![priorityv1 example](other/priorityv1.svg)
--
-- The second variation below drops the title priorities to below the legend:
--
-- > priorityv2Example = priorityv1Example & #hudOptions % #titles %~ fmap (first (const (Priority 51)))
--
-- ![priorityv2 example](other/priorityv2.svg)
data Priority a = Priority {forall a. Priority a -> Double
priority :: Double, forall a. Priority a -> a
item :: a} deriving (Priority a -> Priority a -> Bool
(Priority a -> Priority a -> Bool)
-> (Priority a -> Priority a -> Bool) -> Eq (Priority a)
forall a. Eq a => Priority a -> Priority a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Priority a -> Priority a -> Bool
== :: Priority a -> Priority a -> Bool
$c/= :: forall a. Eq a => Priority a -> Priority a -> Bool
/= :: Priority a -> Priority a -> Bool
Eq, Eq (Priority a)
Eq (Priority a) =>
(Priority a -> Priority a -> Ordering)
-> (Priority a -> Priority a -> Bool)
-> (Priority a -> Priority a -> Bool)
-> (Priority a -> Priority a -> Bool)
-> (Priority a -> Priority a -> Bool)
-> (Priority a -> Priority a -> Priority a)
-> (Priority a -> Priority a -> Priority a)
-> Ord (Priority a)
Priority a -> Priority a -> Bool
Priority a -> Priority a -> Ordering
Priority a -> Priority a -> Priority a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (Priority a)
forall a. Ord a => Priority a -> Priority a -> Bool
forall a. Ord a => Priority a -> Priority a -> Ordering
forall a. Ord a => Priority a -> Priority a -> Priority a
$ccompare :: forall a. Ord a => Priority a -> Priority a -> Ordering
compare :: Priority a -> Priority a -> Ordering
$c< :: forall a. Ord a => Priority a -> Priority a -> Bool
< :: Priority a -> Priority a -> Bool
$c<= :: forall a. Ord a => Priority a -> Priority a -> Bool
<= :: Priority a -> Priority a -> Bool
$c> :: forall a. Ord a => Priority a -> Priority a -> Bool
> :: Priority a -> Priority a -> Bool
$c>= :: forall a. Ord a => Priority a -> Priority a -> Bool
>= :: Priority a -> Priority a -> Bool
$cmax :: forall a. Ord a => Priority a -> Priority a -> Priority a
max :: Priority a -> Priority a -> Priority a
$cmin :: forall a. Ord a => Priority a -> Priority a -> Priority a
min :: Priority a -> Priority a -> Priority a
Ord, Int -> Priority a -> ShowS
[Priority a] -> ShowS
Priority a -> String
(Int -> Priority a -> ShowS)
-> (Priority a -> String)
-> ([Priority a] -> ShowS)
-> Show (Priority a)
forall a. Show a => Int -> Priority a -> ShowS
forall a. Show a => [Priority a] -> ShowS
forall a. Show a => Priority a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Priority a -> ShowS
showsPrec :: Int -> Priority a -> ShowS
$cshow :: forall a. Show a => Priority a -> String
show :: Priority a -> String
$cshowList :: forall a. Show a => [Priority a] -> ShowS
showList :: [Priority a] -> ShowS
Show, (forall x. Priority a -> Rep (Priority a) x)
-> (forall x. Rep (Priority a) x -> Priority a)
-> Generic (Priority a)
forall x. Rep (Priority a) x -> Priority a
forall x. Priority a -> Rep (Priority a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Priority a) x -> Priority a
forall a x. Priority a -> Rep (Priority a) x
$cfrom :: forall a x. Priority a -> Rep (Priority a) x
from :: forall x. Priority a -> Rep (Priority a) x
$cto :: forall a x. Rep (Priority a) x -> Priority a
to :: forall x. Rep (Priority a) x -> Priority a
Generic, (forall a b. (a -> b) -> Priority a -> Priority b)
-> (forall a b. a -> Priority b -> Priority a) -> Functor Priority
forall a b. a -> Priority b -> Priority a
forall a b. (a -> b) -> Priority a -> Priority b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Priority a -> Priority b
fmap :: forall a b. (a -> b) -> Priority a -> Priority b
$c<$ :: forall a b. a -> Priority b -> Priority a
<$ :: forall a b. a -> Priority b -> Priority a
Functor)

-- | Heads-up display additions to charts
newtype Hud = Hud {Hud -> Priority (HudChart -> ChartTree)
phud :: Priority (HudChart -> ChartTree)} deriving ((forall x. Hud -> Rep Hud x)
-> (forall x. Rep Hud x -> Hud) -> Generic Hud
forall x. Rep Hud x -> Hud
forall x. Hud -> Rep Hud x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Hud -> Rep Hud x
from :: forall x. Hud -> Rep Hud x
$cto :: forall x. Rep Hud x -> Hud
to :: forall x. Rep Hud x -> Hud
Generic)

-- | Named pair type to track the split of Chart elements into Hud and Canvas
--
-- - charts: charts that form the canvas or data elements of the chart; the rectangular dimension which is considered to be the data representation space.
--
-- - hud: charts that form the Hud.
data HudChart = HudChart
  { HudChart -> ChartTree
chartSection :: ChartTree,
    HudChart -> ChartTree
hudSection :: ChartTree
  }
  deriving (HudChart -> HudChart -> Bool
(HudChart -> HudChart -> Bool)
-> (HudChart -> HudChart -> Bool) -> Eq HudChart
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HudChart -> HudChart -> Bool
== :: HudChart -> HudChart -> Bool
$c/= :: HudChart -> HudChart -> Bool
/= :: HudChart -> HudChart -> Bool
Eq, Int -> HudChart -> ShowS
[HudChart] -> ShowS
HudChart -> String
(Int -> HudChart -> ShowS)
-> (HudChart -> String) -> ([HudChart] -> ShowS) -> Show HudChart
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HudChart -> ShowS
showsPrec :: Int -> HudChart -> ShowS
$cshow :: HudChart -> String
show :: HudChart -> String
$cshowList :: [HudChart] -> ShowS
showList :: [HudChart] -> ShowS
Show, (forall x. HudChart -> Rep HudChart x)
-> (forall x. Rep HudChart x -> HudChart) -> Generic HudChart
forall x. Rep HudChart x -> HudChart
forall x. HudChart -> Rep HudChart x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. HudChart -> Rep HudChart x
from :: forall x. HudChart -> Rep HudChart x
$cto :: forall x. Rep HudChart x -> HudChart
to :: forall x. Rep HudChart x -> HudChart
Generic)

-- | A type for Rect to represent the bounding box of a chart.
type ChartBox = Rect Double

-- | A type for Rect to represent the bounding box of the data.
type DataBox = Rect Double

-- | A section of a 'HudChart'
data HudChartSection
  = -- | The canvas without any style allowances
    CanvasSection
  | -- | The canvas portion including style boundaries.
    CanvasStyleSection
  | -- | The hud and canvas sections, not including style.
    HudSection
  | -- | The hud and canvas sections, including style
    HudStyleSection
  deriving (HudChartSection -> HudChartSection -> Bool
(HudChartSection -> HudChartSection -> Bool)
-> (HudChartSection -> HudChartSection -> Bool)
-> Eq HudChartSection
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HudChartSection -> HudChartSection -> Bool
== :: HudChartSection -> HudChartSection -> Bool
$c/= :: HudChartSection -> HudChartSection -> Bool
/= :: HudChartSection -> HudChartSection -> Bool
Eq, Int -> HudChartSection -> ShowS
[HudChartSection] -> ShowS
HudChartSection -> String
(Int -> HudChartSection -> ShowS)
-> (HudChartSection -> String)
-> ([HudChartSection] -> ShowS)
-> Show HudChartSection
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HudChartSection -> ShowS
showsPrec :: Int -> HudChartSection -> ShowS
$cshow :: HudChartSection -> String
show :: HudChartSection -> String
$cshowList :: [HudChartSection] -> ShowS
showList :: [HudChartSection] -> ShowS
Show, (forall x. HudChartSection -> Rep HudChartSection x)
-> (forall x. Rep HudChartSection x -> HudChartSection)
-> Generic HudChartSection
forall x. Rep HudChartSection x -> HudChartSection
forall x. HudChartSection -> Rep HudChartSection x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. HudChartSection -> Rep HudChartSection x
from :: forall x. HudChartSection -> Rep HudChartSection x
$cto :: forall x. Rep HudChartSection x -> HudChartSection
to :: forall x. Rep HudChartSection x -> HudChartSection
Generic)

-- | The 'Rect' of a particular 'HudChartSection' of a 'HudChart'
hudChartBox' :: HudChartSection -> Getter HudChart (Maybe (Rect Double))
hudChartBox' :: HudChartSection -> Getter HudChart (Maybe (Rect Double))
hudChartBox' HudChartSection
CanvasSection = (HudChart -> Maybe (Rect Double))
-> Getter HudChart (Maybe (Rect Double))
forall s a. (s -> a) -> Getter s a
to ([Chart] -> Maybe (Rect Double)
boxes ([Chart] -> Maybe (Rect Double))
-> (HudChart -> [Chart]) -> HudChart -> Maybe (Rect Double)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Optic' A_Traversal NoIx HudChart [Chart] -> HudChart -> [Chart]
forall k a (is :: IxList) s.
(Is k A_Fold, Monoid a) =>
Optic' k is s a -> s -> a
foldOf (Optic' A_Lens NoIx HudChart ChartTree
#chartSection Optic' A_Lens NoIx HudChart ChartTree
-> Optic A_Traversal NoIx ChartTree ChartTree [Chart] [Chart]
-> Optic' A_Traversal NoIx HudChart [Chart]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Traversal NoIx ChartTree ChartTree [Chart] [Chart]
charts'))
hudChartBox' HudChartSection
CanvasStyleSection = (HudChart -> Maybe (Rect Double))
-> Getter HudChart (Maybe (Rect Double))
forall s a. (s -> a) -> Getter s a
to ([Chart] -> Maybe (Rect Double)
styleBoxes ([Chart] -> Maybe (Rect Double))
-> (HudChart -> [Chart]) -> HudChart -> Maybe (Rect Double)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Optic' A_Traversal NoIx HudChart [Chart] -> HudChart -> [Chart]
forall k a (is :: IxList) s.
(Is k A_Fold, Monoid a) =>
Optic' k is s a -> s -> a
foldOf (Optic' A_Lens NoIx HudChart ChartTree
#chartSection Optic' A_Lens NoIx HudChart ChartTree
-> Optic A_Traversal NoIx ChartTree ChartTree [Chart] [Chart]
-> Optic' A_Traversal NoIx HudChart [Chart]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Traversal NoIx ChartTree ChartTree [Chart] [Chart]
charts'))
hudChartBox' HudChartSection
HudSection = (HudChart -> Maybe (Rect Double))
-> Getter HudChart (Maybe (Rect Double))
forall s a. (s -> a) -> Getter s a
to ([Chart] -> Maybe (Rect Double)
boxes ([Chart] -> Maybe (Rect Double))
-> (HudChart -> [Chart]) -> HudChart -> Maybe (Rect Double)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (\HudChart
x -> Optic' A_Traversal NoIx HudChart [Chart] -> HudChart -> [Chart]
forall k a (is :: IxList) s.
(Is k A_Fold, Monoid a) =>
Optic' k is s a -> s -> a
foldOf (Optic' A_Lens NoIx HudChart ChartTree
#chartSection Optic' A_Lens NoIx HudChart ChartTree
-> Optic A_Traversal NoIx ChartTree ChartTree [Chart] [Chart]
-> Optic' A_Traversal NoIx HudChart [Chart]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Traversal NoIx ChartTree ChartTree [Chart] [Chart]
charts') HudChart
x [Chart] -> [Chart] -> [Chart]
forall a. Semigroup a => a -> a -> a
<> Optic' A_Traversal NoIx HudChart [Chart] -> HudChart -> [Chart]
forall k a (is :: IxList) s.
(Is k A_Fold, Monoid a) =>
Optic' k is s a -> s -> a
foldOf (Optic' A_Lens NoIx HudChart ChartTree
#hudSection Optic' A_Lens NoIx HudChart ChartTree
-> Optic A_Traversal NoIx ChartTree ChartTree [Chart] [Chart]
-> Optic' A_Traversal NoIx HudChart [Chart]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Traversal NoIx ChartTree ChartTree [Chart] [Chart]
charts') HudChart
x))
hudChartBox' HudChartSection
HudStyleSection = (HudChart -> Maybe (Rect Double))
-> Getter HudChart (Maybe (Rect Double))
forall s a. (s -> a) -> Getter s a
to ([Chart] -> Maybe (Rect Double)
styleBoxes ([Chart] -> Maybe (Rect Double))
-> (HudChart -> [Chart]) -> HudChart -> Maybe (Rect Double)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (\HudChart
x -> Optic' A_Traversal NoIx HudChart [Chart] -> HudChart -> [Chart]
forall k a (is :: IxList) s.
(Is k A_Fold, Monoid a) =>
Optic' k is s a -> s -> a
foldOf (Optic' A_Lens NoIx HudChart ChartTree
#chartSection Optic' A_Lens NoIx HudChart ChartTree
-> Optic A_Traversal NoIx ChartTree ChartTree [Chart] [Chart]
-> Optic' A_Traversal NoIx HudChart [Chart]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Traversal NoIx ChartTree ChartTree [Chart] [Chart]
charts') HudChart
x [Chart] -> [Chart] -> [Chart]
forall a. Semigroup a => a -> a -> a
<> Optic' A_Traversal NoIx HudChart [Chart] -> HudChart -> [Chart]
forall k a (is :: IxList) s.
(Is k A_Fold, Monoid a) =>
Optic' k is s a -> s -> a
foldOf (Optic' A_Lens NoIx HudChart ChartTree
#hudSection Optic' A_Lens NoIx HudChart ChartTree
-> Optic A_Traversal NoIx ChartTree ChartTree [Chart] [Chart]
-> Optic' A_Traversal NoIx HudChart [Chart]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Traversal NoIx ChartTree ChartTree [Chart] [Chart]
charts') HudChart
x))

-- | Append a 'ChartTree' to the hud section of a 'HudChart'.
appendHud :: ChartTree -> HudChart -> HudChart
appendHud :: ChartTree -> HudChart -> HudChart
appendHud ChartTree
cs HudChart
x =
  HudChart
x HudChart -> (HudChart -> HudChart) -> HudChart
forall a b. a -> (a -> b) -> b
& Optic' A_Lens NoIx HudChart ChartTree
-> (ChartTree -> ChartTree) -> HudChart -> HudChart
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over Optic' A_Lens NoIx HudChart ChartTree
#hudSection (ChartTree -> ChartTree -> ChartTree
forall a. Semigroup a => a -> a -> a
<> ChartTree
cs)

-- | Add huds to the hud section of a 'HudChart', given a list of hud makers.
makeHuds :: [HudChart -> ChartTree] -> HudChart -> HudChart
makeHuds :: [HudChart -> ChartTree] -> HudChart -> HudChart
makeHuds [HudChart -> ChartTree]
hs HudChart
hc = Optic' A_Lens NoIx HudChart ChartTree
-> (ChartTree -> ChartTree) -> HudChart -> HudChart
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over Optic' A_Lens NoIx HudChart ChartTree
#hudSection (ChartTree -> ChartTree -> ChartTree
forall a. Semigroup a => a -> a -> a
<> [ChartTree] -> ChartTree
forall a. Monoid a => [a] -> a
mconcat (((HudChart -> ChartTree) -> ChartTree)
-> [HudChart -> ChartTree] -> [ChartTree]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((HudChart -> ChartTree) -> HudChart -> ChartTree
forall a b. (a -> b) -> a -> b
$ HudChart
hc) [HudChart -> ChartTree]
hs)) HudChart
hc

-- | Convert a 'HudChart' to a 'ChartTree' labelling the hud and chart sections.
fromHudChart :: HudChart -> ChartTree
fromHudChart :: HudChart -> ChartTree
fromHudChart HudChart
hc = Maybe Text -> [ChartTree] -> ChartTree
group (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"chart") [Optic' A_Lens NoIx HudChart ChartTree -> HudChart -> ChartTree
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx HudChart ChartTree
#chartSection HudChart
hc] ChartTree -> ChartTree -> ChartTree
forall a. Semigroup a => a -> a -> a
<> Maybe Text -> [ChartTree] -> ChartTree
group (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"hud") [Optic' A_Lens NoIx HudChart ChartTree -> HudChart -> ChartTree
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx HudChart ChartTree
#hudSection HudChart
hc]

-- | Combine huds and charts to form a new Chart using the supplied initial canvas and data dimensions. Note that chart data is transformed by this computation (a linear type might be useful here).
runHudWith ::
  -- | initial canvas
  ChartBox ->
  -- | huds to add
  [Hud] ->
  -- | underlying chart
  ChartTree ->
  -- | integrated chart tree
  ChartTree
runHudWith :: Rect Double -> [Hud] -> ChartTree -> ChartTree
runHudWith Rect Double
cb [Hud]
hs ChartTree
cs =
  [Hud]
hs
    [Hud] -> ([Hud] -> [Hud]) -> [Hud]
forall a b. a -> (a -> b) -> b
& (Hud -> Double) -> [Hud] -> [Hud]
forall b a. Ord b => (a -> b) -> [a] -> [a]
List.sortOn (Optic' A_Lens NoIx Hud Double -> Hud -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view (Optic
  A_Lens
  NoIx
  Hud
  Hud
  (Priority (HudChart -> ChartTree))
  (Priority (HudChart -> ChartTree))
#phud Optic
  A_Lens
  NoIx
  Hud
  Hud
  (Priority (HudChart -> ChartTree))
  (Priority (HudChart -> ChartTree))
-> Optic
     A_Lens
     NoIx
     (Priority (HudChart -> ChartTree))
     (Priority (HudChart -> ChartTree))
     Double
     Double
-> Optic' A_Lens NoIx Hud Double
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  NoIx
  (Priority (HudChart -> ChartTree))
  (Priority (HudChart -> ChartTree))
  Double
  Double
#priority))
    [Hud] -> ([Hud] -> [[Hud]]) -> [[Hud]]
forall a b. a -> (a -> b) -> b
& (Hud -> Hud -> Bool) -> [Hud] -> [[Hud]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
List.groupBy (\Hud
a Hud
b -> Optic' A_Lens NoIx Hud Double -> Hud -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view (Optic
  A_Lens
  NoIx
  Hud
  Hud
  (Priority (HudChart -> ChartTree))
  (Priority (HudChart -> ChartTree))
#phud Optic
  A_Lens
  NoIx
  Hud
  Hud
  (Priority (HudChart -> ChartTree))
  (Priority (HudChart -> ChartTree))
-> Optic
     A_Lens
     NoIx
     (Priority (HudChart -> ChartTree))
     (Priority (HudChart -> ChartTree))
     Double
     Double
-> Optic' A_Lens NoIx Hud Double
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  NoIx
  (Priority (HudChart -> ChartTree))
  (Priority (HudChart -> ChartTree))
  Double
  Double
#priority) Hud
a Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Optic' A_Lens NoIx Hud Double -> Hud -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view (Optic
  A_Lens
  NoIx
  Hud
  Hud
  (Priority (HudChart -> ChartTree))
  (Priority (HudChart -> ChartTree))
#phud Optic
  A_Lens
  NoIx
  Hud
  Hud
  (Priority (HudChart -> ChartTree))
  (Priority (HudChart -> ChartTree))
-> Optic
     A_Lens
     NoIx
     (Priority (HudChart -> ChartTree))
     (Priority (HudChart -> ChartTree))
     Double
     Double
-> Optic' A_Lens NoIx Hud Double
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  NoIx
  (Priority (HudChart -> ChartTree))
  (Priority (HudChart -> ChartTree))
  Double
  Double
#priority) Hud
b)
    [[Hud]]
-> ([[Hud]] -> [[HudChart -> ChartTree]])
-> [[HudChart -> ChartTree]]
forall a b. a -> (a -> b) -> b
& ([Hud] -> [HudChart -> ChartTree])
-> [[Hud]] -> [[HudChart -> ChartTree]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Hud -> HudChart -> ChartTree) -> [Hud] -> [HudChart -> ChartTree]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Optic' A_Lens NoIx Hud (HudChart -> ChartTree)
-> Hud -> HudChart -> ChartTree
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view (Optic
  A_Lens
  NoIx
  Hud
  Hud
  (Priority (HudChart -> ChartTree))
  (Priority (HudChart -> ChartTree))
#phud Optic
  A_Lens
  NoIx
  Hud
  Hud
  (Priority (HudChart -> ChartTree))
  (Priority (HudChart -> ChartTree))
-> Optic
     A_Lens
     NoIx
     (Priority (HudChart -> ChartTree))
     (Priority (HudChart -> ChartTree))
     (HudChart -> ChartTree)
     (HudChart -> ChartTree)
-> Optic' A_Lens NoIx Hud (HudChart -> ChartTree)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  NoIx
  (Priority (HudChart -> ChartTree))
  (Priority (HudChart -> ChartTree))
  (HudChart -> ChartTree)
  (HudChart -> ChartTree)
#item)))
    [[HudChart -> ChartTree]]
-> ([[HudChart -> ChartTree]] -> HudChart) -> HudChart
forall a b. a -> (a -> b) -> b
& (HudChart -> [HudChart -> ChartTree] -> HudChart)
-> HudChart -> [[HudChart -> ChartTree]] -> HudChart
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (([HudChart -> ChartTree] -> HudChart -> HudChart)
-> HudChart -> [HudChart -> ChartTree] -> HudChart
forall a b c. (a -> b -> c) -> b -> a -> c
flip [HudChart -> ChartTree] -> HudChart -> HudChart
makeHuds) HudChart
hc0
    HudChart -> (HudChart -> ChartTree) -> ChartTree
forall a b. a -> (a -> b) -> b
& HudChart -> ChartTree
fromHudChart
  where
    hc0 :: HudChart
hc0 =
      ChartTree -> ChartTree -> HudChart
HudChart
        (ChartTree
cs ChartTree -> (ChartTree -> ChartTree) -> ChartTree
forall a b. a -> (a -> b) -> b
& Optic
  A_Lens
  NoIx
  ChartTree
  ChartTree
  (Maybe (Rect Double))
  (Maybe (Rect Double))
-> Maybe (Rect Double) -> ChartTree -> ChartTree
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic
  A_Lens
  NoIx
  ChartTree
  ChartTree
  (Maybe (Rect Double))
  (Maybe (Rect Double))
styleBox' (Rect Double -> Maybe (Rect Double)
forall a. a -> Maybe a
Just Rect Double
cb))
        ChartTree
forall a. Monoid a => a
mempty

-- | Decorate a ChartTree with HudOptions
addHud :: ChartAspect -> HudOptions -> ChartTree -> ChartTree
addHud :: ChartAspect -> HudOptions -> ChartTree -> ChartTree
addHud ChartAspect
asp HudOptions
ho ChartTree
cs =
  Rect Double -> [Hud] -> ChartTree -> ChartTree
runHudWith
    (ChartAspect -> Maybe ChartTree -> Rect Double
initialCanvas ChartAspect
asp (ChartTree -> Maybe ChartTree
forall a. a -> Maybe a
Just ChartTree
cs'))
    [Hud]
hs
    ChartTree
cs'
  where
    db :: Rect Double
db = Optic' A_Getter NoIx ChartTree (Rect Double)
-> ChartTree -> Rect Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Getter NoIx ChartTree (Rect Double)
safeBox' ChartTree
cs
    (Maybe (Rect Double)
mdb, [Hud]
hs) = HudOptions -> Rect Double -> (Maybe (Rect Double), [Hud])
toHuds HudOptions
ho Rect Double
db
    cs' :: ChartTree
cs' = ChartTree
cs ChartTree -> ChartTree -> ChartTree
forall a. Semigroup a => a -> a -> a
<> ChartTree
-> (Rect Double -> ChartTree) -> Maybe (Rect Double) -> ChartTree
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ChartTree
forall a. Monoid a => a
mempty (\Rect Double
r -> ChartTree -> ChartTree -> Bool -> ChartTree
forall a. a -> a -> Bool -> a
bool (Text -> [Chart] -> ChartTree
named Text
"datapadding" [Style -> [Rect Double] -> Chart
BlankChart Style
defaultStyle [Rect Double
r]]) ChartTree
forall a. Monoid a => a
mempty (Rect Double
r Rect Double -> Rect Double -> Bool
forall a. Eq a => a -> a -> Bool
== Rect Double
db)) Maybe (Rect Double)
mdb

-- | Compute a Rect representing the initial chart canvas from a 'ChartAspect' and maybe a 'ChartTree', before the addition of style and hud elements.
--
-- >>> initialCanvas (FixedAspect 1.5) (Just $ unnamed [RectChart defaultRectStyle [one]])
-- Rect (-0.75) 0.75 (-0.5) 0.5
initialCanvas :: ChartAspect -> Maybe ChartTree -> Rect Double
initialCanvas :: ChartAspect -> Maybe ChartTree -> Rect Double
initialCanvas (FixedAspect Double
a) Maybe ChartTree
_ = Double -> Rect Double
aspect Double
a
initialCanvas (CanvasAspect Double
a) Maybe ChartTree
_ = Double -> Rect Double
aspect Double
a
initialCanvas ChartAspect
ChartAspect Maybe ChartTree
cs = Rect Double
-> (ChartTree -> Rect Double) -> Maybe ChartTree -> Rect Double
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Rect Double
forall a. Multiplicative a => a
one (Double -> Rect Double
aspect (Double -> Rect Double)
-> (ChartTree -> Double) -> ChartTree -> Rect Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Rect Double -> Double
forall a. Field a => Rect a -> a
ratio (Rect Double -> Double)
-> (ChartTree -> Rect Double) -> ChartTree -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Optic' A_Getter NoIx ChartTree (Rect Double)
-> ChartTree -> Rect Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Getter NoIx ChartTree (Rect Double)
safeStyleBox') Maybe ChartTree
cs
initialCanvas ChartAspect
UnscaledAspect Maybe ChartTree
cs = Rect Double
-> (ChartTree -> Rect Double) -> Maybe ChartTree -> Rect Double
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Rect Double
forall a. Multiplicative a => a
one (Optic' A_Getter NoIx ChartTree (Rect Double)
-> ChartTree -> Rect Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Getter NoIx ChartTree (Rect Double)
safeStyleBox') Maybe ChartTree
cs

-- | Compute a Rect representing the final chart canvas from a 'ChartAspect' and maybe a 'ChartTree'. The difference between 'initialCanvas' and finalCanvas is using the actual chart canvas for CanvasAspect.
--
-- >>> finalCanvas (CanvasAspect 1.5) (Just $ unnamed [RectChart defaultRectStyle [one]])
-- Rect (-0.5) 0.5 (-0.5) 0.5
finalCanvas :: ChartAspect -> Maybe ChartTree -> Rect Double
finalCanvas :: ChartAspect -> Maybe ChartTree -> Rect Double
finalCanvas (FixedAspect Double
a) Maybe ChartTree
_ = Double -> Rect Double
aspect Double
a
finalCanvas (CanvasAspect Double
a) Maybe ChartTree
Nothing = Double -> Rect Double
aspect Double
a
finalCanvas (CanvasAspect Double
_) Maybe ChartTree
cs = ChartAspect -> Maybe ChartTree -> Rect Double
finalCanvas ChartAspect
ChartAspect Maybe ChartTree
cs
finalCanvas ChartAspect
ChartAspect Maybe ChartTree
cs = Rect Double
-> (ChartTree -> Rect Double) -> Maybe ChartTree -> Rect Double
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Rect Double
forall a. Multiplicative a => a
one (Double -> Rect Double
aspect (Double -> Rect Double)
-> (ChartTree -> Double) -> ChartTree -> Rect Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Rect Double -> Double
forall a. Field a => Rect a -> a
ratio (Rect Double -> Double)
-> (ChartTree -> Rect Double) -> ChartTree -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Optic' A_Getter NoIx ChartTree (Rect Double)
-> ChartTree -> Rect Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Getter NoIx ChartTree (Rect Double)
safeStyleBox') Maybe ChartTree
cs
finalCanvas ChartAspect
UnscaledAspect Maybe ChartTree
cs = Rect Double
-> (ChartTree -> Rect Double) -> Maybe ChartTree -> Rect Double
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Rect Double
forall a. Multiplicative a => a
one (Optic' A_Getter NoIx ChartTree (Rect Double)
-> ChartTree -> Rect Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Getter NoIx ChartTree (Rect Double)
safeStyleBox') Maybe ChartTree
cs

-- | Add 'HudOptions' to a 'ChartTree' and scale to the 'ChartAspect'.
projectChartTreeWith :: ChartAspect -> HudOptions -> ChartTree -> ChartTree
projectChartTreeWith :: ChartAspect -> HudOptions -> ChartTree -> ChartTree
projectChartTreeWith ChartAspect
asp HudOptions
ho ChartTree
ct = ChartTree
ctFinal
  where
    csAndHud :: ChartTree
csAndHud = ChartAspect -> HudOptions -> ChartTree -> ChartTree
addHud ChartAspect
asp HudOptions
ho ChartTree
ct
    viewbox :: Rect Double
viewbox = ChartAspect -> Maybe ChartTree -> Rect Double
finalCanvas ChartAspect
asp (ChartTree -> Maybe ChartTree
forall a. a -> Maybe a
Just ChartTree
csAndHud)
    ctFinal :: ChartTree
ctFinal = Optic
  A_Lens
  NoIx
  ChartTree
  ChartTree
  (Maybe (Rect Double))
  (Maybe (Rect Double))
-> Maybe (Rect Double) -> ChartTree -> ChartTree
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic
  A_Lens
  NoIx
  ChartTree
  ChartTree
  (Maybe (Rect Double))
  (Maybe (Rect Double))
styleBox' (Rect Double -> Maybe (Rect Double)
forall a. a -> Maybe a
Just Rect Double
viewbox) ChartTree
csAndHud

-- | Scale a 'ChartTree' with a specific 'ChartAspect'.
projectWithAspect :: ChartAspect -> ChartTree -> ChartTree
projectWithAspect :: ChartAspect -> ChartTree -> ChartTree
projectWithAspect ChartAspect
asp ChartTree
ct = Optic
  A_Lens
  NoIx
  ChartTree
  ChartTree
  (Maybe (Rect Double))
  (Maybe (Rect Double))
-> Maybe (Rect Double) -> ChartTree -> ChartTree
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic
  A_Lens
  NoIx
  ChartTree
  ChartTree
  (Maybe (Rect Double))
  (Maybe (Rect Double))
styleBox' (Rect Double -> Maybe (Rect Double)
forall a. a -> Maybe a
Just (ChartAspect -> Maybe ChartTree -> Rect Double
finalCanvas ChartAspect
asp (ChartTree -> Maybe ChartTree
forall a. a -> Maybe a
Just ChartTree
ct))) ChartTree
ct

-- | Typical, configurable hud elements. Anything else can be hand-coded as a 'Hud'.
--
-- ![hud example](other/hudoptions.svg)
data HudOptions = HudOptions
  { HudOptions -> [Priority AxisOptions]
axes :: [Priority AxisOptions],
    HudOptions -> [Priority FrameOptions]
frames :: [Priority FrameOptions],
    HudOptions -> [Priority LegendOptions]
legends :: [Priority LegendOptions],
    HudOptions -> [Priority TitleOptions]
titles :: [Priority TitleOptions]
  }
  deriving (HudOptions -> HudOptions -> Bool
(HudOptions -> HudOptions -> Bool)
-> (HudOptions -> HudOptions -> Bool) -> Eq HudOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HudOptions -> HudOptions -> Bool
== :: HudOptions -> HudOptions -> Bool
$c/= :: HudOptions -> HudOptions -> Bool
/= :: HudOptions -> HudOptions -> Bool
Eq, Int -> HudOptions -> ShowS
[HudOptions] -> ShowS
HudOptions -> String
(Int -> HudOptions -> ShowS)
-> (HudOptions -> String)
-> ([HudOptions] -> ShowS)
-> Show HudOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HudOptions -> ShowS
showsPrec :: Int -> HudOptions -> ShowS
$cshow :: HudOptions -> String
show :: HudOptions -> String
$cshowList :: [HudOptions] -> ShowS
showList :: [HudOptions] -> ShowS
Show, (forall x. HudOptions -> Rep HudOptions x)
-> (forall x. Rep HudOptions x -> HudOptions) -> Generic HudOptions
forall x. Rep HudOptions x -> HudOptions
forall x. HudOptions -> Rep HudOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. HudOptions -> Rep HudOptions x
from :: forall x. HudOptions -> Rep HudOptions x
$cto :: forall x. Rep HudOptions x -> HudOptions
to :: forall x. Rep HudOptions x -> HudOptions
Generic)

instance Semigroup HudOptions where
  <> :: HudOptions -> HudOptions -> HudOptions
(<>) (HudOptions [Priority AxisOptions]
a [Priority FrameOptions]
c [Priority LegendOptions]
l [Priority TitleOptions]
t) (HudOptions [Priority AxisOptions]
a' [Priority FrameOptions]
c' [Priority LegendOptions]
l' [Priority TitleOptions]
t') =
    [Priority AxisOptions]
-> [Priority FrameOptions]
-> [Priority LegendOptions]
-> [Priority TitleOptions]
-> HudOptions
HudOptions ([Priority AxisOptions]
a [Priority AxisOptions]
-> [Priority AxisOptions] -> [Priority AxisOptions]
forall a. Semigroup a => a -> a -> a
<> [Priority AxisOptions]
a') ([Priority FrameOptions]
c [Priority FrameOptions]
-> [Priority FrameOptions] -> [Priority FrameOptions]
forall a. Semigroup a => a -> a -> a
<> [Priority FrameOptions]
c') ([Priority LegendOptions]
l [Priority LegendOptions]
-> [Priority LegendOptions] -> [Priority LegendOptions]
forall a. Semigroup a => a -> a -> a
<> [Priority LegendOptions]
l') ([Priority TitleOptions]
t [Priority TitleOptions]
-> [Priority TitleOptions] -> [Priority TitleOptions]
forall a. Semigroup a => a -> a -> a
<> [Priority TitleOptions]
t')

instance Monoid HudOptions where
  mempty :: HudOptions
mempty = [Priority AxisOptions]
-> [Priority FrameOptions]
-> [Priority LegendOptions]
-> [Priority TitleOptions]
-> HudOptions
HudOptions [] [] [] []

-- | The official hud options.
--
-- - A fixed chart aspect (width:height) of 1.5
--
-- - An x axis at the bottom and y axis at the left.
--
-- - The default tick style for each axis of an axis bar, tick glyphs (or marks), automated tick labels, and tick (or grid) lines.
--
-- - A high 'Priority' (and thus inner), low-opacity frame, representing the data area of the chart.
--
-- - A low priority (outer), transparent frame, providing some padding around the chart.
defaultHudOptions :: HudOptions
defaultHudOptions :: HudOptions
defaultHudOptions =
  [Priority AxisOptions]
-> [Priority FrameOptions]
-> [Priority LegendOptions]
-> [Priority TitleOptions]
-> HudOptions
HudOptions
    [ Double -> AxisOptions -> Priority AxisOptions
forall a. Double -> a -> Priority a
Priority Double
5 AxisOptions
defaultXAxisOptions,
      Double -> AxisOptions -> Priority AxisOptions
forall a. Double -> a -> Priority a
Priority Double
5 AxisOptions
defaultYAxisOptions
    ]
    [ Double -> FrameOptions -> Priority FrameOptions
forall a. Double -> a -> Priority a
Priority Double
1 (FrameOptions
defaultFrameOptions FrameOptions -> (FrameOptions -> FrameOptions) -> FrameOptions
forall a b. a -> (a -> b) -> b
& Optic
  A_Lens
  NoIx
  FrameOptions
  FrameOptions
  HudChartSection
  HudChartSection
-> HudChartSection -> FrameOptions -> FrameOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic
  A_Lens
  NoIx
  FrameOptions
  FrameOptions
  HudChartSection
  HudChartSection
#anchorTo HudChartSection
CanvasStyleSection),
      Double -> FrameOptions -> Priority FrameOptions
forall a. Double -> a -> Priority a
Priority Double
20 (FrameOptions
defaultFrameOptions FrameOptions -> (FrameOptions -> FrameOptions) -> FrameOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx FrameOptions FrameOptions Double Double
-> Double -> FrameOptions -> FrameOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx FrameOptions FrameOptions Double Double
#buffer Double
0.04 FrameOptions -> (FrameOptions -> FrameOptions) -> FrameOptions
forall a b. a -> (a -> b) -> b
& Optic
  A_Lens NoIx FrameOptions FrameOptions (Maybe Style) (Maybe Style)
-> Maybe Style -> FrameOptions -> FrameOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic
  A_Lens NoIx FrameOptions FrameOptions (Maybe Style) (Maybe Style)
#frame (Style -> Maybe Style
forall a. a -> Maybe a
Just Style
clear))
    ]
    []
    []

-- | alter a colour with a function
colourHudOptions :: (Colour -> Colour) -> HudOptions -> HudOptions
colourHudOptions :: (Colour -> Colour) -> HudOptions -> HudOptions
colourHudOptions Colour -> Colour
f HudOptions
o =
  HudOptions
o
    HudOptions -> (HudOptions -> HudOptions) -> HudOptions
forall a b. a -> (a -> b) -> b
& Optic
  A_Traversal
  (Int : NoIx)
  HudOptions
  HudOptions
  FrameOptions
  FrameOptions
-> (FrameOptions -> FrameOptions) -> HudOptions -> HudOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over (Optic
  A_Lens
  NoIx
  HudOptions
  HudOptions
  [Priority FrameOptions]
  [Priority FrameOptions]
#frames Optic
  A_Lens
  NoIx
  HudOptions
  HudOptions
  [Priority FrameOptions]
  [Priority FrameOptions]
-> Optic
     A_Traversal
     (Int : NoIx)
     [Priority FrameOptions]
     [Priority FrameOptions]
     (Priority FrameOptions)
     (Priority FrameOptions)
-> Optic
     A_Traversal
     (Int : NoIx)
     HudOptions
     HudOptions
     (Priority FrameOptions)
     (Priority FrameOptions)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Traversal
  (Int : NoIx)
  [Priority FrameOptions]
  [Priority FrameOptions]
  (Priority FrameOptions)
  (Priority FrameOptions)
forall i s t a b. Each i s t a b => IxTraversal i s t a b
each Optic
  A_Traversal
  (Int : NoIx)
  HudOptions
  HudOptions
  (Priority FrameOptions)
  (Priority FrameOptions)
-> Optic
     A_Lens
     NoIx
     (Priority FrameOptions)
     (Priority FrameOptions)
     FrameOptions
     FrameOptions
-> Optic
     A_Traversal
     (Int : NoIx)
     HudOptions
     HudOptions
     FrameOptions
     FrameOptions
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  NoIx
  (Priority FrameOptions)
  (Priority FrameOptions)
  FrameOptions
  FrameOptions
#item) FrameOptions -> FrameOptions
fFrame
    HudOptions -> (HudOptions -> HudOptions) -> HudOptions
forall a b. a -> (a -> b) -> b
& Optic A_Traversal (Int : NoIx) HudOptions HudOptions Colour Colour
-> (Colour -> Colour) -> HudOptions -> HudOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over (Optic
  A_Lens
  NoIx
  HudOptions
  HudOptions
  [Priority TitleOptions]
  [Priority TitleOptions]
#titles Optic
  A_Lens
  NoIx
  HudOptions
  HudOptions
  [Priority TitleOptions]
  [Priority TitleOptions]
-> Optic
     A_Traversal
     (Int : NoIx)
     [Priority TitleOptions]
     [Priority TitleOptions]
     (Priority TitleOptions)
     (Priority TitleOptions)
-> Optic
     A_Traversal
     (Int : NoIx)
     HudOptions
     HudOptions
     (Priority TitleOptions)
     (Priority TitleOptions)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Traversal
  (Int : NoIx)
  [Priority TitleOptions]
  [Priority TitleOptions]
  (Priority TitleOptions)
  (Priority TitleOptions)
forall i s t a b. Each i s t a b => IxTraversal i s t a b
each Optic
  A_Traversal
  (Int : NoIx)
  HudOptions
  HudOptions
  (Priority TitleOptions)
  (Priority TitleOptions)
-> Optic
     A_Lens
     NoIx
     (Priority TitleOptions)
     (Priority TitleOptions)
     TitleOptions
     TitleOptions
-> Optic
     A_Traversal
     (Int : NoIx)
     HudOptions
     HudOptions
     TitleOptions
     TitleOptions
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  NoIx
  (Priority TitleOptions)
  (Priority TitleOptions)
  TitleOptions
  TitleOptions
#item Optic
  A_Traversal
  (Int : NoIx)
  HudOptions
  HudOptions
  TitleOptions
  TitleOptions
-> Optic A_Lens NoIx TitleOptions TitleOptions Style Style
-> Optic A_Traversal (Int : NoIx) HudOptions HudOptions Style Style
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx TitleOptions TitleOptions Style Style
#style Optic A_Traversal (Int : NoIx) HudOptions HudOptions Style Style
-> Optic A_Lens NoIx Style Style Colour Colour
-> Optic
     A_Traversal (Int : NoIx) HudOptions HudOptions Colour Colour
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Style Style Colour Colour
#color) Colour -> Colour
f
    HudOptions -> (HudOptions -> HudOptions) -> HudOptions
forall a b. a -> (a -> b) -> b
& Optic
  A_Traversal
  (Int : NoIx)
  HudOptions
  HudOptions
  AxisOptions
  AxisOptions
-> (AxisOptions -> AxisOptions) -> HudOptions -> HudOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over (Optic
  A_Lens
  NoIx
  HudOptions
  HudOptions
  [Priority AxisOptions]
  [Priority AxisOptions]
#axes Optic
  A_Lens
  NoIx
  HudOptions
  HudOptions
  [Priority AxisOptions]
  [Priority AxisOptions]
-> Optic
     A_Traversal
     (Int : NoIx)
     [Priority AxisOptions]
     [Priority AxisOptions]
     (Priority AxisOptions)
     (Priority AxisOptions)
-> Optic
     A_Traversal
     (Int : NoIx)
     HudOptions
     HudOptions
     (Priority AxisOptions)
     (Priority AxisOptions)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Traversal
  (Int : NoIx)
  [Priority AxisOptions]
  [Priority AxisOptions]
  (Priority AxisOptions)
  (Priority AxisOptions)
forall i s t a b. Each i s t a b => IxTraversal i s t a b
each Optic
  A_Traversal
  (Int : NoIx)
  HudOptions
  HudOptions
  (Priority AxisOptions)
  (Priority AxisOptions)
-> Optic
     A_Lens
     NoIx
     (Priority AxisOptions)
     (Priority AxisOptions)
     AxisOptions
     AxisOptions
-> Optic
     A_Traversal
     (Int : NoIx)
     HudOptions
     HudOptions
     AxisOptions
     AxisOptions
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  NoIx
  (Priority AxisOptions)
  (Priority AxisOptions)
  AxisOptions
  AxisOptions
#item) AxisOptions -> AxisOptions
fAxis
    HudOptions -> (HudOptions -> HudOptions) -> HudOptions
forall a b. a -> (a -> b) -> b
& Optic
  A_Traversal
  (Int : NoIx)
  HudOptions
  HudOptions
  LegendOptions
  LegendOptions
-> (LegendOptions -> LegendOptions) -> HudOptions -> HudOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over (Optic
  A_Lens
  NoIx
  HudOptions
  HudOptions
  [Priority LegendOptions]
  [Priority LegendOptions]
#legends Optic
  A_Lens
  NoIx
  HudOptions
  HudOptions
  [Priority LegendOptions]
  [Priority LegendOptions]
-> Optic
     A_Traversal
     (Int : NoIx)
     [Priority LegendOptions]
     [Priority LegendOptions]
     (Priority LegendOptions)
     (Priority LegendOptions)
-> Optic
     A_Traversal
     (Int : NoIx)
     HudOptions
     HudOptions
     (Priority LegendOptions)
     (Priority LegendOptions)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Traversal
  (Int : NoIx)
  [Priority LegendOptions]
  [Priority LegendOptions]
  (Priority LegendOptions)
  (Priority LegendOptions)
forall i s t a b. Each i s t a b => IxTraversal i s t a b
each Optic
  A_Traversal
  (Int : NoIx)
  HudOptions
  HudOptions
  (Priority LegendOptions)
  (Priority LegendOptions)
-> Optic
     A_Lens
     NoIx
     (Priority LegendOptions)
     (Priority LegendOptions)
     LegendOptions
     LegendOptions
-> Optic
     A_Traversal
     (Int : NoIx)
     HudOptions
     HudOptions
     LegendOptions
     LegendOptions
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  NoIx
  (Priority LegendOptions)
  (Priority LegendOptions)
  LegendOptions
  LegendOptions
#item) LegendOptions -> LegendOptions
fLegend
  where
    fAxis :: AxisOptions -> AxisOptions
    fAxis :: AxisOptions -> AxisOptions
fAxis AxisOptions
a =
      AxisOptions
a
        AxisOptions -> (AxisOptions -> AxisOptions) -> AxisOptions
forall a b. a -> (a -> b) -> b
& Optic An_AffineTraversal NoIx AxisOptions AxisOptions Colour Colour
-> (Colour -> Colour) -> AxisOptions -> AxisOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over (Optic
  A_Lens NoIx AxisOptions AxisOptions (Maybe AxisBar) (Maybe AxisBar)
#axisBar Optic
  A_Lens NoIx AxisOptions AxisOptions (Maybe AxisBar) (Maybe AxisBar)
-> Optic' A_Lens NoIx AxisBar Style
-> Optic
     An_AffineTraversal NoIx AxisOptions AxisOptions Style Style
forall (is :: IxList) (js :: IxList) (ks :: IxList) k k' l m s t u
       v a b.
(AppendIndices is js ks, JoinKinds k A_Prism k',
 JoinKinds k' l m) =>
Optic k is s t (Maybe u) (Maybe v)
-> Optic l js u v a b -> Optic m ks s t a b
%? Optic' A_Lens NoIx AxisBar Style
#style Optic An_AffineTraversal NoIx AxisOptions AxisOptions Style Style
-> Optic A_Lens NoIx Style Style Colour Colour
-> Optic
     An_AffineTraversal NoIx AxisOptions AxisOptions Colour Colour
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Style Style Colour Colour
#color) Colour -> Colour
f
        AxisOptions -> (AxisOptions -> AxisOptions) -> AxisOptions
forall a b. a -> (a -> b) -> b
& Optic An_AffineTraversal NoIx AxisOptions AxisOptions Colour Colour
-> (Colour -> Colour) -> AxisOptions -> AxisOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over (Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
#ticks Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
-> Optic' A_Lens NoIx Ticks (Maybe TickStyle)
-> Optic
     A_Lens
     NoIx
     AxisOptions
     AxisOptions
     (Maybe TickStyle)
     (Maybe TickStyle)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic' A_Lens NoIx Ticks (Maybe TickStyle)
#glyphTick Optic
  A_Lens
  NoIx
  AxisOptions
  AxisOptions
  (Maybe TickStyle)
  (Maybe TickStyle)
-> Optic' A_Lens NoIx TickStyle Style
-> Optic
     An_AffineTraversal NoIx AxisOptions AxisOptions Style Style
forall (is :: IxList) (js :: IxList) (ks :: IxList) k k' l m s t u
       v a b.
(AppendIndices is js ks, JoinKinds k A_Prism k',
 JoinKinds k' l m) =>
Optic k is s t (Maybe u) (Maybe v)
-> Optic l js u v a b -> Optic m ks s t a b
%? Optic' A_Lens NoIx TickStyle Style
#style Optic An_AffineTraversal NoIx AxisOptions AxisOptions Style Style
-> Optic A_Lens NoIx Style Style Colour Colour
-> Optic
     An_AffineTraversal NoIx AxisOptions AxisOptions Colour Colour
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Style Style Colour Colour
#color) Colour -> Colour
f
        AxisOptions -> (AxisOptions -> AxisOptions) -> AxisOptions
forall a b. a -> (a -> b) -> b
& Optic An_AffineTraversal NoIx AxisOptions AxisOptions Colour Colour
-> (Colour -> Colour) -> AxisOptions -> AxisOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over (Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
#ticks Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
-> Optic' A_Lens NoIx Ticks (Maybe TickStyle)
-> Optic
     A_Lens
     NoIx
     AxisOptions
     AxisOptions
     (Maybe TickStyle)
     (Maybe TickStyle)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic' A_Lens NoIx Ticks (Maybe TickStyle)
#glyphTick Optic
  A_Lens
  NoIx
  AxisOptions
  AxisOptions
  (Maybe TickStyle)
  (Maybe TickStyle)
-> Optic' A_Lens NoIx TickStyle Style
-> Optic
     An_AffineTraversal NoIx AxisOptions AxisOptions Style Style
forall (is :: IxList) (js :: IxList) (ks :: IxList) k k' l m s t u
       v a b.
(AppendIndices is js ks, JoinKinds k A_Prism k',
 JoinKinds k' l m) =>
Optic k is s t (Maybe u) (Maybe v)
-> Optic l js u v a b -> Optic m ks s t a b
%? Optic' A_Lens NoIx TickStyle Style
#style Optic An_AffineTraversal NoIx AxisOptions AxisOptions Style Style
-> Optic A_Lens NoIx Style Style Colour Colour
-> Optic
     An_AffineTraversal NoIx AxisOptions AxisOptions Colour Colour
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Style Style Colour Colour
#borderColor) Colour -> Colour
f
        AxisOptions -> (AxisOptions -> AxisOptions) -> AxisOptions
forall a b. a -> (a -> b) -> b
& Optic An_AffineTraversal NoIx AxisOptions AxisOptions Colour Colour
-> (Colour -> Colour) -> AxisOptions -> AxisOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over (Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
#ticks Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
-> Optic' A_Lens NoIx Ticks (Maybe TickStyle)
-> Optic
     A_Lens
     NoIx
     AxisOptions
     AxisOptions
     (Maybe TickStyle)
     (Maybe TickStyle)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic' A_Lens NoIx Ticks (Maybe TickStyle)
#textTick Optic
  A_Lens
  NoIx
  AxisOptions
  AxisOptions
  (Maybe TickStyle)
  (Maybe TickStyle)
-> Optic' A_Lens NoIx TickStyle Style
-> Optic
     An_AffineTraversal NoIx AxisOptions AxisOptions Style Style
forall (is :: IxList) (js :: IxList) (ks :: IxList) k k' l m s t u
       v a b.
(AppendIndices is js ks, JoinKinds k A_Prism k',
 JoinKinds k' l m) =>
Optic k is s t (Maybe u) (Maybe v)
-> Optic l js u v a b -> Optic m ks s t a b
%? Optic' A_Lens NoIx TickStyle Style
#style Optic An_AffineTraversal NoIx AxisOptions AxisOptions Style Style
-> Optic A_Lens NoIx Style Style Colour Colour
-> Optic
     An_AffineTraversal NoIx AxisOptions AxisOptions Colour Colour
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Style Style Colour Colour
#color) Colour -> Colour
f
        AxisOptions -> (AxisOptions -> AxisOptions) -> AxisOptions
forall a b. a -> (a -> b) -> b
& Optic An_AffineTraversal NoIx AxisOptions AxisOptions Colour Colour
-> (Colour -> Colour) -> AxisOptions -> AxisOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over
          (Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
#ticks Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
-> Optic' A_Lens NoIx Ticks (Maybe TickStyle)
-> Optic
     A_Lens
     NoIx
     AxisOptions
     AxisOptions
     (Maybe TickStyle)
     (Maybe TickStyle)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic' A_Lens NoIx Ticks (Maybe TickStyle)
#lineTick Optic
  A_Lens
  NoIx
  AxisOptions
  AxisOptions
  (Maybe TickStyle)
  (Maybe TickStyle)
-> Optic' A_Lens NoIx TickStyle Style
-> Optic
     An_AffineTraversal NoIx AxisOptions AxisOptions Style Style
forall (is :: IxList) (js :: IxList) (ks :: IxList) k k' l m s t u
       v a b.
(AppendIndices is js ks, JoinKinds k A_Prism k',
 JoinKinds k' l m) =>
Optic k is s t (Maybe u) (Maybe v)
-> Optic l js u v a b -> Optic m ks s t a b
%? Optic' A_Lens NoIx TickStyle Style
#style Optic An_AffineTraversal NoIx AxisOptions AxisOptions Style Style
-> Optic A_Lens NoIx Style Style Colour Colour
-> Optic
     An_AffineTraversal NoIx AxisOptions AxisOptions Colour Colour
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Style Style Colour Colour
#color)
          Colour -> Colour
f
    fLegend :: LegendOptions -> LegendOptions
    fLegend :: LegendOptions -> LegendOptions
fLegend LegendOptions
a =
      LegendOptions
a
        LegendOptions -> (LegendOptions -> LegendOptions) -> LegendOptions
forall a b. a -> (a -> b) -> b
& Optic' A_Lens NoIx LegendOptions Style
-> (Style -> Style) -> LegendOptions -> LegendOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over Optic' A_Lens NoIx LegendOptions Style
#textStyle (Optic A_Lens NoIx Style Style Colour Colour
-> (Colour -> Colour) -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over Optic A_Lens NoIx Style Style Colour Colour
#color Colour -> Colour
f)
        LegendOptions -> (LegendOptions -> LegendOptions) -> LegendOptions
forall a b. a -> (a -> b) -> b
& Optic
  A_Lens NoIx LegendOptions LegendOptions (Maybe Style) (Maybe Style)
-> (Maybe Style -> Maybe Style) -> LegendOptions -> LegendOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over Optic
  A_Lens NoIx LegendOptions LegendOptions (Maybe Style) (Maybe Style)
#frame ((Style -> Style) -> Maybe Style -> Maybe Style
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Optic A_Lens NoIx Style Style Colour Colour
-> (Colour -> Colour) -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over Optic A_Lens NoIx Style Style Colour Colour
#color Colour -> Colour
f (Style -> Style) -> (Style -> Style) -> Style -> Style
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Optic A_Lens NoIx Style Style Colour Colour
-> (Colour -> Colour) -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over Optic A_Lens NoIx Style Style Colour Colour
#borderColor Colour -> Colour
f))
    fFrame :: FrameOptions -> FrameOptions
    fFrame :: FrameOptions -> FrameOptions
fFrame FrameOptions
a =
      FrameOptions
a
        FrameOptions -> (FrameOptions -> FrameOptions) -> FrameOptions
forall a b. a -> (a -> b) -> b
& Optic An_AffineTraversal NoIx FrameOptions FrameOptions Style Style
-> (Style -> Style) -> FrameOptions -> FrameOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over (Optic
  A_Lens NoIx FrameOptions FrameOptions (Maybe Style) (Maybe Style)
#frame Optic
  A_Lens NoIx FrameOptions FrameOptions (Maybe Style) (Maybe Style)
-> Optic A_Prism NoIx (Maybe Style) (Maybe Style) Style Style
-> Optic
     An_AffineTraversal NoIx FrameOptions FrameOptions Style Style
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Prism NoIx (Maybe Style) (Maybe Style) Style Style
forall a b. Prism (Maybe a) (Maybe b) a b
_Just) (Optic A_Lens NoIx Style Style Colour Colour
-> (Colour -> Colour) -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over Optic A_Lens NoIx Style Style Colour Colour
#color Colour -> Colour
f (Style -> Style) -> (Style -> Style) -> Style -> Style
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Optic A_Lens NoIx Style Style Colour Colour
-> (Colour -> Colour) -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over Optic A_Lens NoIx Style Style Colour Colour
#borderColor Colour -> Colour
f)

-- | axis options
data AxisOptions = AxisOptions
  { AxisOptions -> Maybe AxisBar
axisBar :: Maybe AxisBar,
    AxisOptions -> Maybe Adjustments
adjustments :: Maybe Adjustments,
    AxisOptions -> Ticks
ticks :: Ticks,
    AxisOptions -> Place
place :: Place
  }
  deriving (AxisOptions -> AxisOptions -> Bool
(AxisOptions -> AxisOptions -> Bool)
-> (AxisOptions -> AxisOptions -> Bool) -> Eq AxisOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AxisOptions -> AxisOptions -> Bool
== :: AxisOptions -> AxisOptions -> Bool
$c/= :: AxisOptions -> AxisOptions -> Bool
/= :: AxisOptions -> AxisOptions -> Bool
Eq, Int -> AxisOptions -> ShowS
[AxisOptions] -> ShowS
AxisOptions -> String
(Int -> AxisOptions -> ShowS)
-> (AxisOptions -> String)
-> ([AxisOptions] -> ShowS)
-> Show AxisOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AxisOptions -> ShowS
showsPrec :: Int -> AxisOptions -> ShowS
$cshow :: AxisOptions -> String
show :: AxisOptions -> String
$cshowList :: [AxisOptions] -> ShowS
showList :: [AxisOptions] -> ShowS
Show, (forall x. AxisOptions -> Rep AxisOptions x)
-> (forall x. Rep AxisOptions x -> AxisOptions)
-> Generic AxisOptions
forall x. Rep AxisOptions x -> AxisOptions
forall x. AxisOptions -> Rep AxisOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. AxisOptions -> Rep AxisOptions x
from :: forall x. AxisOptions -> Rep AxisOptions x
$cto :: forall x. Rep AxisOptions x -> AxisOptions
to :: forall x. Rep AxisOptions x -> AxisOptions
Generic)

-- | The official X-axis
defaultXAxisOptions :: AxisOptions
defaultXAxisOptions :: AxisOptions
defaultXAxisOptions = Maybe AxisBar -> Maybe Adjustments -> Ticks -> Place -> AxisOptions
AxisOptions (AxisBar -> Maybe AxisBar
forall a. a -> Maybe a
Just AxisBar
defaultAxisBar) (Adjustments -> Maybe Adjustments
forall a. a -> Maybe a
Just Adjustments
defaultAdjustments) Ticks
defaultXTicks Place
PlaceBottom

-- | The official Y-axis
defaultYAxisOptions :: AxisOptions
defaultYAxisOptions :: AxisOptions
defaultYAxisOptions = Maybe AxisBar -> Maybe Adjustments -> Ticks -> Place -> AxisOptions
AxisOptions (AxisBar -> Maybe AxisBar
forall a. a -> Maybe a
Just AxisBar
defaultAxisBar) (Adjustments -> Maybe Adjustments
forall a. a -> Maybe a
Just Adjustments
defaultAdjustments) Ticks
defaultYTicks Place
PlaceLeft

-- | The bar on an axis representing the x or y plane.
--
-- >>> defaultAxisBar
-- AxisBar {style = Style {size = 6.0e-2, borderSize = 0.0, color = Colour 0.05 0.05 0.05 0.40, borderColor = Colour 0.00 0.00 0.00 0.00, scaleP = NoScaleP, textAnchor = AnchorMiddle, rotation = Nothing, translate = Nothing, escapeText = EscapeText, frame = Nothing, lineCap = Nothing, lineJoin = Nothing, dasharray = Nothing, dashoffset = Nothing, hsize = 0.6, vsize = 1.1, vshift = -0.25, glyphShape = SquareGlyph}, size = 4.0e-3, buffer = 1.0e-2, overhang = 2.0e-3, anchorTo = CanvasSection}
data AxisBar = AxisBar
  { AxisBar -> Style
style :: Style,
    AxisBar -> Double
size :: Double,
    AxisBar -> Double
buffer :: Double,
    -- | extension over the edges of the axis range
    AxisBar -> Double
overhang :: Double,
    -- | Which hud-chart section to anchor to
    AxisBar -> HudChartSection
anchorTo :: HudChartSection
  }
  deriving (Int -> AxisBar -> ShowS
[AxisBar] -> ShowS
AxisBar -> String
(Int -> AxisBar -> ShowS)
-> (AxisBar -> String) -> ([AxisBar] -> ShowS) -> Show AxisBar
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AxisBar -> ShowS
showsPrec :: Int -> AxisBar -> ShowS
$cshow :: AxisBar -> String
show :: AxisBar -> String
$cshowList :: [AxisBar] -> ShowS
showList :: [AxisBar] -> ShowS
Show, AxisBar -> AxisBar -> Bool
(AxisBar -> AxisBar -> Bool)
-> (AxisBar -> AxisBar -> Bool) -> Eq AxisBar
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AxisBar -> AxisBar -> Bool
== :: AxisBar -> AxisBar -> Bool
$c/= :: AxisBar -> AxisBar -> Bool
/= :: AxisBar -> AxisBar -> Bool
Eq, (forall x. AxisBar -> Rep AxisBar x)
-> (forall x. Rep AxisBar x -> AxisBar) -> Generic AxisBar
forall x. Rep AxisBar x -> AxisBar
forall x. AxisBar -> Rep AxisBar x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. AxisBar -> Rep AxisBar x
from :: forall x. AxisBar -> Rep AxisBar x
$cto :: forall x. Rep AxisBar x -> AxisBar
to :: forall x. Rep AxisBar x -> AxisBar
Generic)

-- | The official axis bar
defaultAxisBar :: AxisBar
defaultAxisBar :: AxisBar
defaultAxisBar = Style -> Double -> Double -> Double -> HudChartSection -> AxisBar
AxisBar (Style
defaultRectStyle Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Double Double
-> Double -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Double Double
#borderSize Double
0 Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Colour Colour
-> Colour -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Colour Colour
#borderColor Colour
transparent Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Colour Colour
-> Colour -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Colour Colour
#color (Optic A_Lens NoIx Colour Colour Double Double
-> Double -> Colour -> Colour
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Colour Colour Double Double
opac' Double
0.4 Colour
dark)) Double
0.004 Double
0.01 Double
0.002 HudChartSection
CanvasSection

-- | Options for titles.  Defaults to center aligned, and placed at Top of the hud
--
-- >>> defaultTitleOptions "title"
-- TitleOptions {text = "title", style = Style {size = 0.12, borderSize = 1.0e-2, color = Colour 0.05 0.05 0.05 1.00, borderColor = Colour 0.02 0.29 0.48 1.00, scaleP = NoScaleP, textAnchor = AnchorMiddle, rotation = Nothing, translate = Nothing, escapeText = EscapeText, frame = Nothing, lineCap = Nothing, lineJoin = Nothing, dasharray = Nothing, dashoffset = Nothing, hsize = 0.6, vsize = 1.1, vshift = -0.25, glyphShape = SquareGlyph}, place = PlaceTop, anchoring = 0.0, buffer = 4.0e-2}
data TitleOptions = TitleOptions
  { TitleOptions -> Text
text :: Text,
    TitleOptions -> Style
style :: Style,
    TitleOptions -> Place
place :: Place,
    TitleOptions -> Double
anchoring :: Double,
    TitleOptions -> Double
buffer :: Double
  }
  deriving (Int -> TitleOptions -> ShowS
[TitleOptions] -> ShowS
TitleOptions -> String
(Int -> TitleOptions -> ShowS)
-> (TitleOptions -> String)
-> ([TitleOptions] -> ShowS)
-> Show TitleOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TitleOptions -> ShowS
showsPrec :: Int -> TitleOptions -> ShowS
$cshow :: TitleOptions -> String
show :: TitleOptions -> String
$cshowList :: [TitleOptions] -> ShowS
showList :: [TitleOptions] -> ShowS
Show, TitleOptions -> TitleOptions -> Bool
(TitleOptions -> TitleOptions -> Bool)
-> (TitleOptions -> TitleOptions -> Bool) -> Eq TitleOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TitleOptions -> TitleOptions -> Bool
== :: TitleOptions -> TitleOptions -> Bool
$c/= :: TitleOptions -> TitleOptions -> Bool
/= :: TitleOptions -> TitleOptions -> Bool
Eq, (forall x. TitleOptions -> Rep TitleOptions x)
-> (forall x. Rep TitleOptions x -> TitleOptions)
-> Generic TitleOptions
forall x. Rep TitleOptions x -> TitleOptions
forall x. TitleOptions -> Rep TitleOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TitleOptions -> Rep TitleOptions x
from :: forall x. TitleOptions -> Rep TitleOptions x
$cto :: forall x. Rep TitleOptions x -> TitleOptions
to :: forall x. Rep TitleOptions x -> TitleOptions
Generic)

-- | The official hud title
defaultTitleOptions :: Text -> TitleOptions
defaultTitleOptions :: Text -> TitleOptions
defaultTitleOptions Text
txt =
  Text -> Style -> Place -> Double -> Double -> TitleOptions
TitleOptions
    Text
txt
    ( Style
defaultTextStyle
        Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Double Double
-> Double -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Double Double
#size Double
0.12
    )
    Place
PlaceTop
    Double
0
    Double
0.04

-- | axis tick markings
--
-- >>> defaultXTicks
-- Ticks {tick = TickRound (FormatN {fstyle = FSCommaPrec, sigFigs = Just 1, maxDistinguishIterations = 4, addLPad = True, cutRightZeros = True}) 5 TickExtend, glyphTick = Just (TickStyle {style = Style {size = 3.0e-2, borderSize = 4.0e-3, color = Colour 0.05 0.05 0.05 0.40, borderColor = Colour 0.05 0.05 0.05 0.40, scaleP = ScalePY, textAnchor = AnchorMiddle, rotation = Nothing, translate = Nothing, escapeText = EscapeText, frame = Nothing, lineCap = Nothing, lineJoin = Nothing, dasharray = Nothing, dashoffset = Nothing, hsize = 0.6, vsize = 1.1, vshift = -0.25, glyphShape = VLineGlyph}, anchorTo = CanvasSection, buffer = 1.0e-2}), textTick = Just (TickStyle {style = Style {size = 4.0e-2, borderSize = 1.0e-2, color = Colour 0.05 0.05 0.05 1.00, borderColor = Colour 0.02 0.29 0.48 1.00, scaleP = NoScaleP, textAnchor = AnchorMiddle, rotation = Nothing, translate = Nothing, escapeText = EscapeText, frame = Nothing, lineCap = Nothing, lineJoin = Nothing, dasharray = Nothing, dashoffset = Nothing, hsize = 0.6, vsize = 1.1, vshift = -0.25, glyphShape = SquareGlyph}, anchorTo = HudStyleSection, buffer = 1.0e-2}), lineTick = Just (TickStyle {style = Style {size = 5.0e-3, borderSize = 1.0e-2, color = Colour 0.05 0.05 0.05 0.05, borderColor = Colour 0.02 0.29 0.48 1.00, scaleP = NoScaleP, textAnchor = AnchorMiddle, rotation = Nothing, translate = Nothing, escapeText = EscapeText, frame = Nothing, lineCap = Nothing, lineJoin = Nothing, dasharray = Nothing, dashoffset = Nothing, hsize = 0.6, vsize = 1.1, vshift = -0.25, glyphShape = SquareGlyph}, anchorTo = CanvasSection, buffer = 0.0})}
data Ticks = Ticks
  { Ticks -> Tick
tick :: Tick,
    Ticks -> Maybe TickStyle
glyphTick :: Maybe TickStyle,
    Ticks -> Maybe TickStyle
textTick :: Maybe TickStyle,
    Ticks -> Maybe TickStyle
lineTick :: Maybe TickStyle
  }
  deriving (Int -> Ticks -> ShowS
[Ticks] -> ShowS
Ticks -> String
(Int -> Ticks -> ShowS)
-> (Ticks -> String) -> ([Ticks] -> ShowS) -> Show Ticks
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Ticks -> ShowS
showsPrec :: Int -> Ticks -> ShowS
$cshow :: Ticks -> String
show :: Ticks -> String
$cshowList :: [Ticks] -> ShowS
showList :: [Ticks] -> ShowS
Show, Ticks -> Ticks -> Bool
(Ticks -> Ticks -> Bool) -> (Ticks -> Ticks -> Bool) -> Eq Ticks
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Ticks -> Ticks -> Bool
== :: Ticks -> Ticks -> Bool
$c/= :: Ticks -> Ticks -> Bool
/= :: Ticks -> Ticks -> Bool
Eq, (forall x. Ticks -> Rep Ticks x)
-> (forall x. Rep Ticks x -> Ticks) -> Generic Ticks
forall x. Rep Ticks x -> Ticks
forall x. Ticks -> Rep Ticks x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Ticks -> Rep Ticks x
from :: forall x. Ticks -> Rep Ticks x
$cto :: forall x. Rep Ticks x -> Ticks
to :: forall x. Rep Ticks x -> Ticks
Generic)

-- | Common elements across all tick types.
data TickStyle = TickStyle
  { TickStyle -> Style
style :: Style,
    TickStyle -> HudChartSection
anchorTo :: HudChartSection,
    TickStyle -> Double
buffer :: Double
  }
  deriving (Int -> TickStyle -> ShowS
[TickStyle] -> ShowS
TickStyle -> String
(Int -> TickStyle -> ShowS)
-> (TickStyle -> String)
-> ([TickStyle] -> ShowS)
-> Show TickStyle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TickStyle -> ShowS
showsPrec :: Int -> TickStyle -> ShowS
$cshow :: TickStyle -> String
show :: TickStyle -> String
$cshowList :: [TickStyle] -> ShowS
showList :: [TickStyle] -> ShowS
Show, TickStyle -> TickStyle -> Bool
(TickStyle -> TickStyle -> Bool)
-> (TickStyle -> TickStyle -> Bool) -> Eq TickStyle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TickStyle -> TickStyle -> Bool
== :: TickStyle -> TickStyle -> Bool
$c/= :: TickStyle -> TickStyle -> Bool
/= :: TickStyle -> TickStyle -> Bool
Eq, (forall x. TickStyle -> Rep TickStyle x)
-> (forall x. Rep TickStyle x -> TickStyle) -> Generic TickStyle
forall x. Rep TickStyle x -> TickStyle
forall x. TickStyle -> Rep TickStyle x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TickStyle -> Rep TickStyle x
from :: forall x. TickStyle -> Rep TickStyle x
$cto :: forall x. Rep TickStyle x -> TickStyle
to :: forall x. Rep TickStyle x -> TickStyle
Generic)

-- | The official glyph tick
defaultGlyphTickStyleX :: TickStyle
defaultGlyphTickStyleX :: TickStyle
defaultGlyphTickStyleX =
  Style -> HudChartSection -> Double -> TickStyle
TickStyle
    ( Style
defaultGlyphStyle
        Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Double Double
-> Double -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Double Double
#borderSize Double
0.004
        Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style GlyphShape GlyphShape
-> GlyphShape -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style GlyphShape GlyphShape
#glyphShape GlyphShape
VLineGlyph
        Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Colour Colour
-> Colour -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Colour Colour
#color (Optic A_Lens NoIx Colour Colour Double Double
-> Double -> Colour -> Colour
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Colour Colour Double Double
opac' Double
0.4 Colour
dark)
        Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Colour Colour
-> Colour -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Colour Colour
#borderColor (Optic A_Lens NoIx Colour Colour Double Double
-> Double -> Colour -> Colour
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Colour Colour Double Double
opac' Double
0.4 Colour
dark)
        Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style ScaleP ScaleP
-> ScaleP -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style ScaleP ScaleP
#scaleP ScaleP
ScalePY
    )
    HudChartSection
CanvasSection
    Double
0.01

-- | The official glyph tick
defaultGlyphTickStyleY :: TickStyle
defaultGlyphTickStyleY :: TickStyle
defaultGlyphTickStyleY =
  Style -> HudChartSection -> Double -> TickStyle
TickStyle
    ( Style
defaultGlyphStyle
        Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Double Double
-> Double -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Double Double
#borderSize Double
0.004
        Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style GlyphShape GlyphShape
-> GlyphShape -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style GlyphShape GlyphShape
#glyphShape GlyphShape
HLineGlyph
        Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Colour Colour
-> Colour -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Colour Colour
#color (Optic A_Lens NoIx Colour Colour Double Double
-> Double -> Colour -> Colour
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Colour Colour Double Double
opac' Double
0.4 Colour
dark)
        Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Colour Colour
-> Colour -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Colour Colour
#borderColor (Optic A_Lens NoIx Colour Colour Double Double
-> Double -> Colour -> Colour
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Colour Colour Double Double
opac' Double
0.4 Colour
dark)
        Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style ScaleP ScaleP
-> ScaleP -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style ScaleP ScaleP
#scaleP ScaleP
ScalePX
    )
    HudChartSection
CanvasSection
    Double
0.01

-- | The official text tick
defaultTextTick :: TickStyle
defaultTextTick :: TickStyle
defaultTextTick =
  Style -> HudChartSection -> Double -> TickStyle
TickStyle
    (Style
defaultTextStyle Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Double Double
-> Double -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Double Double
#size Double
0.04)
    HudChartSection
HudStyleSection
    Double
0.01

-- | The official line tick
defaultLineTick :: TickStyle
defaultLineTick :: TickStyle
defaultLineTick =
  Style -> HudChartSection -> Double -> TickStyle
TickStyle
    ( Style
defaultLineStyle
        Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Double Double
-> Double -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Double Double
#size Double
5.0e-3
        Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Double Double
-> Double -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (Optic A_Lens NoIx Style Style Colour Colour
#color Optic A_Lens NoIx Style Style Colour Colour
-> Optic A_Lens NoIx Colour Colour Double Double
-> Optic A_Lens NoIx Style Style Double Double
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Colour Colour Double Double
opac') Double
0.05
    )
    HudChartSection
CanvasSection
    Double
0

-- | The official X-axis tick
defaultXTicks :: Ticks
defaultXTicks :: Ticks
defaultXTicks =
  Tick
-> Maybe TickStyle -> Maybe TickStyle -> Maybe TickStyle -> Ticks
Ticks
    Tick
defaultTick
    (TickStyle -> Maybe TickStyle
forall a. a -> Maybe a
Just TickStyle
defaultGlyphTickStyleX)
    (TickStyle -> Maybe TickStyle
forall a. a -> Maybe a
Just TickStyle
defaultTextTick)
    (TickStyle -> Maybe TickStyle
forall a. a -> Maybe a
Just TickStyle
defaultLineTick)

-- | The official Y-axis tick
defaultYTicks :: Ticks
defaultYTicks :: Ticks
defaultYTicks =
  Tick
-> Maybe TickStyle -> Maybe TickStyle -> Maybe TickStyle -> Ticks
Ticks
    Tick
defaultTick
    (TickStyle -> Maybe TickStyle
forall a. a -> Maybe a
Just TickStyle
defaultGlyphTickStyleY)
    (TickStyle -> Maybe TickStyle
forall a. a -> Maybe a
Just TickStyle
defaultTextTick)
    (TickStyle -> Maybe TickStyle
forall a. a -> Maybe a
Just TickStyle
defaultLineTick)

-- | Style of tick marks on an axis.
data Tick
  = -- | no ticks on axis
    TickNone
  | -- | specific labels (equidistant placement)
    TickLabels [Text]
  | -- | sensibly rounded ticks, a guide to how many, and whether to extend beyond the data bounding box
    TickRound FormatN Int TickExtend
  | -- | exactly n equally spaced ticks
    TickExact FormatN Int
  | -- | specific labels and placement
    TickPlaced [(Double, Text)]
  deriving (Int -> Tick -> ShowS
[Tick] -> ShowS
Tick -> String
(Int -> Tick -> ShowS)
-> (Tick -> String) -> ([Tick] -> ShowS) -> Show Tick
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Tick -> ShowS
showsPrec :: Int -> Tick -> ShowS
$cshow :: Tick -> String
show :: Tick -> String
$cshowList :: [Tick] -> ShowS
showList :: [Tick] -> ShowS
Show, Tick -> Tick -> Bool
(Tick -> Tick -> Bool) -> (Tick -> Tick -> Bool) -> Eq Tick
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Tick -> Tick -> Bool
== :: Tick -> Tick -> Bool
$c/= :: Tick -> Tick -> Bool
/= :: Tick -> Tick -> Bool
Eq, (forall x. Tick -> Rep Tick x)
-> (forall x. Rep Tick x -> Tick) -> Generic Tick
forall x. Rep Tick x -> Tick
forall x. Tick -> Rep Tick x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Tick -> Rep Tick x
from :: forall x. Tick -> Rep Tick x
$cto :: forall x. Rep Tick x -> Tick
to :: forall x. Rep Tick x -> Tick
Generic)

-- | Lens between a FormatN and a Tick.
formatN' :: Lens' Tick (Maybe FormatN)
formatN' :: Lens' Tick (Maybe FormatN)
formatN' =
  (Tick -> Maybe FormatN)
-> (Tick -> Maybe FormatN -> Tick) -> Lens' Tick (Maybe FormatN)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Tick -> Maybe FormatN
formatN_ Tick -> Maybe FormatN -> Tick
reformatN_

formatN_ :: Tick -> Maybe FormatN
formatN_ :: Tick -> Maybe FormatN
formatN_ = \case
  TickRound FormatN
f Int
_ TickExtend
_ -> FormatN -> Maybe FormatN
forall a. a -> Maybe a
Just FormatN
f
  TickExact FormatN
f Int
_ -> FormatN -> Maybe FormatN
forall a. a -> Maybe a
Just FormatN
f
  Tick
_ -> Maybe FormatN
forall a. Maybe a
Nothing

reformatN_ :: Tick -> Maybe FormatN -> Tick
reformatN_ :: Tick -> Maybe FormatN -> Tick
reformatN_ Tick
ts Maybe FormatN
Nothing = Tick
ts
reformatN_ (TickRound FormatN
_ Int
n TickExtend
e) (Just FormatN
f) = FormatN -> Int -> TickExtend -> Tick
TickRound FormatN
f Int
n TickExtend
e
reformatN_ (TickExact FormatN
_ Int
n) (Just FormatN
f) = FormatN -> Int -> Tick
TickExact FormatN
f Int
n
reformatN_ Tick
ts Maybe FormatN
_ = Tick
ts

-- | Lens between number of ticks and a Tick.
--
-- Only for TickRound and TickExact
numTicks' :: Lens' Tick (Maybe Int)
numTicks' :: Lens' Tick (Maybe Int)
numTicks' =
  (Tick -> Maybe Int)
-> (Tick -> Maybe Int -> Tick) -> Lens' Tick (Maybe Int)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Tick -> Maybe Int
numTicks_ Tick -> Maybe Int -> Tick
renumTicks_

numTicks_ :: Tick -> Maybe Int
numTicks_ :: Tick -> Maybe Int
numTicks_ = \case
  TickRound FormatN
_ Int
n TickExtend
_ -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
n
  TickExact FormatN
_ Int
n -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
n
  Tick
_ -> Maybe Int
forall a. Maybe a
Nothing

renumTicks_ :: Tick -> Maybe Int -> Tick
renumTicks_ :: Tick -> Maybe Int -> Tick
renumTicks_ Tick
ts Maybe Int
Nothing = Tick
ts
renumTicks_ (TickRound FormatN
f Int
_ TickExtend
e) (Just Int
n) = FormatN -> Int -> TickExtend -> Tick
TickRound FormatN
f Int
n TickExtend
e
renumTicks_ (TickExact FormatN
f Int
_) (Just Int
n) = FormatN -> Int -> Tick
TickExact FormatN
f Int
n
renumTicks_ Tick
ts Maybe Int
_ = Tick
ts

-- | Lens between a FormatN and a Tick.
tickExtend' :: Lens' Tick (Maybe TickExtend)
tickExtend' :: Lens' Tick (Maybe TickExtend)
tickExtend' =
  (Tick -> Maybe TickExtend)
-> (Tick -> Maybe TickExtend -> Tick)
-> Lens' Tick (Maybe TickExtend)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Tick -> Maybe TickExtend
tickExtend_ Tick -> Maybe TickExtend -> Tick
tickReExtend_

tickExtend_ :: Tick -> Maybe TickExtend
tickExtend_ :: Tick -> Maybe TickExtend
tickExtend_ = \case
  TickRound FormatN
_ Int
_ TickExtend
e -> TickExtend -> Maybe TickExtend
forall a. a -> Maybe a
Just TickExtend
e
  Tick
_ -> Maybe TickExtend
forall a. Maybe a
Nothing

tickReExtend_ :: Tick -> Maybe TickExtend -> Tick
tickReExtend_ :: Tick -> Maybe TickExtend -> Tick
tickReExtend_ Tick
ts Maybe TickExtend
Nothing = Tick
ts
tickReExtend_ (TickRound FormatN
f Int
n TickExtend
_) (Just TickExtend
e) = FormatN -> Int -> TickExtend -> Tick
TickRound FormatN
f Int
n TickExtend
e
tickReExtend_ Tick
ts Maybe TickExtend
_ = Tick
ts

-- | The official tick style
--
-- >>> defaultTick
-- TickRound (FormatN {fstyle = FSCommaPrec, sigFigs = Just 1, maxDistinguishIterations = 4, addLPad = True, cutRightZeros = True}) 5 TickExtend
defaultTick :: Tick
defaultTick :: Tick
defaultTick = FormatN -> Int -> TickExtend -> Tick
TickRound (FStyle -> Maybe Int -> Int -> Bool -> Bool -> FormatN
FormatN FStyle
FSCommaPrec (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1) Int
4 Bool
True Bool
True) Int
5 TickExtend
TickExtend

-- | Whether Ticks are allowed to extend the data range
data TickExtend = TickExtend | NoTickExtend deriving (TickExtend -> TickExtend -> Bool
(TickExtend -> TickExtend -> Bool)
-> (TickExtend -> TickExtend -> Bool) -> Eq TickExtend
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TickExtend -> TickExtend -> Bool
== :: TickExtend -> TickExtend -> Bool
$c/= :: TickExtend -> TickExtend -> Bool
/= :: TickExtend -> TickExtend -> Bool
Eq, Int -> TickExtend -> ShowS
[TickExtend] -> ShowS
TickExtend -> String
(Int -> TickExtend -> ShowS)
-> (TickExtend -> String)
-> ([TickExtend] -> ShowS)
-> Show TickExtend
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TickExtend -> ShowS
showsPrec :: Int -> TickExtend -> ShowS
$cshow :: TickExtend -> String
show :: TickExtend -> String
$cshowList :: [TickExtend] -> ShowS
showList :: [TickExtend] -> ShowS
Show, (forall x. TickExtend -> Rep TickExtend x)
-> (forall x. Rep TickExtend x -> TickExtend) -> Generic TickExtend
forall x. Rep TickExtend x -> TickExtend
forall x. TickExtend -> Rep TickExtend x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TickExtend -> Rep TickExtend x
from :: forall x. TickExtend -> Rep TickExtend x
$cto :: forall x. Rep TickExtend x -> TickExtend
to :: forall x. Rep TickExtend x -> TickExtend
Generic)

-- | options for prettifying axis decorations
--
-- >>> defaultAdjustments
-- Adjustments {maxXRatio = 8.0e-2, maxYRatio = 6.0e-2, angledRatio = 0.12, allowDiagonal = True}
data Adjustments = Adjustments
  { Adjustments -> Double
maxXRatio :: Double,
    Adjustments -> Double
maxYRatio :: Double,
    Adjustments -> Double
angledRatio :: Double,
    Adjustments -> Bool
allowDiagonal :: Bool
  }
  deriving (Int -> Adjustments -> ShowS
[Adjustments] -> ShowS
Adjustments -> String
(Int -> Adjustments -> ShowS)
-> (Adjustments -> String)
-> ([Adjustments] -> ShowS)
-> Show Adjustments
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Adjustments -> ShowS
showsPrec :: Int -> Adjustments -> ShowS
$cshow :: Adjustments -> String
show :: Adjustments -> String
$cshowList :: [Adjustments] -> ShowS
showList :: [Adjustments] -> ShowS
Show, Adjustments -> Adjustments -> Bool
(Adjustments -> Adjustments -> Bool)
-> (Adjustments -> Adjustments -> Bool) -> Eq Adjustments
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Adjustments -> Adjustments -> Bool
== :: Adjustments -> Adjustments -> Bool
$c/= :: Adjustments -> Adjustments -> Bool
/= :: Adjustments -> Adjustments -> Bool
Eq, (forall x. Adjustments -> Rep Adjustments x)
-> (forall x. Rep Adjustments x -> Adjustments)
-> Generic Adjustments
forall x. Rep Adjustments x -> Adjustments
forall x. Adjustments -> Rep Adjustments x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Adjustments -> Rep Adjustments x
from :: forall x. Adjustments -> Rep Adjustments x
$cto :: forall x. Rep Adjustments x -> Adjustments
to :: forall x. Rep Adjustments x -> Adjustments
Generic)

-- | The official hud adjustments.
defaultAdjustments :: Adjustments
defaultAdjustments :: Adjustments
defaultAdjustments = Double -> Double -> Double -> Bool -> Adjustments
Adjustments Double
0.08 Double
0.06 Double
0.12 Bool
True

-- | Legend options
--
-- >>> defaultLegendOptions
-- LegendOptions {legendSize = 0.3, buffer = 0.1, vgap = 0.2, hgap = 0.1, textStyle = Style {size = 0.16, borderSize = 1.0e-2, color = Colour 0.05 0.05 0.05 1.00, borderColor = Colour 0.02 0.29 0.48 1.00, scaleP = NoScaleP, textAnchor = AnchorMiddle, rotation = Nothing, translate = Nothing, escapeText = EscapeText, frame = Nothing, lineCap = Nothing, lineJoin = Nothing, dasharray = Nothing, dashoffset = Nothing, hsize = 0.6, vsize = 1.1, vshift = -0.25, glyphShape = SquareGlyph}, innerPad = 0.1, outerPad = 2.0e-2, frame = Just (Style {size = 6.0e-2, borderSize = 5.0e-3, color = Colour 0.05 0.05 0.05 0.00, borderColor = Colour 0.05 0.05 0.05 1.00, scaleP = NoScaleP, textAnchor = AnchorMiddle, rotation = Nothing, translate = Nothing, escapeText = EscapeText, frame = Nothing, lineCap = Nothing, lineJoin = Nothing, dasharray = Nothing, dashoffset = Nothing, hsize = 0.6, vsize = 1.1, vshift = -0.25, glyphShape = SquareGlyph}), place = PlaceRight, anchoring = 0.0, anchorTo = CanvasStyleSection, numStacks = 1, alignCharts = AlignRight, scaleChartsBy = 0.25, scaleP = ScalePX, legendCharts = []}
data LegendOptions = LegendOptions
  { LegendOptions -> Double
legendSize :: Double,
    LegendOptions -> Double
buffer :: Double,
    LegendOptions -> Double
vgap :: Double,
    LegendOptions -> Double
hgap :: Double,
    LegendOptions -> Style
textStyle :: Style,
    LegendOptions -> Double
innerPad :: Double,
    LegendOptions -> Double
outerPad :: Double,
    LegendOptions -> Maybe Style
frame :: Maybe Style,
    LegendOptions -> Place
place :: Place,
    LegendOptions -> Double
anchoring :: Double,
    LegendOptions -> HudChartSection
anchorTo :: HudChartSection,
    LegendOptions -> Int
numStacks :: Int,
    LegendOptions -> Align
alignCharts :: Align,
    LegendOptions -> Double
scaleChartsBy :: Double,
    LegendOptions -> ScaleP
scaleP :: ScaleP,
    LegendOptions -> [(Text, [Chart])]
legendCharts :: [(Text, [Chart])]
  }
  deriving (Int -> LegendOptions -> ShowS
[LegendOptions] -> ShowS
LegendOptions -> String
(Int -> LegendOptions -> ShowS)
-> (LegendOptions -> String)
-> ([LegendOptions] -> ShowS)
-> Show LegendOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LegendOptions -> ShowS
showsPrec :: Int -> LegendOptions -> ShowS
$cshow :: LegendOptions -> String
show :: LegendOptions -> String
$cshowList :: [LegendOptions] -> ShowS
showList :: [LegendOptions] -> ShowS
Show, LegendOptions -> LegendOptions -> Bool
(LegendOptions -> LegendOptions -> Bool)
-> (LegendOptions -> LegendOptions -> Bool) -> Eq LegendOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LegendOptions -> LegendOptions -> Bool
== :: LegendOptions -> LegendOptions -> Bool
$c/= :: LegendOptions -> LegendOptions -> Bool
/= :: LegendOptions -> LegendOptions -> Bool
Eq, (forall x. LegendOptions -> Rep LegendOptions x)
-> (forall x. Rep LegendOptions x -> LegendOptions)
-> Generic LegendOptions
forall x. Rep LegendOptions x -> LegendOptions
forall x. LegendOptions -> Rep LegendOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. LegendOptions -> Rep LegendOptions x
from :: forall x. LegendOptions -> Rep LegendOptions x
$cto :: forall x. Rep LegendOptions x -> LegendOptions
to :: forall x. Rep LegendOptions x -> LegendOptions
Generic)

-- | The official legend options
defaultLegendOptions :: LegendOptions
defaultLegendOptions :: LegendOptions
defaultLegendOptions =
  Double
-> Double
-> Double
-> Double
-> Style
-> Double
-> Double
-> Maybe Style
-> Place
-> Double
-> HudChartSection
-> Int
-> Align
-> Double
-> ScaleP
-> [(Text, [Chart])]
-> LegendOptions
LegendOptions
    Double
0.3
    Double
0.1
    Double
0.2
    Double
0.1
    (Style
defaultTextStyle Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Double Double
-> Double -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Double Double
#size Double
0.16)
    Double
0.1
    Double
0.02
    (Style -> Maybe Style
forall a. a -> Maybe a
Just (Style
defaultRectStyle Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Double Double
-> Double -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Double Double
#borderSize Double
0.005 Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Colour Colour
-> Colour -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Colour Colour
#borderColor (Optic A_Lens NoIx Colour Colour Double Double
-> Double -> Colour -> Colour
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Colour Colour Double Double
opac' Double
1 Colour
dark) Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Colour Colour
-> Colour -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Colour Colour
#color (Optic A_Lens NoIx Colour Colour Double Double
-> Double -> Colour -> Colour
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Colour Colour Double Double
opac' Double
0 Colour
dark)))
    Place
PlaceRight
    Double
0
    HudChartSection
CanvasStyleSection
    Int
1
    Align
AlignRight
    Double
0.25
    ScaleP
ScalePX
    []

-- | Options for hud frames
--
-- >>> defaultFrameOptions
-- FrameOptions {frame = Just (Style {size = 6.0e-2, borderSize = 0.0, color = Colour 1.00 1.00 1.00 0.02, borderColor = Colour 0.00 0.00 0.00 0.00, scaleP = NoScaleP, textAnchor = AnchorMiddle, rotation = Nothing, translate = Nothing, escapeText = EscapeText, frame = Nothing, lineCap = Nothing, lineJoin = Nothing, dasharray = Nothing, dashoffset = Nothing, hsize = 0.6, vsize = 1.1, vshift = -0.25, glyphShape = SquareGlyph}), anchorTo = HudStyleSection, buffer = 0.0}
data FrameOptions = FrameOptions
  { FrameOptions -> Maybe Style
frame :: Maybe Style,
    FrameOptions -> HudChartSection
anchorTo :: HudChartSection,
    FrameOptions -> Double
buffer :: Double
  }
  deriving (FrameOptions -> FrameOptions -> Bool
(FrameOptions -> FrameOptions -> Bool)
-> (FrameOptions -> FrameOptions -> Bool) -> Eq FrameOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FrameOptions -> FrameOptions -> Bool
== :: FrameOptions -> FrameOptions -> Bool
$c/= :: FrameOptions -> FrameOptions -> Bool
/= :: FrameOptions -> FrameOptions -> Bool
Eq, Int -> FrameOptions -> ShowS
[FrameOptions] -> ShowS
FrameOptions -> String
(Int -> FrameOptions -> ShowS)
-> (FrameOptions -> String)
-> ([FrameOptions] -> ShowS)
-> Show FrameOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FrameOptions -> ShowS
showsPrec :: Int -> FrameOptions -> ShowS
$cshow :: FrameOptions -> String
show :: FrameOptions -> String
$cshowList :: [FrameOptions] -> ShowS
showList :: [FrameOptions] -> ShowS
Show, (forall x. FrameOptions -> Rep FrameOptions x)
-> (forall x. Rep FrameOptions x -> FrameOptions)
-> Generic FrameOptions
forall x. Rep FrameOptions x -> FrameOptions
forall x. FrameOptions -> Rep FrameOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. FrameOptions -> Rep FrameOptions x
from :: forall x. FrameOptions -> Rep FrameOptions x
$cto :: forall x. Rep FrameOptions x -> FrameOptions
to :: forall x. Rep FrameOptions x -> FrameOptions
Generic)

-- | The official hud frame
defaultFrameOptions :: FrameOptions
defaultFrameOptions :: FrameOptions
defaultFrameOptions = Maybe Style -> HudChartSection -> Double -> FrameOptions
FrameOptions (Style -> Maybe Style
forall a. a -> Maybe a
Just (Colour -> Style
blob (Double -> Double -> Colour
grey Double
1 Double
0.02))) HudChartSection
HudStyleSection Double
0

-- * Huds

-- | Make Huds and potential data box extension; from a HudOption and an initial data box.
toHuds :: HudOptions -> DataBox -> (Maybe DataBox, [Hud])
toHuds :: HudOptions -> Rect Double -> (Maybe (Rect Double), [Hud])
toHuds HudOptions
o Rect Double
db =
  (Maybe (Rect Double)
mdb,) ([Hud] -> (Maybe (Rect Double), [Hud]))
-> [Hud] -> (Maybe (Rect Double), [Hud])
forall a b. (a -> b) -> a -> b
$
    (Priority (HudChart -> ChartTree) -> Hud)
-> [Priority (HudChart -> ChartTree)] -> [Hud]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Priority (HudChart -> ChartTree) -> Hud
Hud ([Priority (HudChart -> ChartTree)] -> [Hud])
-> [Priority (HudChart -> ChartTree)] -> [Hud]
forall a b. (a -> b) -> a -> b
$
      ([Priority AxisOptions]
as' [Priority AxisOptions]
-> ([Priority AxisOptions] -> [Priority (HudChart -> ChartTree)])
-> [Priority (HudChart -> ChartTree)]
forall a b. a -> (a -> b) -> b
& (Priority AxisOptions -> Priority (HudChart -> ChartTree))
-> [Priority AxisOptions] -> [Priority (HudChart -> ChartTree)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Optic
  A_Lens
  NoIx
  (Priority AxisOptions)
  (Priority (HudChart -> ChartTree))
  AxisOptions
  (HudChart -> ChartTree)
-> (AxisOptions -> HudChart -> ChartTree)
-> Priority AxisOptions
-> Priority (HudChart -> ChartTree)
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over Optic
  A_Lens
  NoIx
  (Priority AxisOptions)
  (Priority (HudChart -> ChartTree))
  AxisOptions
  (HudChart -> ChartTree)
#item (AxisOptions -> Rect Double -> HudChart -> ChartTree
`axisHud` Rect Double
db')))
        [Priority (HudChart -> ChartTree)]
-> [Priority (HudChart -> ChartTree)]
-> [Priority (HudChart -> ChartTree)]
forall a. Semigroup a => a -> a -> a
<> (Optic
  A_Lens
  NoIx
  HudOptions
  HudOptions
  [Priority FrameOptions]
  [Priority FrameOptions]
-> HudOptions -> [Priority FrameOptions]
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic
  A_Lens
  NoIx
  HudOptions
  HudOptions
  [Priority FrameOptions]
  [Priority FrameOptions]
#frames HudOptions
o [Priority FrameOptions]
-> ([Priority FrameOptions] -> [Priority (HudChart -> ChartTree)])
-> [Priority (HudChart -> ChartTree)]
forall a b. a -> (a -> b) -> b
& (Priority FrameOptions -> Priority (HudChart -> ChartTree))
-> [Priority FrameOptions] -> [Priority (HudChart -> ChartTree)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Optic
  A_Lens
  NoIx
  (Priority FrameOptions)
  (Priority (HudChart -> ChartTree))
  FrameOptions
  (HudChart -> ChartTree)
-> (FrameOptions -> HudChart -> ChartTree)
-> Priority FrameOptions
-> Priority (HudChart -> ChartTree)
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over Optic
  A_Lens
  NoIx
  (Priority FrameOptions)
  (Priority (HudChart -> ChartTree))
  FrameOptions
  (HudChart -> ChartTree)
#item FrameOptions -> HudChart -> ChartTree
frameHud))
        [Priority (HudChart -> ChartTree)]
-> [Priority (HudChart -> ChartTree)]
-> [Priority (HudChart -> ChartTree)]
forall a. Semigroup a => a -> a -> a
<> (Optic
  A_Lens
  NoIx
  HudOptions
  HudOptions
  [Priority LegendOptions]
  [Priority LegendOptions]
-> HudOptions -> [Priority LegendOptions]
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic
  A_Lens
  NoIx
  HudOptions
  HudOptions
  [Priority LegendOptions]
  [Priority LegendOptions]
#legends HudOptions
o [Priority LegendOptions]
-> ([Priority LegendOptions] -> [Priority (HudChart -> ChartTree)])
-> [Priority (HudChart -> ChartTree)]
forall a b. a -> (a -> b) -> b
& (Priority LegendOptions -> Priority (HudChart -> ChartTree))
-> [Priority LegendOptions] -> [Priority (HudChart -> ChartTree)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Optic
  A_Lens
  NoIx
  (Priority LegendOptions)
  (Priority (HudChart -> ChartTree))
  LegendOptions
  (HudChart -> ChartTree)
-> (LegendOptions -> HudChart -> ChartTree)
-> Priority LegendOptions
-> Priority (HudChart -> ChartTree)
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over Optic
  A_Lens
  NoIx
  (Priority LegendOptions)
  (Priority (HudChart -> ChartTree))
  LegendOptions
  (HudChart -> ChartTree)
#item LegendOptions -> HudChart -> ChartTree
legendHud))
        [Priority (HudChart -> ChartTree)]
-> [Priority (HudChart -> ChartTree)]
-> [Priority (HudChart -> ChartTree)]
forall a. Semigroup a => a -> a -> a
<> (Optic
  A_Lens
  NoIx
  HudOptions
  HudOptions
  [Priority TitleOptions]
  [Priority TitleOptions]
-> HudOptions -> [Priority TitleOptions]
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic
  A_Lens
  NoIx
  HudOptions
  HudOptions
  [Priority TitleOptions]
  [Priority TitleOptions]
#titles HudOptions
o [Priority TitleOptions]
-> ([Priority TitleOptions] -> [Priority (HudChart -> ChartTree)])
-> [Priority (HudChart -> ChartTree)]
forall a b. a -> (a -> b) -> b
& (Priority TitleOptions -> Priority (HudChart -> ChartTree))
-> [Priority TitleOptions] -> [Priority (HudChart -> ChartTree)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Optic
  A_Lens
  NoIx
  (Priority TitleOptions)
  (Priority (HudChart -> ChartTree))
  TitleOptions
  (HudChart -> ChartTree)
-> (TitleOptions -> HudChart -> ChartTree)
-> Priority TitleOptions
-> Priority (HudChart -> ChartTree)
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over Optic
  A_Lens
  NoIx
  (Priority TitleOptions)
  (Priority (HudChart -> ChartTree))
  TitleOptions
  (HudChart -> ChartTree)
#item TitleOptions -> HudChart -> ChartTree
titleHud))
  where
    (Maybe (Rect Double)
mdb, [Priority AxisOptions]
as') = Rect Double
-> [Priority AxisOptions]
-> (Maybe (Rect Double), [Priority AxisOptions])
freezeAxes Rect Double
db (Optic
  A_Lens
  NoIx
  HudOptions
  HudOptions
  [Priority AxisOptions]
  [Priority AxisOptions]
-> HudOptions -> [Priority AxisOptions]
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic
  A_Lens
  NoIx
  HudOptions
  HudOptions
  [Priority AxisOptions]
  [Priority AxisOptions]
#axes HudOptions
o)
    db' :: Rect Double
db' = Rect Double -> Maybe (Rect Double) -> Rect Double
forall a. a -> Maybe a -> a
fromMaybe Rect Double
db Maybe (Rect Double)
mdb

-- | Freeze axes by freezing ticks, supplying a new 'DataBox' if the ticks extend the canvas.
freezeAxes :: DataBox -> [Priority AxisOptions] -> (Maybe DataBox, [Priority AxisOptions])
freezeAxes :: Rect Double
-> [Priority AxisOptions]
-> (Maybe (Rect Double), [Priority AxisOptions])
freezeAxes Rect Double
db0 [Priority AxisOptions]
as =
  ((Maybe (Rect Double), [Priority AxisOptions])
 -> Priority AxisOptions
 -> (Maybe (Rect Double), [Priority AxisOptions]))
-> (Maybe (Rect Double), [Priority AxisOptions])
-> [Priority AxisOptions]
-> (Maybe (Rect Double), [Priority AxisOptions])
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl'
    ( \(Maybe (Rect Double)
dbm, [Priority AxisOptions]
as') Priority AxisOptions
ao ->
        let (Maybe (Rect Double)
dbm', AxisOptions
ao') = Rect Double -> AxisOptions -> (Maybe (Rect Double), AxisOptions)
freezeTicks (Rect Double -> Maybe (Rect Double) -> Rect Double
forall a. a -> Maybe a -> a
fromMaybe Rect Double
db0 Maybe (Rect Double)
dbm) (Optic
  A_Lens
  NoIx
  (Priority AxisOptions)
  (Priority AxisOptions)
  AxisOptions
  AxisOptions
-> Priority AxisOptions -> AxisOptions
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic
  A_Lens
  NoIx
  (Priority AxisOptions)
  (Priority AxisOptions)
  AxisOptions
  AxisOptions
#item Priority AxisOptions
ao)
         in (Maybe (Rect Double)
dbm' Maybe (Rect Double) -> Maybe (Rect Double) -> Maybe (Rect Double)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (Rect Double)
dbm, [Priority AxisOptions]
as' [Priority AxisOptions]
-> [Priority AxisOptions] -> [Priority AxisOptions]
forall a. Semigroup a => a -> a -> a
<> [Priority AxisOptions
ao Priority AxisOptions
-> (Priority AxisOptions -> Priority AxisOptions)
-> Priority AxisOptions
forall a b. a -> (a -> b) -> b
& Optic
  A_Lens
  NoIx
  (Priority AxisOptions)
  (Priority AxisOptions)
  AxisOptions
  AxisOptions
-> AxisOptions -> Priority AxisOptions -> Priority AxisOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic
  A_Lens
  NoIx
  (Priority AxisOptions)
  (Priority AxisOptions)
  AxisOptions
  AxisOptions
#item AxisOptions
ao'])
    )
    (Maybe (Rect Double)
forall a. Maybe a
Nothing, [])
    [Priority AxisOptions]
as

-- | Convert ticks to TickPlaced, freezing the effect of a tick, supplying a new 'DataBox' if the ticks extend the canvas.
freezeTicks :: DataBox -> AxisOptions -> (Maybe DataBox, AxisOptions)
freezeTicks :: Rect Double -> AxisOptions -> (Maybe (Rect Double), AxisOptions)
freezeTicks Rect Double
db AxisOptions
a =
  (Maybe (Range Double) -> Maybe (Rect Double))
-> (Tick -> AxisOptions)
-> (Maybe (Range Double), Tick)
-> (Maybe (Rect Double), AxisOptions)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap
    ((Range Double -> Rect Double)
-> Maybe (Range Double) -> Maybe (Rect Double)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Range Double
x -> Place -> Range Double -> Rect Double -> Rect Double
placeRect (Optic' A_Lens NoIx AxisOptions Place -> AxisOptions -> Place
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx AxisOptions Place
#place AxisOptions
a) Range Double
x Rect Double
db))
    (\Tick
x -> AxisOptions
a AxisOptions -> (AxisOptions -> AxisOptions) -> AxisOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx AxisOptions AxisOptions Tick Tick
-> Tick -> AxisOptions -> AxisOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
#ticks Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
-> Optic A_Lens NoIx Ticks Ticks Tick Tick
-> Optic A_Lens NoIx AxisOptions AxisOptions Tick Tick
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Ticks Ticks Tick Tick
#tick) Tick
x)
    (Range Double -> Tick -> (Maybe (Range Double), Tick)
placeTicks (Place -> Rect Double -> Range Double
placeRange (Optic' A_Lens NoIx AxisOptions Place -> AxisOptions -> Place
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx AxisOptions Place
#place AxisOptions
a) Rect Double
db) (Optic A_Lens NoIx AxisOptions AxisOptions Tick Tick
-> AxisOptions -> Tick
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view (Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
#ticks Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
-> Optic A_Lens NoIx Ticks Ticks Tick Tick
-> Optic A_Lens NoIx AxisOptions AxisOptions Tick Tick
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Ticks Ticks Tick Tick
#tick) AxisOptions
a))

placeRect :: Place -> Range Double -> Rect Double -> Rect Double
placeRect :: Place -> Range Double -> Rect Double -> Rect Double
placeRect Place
pl' (Range Double
a0 Double
a1) (Rect Double
x Double
z Double
y Double
w) = case Place
pl' of
  Place
PlaceRight -> Double -> Double -> Double -> Double -> Rect Double
forall a. a -> a -> a -> a -> Rect a
Rect Double
x Double
z Double
a0 Double
a1
  Place
PlaceLeft -> Double -> Double -> Double -> Double -> Rect Double
forall a. a -> a -> a -> a -> Rect a
Rect Double
x Double
z Double
a0 Double
a1
  Place
_ -> Double -> Double -> Double -> Double -> Rect Double
forall a. a -> a -> a -> a -> Rect a
Rect Double
a0 Double
a1 Double
y Double
w

placeRange :: Place -> ChartBox -> Range Double
placeRange :: Place -> Rect Double -> Range Double
placeRange Place
pl (Rect Double
x Double
z Double
y Double
w) = case Place
pl of
  Place
PlaceRight -> Double -> Double -> Range Double
forall a. a -> a -> Range a
Range Double
y Double
w
  Place
PlaceLeft -> Double -> Double -> Range Double
forall a. a -> a -> Range a
Range Double
y Double
w
  Place
_ -> Double -> Double -> Range Double
forall a. a -> a -> Range a
Range Double
x Double
z

placeTicks :: Range Double -> Tick -> (Maybe (Range Double), Tick)
placeTicks :: Range Double -> Tick -> (Maybe (Range Double), Tick)
placeTicks Range Double
r t :: Tick
t@TickRound {} = (Maybe (Range Double)
rExtended, [(Double, Text)] -> Tick
TickPlaced [(Double, Text)]
tPlaced)
  where
    (Maybe (Range Double)
rExtended, [(Double, Text)]
tPlaced) = Range Double -> Tick -> (Maybe (Range Double), [(Double, Text)])
makePlacedTicks Range Double
r Tick
t
placeTicks Range Double
_ Tick
t = (Maybe (Range Double)
forall a. Maybe a
Nothing, Tick
t)

-- | compute tick components given style, ranges and formatting
makePlacedTicks :: Range Double -> Tick -> (Maybe (Range Double), [(Double, Text)])
makePlacedTicks :: Range Double -> Tick -> (Maybe (Range Double), [(Double, Text)])
makePlacedTicks Range Double
r Tick
s =
  case Tick
s of
    Tick
TickNone -> (Maybe (Range Double)
forall a. Maybe a
Nothing, [])
    TickRound FormatN
f Int
n TickExtend
e ->
      ( Maybe (Range Double)
-> Maybe (Range Double) -> Bool -> Maybe (Range Double)
forall a. a -> a -> Bool -> a
bool ([Element (Range Double)] -> Maybe (Range Double)
forall s (f :: * -> *).
(Space s, Traversable f) =>
f (Element s) -> Maybe s
space1 [Double]
[Element (Range Double)]
ticks0) Maybe (Range Double)
forall a. Maybe a
Nothing (TickExtend
e TickExtend -> TickExtend -> Bool
forall a. Eq a => a -> a -> Bool
== TickExtend
NoTickExtend),
        [Double] -> [Text] -> [(Double, Text)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Double]
ticks0 (FormatN -> [Double] -> [Text]
formatNs FormatN
f [Double]
ticks0)
      )
      where
        ticks0 :: [Double]
ticks0 = Pos -> Bool -> Range Double -> Int -> [Double]
gridSensible Pos
OuterPos (TickExtend
e TickExtend -> TickExtend -> Bool
forall a. Eq a => a -> a -> Bool
== TickExtend
NoTickExtend) Range Double
r Int
n
    TickExact FormatN
f Int
n -> (Maybe (Range Double)
forall a. Maybe a
Nothing, [Double] -> [Text] -> [(Double, Text)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Double]
ticks0 (FormatN -> [Double] -> [Text]
formatNs FormatN
f [Double]
ticks0))
      where
        ticks0 :: [Element (Range Double)]
ticks0 = Pos
-> Range Double -> Grid (Range Double) -> [Element (Range Double)]
forall s. FieldSpace s => Pos -> s -> Grid s -> [Element s]
grid Pos
OuterPos Range Double
r Int
Grid (Range Double)
n
    TickLabels [Text]
ls ->
      ( Maybe (Range Double)
forall a. Maybe a
Nothing,
        [Double] -> [Text] -> [(Double, Text)]
forall a b. [a] -> [b] -> [(a, b)]
zip
          (Range Double
-> Range Double -> Element (Range Double) -> Element (Range Double)
forall s.
(Space s, Field (Element s)) =>
s -> s -> Element s -> Element s
project (Double -> Double -> Range Double
forall a. a -> a -> Range a
Range Double
0 (Int -> Double
forall a b. FromIntegral a b => b -> a
fromIntegral (Int -> Double) -> Int -> Double
forall a b. (a -> b) -> a -> b
$ [Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
ls)) Range Double
r (Double -> Double) -> (Int -> Double) -> Int -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (\Double
x -> Double
x Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- Double
0.5) (Double -> Double) -> (Int -> Double) -> Int -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int -> Double
forall a b. FromIntegral a b => b -> a
fromIntegral (Int -> Double) -> [Int] -> [Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int
1 .. [Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
ls])
          [Text]
ls
      )
    TickPlaced [(Double, Text)]
xs -> (Maybe (Range Double)
forall a. Maybe a
Nothing, [(Double, Text)]
xs)

-- | compute data range of Tick given initial data range
computeRangeTick :: Range Double -> Tick -> Range Double
computeRangeTick :: Range Double -> Tick -> Range Double
computeRangeTick Range Double
r Tick
t = Range Double -> Maybe (Range Double) -> Range Double
forall a. a -> Maybe a -> a
fromMaybe Range Double
r ((Maybe (Range Double), [(Double, Text)]) -> Maybe (Range Double)
forall a b. (a, b) -> a
fst (Range Double -> Tick -> (Maybe (Range Double), [(Double, Text)])
makePlacedTicks Range Double
r Tick
t))

-- | Create an axis.
axisHud :: AxisOptions -> DataBox -> HudChart -> ChartTree
axisHud :: AxisOptions -> Rect Double -> HudChart -> ChartTree
axisHud AxisOptions
a Rect Double
db HudChart
hc = Maybe Text -> [ChartTree] -> ChartTree
group (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"axis") [ChartTree
b, ChartTree
t]
  where
    b :: ChartTree
b = ChartTree -> (AxisBar -> ChartTree) -> Maybe AxisBar -> ChartTree
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ChartTree
forall a. Monoid a => a
mempty (\AxisBar
x -> Place -> AxisBar -> HudChart -> ChartTree
axisBarHud (Optic' A_Lens NoIx AxisOptions Place -> AxisOptions -> Place
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx AxisOptions Place
#place AxisOptions
a) AxisBar
x HudChart
hc) (Optic
  A_Lens NoIx AxisOptions AxisOptions (Maybe AxisBar) (Maybe AxisBar)
-> AxisOptions -> Maybe AxisBar
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic
  A_Lens NoIx AxisOptions AxisOptions (Maybe AxisBar) (Maybe AxisBar)
#axisBar AxisOptions
a)
    t :: ChartTree
t = AxisOptions -> Rect Double -> HudChart -> ChartTree
tickHud AxisOptions
a Rect Double
db (ChartTree -> HudChart -> HudChart
appendHud ChartTree
b HudChart
hc)

axisBarHud :: Place -> AxisBar -> HudChart -> ChartTree
axisBarHud :: Place -> AxisBar -> HudChart -> ChartTree
axisBarHud Place
pl AxisBar
b HudChart
hc = ChartTree -> (Chart -> ChartTree) -> Maybe Chart -> ChartTree
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ChartTree
forall a. Monoid a => a
mempty (Text -> [Chart] -> ChartTree
named Text
"axisbar" ([Chart] -> ChartTree) -> (Chart -> [Chart]) -> Chart -> ChartTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Chart -> [Chart]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure) Maybe Chart
c
  where
    canvasBox :: Maybe (Rect Double)
canvasBox = Getter HudChart (Maybe (Rect Double))
-> HudChart -> Maybe (Rect Double)
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view (HudChartSection -> Getter HudChart (Maybe (Rect Double))
hudChartBox' HudChartSection
CanvasSection) HudChart
hc
    anchoredBox :: Maybe (Rect Double)
anchoredBox = Getter HudChart (Maybe (Rect Double))
-> HudChart -> Maybe (Rect Double)
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view (HudChartSection -> Getter HudChart (Maybe (Rect Double))
hudChartBox' (Optic' A_Lens NoIx AxisBar HudChartSection
-> AxisBar -> HudChartSection
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx AxisBar HudChartSection
#anchorTo AxisBar
b)) HudChart
hc
    c :: Maybe Chart
c = Place -> AxisBar -> Rect Double -> Rect Double -> Chart
bar_ Place
pl AxisBar
b (Rect Double -> Rect Double -> Chart)
-> Maybe (Rect Double) -> Maybe (Rect Double -> Chart)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Rect Double)
canvasBox Maybe (Rect Double -> Chart) -> Maybe (Rect Double) -> Maybe Chart
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe (Rect Double)
anchoredBox

bar_ :: Place -> AxisBar -> Rect Double -> Rect Double -> Chart
bar_ :: Place -> AxisBar -> Rect Double -> Rect Double -> Chart
bar_ Place
pl AxisBar
b (Rect Double
x Double
z Double
y Double
w) (Rect Double
x' Double
z' Double
y' Double
w') =
  Style -> ChartData -> Chart
Chart (Optic' A_Lens NoIx AxisBar Style -> AxisBar -> Style
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx AxisBar Style
#style AxisBar
b) (ChartData -> Chart)
-> ([Rect Double] -> ChartData) -> [Rect Double] -> Chart
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [Rect Double] -> ChartData
RectData ([Rect Double] -> Chart) -> [Rect Double] -> Chart
forall a b. (a -> b) -> a -> b
$
    case Place
pl of
      Place
PlaceTop ->
        [ Double -> Double -> Double -> Double -> Rect Double
forall a. a -> a -> a -> a -> Rect a
Rect
            (Double
x Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- Optic' A_Lens NoIx AxisBar Double -> AxisBar -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx AxisBar Double
#overhang AxisBar
b)
            (Double
z Double -> Double -> Double
forall a. Additive a => a -> a -> a
+ Optic' A_Lens NoIx AxisBar Double -> AxisBar -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx AxisBar Double
#overhang AxisBar
b)
            (Double
w' Double -> Double -> Double
forall a. Additive a => a -> a -> a
+ Optic' A_Lens NoIx AxisBar Double -> AxisBar -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx AxisBar Double
#buffer AxisBar
b)
            (Double
w' Double -> Double -> Double
forall a. Additive a => a -> a -> a
+ Optic' A_Lens NoIx AxisBar Double -> AxisBar -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx AxisBar Double
#buffer AxisBar
b Double -> Double -> Double
forall a. Additive a => a -> a -> a
+ Optic' A_Lens NoIx AxisBar Double -> AxisBar -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx AxisBar Double
#size AxisBar
b)
        ]
      Place
PlaceBottom ->
        [ Double -> Double -> Double -> Double -> Rect Double
forall a. a -> a -> a -> a -> Rect a
Rect
            (Double
x Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- Optic' A_Lens NoIx AxisBar Double -> AxisBar -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx AxisBar Double
#overhang AxisBar
b)
            (Double
z Double -> Double -> Double
forall a. Additive a => a -> a -> a
+ Optic' A_Lens NoIx AxisBar Double -> AxisBar -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx AxisBar Double
#overhang AxisBar
b)
            (Double
y' Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- Optic' A_Lens NoIx AxisBar Double -> AxisBar -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx AxisBar Double
#size AxisBar
b Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- Optic' A_Lens NoIx AxisBar Double -> AxisBar -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx AxisBar Double
#buffer AxisBar
b)
            (Double
y' Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- Optic' A_Lens NoIx AxisBar Double -> AxisBar -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx AxisBar Double
#buffer AxisBar
b)
        ]
      Place
PlaceLeft ->
        [ Double -> Double -> Double -> Double -> Rect Double
forall a. a -> a -> a -> a -> Rect a
Rect
            (Double
x' Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- Optic' A_Lens NoIx AxisBar Double -> AxisBar -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx AxisBar Double
#size AxisBar
b Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- Optic' A_Lens NoIx AxisBar Double -> AxisBar -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx AxisBar Double
#buffer AxisBar
b)
            (Double
x' Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- Optic' A_Lens NoIx AxisBar Double -> AxisBar -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx AxisBar Double
#buffer AxisBar
b)
            (Double
y Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- Optic' A_Lens NoIx AxisBar Double -> AxisBar -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx AxisBar Double
#overhang AxisBar
b)
            (Double
w Double -> Double -> Double
forall a. Additive a => a -> a -> a
+ Optic' A_Lens NoIx AxisBar Double -> AxisBar -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx AxisBar Double
#overhang AxisBar
b)
        ]
      Place
PlaceRight ->
        [ Double -> Double -> Double -> Double -> Rect Double
forall a. a -> a -> a -> a -> Rect a
Rect
            (Double
z' Double -> Double -> Double
forall a. Additive a => a -> a -> a
+ Optic' A_Lens NoIx AxisBar Double -> AxisBar -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx AxisBar Double
#buffer AxisBar
b)
            (Double
z' Double -> Double -> Double
forall a. Additive a => a -> a -> a
+ Optic' A_Lens NoIx AxisBar Double -> AxisBar -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx AxisBar Double
#buffer AxisBar
b Double -> Double -> Double
forall a. Additive a => a -> a -> a
+ Optic' A_Lens NoIx AxisBar Double -> AxisBar -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx AxisBar Double
#size AxisBar
b)
            (Double
y Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- Optic' A_Lens NoIx AxisBar Double -> AxisBar -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx AxisBar Double
#overhang AxisBar
b)
            (Double
w Double -> Double -> Double
forall a. Additive a => a -> a -> a
+ Optic' A_Lens NoIx AxisBar Double -> AxisBar -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx AxisBar Double
#overhang AxisBar
b)
        ]
      PlaceAbsolute (Point Double
x'' Double
_) ->
        [ Double -> Double -> Double -> Double -> Rect Double
forall a. a -> a -> a -> a -> Rect a
Rect
            (Double
x'' Double -> Double -> Double
forall a. Additive a => a -> a -> a
+ Optic' A_Lens NoIx AxisBar Double -> AxisBar -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx AxisBar Double
#buffer AxisBar
b)
            (Double
x'' Double -> Double -> Double
forall a. Additive a => a -> a -> a
+ Optic' A_Lens NoIx AxisBar Double -> AxisBar -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx AxisBar Double
#buffer AxisBar
b Double -> Double -> Double
forall a. Additive a => a -> a -> a
+ Optic' A_Lens NoIx AxisBar Double -> AxisBar -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx AxisBar Double
#size AxisBar
b)
            (Double
y Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- Optic' A_Lens NoIx AxisBar Double -> AxisBar -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx AxisBar Double
#overhang AxisBar
b)
            (Double
w Double -> Double -> Double
forall a. Additive a => a -> a -> a
+ Optic' A_Lens NoIx AxisBar Double -> AxisBar -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx AxisBar Double
#overhang AxisBar
b)
        ]

-- * tick hud creation

tickHud :: AxisOptions -> DataBox -> HudChart -> ChartTree
tickHud :: AxisOptions -> Rect Double -> HudChart -> ChartTree
tickHud AxisOptions
ao Rect Double
db HudChart
hc = ChartTree
-> (Rect Double -> ChartTree) -> Maybe (Rect Double) -> ChartTree
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ChartTree
forall a. Monoid a => a
mempty Rect Double -> ChartTree
ts (Getter HudChart (Maybe (Rect Double))
-> HudChart -> Maybe (Rect Double)
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view (HudChartSection -> Getter HudChart (Maybe (Rect Double))
hudChartBox' HudChartSection
HudStyleSection) HudChart
hc)
  where
    ts :: Rect Double -> ChartTree
ts Rect Double
b = Place -> Ticks -> Rect Double -> HudChart -> ChartTree
applyTicks (Optic' A_Lens NoIx AxisOptions Place -> AxisOptions -> Place
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx AxisOptions Place
#place AxisOptions
ao) (Rect Double -> Ticks
adjTick Rect Double
b) Rect Double
db HudChart
hc
    adjTick :: Rect Double -> Ticks
adjTick Rect Double
b = Ticks -> (Adjustments -> Ticks) -> Maybe Adjustments -> Ticks
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
-> AxisOptions -> Ticks
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
#ticks AxisOptions
ao) (\Adjustments
x -> Adjustments
-> Rect Double -> Rect Double -> Place -> Ticks -> Ticks
adjustTicks Adjustments
x Rect Double
b Rect Double
db (Optic' A_Lens NoIx AxisOptions Place -> AxisOptions -> Place
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx AxisOptions Place
#place AxisOptions
ao) (Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
-> AxisOptions -> Ticks
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
#ticks AxisOptions
ao)) (Optic' A_Lens NoIx AxisOptions (Maybe Adjustments)
-> AxisOptions -> Maybe Adjustments
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx AxisOptions (Maybe Adjustments)
#adjustments AxisOptions
ao)

-- | Create tick glyphs (marks), lines (grid) and text (labels)
applyTicks ::
  Place ->
  Ticks ->
  DataBox ->
  HudChart ->
  ChartTree
applyTicks :: Place -> Ticks -> Rect Double -> HudChart -> ChartTree
applyTicks Place
pl Ticks
t Rect Double
db HudChart
hc = Maybe Text -> [ChartTree] -> ChartTree
group (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"ticks") [ChartTree
lt, ChartTree
gt, ChartTree
tt]
  where
    lt :: ChartTree
lt = ChartTree
-> (TickStyle -> ChartTree) -> Maybe TickStyle -> ChartTree
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ChartTree
forall a. Monoid a => a
mempty (\TickStyle
x -> Place -> TickStyle -> Tick -> Rect Double -> HudChart -> ChartTree
tickLine Place
pl TickStyle
x (Optic A_Lens NoIx Ticks Ticks Tick Tick -> Ticks -> Tick
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic A_Lens NoIx Ticks Ticks Tick Tick
#tick Ticks
t) Rect Double
db HudChart
hc) (Optic' A_Lens NoIx Ticks (Maybe TickStyle)
-> Ticks -> Maybe TickStyle
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx Ticks (Maybe TickStyle)
#lineTick Ticks
t)
    gt :: ChartTree
gt = ChartTree
-> (TickStyle -> ChartTree) -> Maybe TickStyle -> ChartTree
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ChartTree
forall a. Monoid a => a
mempty (\TickStyle
x -> Place -> TickStyle -> Tick -> Rect Double -> HudChart -> ChartTree
tickGlyph Place
pl TickStyle
x (Optic A_Lens NoIx Ticks Ticks Tick Tick -> Ticks -> Tick
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic A_Lens NoIx Ticks Ticks Tick Tick
#tick Ticks
t) Rect Double
db HudChart
hc) (Optic' A_Lens NoIx Ticks (Maybe TickStyle)
-> Ticks -> Maybe TickStyle
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx Ticks (Maybe TickStyle)
#glyphTick Ticks
t)
    tt :: ChartTree
tt = ChartTree
-> (TickStyle -> ChartTree) -> Maybe TickStyle -> ChartTree
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ChartTree
forall a. Monoid a => a
mempty (\TickStyle
x -> Place -> TickStyle -> Tick -> Rect Double -> HudChart -> ChartTree
tickText Place
pl TickStyle
x (Optic A_Lens NoIx Ticks Ticks Tick Tick -> Ticks -> Tick
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic A_Lens NoIx Ticks Ticks Tick Tick
#tick Ticks
t) Rect Double
db (ChartTree -> HudChart -> HudChart
appendHud ChartTree
gt HudChart
hc)) (Optic' A_Lens NoIx Ticks (Maybe TickStyle)
-> Ticks -> Maybe TickStyle
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx Ticks (Maybe TickStyle)
#textTick Ticks
t)

-- | adjust Tick for sane font sizes etc
adjustTicks ::
  Adjustments ->
  ChartBox ->
  DataBox ->
  Place ->
  Ticks ->
  Ticks
adjustTicks :: Adjustments
-> Rect Double -> Rect Double -> Place -> Ticks -> Ticks
adjustTicks (Adjustments Double
mrx Double
ma Double
mry Bool
ad) Rect Double
vb Rect Double
cs Place
pl Ticks
t
  | Place
pl Place -> Place -> Bool
forall a. Eq a => a -> a -> Bool
== Place
PlaceBottom Bool -> Bool -> Bool
|| Place
pl Place -> Place -> Bool
forall a. Eq a => a -> a -> Bool
== Place
PlaceTop =
      if Bool
ad
        then
          ( if Double
adjustSizeX Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
1
              then
                ( case Place
pl of
                    Place
PlaceBottom -> Optic An_AffineTraversal NoIx Ticks Ticks TextAnchor TextAnchor
-> TextAnchor -> Ticks -> Ticks
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (Optic' A_Lens NoIx Ticks (Maybe TickStyle)
#textTick Optic' A_Lens NoIx Ticks (Maybe TickStyle)
-> Optic' A_Lens NoIx TickStyle Style
-> Optic An_AffineTraversal NoIx Ticks Ticks Style Style
forall (is :: IxList) (js :: IxList) (ks :: IxList) k k' l m s t u
       v a b.
(AppendIndices is js ks, JoinKinds k A_Prism k',
 JoinKinds k' l m) =>
Optic k is s t (Maybe u) (Maybe v)
-> Optic l js u v a b -> Optic m ks s t a b
%? Optic' A_Lens NoIx TickStyle Style
#style Optic An_AffineTraversal NoIx Ticks Ticks Style Style
-> Optic A_Lens NoIx Style Style TextAnchor TextAnchor
-> Optic An_AffineTraversal NoIx Ticks Ticks TextAnchor TextAnchor
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Style Style TextAnchor TextAnchor
#textAnchor) TextAnchor
AnchorEnd
                    Place
PlaceTop -> Optic An_AffineTraversal NoIx Ticks Ticks TextAnchor TextAnchor
-> TextAnchor -> Ticks -> Ticks
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (Optic' A_Lens NoIx Ticks (Maybe TickStyle)
#textTick Optic' A_Lens NoIx Ticks (Maybe TickStyle)
-> Optic' A_Lens NoIx TickStyle Style
-> Optic An_AffineTraversal NoIx Ticks Ticks Style Style
forall (is :: IxList) (js :: IxList) (ks :: IxList) k k' l m s t u
       v a b.
(AppendIndices is js ks, JoinKinds k A_Prism k',
 JoinKinds k' l m) =>
Optic k is s t (Maybe u) (Maybe v)
-> Optic l js u v a b -> Optic m ks s t a b
%? Optic' A_Lens NoIx TickStyle Style
#style Optic An_AffineTraversal NoIx Ticks Ticks Style Style
-> Optic A_Lens NoIx Style Style TextAnchor TextAnchor
-> Optic An_AffineTraversal NoIx Ticks Ticks TextAnchor TextAnchor
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Style Style TextAnchor TextAnchor
#textAnchor) TextAnchor
AnchorStart
                    Place
_ -> Optic An_AffineTraversal NoIx Ticks Ticks TextAnchor TextAnchor
-> TextAnchor -> Ticks -> Ticks
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (Optic' A_Lens NoIx Ticks (Maybe TickStyle)
#textTick Optic' A_Lens NoIx Ticks (Maybe TickStyle)
-> Optic' A_Lens NoIx TickStyle Style
-> Optic An_AffineTraversal NoIx Ticks Ticks Style Style
forall (is :: IxList) (js :: IxList) (ks :: IxList) k k' l m s t u
       v a b.
(AppendIndices is js ks, JoinKinds k A_Prism k',
 JoinKinds k' l m) =>
Optic k is s t (Maybe u) (Maybe v)
-> Optic l js u v a b -> Optic m ks s t a b
%? Optic' A_Lens NoIx TickStyle Style
#style Optic An_AffineTraversal NoIx Ticks Ticks Style Style
-> Optic A_Lens NoIx Style Style TextAnchor TextAnchor
-> Optic An_AffineTraversal NoIx Ticks Ticks TextAnchor TextAnchor
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Style Style TextAnchor TextAnchor
#textAnchor) TextAnchor
AnchorEnd
                )
                  (Ticks -> Ticks) -> (Ticks -> Ticks) -> Ticks -> Ticks
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Optic An_AffineTraversal NoIx Ticks Ticks Double Double
-> (Double -> Double) -> Ticks -> Ticks
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over (Optic' A_Lens NoIx Ticks (Maybe TickStyle)
#textTick Optic' A_Lens NoIx Ticks (Maybe TickStyle)
-> Optic' A_Lens NoIx TickStyle Style
-> Optic An_AffineTraversal NoIx Ticks Ticks Style Style
forall (is :: IxList) (js :: IxList) (ks :: IxList) k k' l m s t u
       v a b.
(AppendIndices is js ks, JoinKinds k A_Prism k',
 JoinKinds k' l m) =>
Optic k is s t (Maybe u) (Maybe v)
-> Optic l js u v a b -> Optic m ks s t a b
%? Optic' A_Lens NoIx TickStyle Style
#style Optic An_AffineTraversal NoIx Ticks Ticks Style Style
-> Optic A_Lens NoIx Style Style Double Double
-> Optic An_AffineTraversal NoIx Ticks Ticks Double Double
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Style Style Double Double
#size) (Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ Double
adjustSizeA)
                  (Ticks -> Ticks) -> Ticks -> Ticks
forall a b. (a -> b) -> a -> b
$ (Optic' A_Lens NoIx Ticks (Maybe TickStyle)
#textTick Optic' A_Lens NoIx Ticks (Maybe TickStyle)
-> Optic' A_Lens NoIx TickStyle Style
-> Optic An_AffineTraversal NoIx Ticks Ticks Style Style
forall (is :: IxList) (js :: IxList) (ks :: IxList) k k' l m s t u
       v a b.
(AppendIndices is js ks, JoinKinds k A_Prism k',
 JoinKinds k' l m) =>
Optic k is s t (Maybe u) (Maybe v)
-> Optic l js u v a b -> Optic m ks s t a b
%? Optic' A_Lens NoIx TickStyle Style
#style Optic An_AffineTraversal NoIx Ticks Ticks Style Style
-> Optic A_Lens NoIx Style Style (Maybe Double) (Maybe Double)
-> Optic
     An_AffineTraversal NoIx Ticks Ticks (Maybe Double) (Maybe Double)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Style Style (Maybe Double) (Maybe Double)
#rotation Optic
  An_AffineTraversal NoIx Ticks Ticks (Maybe Double) (Maybe Double)
-> Double -> Ticks -> Ticks
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a (Maybe b) -> b -> s -> t
?~ Double
forall a. TrigField a => a
pi Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ Double
4) Ticks
t
              else Optic An_AffineTraversal NoIx Ticks Ticks Double Double
-> (Double -> Double) -> Ticks -> Ticks
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over (Optic' A_Lens NoIx Ticks (Maybe TickStyle)
#textTick Optic' A_Lens NoIx Ticks (Maybe TickStyle)
-> Optic' A_Lens NoIx TickStyle Style
-> Optic An_AffineTraversal NoIx Ticks Ticks Style Style
forall (is :: IxList) (js :: IxList) (ks :: IxList) k k' l m s t u
       v a b.
(AppendIndices is js ks, JoinKinds k A_Prism k',
 JoinKinds k' l m) =>
Optic k is s t (Maybe u) (Maybe v)
-> Optic l js u v a b -> Optic m ks s t a b
%? Optic' A_Lens NoIx TickStyle Style
#style Optic An_AffineTraversal NoIx Ticks Ticks Style Style
-> Optic A_Lens NoIx Style Style Double Double
-> Optic An_AffineTraversal NoIx Ticks Ticks Double Double
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Style Style Double Double
#size) (Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ Double
adjustSizeA) Ticks
t
          )
        else Ticks
t Ticks -> (Ticks -> Ticks) -> Ticks
forall a b. a -> (a -> b) -> b
& Optic An_AffineTraversal NoIx Ticks Ticks Double Double
-> (Double -> Double) -> Ticks -> Ticks
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over (Optic' A_Lens NoIx Ticks (Maybe TickStyle)
#textTick Optic' A_Lens NoIx Ticks (Maybe TickStyle)
-> Optic' A_Lens NoIx TickStyle Style
-> Optic An_AffineTraversal NoIx Ticks Ticks Style Style
forall (is :: IxList) (js :: IxList) (ks :: IxList) k k' l m s t u
       v a b.
(AppendIndices is js ks, JoinKinds k A_Prism k',
 JoinKinds k' l m) =>
Optic k is s t (Maybe u) (Maybe v)
-> Optic l js u v a b -> Optic m ks s t a b
%? Optic' A_Lens NoIx TickStyle Style
#style Optic An_AffineTraversal NoIx Ticks Ticks Style Style
-> Optic A_Lens NoIx Style Style Double Double
-> Optic An_AffineTraversal NoIx Ticks Ticks Double Double
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Style Style Double Double
#size) (Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ Double
adjustSizeX)
  | Bool
otherwise -- pl `elem` [PlaceLeft, PlaceRight]
    =
      Optic An_AffineTraversal NoIx Ticks Ticks Double Double
-> (Double -> Double) -> Ticks -> Ticks
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over (Optic' A_Lens NoIx Ticks (Maybe TickStyle)
#textTick Optic' A_Lens NoIx Ticks (Maybe TickStyle)
-> Optic' A_Lens NoIx TickStyle Style
-> Optic An_AffineTraversal NoIx Ticks Ticks Style Style
forall (is :: IxList) (js :: IxList) (ks :: IxList) k k' l m s t u
       v a b.
(AppendIndices is js ks, JoinKinds k A_Prism k',
 JoinKinds k' l m) =>
Optic k is s t (Maybe u) (Maybe v)
-> Optic l js u v a b -> Optic m ks s t a b
%? Optic' A_Lens NoIx TickStyle Style
#style Optic An_AffineTraversal NoIx Ticks Ticks Style Style
-> Optic A_Lens NoIx Style Style Double Double
-> Optic An_AffineTraversal NoIx Ticks Ticks Double Double
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Style Style Double Double
#size) (Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ Double
adjustSizeY) Ticks
t
  where
    max' :: [a] -> a
max' [] = a
1
    max' [a]
xs = [a] -> a
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [a]
xs
    ra :: Rect a -> Range a
ra (Rect a
x a
z a
y a
w)
      | Place
pl Place -> Place -> Bool
forall a. Eq a => a -> a -> Bool
== Place
PlaceTop Bool -> Bool -> Bool
|| Place
pl Place -> Place -> Bool
forall a. Eq a => a -> a -> Bool
== Place
PlaceBottom = a -> a -> Range a
forall a. a -> a -> Range a
Range a
x a
z
      | Bool
otherwise = a -> a -> Range a
forall a. a -> a -> Range a
Range a
y a
w
    asp :: Range Double
asp = Rect Double -> Range Double
forall {a}. Rect a -> Range a
ra Rect Double
vb
    r :: Range Double
r = Rect Double -> Range Double
forall {a}. Rect a -> Range a
ra Rect Double
cs
    tickl :: [Text]
tickl = (Double, Text) -> Text
forall a b. (a, b) -> b
snd ((Double, Text) -> Text) -> [(Double, Text)] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tick -> Range Double -> Range Double -> [(Double, Text)]
ticksR (Optic A_Lens NoIx Ticks Ticks Tick Tick -> Ticks -> Tick
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic A_Lens NoIx Ticks Ticks Tick Tick
#tick Ticks
t) Range Double
asp Range Double
r
    maxWidth :: Double
    maxWidth :: Double
maxWidth =
      Double -> (TickStyle -> Double) -> Maybe TickStyle -> Double
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
        Double
1
        ( \TickStyle
tt ->
            [Double] -> Double
forall {a}. (FromInteger a, Ord a) => [a] -> a
max' ([Double] -> Double) -> [Double] -> Double
forall a b. (a -> b) -> a -> b
$
              (\(Rect Double
x Double
z Double
_ Double
_) -> Double
z Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- Double
x)
                (Rect Double -> Double) -> (Text -> Rect Double) -> Text -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (\Text
x -> Style -> Text -> Point Double -> Rect Double
styleBoxText (Optic' A_Lens NoIx TickStyle Style -> TickStyle -> Style
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx TickStyle Style
#style TickStyle
tt) Text
x (Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
0 Double
0))
                (Text -> Double) -> [Text] -> [Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
tickl
        )
        (Optic' A_Lens NoIx Ticks (Maybe TickStyle)
-> Ticks -> Maybe TickStyle
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx Ticks (Maybe TickStyle)
#textTick Ticks
t)
    maxHeight :: Double
maxHeight =
      Double -> (TickStyle -> Double) -> Maybe TickStyle -> Double
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
        Double
1
        ( \TickStyle
tt ->
            [Double] -> Double
forall {a}. (FromInteger a, Ord a) => [a] -> a
max' ([Double] -> Double) -> [Double] -> Double
forall a b. (a -> b) -> a -> b
$
              (\(Rect Double
_ Double
_ Double
y Double
w) -> Double
w Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- Double
y)
                (Rect Double -> Double) -> (Text -> Rect Double) -> Text -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (\Text
x -> Style -> Text -> Point Double -> Rect Double
styleBoxText (Optic' A_Lens NoIx TickStyle Style -> TickStyle -> Style
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx TickStyle Style
#style TickStyle
tt) Text
x (Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
0 Double
0))
                (Text -> Double) -> [Text] -> [Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
tickl
        )
        (Optic' A_Lens NoIx Ticks (Maybe TickStyle)
-> Ticks -> Maybe TickStyle
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx Ticks (Maybe TickStyle)
#textTick Ticks
t)

    adjustSizeX :: Double
    adjustSizeX :: Double
adjustSizeX = Double -> Double -> Double
forall a. Ord a => a -> a -> a
max (Double
maxWidth Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ (Range Double -> Element (Range Double)
forall s. Space s => s -> Element s
upper Range Double
asp Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- Range Double -> Element (Range Double)
forall s. Space s => s -> Element s
lower Range Double
asp) Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ Double
mrx) Double
1
    adjustSizeY :: Double
adjustSizeY = Double -> Double -> Double
forall a. Ord a => a -> a -> a
max (Double
maxHeight Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ (Range Double -> Element (Range Double)
forall s. Space s => s -> Element s
upper Range Double
asp Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- Range Double -> Element (Range Double)
forall s. Space s => s -> Element s
lower Range Double
asp) Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ Double
mry) Double
1
    adjustSizeA :: Double
adjustSizeA = Double -> Double -> Double
forall a. Ord a => a -> a -> a
max (Double
maxHeight Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ (Range Double -> Element (Range Double)
forall s. Space s => s -> Element s
upper Range Double
asp Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- Range Double -> Element (Range Double)
forall s. Space s => s -> Element s
lower Range Double
asp) Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ Double
ma) Double
1

-- | compute tick values and labels given options, ranges and formatting
ticksR :: Tick -> Range Double -> Range Double -> [(Double, Text)]
ticksR :: Tick -> Range Double -> Range Double -> [(Double, Text)]
ticksR Tick
s Range Double
d Range Double
r =
  case Tick
s of
    Tick
TickNone -> []
    TickRound FormatN
f Int
n TickExtend
e -> [Double] -> [Text] -> [(Double, Text)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Range Double
-> Range Double -> Element (Range Double) -> Element (Range Double)
forall s.
(Space s, Field (Element s)) =>
s -> s -> Element s -> Element s
project Range Double
r Range Double
d (Double -> Double) -> [Double] -> [Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Double]
ticks0) (FormatN -> [Double] -> [Text]
formatNs FormatN
f [Double]
ticks0)
      where
        ticks0 :: [Double]
ticks0 = Pos -> Bool -> Range Double -> Int -> [Double]
gridSensible Pos
OuterPos (TickExtend
e TickExtend -> TickExtend -> Bool
forall a. Eq a => a -> a -> Bool
== TickExtend
NoTickExtend) Range Double
r Int
n
    TickExact FormatN
f Int
n -> [Double] -> [Text] -> [(Double, Text)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Range Double
-> Range Double -> Element (Range Double) -> Element (Range Double)
forall s.
(Space s, Field (Element s)) =>
s -> s -> Element s -> Element s
project Range Double
r Range Double
d (Double -> Double) -> [Double] -> [Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Double]
ticks0) (FormatN -> [Double] -> [Text]
formatNs FormatN
f [Double]
ticks0)
      where
        ticks0 :: [Element (Range Double)]
ticks0 = Pos
-> Range Double -> Grid (Range Double) -> [Element (Range Double)]
forall s. FieldSpace s => Pos -> s -> Grid s -> [Element s]
grid Pos
OuterPos Range Double
r Int
Grid (Range Double)
n
    TickLabels [Text]
ls ->
      [Double] -> [Text] -> [(Double, Text)]
forall a b. [a] -> [b] -> [(a, b)]
zip
        (Range Double
-> Range Double -> Element (Range Double) -> Element (Range Double)
forall s.
(Space s, Field (Element s)) =>
s -> s -> Element s -> Element s
project (Double -> Double -> Range Double
forall a. a -> a -> Range a
Range Double
0 (Int -> Double
forall a b. FromIntegral a b => b -> a
fromIntegral (Int -> Double) -> Int -> Double
forall a b. (a -> b) -> a -> b
$ [Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
ls)) Range Double
d (Double -> Double) -> (Int -> Double) -> Int -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (\Double
x -> Double
x Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- Double
0.5) (Double -> Double) -> (Int -> Double) -> Int -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int -> Double
forall a b. FromIntegral a b => b -> a
fromIntegral (Int -> Double) -> [Int] -> [Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int
1 .. [Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
ls])
        [Text]
ls
    TickPlaced [(Double, Text)]
xs -> [Double] -> [Text] -> [(Double, Text)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Range Double
-> Range Double -> Element (Range Double) -> Element (Range Double)
forall s.
(Space s, Field (Element s)) =>
s -> s -> Element s -> Element s
project Range Double
r Range Double
d (Double -> Double)
-> ((Double, Text) -> Double) -> (Double, Text) -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Double, Text) -> Double
forall a b. (a, b) -> a
fst ((Double, Text) -> Double) -> [(Double, Text)] -> [Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Double, Text)]
xs) ((Double, Text) -> Text
forall a b. (a, b) -> b
snd ((Double, Text) -> Text) -> [(Double, Text)] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Double, Text)]
xs)

-- | aka marks
tickGlyph ::
  Place ->
  TickStyle ->
  Tick ->
  DataBox ->
  HudChart ->
  ChartTree
tickGlyph :: Place -> TickStyle -> Tick -> Rect Double -> HudChart -> ChartTree
tickGlyph Place
pl TickStyle
s Tick
ts Rect Double
db HudChart
hc = ChartTree -> (Chart -> ChartTree) -> Maybe Chart -> ChartTree
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ChartTree
forall a. Monoid a => a
mempty (Text -> [Chart] -> ChartTree
named Text
"tickglyph" ([Chart] -> ChartTree) -> (Chart -> [Chart]) -> Chart -> ChartTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Chart -> [Chart]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure) Maybe Chart
c
  where
    anchorBox :: Maybe (Rect Double)
anchorBox = Getter HudChart (Maybe (Rect Double))
-> HudChart -> Maybe (Rect Double)
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view (HudChartSection -> Getter HudChart (Maybe (Rect Double))
hudChartBox' (Optic' A_Lens NoIx TickStyle HudChartSection
-> TickStyle -> HudChartSection
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx TickStyle HudChartSection
#anchorTo TickStyle
s)) HudChart
hc
    canvasBox :: Maybe (Rect Double)
canvasBox = Getter HudChart (Maybe (Rect Double))
-> HudChart -> Maybe (Rect Double)
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view (HudChartSection -> Getter HudChart (Maybe (Rect Double))
hudChartBox' HudChartSection
CanvasSection) HudChart
hc
    c :: Maybe Chart
c = case (Maybe (Rect Double)
canvasBox, Maybe (Rect Double)
anchorBox) of
      (Just Rect Double
cb, Just Rect Double
ab) -> Chart -> Maybe Chart
forall a. a -> Maybe a
Just (Chart -> Maybe Chart) -> Chart -> Maybe Chart
forall a b. (a -> b) -> a -> b
$ Style -> ChartData -> Chart
Chart (Optic' A_Lens NoIx TickStyle Style -> TickStyle -> Style
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx TickStyle Style
#style TickStyle
s) ([Point Double] -> ChartData
GlyphData [Point Double]
ps)
        where
          ps :: [Point Double]
ps = Place
-> Double -> Rect Double -> Rect Double -> Double -> Point Double
placePosTick Place
pl (Optic' A_Lens NoIx TickStyle Double -> TickStyle -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx TickStyle Double
#buffer TickStyle
s) Rect Double
ab Rect Double
bb (Double -> Point Double)
-> ((Double, Text) -> Double) -> (Double, Text) -> Point Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Double, Text) -> Double
forall a b. (a, b) -> a
fst ((Double, Text) -> Point Double)
-> [(Double, Text)] -> [Point Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tick -> Place -> Rect Double -> Rect Double -> [(Double, Text)]
ticksPlacedCanvas Tick
ts Place
pl Rect Double
cb Rect Double
db
          bb :: Rect Double
bb = Rect Double -> Maybe (Rect Double) -> Rect Double
forall a. a -> Maybe a -> a
fromMaybe Rect Double
forall a. Additive a => a
zero (Maybe (Rect Double) -> Rect Double)
-> Maybe (Rect Double) -> Rect Double
forall a b. (a -> b) -> a -> b
$ Chart -> Maybe (Rect Double)
sbox (Style -> ChartData -> Chart
Chart (Optic' A_Lens NoIx TickStyle Style -> TickStyle -> Style
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx TickStyle Style
#style TickStyle
s) ([Point Double] -> ChartData
GlyphData [Point Double
forall a. Additive a => a
zero]))
      (Maybe (Rect Double), Maybe (Rect Double))
_ -> Maybe Chart
forall a. Maybe a
Nothing

placePosTick :: Place -> Double -> ChartBox -> Rect Double -> Double -> Point Double
placePosTick :: Place
-> Double -> Rect Double -> Rect Double -> Double -> Point Double
placePosTick Place
pl Double
b (Rect Double
x Double
z Double
y Double
w) (Rect Double
x' Double
z' Double
y' Double
w') Double
pos = case Place
pl of
  Place
PlaceTop -> Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
pos (Double
w Double -> Double -> Double
forall a. Additive a => a -> a -> a
+ Double
b Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- Double
y')
  Place
PlaceBottom -> Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
pos (Double
y Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- Double
b Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- Double
w')
  Place
PlaceLeft -> Double -> Double -> Point Double
forall a. a -> a -> Point a
Point (Double
x Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- Double
b Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- Double
z') Double
pos
  Place
PlaceRight -> Double -> Double -> Point Double
forall a. a -> a -> Point a
Point (Double
z Double -> Double -> Double
forall a. Additive a => a -> a -> a
+ Double
b Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- Double
x') Double
pos
  PlaceAbsolute Point Double
p -> Point Double
p Point Double -> Point Double -> Point Double
forall a. Additive a => a -> a -> a
+ Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
0 Double
pos

-- | compute tick positions and string values in canvas space given placement, the canvas box & data box
ticksPlacedCanvas :: Tick -> Place -> ChartBox -> DataBox -> [(Double, Text)]
ticksPlacedCanvas :: Tick -> Place -> Rect Double -> Rect Double -> [(Double, Text)]
ticksPlacedCanvas Tick
ts Place
pl Rect Double
cb Rect Double
db =
  (Double -> Double) -> (Double, Text) -> (Double, Text)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Range Double
-> Range Double -> Element (Range Double) -> Element (Range Double)
forall s.
(Space s, Field (Element s)) =>
s -> s -> Element s -> Element s
project (Place -> Rect Double -> Range Double
placeRange Place
pl Rect Double
db) (Place -> Rect Double -> Range Double
placeRange Place
pl Rect Double
cb))
    ((Double, Text) -> (Double, Text))
-> [(Double, Text)] -> [(Double, Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Maybe (Range Double), [(Double, Text)]) -> [(Double, Text)]
forall a b. (a, b) -> b
snd (Range Double -> Tick -> (Maybe (Range Double), [(Double, Text)])
makePlacedTicks (Place -> Rect Double -> Range Double
placeRange Place
pl Rect Double
db) Tick
ts)

-- | aka tick labels
tickText ::
  Place ->
  TickStyle ->
  Tick ->
  DataBox ->
  HudChart ->
  ChartTree
tickText :: Place -> TickStyle -> Tick -> Rect Double -> HudChart -> ChartTree
tickText Place
pl TickStyle
s Tick
ts Rect Double
db HudChart
hc = ChartTree
-> (Maybe Chart -> ChartTree) -> Maybe (Maybe Chart) -> ChartTree
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ChartTree
forall a. Monoid a => a
mempty (Text -> [Chart] -> ChartTree
named Text
"ticktext" ([Chart] -> ChartTree)
-> (Maybe Chart -> [Chart]) -> Maybe Chart -> ChartTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Maybe Chart -> [Chart]
forall a. Maybe a -> [a]
maybeToList) Maybe (Maybe Chart)
c
  where
    anchorBox :: Maybe (Rect Double)
anchorBox = Getter HudChart (Maybe (Rect Double))
-> HudChart -> Maybe (Rect Double)
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view (HudChartSection -> Getter HudChart (Maybe (Rect Double))
hudChartBox' (Optic' A_Lens NoIx TickStyle HudChartSection
-> TickStyle -> HudChartSection
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx TickStyle HudChartSection
#anchorTo TickStyle
s)) HudChart
hc
    cb :: Maybe (Rect Double)
cb = Getter HudChart (Maybe (Rect Double))
-> HudChart -> Maybe (Rect Double)
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view (HudChartSection -> Getter HudChart (Maybe (Rect Double))
hudChartBox' HudChartSection
CanvasSection) HudChart
hc
    c :: Maybe (Maybe Chart)
c = Place
-> TickStyle
-> Tick
-> Rect Double
-> Rect Double
-> Rect Double
-> Maybe Chart
tickText_ Place
pl TickStyle
s Tick
ts (Rect Double -> Rect Double -> Rect Double -> Maybe Chart)
-> Maybe (Rect Double)
-> Maybe (Rect Double -> Rect Double -> Maybe Chart)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Rect Double)
anchorBox Maybe (Rect Double -> Rect Double -> Maybe Chart)
-> Maybe (Rect Double) -> Maybe (Rect Double -> Maybe Chart)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe (Rect Double)
cb Maybe (Rect Double -> Maybe Chart)
-> Maybe (Rect Double) -> Maybe (Maybe Chart)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Rect Double -> Maybe (Rect Double)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Rect Double
db

tickText_ ::
  Place ->
  TickStyle ->
  Tick ->
  ChartBox ->
  ChartBox ->
  DataBox ->
  Maybe Chart
tickText_ :: Place
-> TickStyle
-> Tick
-> Rect Double
-> Rect Double
-> Rect Double
-> Maybe Chart
tickText_ Place
pl TickStyle
s Tick
ts Rect Double
sb Rect Double
cb Rect Double
db =
  case [(Text, Point Double)]
l of
    [] -> Maybe Chart
forall a. Maybe a
Nothing
    [(Text, Point Double)]
_ -> Chart -> Maybe Chart
forall a. a -> Maybe a
Just (Chart -> Maybe Chart) -> Chart -> Maybe Chart
forall a b. (a -> b) -> a -> b
$ Style -> ChartData -> Chart
Chart (Place -> Style -> Style
placeTextAnchor Place
pl (Optic' A_Lens NoIx TickStyle Style -> TickStyle -> Style
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx TickStyle Style
#style TickStyle
s)) ([(Text, Point Double)] -> ChartData
TextData [(Text, Point Double)]
l)
  where
    l :: [(Text, Point Double)]
l =
      (Point Double, Text) -> (Text, Point Double)
forall a b. (a, b) -> (b, a)
swap ((Point Double, Text) -> (Text, Point Double))
-> ((Double, Text) -> (Point Double, Text))
-> (Double, Text)
-> (Text, Point Double)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Double -> Point Double) -> (Double, Text) -> (Point Double, Text)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Point Double -> Point Double -> Point Double
addp (Place -> Double -> Rect Double -> Point Double
placeSides Place
pl (Optic' A_Lens NoIx TickStyle Double -> TickStyle -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx TickStyle Double
#buffer TickStyle
s) Rect Double
sb Point Double -> Point Double -> Point Double
forall a. Additive a => a -> a -> a
+ Place -> Style -> Double -> Point Double
textPos Place
pl (Optic' A_Lens NoIx TickStyle Style -> TickStyle -> Style
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx TickStyle Style
#style TickStyle
s) (Optic' A_Lens NoIx TickStyle Double -> TickStyle -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx TickStyle Double
#buffer TickStyle
s)) (Point Double -> Point Double)
-> (Double -> Point Double) -> Double -> Point Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Place -> Double -> Point Double
placeOrigin Place
pl)
        ((Double, Text) -> (Text, Point Double))
-> [(Double, Text)] -> [(Text, Point Double)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tick -> Place -> Rect Double -> Rect Double -> [(Double, Text)]
ticksPlacedCanvas Tick
ts Place
pl Rect Double
cb Rect Double
db

placeSides :: Place -> Double -> ChartBox -> Point Double
placeSides :: Place -> Double -> Rect Double -> Point Double
placeSides Place
pl Double
b (Rect Double
x Double
z Double
y Double
w) = case Place
pl of
  Place
PlaceTop -> Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
0 (Double
w Double -> Double -> Double
forall a. Additive a => a -> a -> a
+ Double
b)
  Place
PlaceBottom -> Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
0 (Double
y Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- Double
b)
  Place
PlaceLeft -> Double -> Double -> Point Double
forall a. a -> a -> Point a
Point (Double
x Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- Double
b) Double
0
  Place
PlaceRight -> Double -> Double -> Point Double
forall a. a -> a -> Point a
Point (Double
z Double -> Double -> Double
forall a. Additive a => a -> a -> a
+ Double
b) Double
0
  PlaceAbsolute Point Double
p -> Point Double
p

placeOrigin :: Place -> Double -> Point Double
placeOrigin :: Place -> Double -> Point Double
placeOrigin Place
pl Double
x
  | Place
pl Place -> Place -> Bool
forall a. Eq a => a -> a -> Bool
== Place
PlaceTop Bool -> Bool -> Bool
|| Place
pl Place -> Place -> Bool
forall a. Eq a => a -> a -> Bool
== Place
PlaceBottom = Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
x Double
0
  | Bool
otherwise = Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
0 Double
x

-- | aka grid lines
tickLine ::
  Place ->
  TickStyle ->
  Tick ->
  DataBox ->
  HudChart ->
  ChartTree
tickLine :: Place -> TickStyle -> Tick -> Rect Double -> HudChart -> ChartTree
tickLine Place
pl TickStyle
s Tick
ts Rect Double
db HudChart
hc =
  case Maybe (Rect Double)
cb of
    Maybe (Rect Double)
Nothing -> ChartTree
forall a. Monoid a => a
mempty
    Just Rect Double
cb' ->
      let l :: [[Point Double]]
l = (\Double
x -> Place -> Rect Double -> Double -> Double -> [Point Double]
placeGridLines Place
pl Rect Double
cb' Double
x (Optic' A_Lens NoIx TickStyle Double -> TickStyle -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx TickStyle Double
#buffer TickStyle
s)) (Double -> [Point Double]) -> [Double] -> [[Point Double]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Double, Text) -> Double) -> [(Double, Text)] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Double, Text) -> Double
forall a b. (a, b) -> a
fst (Tick -> Place -> Rect Double -> Rect Double -> [(Double, Text)]
ticksPlacedCanvas Tick
ts Place
pl Rect Double
cb' Rect Double
db)
       in ChartTree -> ChartTree -> Bool -> ChartTree
forall a. a -> a -> Bool -> a
bool (Text -> [Chart] -> ChartTree
named Text
"ticklines" [Style -> ChartData -> Chart
Chart (Optic' A_Lens NoIx TickStyle Style -> TickStyle -> Style
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx TickStyle Style
#style TickStyle
s) ([[Point Double]] -> ChartData
LineData [[Point Double]]
l)]) ChartTree
forall a. Monoid a => a
mempty ([[Point Double]] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Point Double]]
l)
  where
    cb :: Maybe (Rect Double)
cb = Getter HudChart (Maybe (Rect Double))
-> HudChart -> Maybe (Rect Double)
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view (HudChartSection -> Getter HudChart (Maybe (Rect Double))
hudChartBox' (Optic' A_Lens NoIx TickStyle HudChartSection
-> TickStyle -> HudChartSection
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx TickStyle HudChartSection
#anchorTo TickStyle
s)) HudChart
hc

placeGridLines :: Place -> ChartBox -> Double -> Double -> [Point Double]
placeGridLines :: Place -> Rect Double -> Double -> Double -> [Point Double]
placeGridLines Place
pl (Rect Double
x Double
z Double
y Double
w) Double
a Double
b
  | Place
pl Place -> Place -> Bool
forall a. Eq a => a -> a -> Bool
== Place
PlaceTop Bool -> Bool -> Bool
|| Place
pl Place -> Place -> Bool
forall a. Eq a => a -> a -> Bool
== Place
PlaceBottom = [Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
a (Double
y Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- Double
b), Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
a (Double
w Double -> Double -> Double
forall a. Additive a => a -> a -> a
+ Double
b)]
  | Bool
otherwise = [Double -> Double -> Point Double
forall a. a -> a -> Point a
Point (Double
x Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- Double
b) Double
a, Double -> Double -> Point Double
forall a. a -> a -> Point a
Point (Double
z Double -> Double -> Double
forall a. Additive a => a -> a -> a
+ Double
b) Double
a]

-- | title append transformation.
titleHud :: TitleOptions -> HudChart -> ChartTree
titleHud :: TitleOptions -> HudChart -> ChartTree
titleHud TitleOptions
t HudChart
hc = ChartTree
-> (Rect Double -> ChartTree) -> Maybe (Rect Double) -> ChartTree
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ChartTree
forall a. Monoid a => a
mempty ((Text -> [Chart] -> ChartTree
named Text
"title" ([Chart] -> ChartTree) -> (Chart -> [Chart]) -> Chart -> ChartTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Chart -> [Chart]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure) (Chart -> ChartTree)
-> (Rect Double -> Chart) -> Rect Double -> ChartTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. TitleOptions -> Rect Double -> Chart
title_ TitleOptions
t) Maybe (Rect Double)
hb
  where
    hb :: Maybe (Rect Double)
hb = Getter HudChart (Maybe (Rect Double))
-> HudChart -> Maybe (Rect Double)
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view (HudChartSection -> Getter HudChart (Maybe (Rect Double))
hudChartBox' HudChartSection
HudStyleSection) HudChart
hc

title_ :: TitleOptions -> ChartBox -> Chart
title_ :: TitleOptions -> Rect Double -> Chart
title_ TitleOptions
t Rect Double
cb =
  Style -> ChartData -> Chart
Chart
    Style
s'
    ([(Text, Point Double)] -> ChartData
TextData [(Optic' A_Lens NoIx TitleOptions Text -> TitleOptions -> Text
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx TitleOptions Text
#text TitleOptions
t, Point Double
placePosTitle)])
  where
    s' :: Style
s' = Optic A_Lens NoIx TitleOptions TitleOptions Style Style
-> TitleOptions -> Style
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic A_Lens NoIx TitleOptions TitleOptions Style Style
#style TitleOptions
t Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style TextAnchor TextAnchor
-> TextAnchor -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style TextAnchor TextAnchor
#textAnchor (Double -> TextAnchor
fromAnchoring (Optic' A_Lens NoIx TitleOptions Double -> TitleOptions -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx TitleOptions Double
#anchoring TitleOptions
t)) Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style (Maybe Double) (Maybe Double)
-> Maybe Double -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style (Maybe Double) (Maybe Double)
#rotation (Maybe Double -> Maybe Double -> Bool -> Maybe Double
forall a. a -> a -> Bool -> a
bool (Double -> Maybe Double
forall a. a -> Maybe a
Just Double
rot) Maybe Double
forall a. Maybe a
Nothing (Double
rot Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
0))
    rot' :: Double
rot' = Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
0 (Optic' A_Lens NoIx TitleOptions (Maybe Double)
-> TitleOptions -> Maybe Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view (Optic A_Lens NoIx TitleOptions TitleOptions Style Style
#style Optic A_Lens NoIx TitleOptions TitleOptions Style Style
-> Optic A_Lens NoIx Style Style (Maybe Double) (Maybe Double)
-> Optic' A_Lens NoIx TitleOptions (Maybe Double)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Style Style (Maybe Double) (Maybe Double)
#rotation) TitleOptions
t)
    rot :: Double
rot
      | Optic' A_Lens NoIx TitleOptions Place -> TitleOptions -> Place
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx TitleOptions Place
#place TitleOptions
t Place -> Place -> Bool
forall a. Eq a => a -> a -> Bool
== Place
PlaceRight = Double
forall a. TrigField a => a
pi Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ Double
2 Double -> Double -> Double
forall a. Additive a => a -> a -> a
+ Double
rot'
      | Optic' A_Lens NoIx TitleOptions Place -> TitleOptions -> Place
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx TitleOptions Place
#place TitleOptions
t Place -> Place -> Bool
forall a. Eq a => a -> a -> Bool
== Place
PlaceLeft = Double
forall a. TrigField a => a
pi Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ Double
2 Double -> Double -> Double
forall a. Additive a => a -> a -> a
+ Double
rot'
      | Bool
otherwise = Double
rot'
    placePosTitle :: Point Double
placePosTitle =
      Place
-> Double -> Double -> Rect Double -> Rect Double -> Point Double
beside
        (Optic' A_Lens NoIx TitleOptions Place -> TitleOptions -> Place
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx TitleOptions Place
#place TitleOptions
t)
        (Optic' A_Lens NoIx TitleOptions Double -> TitleOptions -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx TitleOptions Double
#anchoring TitleOptions
t)
        (Optic' A_Lens NoIx TitleOptions Double -> TitleOptions -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx TitleOptions Double
#buffer TitleOptions
t)
        Rect Double
cb
        (Style -> Text -> Point Double -> Rect Double
styleBoxText Style
s' (Optic' A_Lens NoIx TitleOptions Text -> TitleOptions -> Text
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx TitleOptions Text
#text TitleOptions
t) Point Double
forall a. Additive a => a
zero)

textPos :: Place -> Style -> Double -> Point Double
textPos :: Place -> Style -> Double -> Point Double
textPos Place
pl Style
tt Double
b = case Place
pl of
  Place
PlaceTop -> Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
0 (Double
b Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- Optic A_Lens NoIx Style Style Double Double -> Style -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic A_Lens NoIx Style Style Double Double
#vshift Style
tt Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Optic A_Lens NoIx Style Style Double Double -> Style -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic A_Lens NoIx Style Style Double Double
#vsize Style
tt Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Optic A_Lens NoIx Style Style Double Double -> Style -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic A_Lens NoIx Style Style Double Double
#size Style
tt)
  Place
PlaceBottom -> Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
0 (-Double
b Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- Optic A_Lens NoIx Style Style Double Double -> Style -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic A_Lens NoIx Style Style Double Double
#vshift Style
tt Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Optic A_Lens NoIx Style Style Double Double -> Style -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic A_Lens NoIx Style Style Double Double
#vsize Style
tt Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Optic A_Lens NoIx Style Style Double Double -> Style -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic A_Lens NoIx Style Style Double Double
#size Style
tt Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- Optic A_Lens NoIx Style Style Double Double -> Style -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic A_Lens NoIx Style Style Double Double
#vsize Style
tt Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Optic A_Lens NoIx Style Style Double Double -> Style -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic A_Lens NoIx Style Style Double Double
#size Style
tt)
  Place
PlaceLeft ->
    Double -> Double -> Point Double
forall a. a -> a -> Point a
Point
      (-Double
b)
      (Optic A_Lens NoIx Style Style Double Double -> Style -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic A_Lens NoIx Style Style Double Double
#vshift Style
tt Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Optic A_Lens NoIx Style Style Double Double -> Style -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic A_Lens NoIx Style Style Double Double
#vsize Style
tt Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Optic A_Lens NoIx Style Style Double Double -> Style -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic A_Lens NoIx Style Style Double Double
#size Style
tt)
  Place
PlaceRight ->
    Double -> Double -> Point Double
forall a. a -> a -> Point a
Point
      Double
b
      (Optic A_Lens NoIx Style Style Double Double -> Style -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic A_Lens NoIx Style Style Double Double
#vshift Style
tt Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Optic A_Lens NoIx Style Style Double Double -> Style -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic A_Lens NoIx Style Style Double Double
#vsize Style
tt Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Optic A_Lens NoIx Style Style Double Double -> Style -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic A_Lens NoIx Style Style Double Double
#size Style
tt)
  PlaceAbsolute Point Double
p -> Point Double
p

placeTextAnchor :: Place -> (Style -> Style)
placeTextAnchor :: Place -> Style -> Style
placeTextAnchor Place
pl
  | Place
pl Place -> Place -> Bool
forall a. Eq a => a -> a -> Bool
== Place
PlaceLeft = Optic A_Lens NoIx Style Style TextAnchor TextAnchor
-> TextAnchor -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style TextAnchor TextAnchor
#textAnchor TextAnchor
AnchorEnd
  | Place
pl Place -> Place -> Bool
forall a. Eq a => a -> a -> Bool
== Place
PlaceRight = Optic A_Lens NoIx Style Style TextAnchor TextAnchor
-> TextAnchor -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style TextAnchor TextAnchor
#textAnchor TextAnchor
AnchorStart
  | Bool
otherwise = Style -> Style
forall a. a -> a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id

-- | Make a frame hud transformation.
frameHud :: FrameOptions -> HudChart -> ChartTree
frameHud :: FrameOptions -> HudChart -> ChartTree
frameHud FrameOptions
o HudChart
hc =
  case Maybe (Rect Double)
r of
    Maybe (Rect Double)
Nothing -> ChartTree
forall a. Monoid a => a
mempty
    Just Rect Double
r' -> case Optic
  A_Lens NoIx FrameOptions FrameOptions (Maybe Style) (Maybe Style)
-> FrameOptions -> Maybe Style
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic
  A_Lens NoIx FrameOptions FrameOptions (Maybe Style) (Maybe Style)
#frame FrameOptions
o of
      Maybe Style
Nothing -> Text -> [Chart] -> ChartTree
named Text
"frame" [Style -> ChartData -> Chart
Chart Style
defaultStyle ([Rect Double] -> ChartData
BlankData [Rect Double
r'])]
      Just Style
rs -> Text -> [Chart] -> ChartTree
named Text
"frame" [Style -> ChartData -> Chart
Chart Style
rs ([Rect Double] -> ChartData
RectData [Rect Double
r'])]
  where
    r :: Maybe (Rect Double)
r = Double -> Rect Double -> Rect Double
forall a. Subtractive a => a -> Rect a -> Rect a
padRect (Optic A_Lens NoIx FrameOptions FrameOptions Double Double
-> FrameOptions -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic A_Lens NoIx FrameOptions FrameOptions Double Double
#buffer FrameOptions
o) (Rect Double -> Rect Double)
-> Maybe (Rect Double) -> Maybe (Rect Double)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getter HudChart (Maybe (Rect Double))
-> HudChart -> Maybe (Rect Double)
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view (HudChartSection -> Getter HudChart (Maybe (Rect Double))
hudChartBox' (Optic
  A_Lens
  NoIx
  FrameOptions
  FrameOptions
  HudChartSection
  HudChartSection
-> FrameOptions -> HudChartSection
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic
  A_Lens
  NoIx
  FrameOptions
  FrameOptions
  HudChartSection
  HudChartSection
#anchorTo FrameOptions
o)) HudChart
hc

-- | Make a legend from 'LegendOptions' given an existing 'HudChart'
legendHud :: LegendOptions -> HudChart -> ChartTree
legendHud :: LegendOptions -> HudChart -> ChartTree
legendHud LegendOptions
o HudChart
hc = ChartTree
-> (Rect Double -> ChartTree) -> Maybe (Rect Double) -> ChartTree
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ChartTree
forall a. Monoid a => a
mempty (\Rect Double
b -> Place -> Double -> Double -> Rect Double -> ChartTree -> ChartTree
besideChart (Optic' A_Lens NoIx LegendOptions Place -> LegendOptions -> Place
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx LegendOptions Place
#place LegendOptions
o) (Optic' A_Lens NoIx LegendOptions Double -> LegendOptions -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx LegendOptions Double
#anchoring LegendOptions
o) (Optic' A_Lens NoIx LegendOptions Double -> LegendOptions -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx LegendOptions Double
#buffer LegendOptions
o) Rect Double
b (Optic A_Traversal NoIx ChartTree ChartTree Chart Chart
-> (Chart -> Chart) -> ChartTree -> ChartTree
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over Optic A_Traversal NoIx ChartTree ChartTree Chart Chart
chart' (Double -> Chart -> Chart
scaleChart (Optic' A_Lens NoIx LegendOptions Double -> LegendOptions -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx LegendOptions Double
#scaleChartsBy LegendOptions
o)) ChartTree
lcs)) (Getter HudChart (Maybe (Rect Double))
-> HudChart -> Maybe (Rect Double)
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view (HudChartSection -> Getter HudChart (Maybe (Rect Double))
hudChartBox' (Optic' A_Lens NoIx LegendOptions HudChartSection
-> LegendOptions -> HudChartSection
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx LegendOptions HudChartSection
#anchorTo LegendOptions
o)) HudChart
hc)
  where
    lcs :: ChartTree
lcs = LegendOptions -> ChartTree
legendChart LegendOptions
o ChartTree -> (ChartTree -> ChartTree) -> ChartTree
forall a b. a -> (a -> b) -> b
& Optic A_Traversal (Int : NoIx) ChartTree ChartTree ScaleP ScaleP
-> ScaleP -> ChartTree -> ChartTree
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (Optic A_Traversal NoIx ChartTree ChartTree [Chart] [Chart]
charts' Optic A_Traversal NoIx ChartTree ChartTree [Chart] [Chart]
-> Optic A_Traversal (Int : NoIx) [Chart] [Chart] Chart Chart
-> Optic A_Traversal (Int : NoIx) ChartTree ChartTree Chart Chart
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Traversal (Int : NoIx) [Chart] [Chart] Chart Chart
forall i s t a b. Each i s t a b => IxTraversal i s t a b
each Optic A_Traversal (Int : NoIx) ChartTree ChartTree Chart Chart
-> Optic A_Lens NoIx Chart Chart Style Style
-> Optic A_Traversal (Int : NoIx) ChartTree ChartTree Style Style
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Chart Chart Style Style
#chartStyle Optic A_Traversal (Int : NoIx) ChartTree ChartTree Style Style
-> Optic A_Lens NoIx Style Style ScaleP ScaleP
-> Optic A_Traversal (Int : NoIx) ChartTree ChartTree ScaleP ScaleP
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Style Style ScaleP ScaleP
#scaleP) (Optic' A_Lens NoIx LegendOptions ScaleP -> LegendOptions -> ScaleP
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx LegendOptions ScaleP
#scaleP LegendOptions
o)

-- | frame a legend
legendFrame :: LegendOptions -> ChartTree -> ChartTree
legendFrame :: LegendOptions -> ChartTree -> ChartTree
legendFrame LegendOptions
l ChartTree
content' =
  Maybe Text -> [ChartTree] -> ChartTree
group (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"legend") [ChartTree
borders, Maybe Text -> ChartTree -> ChartTree
rename (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"legendContent") ChartTree
content']
  where
    borders :: ChartTree
borders = [ChartTree] -> ChartTree
forall a. Monoid a => [a] -> a
mconcat ([ChartTree] -> ChartTree) -> [ChartTree] -> ChartTree
forall a b. (a -> b) -> a -> b
$ [ChartTree
outer, ChartTree
inner] [ChartTree] -> [ChartTree] -> [ChartTree]
forall a. Semigroup a => a -> a -> a
<> [ChartTree]
frame'
    outer :: ChartTree
outer = Double -> ChartTree -> ChartTree
padChart (Optic' A_Lens NoIx LegendOptions Double -> LegendOptions -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx LegendOptions Double
#outerPad LegendOptions
l) ChartTree
inner
    frame' :: [ChartTree]
frame' = (Style -> [ChartTree]) -> Maybe Style -> [ChartTree]
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\Style
r -> [Style -> Double -> ChartTree -> ChartTree
frameChart Style
r Double
0 ChartTree
inner]) (Optic
  A_Lens NoIx LegendOptions LegendOptions (Maybe Style) (Maybe Style)
-> LegendOptions -> Maybe Style
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic
  A_Lens NoIx LegendOptions LegendOptions (Maybe Style) (Maybe Style)
#frame LegendOptions
l)
    inner :: ChartTree
inner = Double -> ChartTree -> ChartTree
padChart (Optic' A_Lens NoIx LegendOptions Double -> LegendOptions -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx LegendOptions Double
#innerPad LegendOptions
l) ChartTree
content'

-- | Make the contents portion of a legend
legendChart :: LegendOptions -> ChartTree
legendChart :: LegendOptions -> ChartTree
legendChart LegendOptions
l = LegendOptions -> ChartTree -> ChartTree
legendFrame LegendOptions
l ChartTree
content'
  where
    content' :: ChartTree
content' =
      Int -> Align -> Align -> Double -> [ChartTree] -> ChartTree
stack
        (Optic' A_Lens NoIx LegendOptions Int -> LegendOptions -> Int
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx LegendOptions Int
#numStacks LegendOptions
l)
        Align
AlignLeft
        Align
AlignMid
        (Optic' A_Lens NoIx LegendOptions Double -> LegendOptions -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx LegendOptions Double
#hgap LegendOptions
l)
        ( ( \(Chart
t, [Chart]
a) ->
              Align -> Double -> [ChartTree] -> ChartTree
hori
                Align
AlignMid
                (Optic' A_Lens NoIx LegendOptions Double -> LegendOptions -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx LegendOptions Double
#vgap LegendOptions
l Double -> Double -> Double
forall a. Additive a => a -> a -> a
+ Double -> Double -> Bool -> Double
forall a. a -> a -> Bool -> a
bool Double
0 (Double
twidth Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- Chart -> Double
gapwidth Chart
t) (Optic' A_Lens NoIx LegendOptions Align -> LegendOptions -> Align
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx LegendOptions Align
#alignCharts LegendOptions
l Align -> Align -> Bool
forall a. Eq a => a -> a -> Bool
== Align
AlignRight))
                (([Chart] -> ChartTree) -> [[Chart]] -> [ChartTree]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Chart] -> ChartTree
unnamed [[Chart
t], [Chart]
a])
          )
            ((Chart, [Chart]) -> ChartTree)
-> [(Chart, [Chart])] -> [ChartTree]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Chart, [Chart])]
es
        )
    es :: [(Chart, [Chart])]
es = (Text -> [Chart] -> (Chart, [Chart]))
-> (Text, [Chart]) -> (Chart, [Chart])
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (LegendOptions -> Text -> [Chart] -> (Chart, [Chart])
legendEntry LegendOptions
l) ((Text, [Chart]) -> (Chart, [Chart]))
-> [(Text, [Chart])] -> [(Chart, [Chart])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Optic' A_Lens NoIx LegendOptions [(Text, [Chart])]
-> LegendOptions -> [(Text, [Chart])]
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx LegendOptions [(Text, [Chart])]
#legendCharts LegendOptions
l
    twidth :: Double
twidth = Double -> (Rect Double -> Double) -> Maybe (Rect Double) -> Double
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Double
forall a. Additive a => a
zero (\(Rect Double
x Double
z Double
_ Double
_) -> Double
z Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- Double
x) ([Chart] -> Maybe (Rect Double)
styleBoxes ((Chart, [Chart]) -> Chart
forall a b. (a, b) -> a
fst ((Chart, [Chart]) -> Chart) -> [(Chart, [Chart])] -> [Chart]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Chart, [Chart])]
es))
    gapwidth :: Chart -> Double
gapwidth Chart
t = Double -> (Rect Double -> Double) -> Maybe (Rect Double) -> Double
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Double
0 (\(Rect Double
x Double
z Double
_ Double
_) -> Double
z Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- Double
x) (Chart -> Maybe (Rect Double)
sbox Chart
t)

legendText ::
  LegendOptions ->
  Text ->
  Chart
legendText :: LegendOptions -> Text -> Chart
legendText LegendOptions
l Text
t =
  Style -> ChartData -> Chart
Chart (Optic' A_Lens NoIx LegendOptions Style -> LegendOptions -> Style
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx LegendOptions Style
#textStyle LegendOptions
l Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style TextAnchor TextAnchor
-> TextAnchor -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style TextAnchor TextAnchor
#textAnchor TextAnchor
AnchorStart Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style ScaleP ScaleP
-> ScaleP -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style ScaleP ScaleP
#scaleP ScaleP
ScalePX) ([(Text, Point Double)] -> ChartData
TextData [(Text
t, Point Double
forall a. Additive a => a
zero)])

legendizeChart ::
  LegendOptions ->
  Chart ->
  Chart
legendizeChart :: LegendOptions -> Chart -> Chart
legendizeChart LegendOptions
l Chart
c =
  case Chart
c of
    (Chart Style
rs (RectData [Rect Double]
_)) -> Style -> ChartData -> Chart
Chart Style
rs ([Rect Double] -> ChartData
RectData [Double -> Double -> Double -> Double -> Rect Double
forall a. a -> a -> a -> a -> Rect a
Rect Double
0 (Optic' A_Lens NoIx LegendOptions Double -> LegendOptions -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx LegendOptions Double
#legendSize LegendOptions
l) Double
0 (Optic' A_Lens NoIx LegendOptions Double -> LegendOptions -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx LegendOptions Double
#legendSize LegendOptions
l)])
    (Chart Style
ts (TextData [(Text, Point Double)]
t)) -> let txt :: Text
txt = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"text" ([Text] -> Maybe Text
forall a. [a] -> Maybe a
listToMaybe ((Text, Point Double) -> Text
forall a b. (a, b) -> a
fst ((Text, Point Double) -> Text) -> [(Text, Point Double)] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, Point Double)]
t)) in Style -> ChartData -> Chart
Chart (Style
ts Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Double Double
-> Double -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Double Double
#size (Optic' A_Lens NoIx LegendOptions Double -> LegendOptions -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx LegendOptions Double
#legendSize LegendOptions
l Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ Int -> Double
forall a b. FromIntegral a b => b -> a
fromIntegral (Text -> Int
Text.length Text
txt))) ([(Text, Point Double)] -> ChartData
TextData [(Text
txt, Double -> Double -> Point Double
forall a. a -> a -> Point a
Point (Double
0.5 Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Optic' A_Lens NoIx LegendOptions Double -> LegendOptions -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx LegendOptions Double
#legendSize LegendOptions
l) (Double
0.33 Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Optic' A_Lens NoIx LegendOptions Double -> LegendOptions -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx LegendOptions Double
#legendSize LegendOptions
l))])
    (Chart Style
gs (GlyphData [Point Double]
_)) -> Style -> ChartData -> Chart
Chart (Style
gs Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Double Double
-> Double -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Double Double
#size (Optic' A_Lens NoIx LegendOptions Double -> LegendOptions -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx LegendOptions Double
#legendSize LegendOptions
l)) ([Point Double] -> ChartData
GlyphData [Double -> Double -> Point Double
forall a. a -> a -> Point a
Point (Double
0.5 Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Optic' A_Lens NoIx LegendOptions Double -> LegendOptions -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx LegendOptions Double
#legendSize LegendOptions
l) (Double
0.33 Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Optic' A_Lens NoIx LegendOptions Double -> LegendOptions -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx LegendOptions Double
#legendSize LegendOptions
l)])
    (Chart Style
ls (LineData [[Point Double]]
_)) ->
      Style -> ChartData -> Chart
Chart
        (Style
ls Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Double Double
-> (Double -> Double) -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over Optic A_Lens NoIx Style Style Double Double
#size (Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ Optic' A_Lens NoIx LegendOptions Double -> LegendOptions -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx LegendOptions Double
#scaleChartsBy LegendOptions
l))
        ([[Point Double]] -> ChartData
LineData [[Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
0 (Double
1 Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Optic' A_Lens NoIx LegendOptions Double -> LegendOptions -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx LegendOptions Double
#legendSize LegendOptions
l), Double -> Double -> Point Double
forall a. a -> a -> Point a
Point (Double
2 Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Optic' A_Lens NoIx LegendOptions Double -> LegendOptions -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx LegendOptions Double
#legendSize LegendOptions
l) (Double
1 Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Optic' A_Lens NoIx LegendOptions Double -> LegendOptions -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx LegendOptions Double
#legendSize LegendOptions
l)]])
    (Chart Style
ps (PathData [PathData Double]
_)) ->
      ( let cs :: [PathData Double]
cs =
              QuadPosition Double -> [PathData Double]
singletonQuad
                ( Point Double -> Point Double -> Point Double -> QuadPosition Double
forall a. Point a -> Point a -> Point a -> QuadPosition a
QuadPosition
                    (Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
0 Double
0)
                    (Double -> Double -> Point Double
forall a. a -> a -> Point a
Point (Optic' A_Lens NoIx LegendOptions Double -> LegendOptions -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx LegendOptions Double
#legendSize LegendOptions
l) (Optic' A_Lens NoIx LegendOptions Double -> LegendOptions -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx LegendOptions Double
#legendSize LegendOptions
l))
                    (Double -> Double -> Point Double
forall a. a -> a -> Point a
Point (Double
2 Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Optic' A_Lens NoIx LegendOptions Double -> LegendOptions -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx LegendOptions Double
#legendSize LegendOptions
l) ((-Double
1) Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Optic' A_Lens NoIx LegendOptions Double -> LegendOptions -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx LegendOptions Double
#legendSize LegendOptions
l))
                )
         in Style -> ChartData -> Chart
Chart (Style
ps Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Double Double
-> Double -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Double Double
#borderSize (Optic' A_Lens NoIx LegendOptions Double -> LegendOptions -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx LegendOptions Double
#legendSize LegendOptions
l)) ([PathData Double] -> ChartData
PathData [PathData Double]
cs)
      )
    Chart
_ -> Rect Double -> Chart
blankChart1 (Double -> Double -> Double -> Double -> Rect Double
forall a. a -> a -> a -> a -> Rect a
Rect Double
0 (Optic' A_Lens NoIx LegendOptions Double -> LegendOptions -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx LegendOptions Double
#legendSize LegendOptions
l) Double
0 (Optic' A_Lens NoIx LegendOptions Double -> LegendOptions -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx LegendOptions Double
#legendSize LegendOptions
l))

legendEntry ::
  LegendOptions ->
  Text ->
  [Chart] ->
  (Chart, [Chart])
legendEntry :: LegendOptions -> Text -> [Chart] -> (Chart, [Chart])
legendEntry LegendOptions
l Text
t [Chart]
cs =
  (LegendOptions -> Text -> Chart
legendText LegendOptions
l Text
t, (Chart -> Chart) -> [Chart] -> [Chart]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (LegendOptions -> Chart -> Chart
legendizeChart LegendOptions
l) [Chart]
cs)