{-# 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,
    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,
    LegendOptions (..),
    defaultLegendOptions,

    -- * Convert Hud elements to charts
    axisHud,
    titleHud,
    frameHud,
    legendHud,
  )
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
forall a. Eq a => Priority a -> Priority a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Priority a -> Priority a -> Bool
$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
Eq, Priority a -> Priority a -> Bool
Priority a -> Priority a -> Ordering
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
min :: Priority a -> Priority a -> Priority a
$cmin :: forall a. Ord a => Priority a -> Priority a -> Priority a
max :: Priority a -> Priority a -> Priority a
$cmax :: forall a. Ord a => Priority a -> Priority a -> Priority a
>= :: 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
$c< :: forall a. Ord a => Priority a -> Priority a -> Bool
compare :: Priority a -> Priority a -> Ordering
$ccompare :: forall a. Ord a => Priority a -> Priority a -> Ordering
Ord, Int -> Priority a -> ShowS
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
showList :: [Priority a] -> ShowS
$cshowList :: forall a. Show a => [Priority a] -> ShowS
show :: Priority a -> String
$cshow :: forall a. Show a => Priority a -> String
showsPrec :: Int -> Priority a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Priority a -> ShowS
Show, 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
$cto :: forall a x. Rep (Priority a) x -> Priority a
$cfrom :: forall a x. Priority a -> Rep (Priority a) x
Generic, 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
<$ :: forall a b. a -> Priority b -> Priority a
$c<$ :: forall a b. a -> Priority b -> Priority a
fmap :: forall a b. (a -> b) -> Priority a -> Priority b
$cfmap :: forall a b. (a -> b) -> Priority a -> Priority b
Functor)

-- | Heads-up display additions to charts
newtype Hud = Hud {Hud -> Priority (HudChart -> ChartTree)
phud :: Priority (HudChart -> ChartTree)} deriving (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
$cto :: forall x. Rep Hud x -> Hud
$cfrom :: forall x. Hud -> Rep Hud x
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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HudChart -> HudChart -> Bool
$c/= :: HudChart -> HudChart -> Bool
== :: HudChart -> HudChart -> Bool
$c== :: HudChart -> HudChart -> Bool
Eq, Int -> HudChart -> ShowS
[HudChart] -> ShowS
HudChart -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HudChart] -> ShowS
$cshowList :: [HudChart] -> ShowS
show :: HudChart -> String
$cshow :: HudChart -> String
showsPrec :: Int -> HudChart -> ShowS
$cshowsPrec :: Int -> HudChart -> ShowS
Show, 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
$cto :: forall x. Rep HudChart x -> HudChart
$cfrom :: forall x. HudChart -> Rep HudChart x
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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HudChartSection -> HudChartSection -> Bool
$c/= :: HudChartSection -> HudChartSection -> Bool
== :: HudChartSection -> HudChartSection -> Bool
$c== :: HudChartSection -> HudChartSection -> Bool
Eq, Int -> HudChartSection -> ShowS
[HudChartSection] -> ShowS
HudChartSection -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HudChartSection] -> ShowS
$cshowList :: [HudChartSection] -> ShowS
show :: HudChartSection -> String
$cshow :: HudChartSection -> String
showsPrec :: Int -> HudChartSection -> ShowS
$cshowsPrec :: Int -> HudChartSection -> ShowS
Show, 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
$cto :: forall x. Rep HudChartSection x -> HudChartSection
$cfrom :: forall x. HudChartSection -> Rep HudChartSection x
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 = forall s a. (s -> a) -> Getter s a
to ([Chart] -> Maybe (Rect Double)
boxes forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall k a (is :: IxList) s.
(Is k A_Fold, Monoid a) =>
Optic' k is s a -> s -> a
foldOf (forall a. IsLabel "chartSection" a => a
#chartSection forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Traversal' ChartTree [Chart]
charts'))
hudChartBox' HudChartSection
CanvasStyleSection = forall s a. (s -> a) -> Getter s a
to ([Chart] -> Maybe (Rect Double)
styleBoxes forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall k a (is :: IxList) s.
(Is k A_Fold, Monoid a) =>
Optic' k is s a -> s -> a
foldOf (forall a. IsLabel "chartSection" a => a
#chartSection forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Traversal' ChartTree [Chart]
charts'))
hudChartBox' HudChartSection
HudSection = forall s a. (s -> a) -> Getter s a
to ([Chart] -> Maybe (Rect Double)
boxes forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (\HudChart
x -> forall k a (is :: IxList) s.
(Is k A_Fold, Monoid a) =>
Optic' k is s a -> s -> a
foldOf (forall a. IsLabel "chartSection" a => a
#chartSection forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Traversal' ChartTree [Chart]
charts') HudChart
x forall a. Semigroup a => a -> a -> a
<> forall k a (is :: IxList) s.
(Is k A_Fold, Monoid a) =>
Optic' k is s a -> s -> a
foldOf (forall a. IsLabel "hudSection" a => a
#hudSection forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Traversal' ChartTree [Chart]
charts') HudChart
x))
hudChartBox' HudChartSection
HudStyleSection = forall s a. (s -> a) -> Getter s a
to ([Chart] -> Maybe (Rect Double)
styleBoxes forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (\HudChart
x -> forall k a (is :: IxList) s.
(Is k A_Fold, Monoid a) =>
Optic' k is s a -> s -> a
foldOf (forall a. IsLabel "chartSection" a => a
#chartSection forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Traversal' ChartTree [Chart]
charts') HudChart
x forall a. Semigroup a => a -> a -> a
<> forall k a (is :: IxList) s.
(Is k A_Fold, Monoid a) =>
Optic' k is s a -> s -> a
foldOf (forall a. IsLabel "hudSection" a => a
#hudSection forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Traversal' ChartTree [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 forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over forall a. IsLabel "hudSection" a => a
#hudSection (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 = forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over forall a. IsLabel "hudSection" a => a
#hudSection (forall a. Semigroup a => a -> a -> a
<> forall a. Monoid a => [a] -> a
mconcat (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (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 (forall a. a -> Maybe a
Just Text
"chart") [forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "chartSection" a => a
#chartSection HudChart
hc] forall a. Semigroup a => a -> a -> a
<> Maybe Text -> [ChartTree] -> ChartTree
group (forall a. a -> Maybe a
Just Text
"hud") [forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "hudSection" a => a
#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
    forall a b. a -> (a -> b) -> b
& forall b a. Ord b => (a -> b) -> [a] -> [a]
List.sortOn (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view (forall a. IsLabel "phud" a => a
#phud forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a. IsLabel "priority" a => a
#priority))
    forall a b. a -> (a -> b) -> b
& forall a. (a -> a -> Bool) -> [a] -> [[a]]
List.groupBy (\Hud
a Hud
b -> forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view (forall a. IsLabel "phud" a => a
#phud forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a. IsLabel "priority" a => a
#priority) Hud
a forall a. Eq a => a -> a -> Bool
== forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view (forall a. IsLabel "phud" a => a
#phud forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a. IsLabel "priority" a => a
#priority) Hud
b)
    forall a b. a -> (a -> b) -> b
& forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view (forall a. IsLabel "phud" a => a
#phud forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a. IsLabel "item" a => a
#item)))
    forall a b. a -> (a -> b) -> b
& forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (forall a b c. (a -> b -> c) -> b -> a -> c
flip [HudChart -> ChartTree] -> HudChart -> HudChart
makeHuds) HudChart
hc0
    forall a b. a -> (a -> b) -> b
& HudChart -> ChartTree
fromHudChart
  where
    hc0 :: HudChart
hc0 =
      ChartTree -> ChartTree -> HudChart
HudChart
        (ChartTree
cs forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Lens' ChartTree (Maybe (Rect Double))
styleBox' (forall a. a -> Maybe a
Just Rect Double
cb))
        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 (forall a. a -> Maybe a
Just ChartTree
cs'))
    [Hud]
hs
    ChartTree
cs'
  where
    db :: Rect Double
db = forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Getter 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 forall a. Semigroup a => a -> a -> a
<> forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty (\Rect Double
r -> forall a. a -> a -> Bool -> a
bool (Text -> [Chart] -> ChartTree
named Text
"datapadding" [Style -> [Rect Double] -> Chart
BlankChart Style
defaultStyle [Rect Double
r]]) forall a. Monoid a => a
mempty (Rect Double
r 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 = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Multiplicative a => a
one (Double -> Rect Double
aspect forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. Field a => Rect a -> a
ratio forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Getter ChartTree (Rect Double)
safeStyleBox') Maybe ChartTree
cs
initialCanvas ChartAspect
UnscaledAspect Maybe ChartTree
cs = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Multiplicative a => a
one (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Getter 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 = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Multiplicative a => a
one (Double -> Rect Double
aspect forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. Field a => Rect a -> a
ratio forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Getter ChartTree (Rect Double)
safeStyleBox') Maybe ChartTree
cs
finalCanvas ChartAspect
UnscaledAspect Maybe ChartTree
cs = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Multiplicative a => a
one (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Getter 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 (forall a. a -> Maybe a
Just ChartTree
csAndHud)
    ctFinal :: ChartTree
ctFinal = forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Lens' ChartTree (Maybe (Rect Double))
styleBox' (forall a. a -> Maybe a
Just Rect Double
viewbox) ChartTree
csAndHud

-- | 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HudOptions -> HudOptions -> Bool
$c/= :: HudOptions -> HudOptions -> Bool
== :: HudOptions -> HudOptions -> Bool
$c== :: HudOptions -> HudOptions -> Bool
Eq, Int -> HudOptions -> ShowS
[HudOptions] -> ShowS
HudOptions -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HudOptions] -> ShowS
$cshowList :: [HudOptions] -> ShowS
show :: HudOptions -> String
$cshow :: HudOptions -> String
showsPrec :: Int -> HudOptions -> ShowS
$cshowsPrec :: Int -> HudOptions -> ShowS
Show, 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
$cto :: forall x. Rep HudOptions x -> HudOptions
$cfrom :: forall x. HudOptions -> Rep HudOptions x
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 forall a. Semigroup a => a -> a -> a
<> [Priority AxisOptions]
a') ([Priority FrameOptions]
c forall a. Semigroup a => a -> a -> a
<> [Priority FrameOptions]
c') ([Priority LegendOptions]
l forall a. Semigroup a => a -> a -> a
<> [Priority LegendOptions]
l') ([Priority TitleOptions]
t 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
    [ forall a. Double -> a -> Priority a
Priority Double
5 AxisOptions
defaultXAxisOptions,
      forall a. Double -> a -> Priority a
Priority Double
5 AxisOptions
defaultYAxisOptions
    ]
    [ forall a. Double -> a -> Priority a
Priority Double
1 (FrameOptions
defaultFrameOptions forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set forall a. IsLabel "anchorTo" a => a
#anchorTo HudChartSection
CanvasStyleSection),
      forall a. Double -> a -> Priority a
Priority Double
20 (FrameOptions
defaultFrameOptions forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set forall a. IsLabel "buffer" a => a
#buffer Double
0.04 forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set forall a. IsLabel "frame" a => a
#frame (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
    forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over (forall a. IsLabel "frames" a => a
#frames forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall i s t a b. Each i s t a b => IxTraversal i s t a b
each forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a. IsLabel "item" a => a
#item) FrameOptions -> FrameOptions
fFrame
    forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over (forall a. IsLabel "titles" a => a
#titles forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall i s t a b. Each i s t a b => IxTraversal i s t a b
each forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a. IsLabel "item" a => a
#item forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a. IsLabel "style" a => a
#style forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a. IsLabel "color" a => a
#color) Colour -> Colour
f
    forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over (forall a. IsLabel "axes" a => a
#axes forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall i s t a b. Each i s t a b => IxTraversal i s t a b
each forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a. IsLabel "item" a => a
#item) AxisOptions -> AxisOptions
fAxis
    forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over (forall a. IsLabel "legends" a => a
#legends forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall i s t a b. Each i s t a b => IxTraversal i s t a b
each forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a. IsLabel "item" a => a
#item) LegendOptions -> LegendOptions
fLegend
  where
    fAxis :: AxisOptions -> AxisOptions
    fAxis :: AxisOptions -> AxisOptions
fAxis AxisOptions
a =
      AxisOptions
a
        forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over (forall a. IsLabel "axisBar" a => a
#axisBar forall (is :: IxList) (js :: IxList) (ks :: IxList) k k' l m s t u
       v a b.
(AppendIndices is js ks, JoinKinds k A_Prism k',
 JoinKinds k' l m) =>
Optic k is s t (Maybe u) (Maybe v)
-> Optic l js u v a b -> Optic m ks s t a b
%? forall a. IsLabel "style" a => a
#style forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a. IsLabel "color" a => a
#color) Colour -> Colour
f
        forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over (forall a. IsLabel "ticks" a => a
#ticks forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a. IsLabel "glyphTick" a => a
#glyphTick forall (is :: IxList) (js :: IxList) (ks :: IxList) k k' l m s t u
       v a b.
(AppendIndices is js ks, JoinKinds k A_Prism k',
 JoinKinds k' l m) =>
Optic k is s t (Maybe u) (Maybe v)
-> Optic l js u v a b -> Optic m ks s t a b
%? forall a. IsLabel "style" a => a
#style forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a. IsLabel "color" a => a
#color) Colour -> Colour
f
        forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over (forall a. IsLabel "ticks" a => a
#ticks forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a. IsLabel "glyphTick" a => a
#glyphTick forall (is :: IxList) (js :: IxList) (ks :: IxList) k k' l m s t u
       v a b.
(AppendIndices is js ks, JoinKinds k A_Prism k',
 JoinKinds k' l m) =>
Optic k is s t (Maybe u) (Maybe v)
-> Optic l js u v a b -> Optic m ks s t a b
%? forall a. IsLabel "style" a => a
#style forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a. IsLabel "borderColor" a => a
#borderColor) Colour -> Colour
f
        forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over (forall a. IsLabel "ticks" a => a
#ticks forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a. IsLabel "textTick" a => a
#textTick forall (is :: IxList) (js :: IxList) (ks :: IxList) k k' l m s t u
       v a b.
(AppendIndices is js ks, JoinKinds k A_Prism k',
 JoinKinds k' l m) =>
Optic k is s t (Maybe u) (Maybe v)
-> Optic l js u v a b -> Optic m ks s t a b
%? forall a. IsLabel "style" a => a
#style forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a. IsLabel "color" a => a
#color) Colour -> Colour
f
        forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over
          (forall a. IsLabel "ticks" a => a
#ticks forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a. IsLabel "lineTick" a => a
#lineTick forall (is :: IxList) (js :: IxList) (ks :: IxList) k k' l m s t u
       v a b.
(AppendIndices is js ks, JoinKinds k A_Prism k',
 JoinKinds k' l m) =>
Optic k is s t (Maybe u) (Maybe v)
-> Optic l js u v a b -> Optic m ks s t a b
%? forall a. IsLabel "style" a => a
#style forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a. IsLabel "color" a => a
#color)
          Colour -> Colour
f
    fLegend :: LegendOptions -> LegendOptions
    fLegend :: LegendOptions -> LegendOptions
fLegend LegendOptions
a =
      LegendOptions
a
        forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over forall a. IsLabel "textStyle" a => a
#textStyle (forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over forall a. IsLabel "color" a => a
#color Colour -> Colour
f)
        forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over forall a. IsLabel "frame" a => a
#frame (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over forall a. IsLabel "color" a => a
#color Colour -> Colour
f forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over forall a. IsLabel "borderColor" a => a
#borderColor Colour -> Colour
f))
    fFrame :: FrameOptions -> FrameOptions
    fFrame :: FrameOptions -> FrameOptions
fFrame FrameOptions
a =
      FrameOptions
a
        forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over (forall a. IsLabel "frame" a => a
#frame forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a b. Prism (Maybe a) (Maybe b) a b
_Just) (forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over forall a. IsLabel "color" a => a
#color Colour -> Colour
f forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over forall a. IsLabel "borderColor" a => a
#borderColor Colour -> Colour
f)

-- | Placement of elements around (what is implicity but maybe shouldn't just be) a rectangular canvas
data Place
  = PlaceLeft
  | PlaceRight
  | PlaceTop
  | PlaceBottom
  | PlaceAbsolute (Point Double)
  deriving (Int -> Place -> ShowS
[Place] -> ShowS
Place -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Place] -> ShowS
$cshowList :: [Place] -> ShowS
show :: Place -> String
$cshow :: Place -> String
showsPrec :: Int -> Place -> ShowS
$cshowsPrec :: Int -> Place -> ShowS
Show, Place -> Place -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Place -> Place -> Bool
$c/= :: Place -> Place -> Bool
== :: Place -> Place -> Bool
$c== :: Place -> Place -> Bool
Eq, forall x. Rep Place x -> Place
forall x. Place -> Rep Place x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Place x -> Place
$cfrom :: forall x. Place -> Rep Place x
Generic)

-- | Flip Place to the opposite side, or unchanged if 'PlaceAbsolute'.
--
-- >>> flipPlace PlaceLeft
-- PlaceRight
flipPlace :: Place -> Place
flipPlace :: Place -> Place
flipPlace Place
PlaceLeft = Place
PlaceRight
flipPlace Place
PlaceRight = Place
PlaceLeft
flipPlace Place
PlaceTop = Place
PlaceBottom
flipPlace Place
PlaceBottom = Place
PlaceTop
flipPlace Place
x = Place
x

-- | 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AxisOptions -> AxisOptions -> Bool
$c/= :: AxisOptions -> AxisOptions -> Bool
== :: AxisOptions -> AxisOptions -> Bool
$c== :: AxisOptions -> AxisOptions -> Bool
Eq, Int -> AxisOptions -> ShowS
[AxisOptions] -> ShowS
AxisOptions -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AxisOptions] -> ShowS
$cshowList :: [AxisOptions] -> ShowS
show :: AxisOptions -> String
$cshow :: AxisOptions -> String
showsPrec :: Int -> AxisOptions -> ShowS
$cshowsPrec :: Int -> AxisOptions -> ShowS
Show, 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
$cto :: forall x. Rep AxisOptions x -> AxisOptions
$cfrom :: forall x. AxisOptions -> Rep AxisOptions x
Generic)

-- | The official X-axis
defaultXAxisOptions :: AxisOptions
defaultXAxisOptions :: AxisOptions
defaultXAxisOptions = Maybe AxisBar -> Maybe Adjustments -> Ticks -> Place -> AxisOptions
AxisOptions (forall a. a -> Maybe a
Just AxisBar
defaultAxisBar) (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 (forall a. a -> Maybe a
Just AxisBar
defaultAxisBar) (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, anchor = 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AxisBar] -> ShowS
$cshowList :: [AxisBar] -> ShowS
show :: AxisBar -> String
$cshow :: AxisBar -> String
showsPrec :: Int -> AxisBar -> ShowS
$cshowsPrec :: Int -> AxisBar -> ShowS
Show, AxisBar -> AxisBar -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AxisBar -> AxisBar -> Bool
$c/= :: AxisBar -> AxisBar -> Bool
== :: AxisBar -> AxisBar -> Bool
$c== :: AxisBar -> AxisBar -> Bool
Eq, 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
$cto :: forall x. Rep AxisBar x -> AxisBar
$cfrom :: forall x. AxisBar -> Rep AxisBar x
Generic)

-- | The official axis bar
defaultAxisBar :: AxisBar
defaultAxisBar :: AxisBar
defaultAxisBar = Style -> Double -> Double -> Double -> HudChartSection -> AxisBar
AxisBar (Style
defaultRectStyle forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set forall a. IsLabel "borderSize" a => a
#borderSize Double
0 forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set forall a. IsLabel "borderColor" a => a
#borderColor Colour
transparent forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set forall a. IsLabel "color" a => a
#color (forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Lens' Colour Double
opac' Double
0.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, anchor = 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, anchor = AnchorMiddle, buffer = 4.0e-2}
data TitleOptions = TitleOptions
  { TitleOptions -> Text
text :: Text,
    TitleOptions -> Style
style :: Style,
    TitleOptions -> Place
place :: Place,
    TitleOptions -> Anchor
anchor :: Anchor,
    TitleOptions -> Double
buffer :: Double
  }
  deriving (Int -> TitleOptions -> ShowS
[TitleOptions] -> ShowS
TitleOptions -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TitleOptions] -> ShowS
$cshowList :: [TitleOptions] -> ShowS
show :: TitleOptions -> String
$cshow :: TitleOptions -> String
showsPrec :: Int -> TitleOptions -> ShowS
$cshowsPrec :: Int -> TitleOptions -> ShowS
Show, TitleOptions -> TitleOptions -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TitleOptions -> TitleOptions -> Bool
$c/= :: TitleOptions -> TitleOptions -> Bool
== :: TitleOptions -> TitleOptions -> Bool
$c== :: TitleOptions -> TitleOptions -> Bool
Eq, 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
$cto :: forall x. Rep TitleOptions x -> TitleOptions
$cfrom :: forall x. TitleOptions -> Rep TitleOptions x
Generic)

-- | The official hud title
defaultTitleOptions :: Text -> TitleOptions
defaultTitleOptions :: Text -> TitleOptions
defaultTitleOptions Text
txt =
  Text -> Style -> Place -> Anchor -> Double -> TitleOptions
TitleOptions
    Text
txt
    ( Style
defaultTextStyle
        forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set forall a. IsLabel "size" a => a
#size Double
0.12
    )
    Place
PlaceTop
    Anchor
AnchorMiddle
    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, anchor = 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, anchor = 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, anchor = 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Ticks] -> ShowS
$cshowList :: [Ticks] -> ShowS
show :: Ticks -> String
$cshow :: Ticks -> String
showsPrec :: Int -> Ticks -> ShowS
$cshowsPrec :: Int -> Ticks -> ShowS
Show, Ticks -> Ticks -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Ticks -> Ticks -> Bool
$c/= :: Ticks -> Ticks -> Bool
== :: Ticks -> Ticks -> Bool
$c== :: Ticks -> Ticks -> Bool
Eq, 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
$cto :: forall x. Rep Ticks x -> Ticks
$cfrom :: forall x. Ticks -> Rep Ticks x
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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TickStyle] -> ShowS
$cshowList :: [TickStyle] -> ShowS
show :: TickStyle -> String
$cshow :: TickStyle -> String
showsPrec :: Int -> TickStyle -> ShowS
$cshowsPrec :: Int -> TickStyle -> ShowS
Show, TickStyle -> TickStyle -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TickStyle -> TickStyle -> Bool
$c/= :: TickStyle -> TickStyle -> Bool
== :: TickStyle -> TickStyle -> Bool
$c== :: TickStyle -> TickStyle -> Bool
Eq, 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
$cto :: forall x. Rep TickStyle x -> TickStyle
$cfrom :: forall x. TickStyle -> Rep TickStyle x
Generic)

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

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

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

-- | The official line tick
defaultLineTick :: TickStyle
defaultLineTick :: TickStyle
defaultLineTick =
  Style -> HudChartSection -> Double -> TickStyle
TickStyle
    ( Style
defaultLineStyle
        forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set forall a. IsLabel "size" a => a
#size Double
5.0e-3
        forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (forall a. IsLabel "color" a => a
#color forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Lens' Colour Double
opac') Double
0.05
    )
    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
    (forall a. a -> Maybe a
Just TickStyle
defaultGlyphTickStyleX)
    (forall a. a -> Maybe a
Just TickStyle
defaultTextTick)
    (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
    (forall a. a -> Maybe a
Just TickStyle
defaultGlyphTickStyleY)
    (forall a. a -> Maybe a
Just TickStyle
defaultTextTick)
    (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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Tick] -> ShowS
$cshowList :: [Tick] -> ShowS
show :: Tick -> String
$cshow :: Tick -> String
showsPrec :: Int -> Tick -> ShowS
$cshowsPrec :: Int -> Tick -> ShowS
Show, Tick -> Tick -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Tick -> Tick -> Bool
$c/= :: Tick -> Tick -> Bool
== :: Tick -> Tick -> Bool
$c== :: Tick -> Tick -> Bool
Eq, 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
$cto :: forall x. Rep Tick x -> Tick
$cfrom :: forall x. Tick -> Rep Tick x
Generic)

-- | Lens between a FormatN and a Tick.
formatN' :: Lens' Tick (Maybe FormatN)
formatN' :: Lens' Tick (Maybe FormatN)
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
_ -> forall a. a -> Maybe a
Just FormatN
f
  TickExact FormatN
f Int
_ -> forall a. a -> Maybe a
Just FormatN
f
  Tick
_ -> 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' =
  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
_ -> forall a. a -> Maybe a
Just Int
n
  TickExact FormatN
_ Int
n -> forall a. a -> Maybe a
Just Int
n
  Tick
_ -> 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' =
  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 -> forall a. a -> Maybe a
Just TickExtend
e
  Tick
_ -> 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 (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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TickExtend -> TickExtend -> Bool
$c/= :: TickExtend -> TickExtend -> Bool
== :: TickExtend -> TickExtend -> Bool
$c== :: TickExtend -> TickExtend -> Bool
Eq, Int -> TickExtend -> ShowS
[TickExtend] -> ShowS
TickExtend -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TickExtend] -> ShowS
$cshowList :: [TickExtend] -> ShowS
show :: TickExtend -> String
$cshow :: TickExtend -> String
showsPrec :: Int -> TickExtend -> ShowS
$cshowsPrec :: Int -> TickExtend -> ShowS
Show, 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
$cto :: forall x. Rep TickExtend x -> TickExtend
$cfrom :: forall x. TickExtend -> Rep TickExtend x
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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Adjustments] -> ShowS
$cshowList :: [Adjustments] -> ShowS
show :: Adjustments -> String
$cshow :: Adjustments -> String
showsPrec :: Int -> Adjustments -> ShowS
$cshowsPrec :: Int -> Adjustments -> ShowS
Show, Adjustments -> Adjustments -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Adjustments -> Adjustments -> Bool
$c/= :: Adjustments -> Adjustments -> Bool
== :: Adjustments -> Adjustments -> Bool
$c== :: Adjustments -> Adjustments -> Bool
Eq, 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
$cto :: forall x. Rep Adjustments x -> Adjustments
$cfrom :: forall x. Adjustments -> Rep Adjustments x
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, anchor = 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, anchor = 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, 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
scaleChartsBy :: Double,
    LegendOptions -> ScaleP
scaleP :: ScaleP,
    LegendOptions -> [(Text, [Chart])]
legendCharts :: [(Text, [Chart])]
  }
  deriving (Int -> LegendOptions -> ShowS
[LegendOptions] -> ShowS
LegendOptions -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LegendOptions] -> ShowS
$cshowList :: [LegendOptions] -> ShowS
show :: LegendOptions -> String
$cshow :: LegendOptions -> String
showsPrec :: Int -> LegendOptions -> ShowS
$cshowsPrec :: Int -> LegendOptions -> ShowS
Show, LegendOptions -> LegendOptions -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LegendOptions -> LegendOptions -> Bool
$c/= :: LegendOptions -> LegendOptions -> Bool
== :: LegendOptions -> LegendOptions -> Bool
$c== :: LegendOptions -> LegendOptions -> Bool
Eq, 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
$cto :: forall x. Rep LegendOptions x -> LegendOptions
$cfrom :: forall x. LegendOptions -> Rep LegendOptions x
Generic)

-- | The official legend options
defaultLegendOptions :: LegendOptions
defaultLegendOptions :: LegendOptions
defaultLegendOptions =
  Double
-> Double
-> Double
-> Double
-> Style
-> Double
-> Double
-> Maybe Style
-> Place
-> Double
-> ScaleP
-> [(Text, [Chart])]
-> LegendOptions
LegendOptions
    Double
0.3
    Double
0.1
    Double
0.2
    Double
0.1
    (Style
defaultTextStyle forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set forall a. IsLabel "size" a => a
#size Double
0.16)
    Double
0.1
    Double
0.02
    (forall a. a -> Maybe a
Just (Style
defaultRectStyle forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set forall a. IsLabel "borderSize" a => a
#borderSize Double
0.005 forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set forall a. IsLabel "borderColor" a => a
#borderColor (forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Lens' Colour Double
opac' Double
1 Colour
dark) forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set forall a. IsLabel "color" a => a
#color (forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Lens' Colour Double
opac' Double
0 Colour
dark)))
    Place
PlaceRight
    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, anchor = 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FrameOptions -> FrameOptions -> Bool
$c/= :: FrameOptions -> FrameOptions -> Bool
== :: FrameOptions -> FrameOptions -> Bool
$c== :: FrameOptions -> FrameOptions -> Bool
Eq, Int -> FrameOptions -> ShowS
[FrameOptions] -> ShowS
FrameOptions -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FrameOptions] -> ShowS
$cshowList :: [FrameOptions] -> ShowS
show :: FrameOptions -> String
$cshow :: FrameOptions -> String
showsPrec :: Int -> FrameOptions -> ShowS
$cshowsPrec :: Int -> FrameOptions -> ShowS
Show, 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
$cto :: forall x. Rep FrameOptions x -> FrameOptions
$cfrom :: forall x. FrameOptions -> Rep FrameOptions x
Generic)

-- | The official hud frame
defaultFrameOptions :: FrameOptions
defaultFrameOptions :: FrameOptions
defaultFrameOptions = Maybe Style -> HudChartSection -> Double -> FrameOptions
FrameOptions (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,) 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 forall a b. (a -> b) -> a -> b
$
      ([Priority AxisOptions]
as' forall a b. a -> (a -> b) -> b
& forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over forall a. IsLabel "item" a => a
#item (AxisOptions -> Rect Double -> HudChart -> ChartTree
`axisHud` Rect Double
db')))
        forall a. Semigroup a => a -> a -> a
<> (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "frames" a => a
#frames HudOptions
o forall a b. a -> (a -> b) -> b
& forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over forall a. IsLabel "item" a => a
#item FrameOptions -> HudChart -> ChartTree
frameHud))
        forall a. Semigroup a => a -> a -> a
<> (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "legends" a => a
#legends HudOptions
o forall a b. a -> (a -> b) -> b
& forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over forall a. IsLabel "item" a => a
#item LegendOptions -> HudChart -> ChartTree
legendHud))
        forall a. Semigroup a => a -> a -> a
<> (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "titles" a => a
#titles HudOptions
o forall a b. a -> (a -> b) -> b
& forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over forall a. IsLabel "item" a => a
#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 (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "axes" a => a
#axes HudOptions
o)
    db' :: Rect Double
db' = forall a. a -> Maybe a -> a
fromMaybe Rect Double
db Maybe (Rect Double)
mdb

freezeAxes :: DataBox -> [Priority AxisOptions] -> (Maybe DataBox, [Priority AxisOptions])
freezeAxes :: Rect Double
-> [Priority AxisOptions]
-> (Maybe (Rect Double), [Priority AxisOptions])
freezeAxes Rect Double
db0 =
  forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
    ( \Priority AxisOptions
ao (Maybe (Rect Double)
dbm, [Priority AxisOptions]
as') ->
        let (Maybe (Rect Double)
dbm', AxisOptions
ao') = Rect Double -> AxisOptions -> (Maybe (Rect Double), AxisOptions)
freezeTicks (forall a. a -> Maybe a -> a
fromMaybe Rect Double
db0 Maybe (Rect Double)
dbm) (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "item" a => a
#item Priority AxisOptions
ao)
         in (Maybe (Rect Double)
dbm', [Priority AxisOptions]
as' forall a. Semigroup a => a -> a -> a
<> [Priority AxisOptions
ao forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set forall a. IsLabel "item" a => a
#item AxisOptions
ao'])
    )
    (forall a. Maybe a
Nothing, [])

freezeTicks :: DataBox -> AxisOptions -> (Maybe DataBox, AxisOptions)
freezeTicks :: Rect Double -> AxisOptions -> (Maybe (Rect Double), AxisOptions)
freezeTicks Rect Double
db AxisOptions
a =
  forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap
    (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Range Double
x -> Place -> Range Double -> Rect Double -> Rect Double
placeRect (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "place" a => a
#place AxisOptions
a) Range Double
x Rect Double
db))
    (\Tick
x -> AxisOptions
a forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (forall a. IsLabel "ticks" a => a
#ticks forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a. IsLabel "tick" a => a
#tick) Tick
x)
    (Range Double -> Tick -> (Maybe (Range Double), Tick)
placeTicks (Place -> Rect Double -> Range Double
placeRange (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "place" a => a
#place AxisOptions
a) Rect Double
db) (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view (forall a. IsLabel "ticks" a => a
#ticks forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a. IsLabel "tick" a => a
#tick) 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 -> forall a. a -> a -> a -> a -> Rect a
Rect Double
x Double
z Double
a0 Double
a1
  Place
PlaceLeft -> forall a. a -> a -> a -> a -> Rect a
Rect Double
x Double
z Double
a0 Double
a1
  Place
_ -> 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 -> forall a. a -> a -> Range a
Range Double
y Double
w
  Place
PlaceLeft -> forall a. a -> a -> Range a
Range Double
y Double
w
  Place
_ -> 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 = (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 -> (forall a. Maybe a
Nothing, [])
    TickRound FormatN
f Int
n TickExtend
e ->
      ( forall a. a -> a -> Bool -> a
bool (forall s (f :: * -> *).
(Space s, Traversable f) =>
f (Element s) -> Maybe s
space1 [Double]
ticks0) forall a. Maybe a
Nothing (TickExtend
e forall a. Eq a => a -> a -> Bool
== TickExtend
NoTickExtend),
        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 forall a. Eq a => a -> a -> Bool
== TickExtend
NoTickExtend) Range Double
r Int
n
    TickExact FormatN
f Int
n -> (forall a. Maybe a
Nothing, forall a b. [a] -> [b] -> [(a, b)]
zip [Double]
ticks0 (FormatN -> [Double] -> [Text]
formatNs FormatN
f [Double]
ticks0))
      where
        ticks0 :: [Element (Range Double)]
ticks0 = forall s. FieldSpace s => Pos -> s -> Grid s -> [Element s]
grid Pos
OuterPos Range Double
r Int
n
    TickLabels [Text]
ls ->
      ( forall a. Maybe a
Nothing,
        forall a b. [a] -> [b] -> [(a, b)]
zip
          ( forall s.
(Space s, Field (Element s)) =>
s -> s -> Element s -> Element s
project (forall a. a -> a -> Range a
Range Double
0 (forall a b. FromIntegral a b => b -> a
fromIntegral forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
ls)) Range Double
r
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((\Double
x -> Double
x forall a. Subtractive a => a -> a -> a
- Double
0.5) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. FromIntegral a b => b -> a
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int
1 .. forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
ls])
          )
          [Text]
ls
      )
    TickPlaced [(Double, Text)]
xs -> (forall a. Maybe a
Nothing, [(Double, Text)]
xs)

-- | 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 (forall a. a -> Maybe a
Just Text
"axis") [ChartTree
b, ChartTree
t]
  where
    b :: ChartTree
b = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty (\AxisBar
x -> Place -> AxisBar -> HudChart -> ChartTree
axisBarHud (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "place" a => a
#place AxisOptions
a) AxisBar
x HudChart
hc) (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "axisBar" a => a
#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 = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty (Text -> [Chart] -> ChartTree
named Text
"axisbar" forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure) Maybe Chart
c
  where
    canvasBox :: Maybe (Rect Double)
canvasBox = 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 = 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' (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "anchorTo" a => a
#anchorTo AxisBar
b)) HudChart
hc
    c :: Maybe Chart
c = Place -> AxisBar -> Rect Double -> Rect Double -> Chart
bar_ Place
pl AxisBar
b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Rect Double)
canvasBox 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 (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "style" a => a
#style AxisBar
b) 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 forall a b. (a -> b) -> a -> b
$
    case Place
pl of
      Place
PlaceTop ->
        [ forall a. a -> a -> a -> a -> Rect a
Rect
            (Double
x forall a. Subtractive a => a -> a -> a
- forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "overhang" a => a
#overhang AxisBar
b)
            (Double
z forall a. Additive a => a -> a -> a
+ forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "overhang" a => a
#overhang AxisBar
b)
            (Double
w' forall a. Additive a => a -> a -> a
+ forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "buffer" a => a
#buffer AxisBar
b)
            (Double
w' forall a. Additive a => a -> a -> a
+ forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "buffer" a => a
#buffer AxisBar
b forall a. Additive a => a -> a -> a
+ forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "size" a => a
#size AxisBar
b)
        ]
      Place
PlaceBottom ->
        [ forall a. a -> a -> a -> a -> Rect a
Rect
            (Double
x forall a. Subtractive a => a -> a -> a
- forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "overhang" a => a
#overhang AxisBar
b)
            (Double
z forall a. Additive a => a -> a -> a
+ forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "overhang" a => a
#overhang AxisBar
b)
            (Double
y' forall a. Subtractive a => a -> a -> a
- forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "size" a => a
#size AxisBar
b forall a. Subtractive a => a -> a -> a
- forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "buffer" a => a
#buffer AxisBar
b)
            (Double
y' forall a. Subtractive a => a -> a -> a
- forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "buffer" a => a
#buffer AxisBar
b)
        ]
      Place
PlaceLeft ->
        [ forall a. a -> a -> a -> a -> Rect a
Rect
            (Double
x' forall a. Subtractive a => a -> a -> a
- forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "size" a => a
#size AxisBar
b forall a. Subtractive a => a -> a -> a
- forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "buffer" a => a
#buffer AxisBar
b)
            (Double
x' forall a. Subtractive a => a -> a -> a
- forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "buffer" a => a
#buffer AxisBar
b)
            (Double
y forall a. Subtractive a => a -> a -> a
- forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "overhang" a => a
#overhang AxisBar
b)
            (Double
w forall a. Additive a => a -> a -> a
+ forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "overhang" a => a
#overhang AxisBar
b)
        ]
      Place
PlaceRight ->
        [ forall a. a -> a -> a -> a -> Rect a
Rect
            (Double
z' forall a. Additive a => a -> a -> a
+ forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "buffer" a => a
#buffer AxisBar
b)
            (Double
z' forall a. Additive a => a -> a -> a
+ forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "buffer" a => a
#buffer AxisBar
b forall a. Additive a => a -> a -> a
+ forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "size" a => a
#size AxisBar
b)
            (Double
y forall a. Subtractive a => a -> a -> a
- forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "overhang" a => a
#overhang AxisBar
b)
            (Double
w forall a. Additive a => a -> a -> a
+ forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "overhang" a => a
#overhang AxisBar
b)
        ]
      PlaceAbsolute (Point Double
x'' Double
_) ->
        [ forall a. a -> a -> a -> a -> Rect a
Rect
            (Double
x'' forall a. Additive a => a -> a -> a
+ forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "buffer" a => a
#buffer AxisBar
b)
            (Double
x'' forall a. Additive a => a -> a -> a
+ forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "buffer" a => a
#buffer AxisBar
b forall a. Additive a => a -> a -> a
+ forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "size" a => a
#size AxisBar
b)
            (Double
y forall a. Subtractive a => a -> a -> a
- forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "overhang" a => a
#overhang AxisBar
b)
            (Double
w forall a. Additive a => a -> a -> a
+ forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "overhang" a => a
#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 = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty Rect Double -> ChartTree
ts (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 (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "place" a => a
#place AxisOptions
ao) (Rect Double -> Ticks
adjTick Rect Double
b) Rect Double
db HudChart
hc
    adjTick :: Rect Double -> Ticks
adjTick Rect Double
b = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "ticks" a => a
#ticks AxisOptions
ao) (\Adjustments
x -> Adjustments
-> Rect Double -> Rect Double -> Place -> Ticks -> Ticks
adjustTicks Adjustments
x Rect Double
b Rect Double
db (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "place" a => a
#place AxisOptions
ao) (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "ticks" a => a
#ticks AxisOptions
ao)) (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "adjustments" a => a
#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 (forall a. a -> Maybe a
Just Text
"ticks") [ChartTree
lt, ChartTree
gt, ChartTree
tt]
  where
    lt :: ChartTree
lt = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty (\TickStyle
x -> Place -> TickStyle -> Tick -> Rect Double -> HudChart -> ChartTree
tickLine Place
pl TickStyle
x (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "tick" a => a
#tick Ticks
t) Rect Double
db HudChart
hc) (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "lineTick" a => a
#lineTick Ticks
t)
    gt :: ChartTree
gt = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty (\TickStyle
x -> Place -> TickStyle -> Tick -> Rect Double -> HudChart -> ChartTree
tickGlyph Place
pl TickStyle
x (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "tick" a => a
#tick Ticks
t) Rect Double
db HudChart
hc) (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "glyphTick" a => a
#glyphTick Ticks
t)
    tt :: ChartTree
tt = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty (\TickStyle
x -> Place -> TickStyle -> Tick -> Rect Double -> HudChart -> ChartTree
tickText Place
pl TickStyle
x (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "tick" a => a
#tick Ticks
t) Rect Double
db (ChartTree -> HudChart -> HudChart
appendHud ChartTree
gt HudChart
hc)) (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "textTick" a => a
#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 forall a. Eq a => a -> a -> Bool
== Place
PlaceBottom Bool -> Bool -> Bool
|| Place
pl forall a. Eq a => a -> a -> Bool
== Place
PlaceTop =
      if Bool
ad
        then
          ( if Double
adjustSizeX forall a. Ord a => a -> a -> Bool
> Double
1
              then
                ( case Place
pl of
                    Place
PlaceBottom -> forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (forall a. IsLabel "textTick" a => a
#textTick forall (is :: IxList) (js :: IxList) (ks :: IxList) k k' l m s t u
       v a b.
(AppendIndices is js ks, JoinKinds k A_Prism k',
 JoinKinds k' l m) =>
Optic k is s t (Maybe u) (Maybe v)
-> Optic l js u v a b -> Optic m ks s t a b
%? forall a. IsLabel "style" a => a
#style forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a. IsLabel "anchor" a => a
#anchor) Anchor
AnchorEnd
                    Place
PlaceTop -> forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (forall a. IsLabel "textTick" a => a
#textTick forall (is :: IxList) (js :: IxList) (ks :: IxList) k k' l m s t u
       v a b.
(AppendIndices is js ks, JoinKinds k A_Prism k',
 JoinKinds k' l m) =>
Optic k is s t (Maybe u) (Maybe v)
-> Optic l js u v a b -> Optic m ks s t a b
%? forall a. IsLabel "style" a => a
#style forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a. IsLabel "anchor" a => a
#anchor) Anchor
AnchorStart
                    Place
_ -> forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (forall a. IsLabel "textTick" a => a
#textTick forall (is :: IxList) (js :: IxList) (ks :: IxList) k k' l m s t u
       v a b.
(AppendIndices is js ks, JoinKinds k A_Prism k',
 JoinKinds k' l m) =>
Optic k is s t (Maybe u) (Maybe v)
-> Optic l js u v a b -> Optic m ks s t a b
%? forall a. IsLabel "style" a => a
#style forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a. IsLabel "anchor" a => a
#anchor) Anchor
AnchorEnd
                )
                  forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over (forall a. IsLabel "textTick" a => a
#textTick forall (is :: IxList) (js :: IxList) (ks :: IxList) k k' l m s t u
       v a b.
(AppendIndices is js ks, JoinKinds k A_Prism k',
 JoinKinds k' l m) =>
Optic k is s t (Maybe u) (Maybe v)
-> Optic l js u v a b -> Optic m ks s t a b
%? forall a. IsLabel "style" a => a
#style forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a. IsLabel "size" a => a
#size) (forall a. Divisive a => a -> a -> a
/ Double
adjustSizeA)
                  forall a b. (a -> b) -> a -> b
$ (forall a. IsLabel "textTick" a => a
#textTick forall (is :: IxList) (js :: IxList) (ks :: IxList) k k' l m s t u
       v a b.
(AppendIndices is js ks, JoinKinds k A_Prism k',
 JoinKinds k' l m) =>
Optic k is s t (Maybe u) (Maybe v)
-> Optic l js u v a b -> Optic m ks s t a b
%? forall a. IsLabel "style" a => a
#style forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a. IsLabel "rotation" a => a
#rotation forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a (Maybe b) -> b -> s -> t
?~ forall a. TrigField a => a
pi forall a. Divisive a => a -> a -> a
/ Double
4) Ticks
t
              else forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over (forall a. IsLabel "textTick" a => a
#textTick forall (is :: IxList) (js :: IxList) (ks :: IxList) k k' l m s t u
       v a b.
(AppendIndices is js ks, JoinKinds k A_Prism k',
 JoinKinds k' l m) =>
Optic k is s t (Maybe u) (Maybe v)
-> Optic l js u v a b -> Optic m ks s t a b
%? forall a. IsLabel "style" a => a
#style forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a. IsLabel "size" a => a
#size) (forall a. Divisive a => a -> a -> a
/ Double
adjustSizeA) Ticks
t
          )
        else Ticks
t forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over (forall a. IsLabel "textTick" a => a
#textTick forall (is :: IxList) (js :: IxList) (ks :: IxList) k k' l m s t u
       v a b.
(AppendIndices is js ks, JoinKinds k A_Prism k',
 JoinKinds k' l m) =>
Optic k is s t (Maybe u) (Maybe v)
-> Optic l js u v a b -> Optic m ks s t a b
%? forall a. IsLabel "style" a => a
#style forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a. IsLabel "size" a => a
#size) (forall a. Divisive a => a -> a -> a
/ Double
adjustSizeX)
  | Bool
otherwise -- pl `elem` [PlaceLeft, PlaceRight]
    =
      forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over (forall a. IsLabel "textTick" a => a
#textTick forall (is :: IxList) (js :: IxList) (ks :: IxList) k k' l m s t u
       v a b.
(AppendIndices is js ks, JoinKinds k A_Prism k',
 JoinKinds k' l m) =>
Optic k is s t (Maybe u) (Maybe v)
-> Optic l js u v a b -> Optic m ks s t a b
%? forall a. IsLabel "style" a => a
#style forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a. IsLabel "size" a => a
#size) (forall a. Divisive a => a -> a -> a
/ Double
adjustSizeY) Ticks
t
  where
    max' :: [a] -> a
max' [] = a
1
    max' [a]
xs = 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 forall a. Eq a => a -> a -> Bool
== Place
PlaceTop Bool -> Bool -> Bool
|| Place
pl forall a. Eq a => a -> a -> Bool
== Place
PlaceBottom = forall a. a -> a -> Range a
Range a
x a
z
      | Bool
otherwise = forall a. a -> a -> Range a
Range a
y a
w
    asp :: Range Double
asp = forall {a}. Rect a -> Range a
ra Rect Double
vb
    r :: Range Double
r = forall {a}. Rect a -> Range a
ra Rect Double
cs
    tickl :: [Text]
tickl = forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tick -> Range Double -> Range Double -> [(Double, Text)]
ticksR (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "tick" a => a
#tick Ticks
t) Range Double
asp Range Double
r
    maxWidth :: Double
    maxWidth :: Double
maxWidth =
      forall b a. b -> (a -> b) -> Maybe a -> b
maybe
        Double
1
        ( \TickStyle
tt ->
            forall {a}. (FromInteger a, Ord a) => [a] -> a
max' forall a b. (a -> b) -> a -> b
$
              (\(Rect Double
x Double
z Double
_ Double
_) -> Double
z forall a. Subtractive a => a -> a -> a
- Double
x)
                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 (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "style" a => a
#style TickStyle
tt) Text
x (forall a. a -> a -> Point a
Point Double
0 Double
0))
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
tickl
        )
        (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "textTick" a => a
#textTick Ticks
t)
    maxHeight :: Double
maxHeight =
      forall b a. b -> (a -> b) -> Maybe a -> b
maybe
        Double
1
        ( \TickStyle
tt ->
            forall {a}. (FromInteger a, Ord a) => [a] -> a
max' forall a b. (a -> b) -> a -> b
$
              (\(Rect Double
_ Double
_ Double
y Double
w) -> Double
w forall a. Subtractive a => a -> a -> a
- Double
y)
                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 (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "style" a => a
#style TickStyle
tt) Text
x (forall a. a -> a -> Point a
Point Double
0 Double
0))
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
tickl
        )
        (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "textTick" a => a
#textTick Ticks
t)

    adjustSizeX :: Double
    adjustSizeX :: Double
adjustSizeX = forall a. Ord a => a -> a -> a
max (Double
maxWidth forall a. Divisive a => a -> a -> a
/ (forall s. Space s => s -> Element s
upper Range Double
asp forall a. Subtractive a => a -> a -> a
- forall s. Space s => s -> Element s
lower Range Double
asp) forall a. Divisive a => a -> a -> a
/ Double
mrx) Double
1
    adjustSizeY :: Double
adjustSizeY = forall a. Ord a => a -> a -> a
max (Double
maxHeight forall a. Divisive a => a -> a -> a
/ (forall s. Space s => s -> Element s
upper Range Double
asp forall a. Subtractive a => a -> a -> a
- forall s. Space s => s -> Element s
lower Range Double
asp) forall a. Divisive a => a -> a -> a
/ Double
mry) Double
1
    adjustSizeA :: Double
adjustSizeA = forall a. Ord a => a -> a -> a
max (Double
maxHeight forall a. Divisive a => a -> a -> a
/ (forall s. Space s => s -> Element s
upper Range Double
asp forall a. Subtractive a => a -> a -> a
- forall s. Space s => s -> Element s
lower Range Double
asp) 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 -> forall a b. [a] -> [b] -> [(a, b)]
zip (forall s.
(Space s, Field (Element s)) =>
s -> s -> Element s -> Element s
project Range Double
r Range Double
d 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 forall a. Eq a => a -> a -> Bool
== TickExtend
NoTickExtend) Range Double
r Int
n
    TickExact FormatN
f Int
n -> forall a b. [a] -> [b] -> [(a, b)]
zip (forall s.
(Space s, Field (Element s)) =>
s -> s -> Element s -> Element s
project Range Double
r Range Double
d 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 = forall s. FieldSpace s => Pos -> s -> Grid s -> [Element s]
grid Pos
OuterPos Range Double
r Int
n
    TickLabels [Text]
ls ->
      forall a b. [a] -> [b] -> [(a, b)]
zip
        ( forall s.
(Space s, Field (Element s)) =>
s -> s -> Element s -> Element s
project (forall a. a -> a -> Range a
Range Double
0 (forall a b. FromIntegral a b => b -> a
fromIntegral forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
ls)) Range Double
d
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((\Double
x -> Double
x forall a. Subtractive a => a -> a -> a
- Double
0.5) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. FromIntegral a b => b -> a
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int
1 .. forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
ls])
        )
        [Text]
ls
    TickPlaced [(Double, Text)]
xs -> forall a b. [a] -> [b] -> [(a, b)]
zip (forall s.
(Space s, Field (Element s)) =>
s -> s -> Element s -> Element s
project Range Double
r Range Double
d forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Double, Text)]
xs) (forall a b. (a, b) -> b
snd 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 = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty (Text -> [Chart] -> ChartTree
named Text
"tickglyph" forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure) Maybe Chart
c
  where
    anchorBox :: Maybe (Rect Double)
anchorBox = 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' (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "anchorTo" a => a
#anchorTo TickStyle
s)) HudChart
hc
    canvasBox :: Maybe (Rect Double)
canvasBox = 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) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Style -> ChartData -> Chart
Chart (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "style" a => a
#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 (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "buffer" a => a
#buffer TickStyle
s) Rect Double
ab Rect Double
bb forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. (a, b) -> a
fst 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 = forall a. a -> Maybe a -> a
fromMaybe forall a. Additive a => a
zero forall a b. (a -> b) -> a -> b
$ Chart -> Maybe (Rect Double)
sbox (Style -> ChartData -> Chart
Chart (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "style" a => a
#style TickStyle
s) ([Point Double] -> ChartData
GlyphData [forall a. Additive a => a
zero]))
      (Maybe (Rect Double), Maybe (Rect Double))
_ -> 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 -> forall a. a -> a -> Point a
Point Double
pos (Double
w forall a. Additive a => a -> a -> a
+ Double
b forall a. Subtractive a => a -> a -> a
- Double
y')
  Place
PlaceBottom -> forall a. a -> a -> Point a
Point Double
pos (Double
y forall a. Subtractive a => a -> a -> a
- Double
b forall a. Subtractive a => a -> a -> a
- Double
w')
  Place
PlaceLeft -> forall a. a -> a -> Point a
Point (Double
x forall a. Subtractive a => a -> a -> a
- Double
b forall a. Subtractive a => a -> a -> a
- Double
z') Double
pos
  Place
PlaceRight -> forall a. a -> a -> Point a
Point (Double
z forall a. Additive a => a -> a -> a
+ Double
b forall a. Subtractive a => a -> a -> a
- Double
x') Double
pos
  PlaceAbsolute Point Double
p -> Point Double
p forall a. Additive a => a -> a -> a
+ 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 =
  forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (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))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty (Text -> [Chart] -> ChartTree
named Text
"ticktext" forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. Maybe a -> [a]
maybeToList) Maybe (Maybe Chart)
c
  where
    anchorBox :: Maybe (Rect Double)
anchorBox = 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' (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "anchorTo" a => a
#anchorTo TickStyle
s)) HudChart
hc
    cb :: Maybe (Rect Double)
cb = 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Rect Double)
anchorBox forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe (Rect Double)
cb forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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
    [] -> forall a. Maybe a
Nothing
    [(Text, Point Double)]
_ -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Style -> ChartData -> Chart
Chart (Place -> Style -> Style
placeTextAnchor Place
pl (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "style" a => a
#style TickStyle
s)) ([(Text, Point Double)] -> ChartData
TextData [(Text, Point Double)]
l)
  where
    l :: [(Text, Point Double)]
l =
      forall a b. (a, b) -> (b, a)
swap forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Point Double -> Point Double -> Point Double
addp (Point Double -> Point Double -> Point Double
addp (Place -> Double -> Rect Double -> Point Double
placePos Place
pl (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "buffer" a => a
#buffer TickStyle
s) Rect Double
sb) (Place -> Style -> Double -> Point Double
textPos Place
pl (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "style" a => a
#style TickStyle
s) (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "buffer" a => a
#buffer TickStyle
s))) 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)
        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

placeOrigin :: Place -> Double -> Point Double
placeOrigin :: Place -> Double -> Point Double
placeOrigin Place
pl Double
x
  | Place
pl forall a. Eq a => a -> a -> Bool
== Place
PlaceTop Bool -> Bool -> Bool
|| Place
pl forall a. Eq a => a -> a -> Bool
== Place
PlaceBottom = forall a. a -> a -> Point a
Point Double
x Double
0
  | Bool
otherwise = 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 -> 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 (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "buffer" a => a
#buffer TickStyle
s)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap 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 forall a. a -> a -> Bool -> a
bool (Text -> [Chart] -> ChartTree
named Text
"ticklines" [Style -> ChartData -> Chart
Chart (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "style" a => a
#style TickStyle
s) ([[Point Double]] -> ChartData
LineData [[Point Double]]
l)]) forall a. Monoid a => a
mempty (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Point Double]]
l)
  where
    cb :: Maybe (Rect Double)
cb = 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' (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "anchorTo" a => a
#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 forall a. Eq a => a -> a -> Bool
== Place
PlaceTop Bool -> Bool -> Bool
|| Place
pl forall a. Eq a => a -> a -> Bool
== Place
PlaceBottom = [forall a. a -> a -> Point a
Point Double
a (Double
y forall a. Subtractive a => a -> a -> a
- Double
b), forall a. a -> a -> Point a
Point Double
a (Double
w forall a. Additive a => a -> a -> a
+ Double
b)]
  | Bool
otherwise = [forall a. a -> a -> Point a
Point (Double
x forall a. Subtractive a => a -> a -> a
- Double
b) Double
a, forall a. a -> a -> Point a
Point (Double
z 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 = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty ((Text -> [Chart] -> ChartTree
named Text
"title" forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure) 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 = 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
hb =
  Style -> ChartData -> Chart
Chart
    (Style
style' forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set forall a. IsLabel "rotation" a => a
#rotation (forall a. a -> a -> Bool -> a
bool (forall a. a -> Maybe a
Just Double
rot) forall a. Maybe a
Nothing (Double
rot forall a. Eq a => a -> a -> Bool
== Double
0)))
    ([(Text, Point Double)] -> ChartData
TextData [(forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "text" a => a
#text TitleOptions
t, Point Double -> Point Double -> Point Double
addp (TitleOptions -> Rect Double -> Point Double
placePosTitle TitleOptions
t Rect Double
hb) (TitleOptions -> Rect Double -> Point Double
alignPosTitle TitleOptions
t Rect Double
hb))])
  where
    style' :: Style
style'
      | forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "anchor" a => a
#anchor TitleOptions
t forall a. Eq a => a -> a -> Bool
== Anchor
AnchorStart =
          forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set forall a. IsLabel "anchor" a => a
#anchor Anchor
AnchorStart forall a b. (a -> b) -> a -> b
$ forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "style" a => a
#style TitleOptions
t
      | forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "anchor" a => a
#anchor TitleOptions
t forall a. Eq a => a -> a -> Bool
== Anchor
AnchorEnd =
          forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set forall a. IsLabel "anchor" a => a
#anchor Anchor
AnchorEnd forall a b. (a -> b) -> a -> b
$ forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "style" a => a
#style TitleOptions
t
      | Bool
otherwise = forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "style" a => a
#style TitleOptions
t
    rot' :: Double
rot' = forall a. a -> Maybe a -> a
fromMaybe Double
0 (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view (forall a. IsLabel "style" a => a
#style forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a. IsLabel "rotation" a => a
#rotation) TitleOptions
t)
    rot :: Double
rot
      | forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "place" a => a
#place TitleOptions
t forall a. Eq a => a -> a -> Bool
== Place
PlaceRight = forall a. TrigField a => a
pi forall a. Divisive a => a -> a -> a
/ Double
2 forall a. Additive a => a -> a -> a
+ Double
rot'
      | forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "place" a => a
#place TitleOptions
t forall a. Eq a => a -> a -> Bool
== Place
PlaceLeft = forall a. TrigField a => a
pi forall a. Divisive a => a -> a -> a
/ Double
2 forall a. Additive a => a -> a -> a
+ Double
rot'
      | Bool
otherwise = Double
rot'

placePosTitle :: TitleOptions -> ChartBox -> Point Double
placePosTitle :: TitleOptions -> Rect Double -> Point Double
placePosTitle TitleOptions
t (Rect Double
x Double
z Double
y Double
w) =
  case forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "place" a => a
#place TitleOptions
t of
    Place
PlaceTop -> forall a. a -> a -> Point a
Point ((Double
x forall a. Additive a => a -> a -> a
+ Double
z) forall a. Divisive a => a -> a -> a
/ Double
2.0) (Double
w forall a. Subtractive a => a -> a -> a
- Double
y' forall a. Additive a => a -> a -> a
+ forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "buffer" a => a
#buffer TitleOptions
t)
    Place
PlaceBottom -> forall a. a -> a -> Point a
Point ((Double
x forall a. Additive a => a -> a -> a
+ Double
z) forall a. Divisive a => a -> a -> a
/ Double
2.0) (Double
y forall a. Subtractive a => a -> a -> a
- Double
w' forall a. Subtractive a => a -> a -> a
- forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "buffer" a => a
#buffer TitleOptions
t)
    Place
PlaceLeft -> forall a. a -> a -> Point a
Point (Double
x forall a. Additive a => a -> a -> a
+ Double
y' forall a. Subtractive a => a -> a -> a
- forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "buffer" a => a
#buffer TitleOptions
t) ((Double
y forall a. Additive a => a -> a -> a
+ Double
w) forall a. Divisive a => a -> a -> a
/ Double
2.0)
    Place
PlaceRight -> forall a. a -> a -> Point a
Point (Double
z forall a. Additive a => a -> a -> a
+ Double
w' forall a. Additive a => a -> a -> a
+ forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "buffer" a => a
#buffer TitleOptions
t) ((Double
y forall a. Additive a => a -> a -> a
+ Double
w) forall a. Divisive a => a -> a -> a
/ Double
2.0)
    PlaceAbsolute Point Double
p -> Point Double
p
  where
    (Rect Double
_ Double
_ Double
y' Double
w') = Style -> Text -> Point Double -> Rect Double
styleBoxText (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "style" a => a
#style TitleOptions
t) (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "text" a => a
#text TitleOptions
t) forall a. Additive a => a
zero

alignPosTitle :: TitleOptions -> ChartBox -> Point Double
alignPosTitle :: TitleOptions -> Rect Double -> Point Double
alignPosTitle TitleOptions
t (Rect Double
x Double
z Double
y Double
w)
  | forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "anchor" a => a
#anchor TitleOptions
t forall a. Eq a => a -> a -> Bool
== Anchor
AnchorStart
      Bool -> Bool -> Bool
&& (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "place" a => a
#place TitleOptions
t forall a. Eq a => a -> a -> Bool
== Place
PlaceTop Bool -> Bool -> Bool
|| forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "place" a => a
#place TitleOptions
t forall a. Eq a => a -> a -> Bool
== Place
PlaceBottom) =
      forall a. a -> a -> Point a
Point ((Double
x forall a. Subtractive a => a -> a -> a
- Double
z) forall a. Divisive a => a -> a -> a
/ Double
2.0) Double
0.0
  | forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "anchor" a => a
#anchor TitleOptions
t forall a. Eq a => a -> a -> Bool
== Anchor
AnchorStart
      Bool -> Bool -> Bool
&& forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "place" a => a
#place TitleOptions
t forall a. Eq a => a -> a -> Bool
== Place
PlaceLeft =
      forall a. a -> a -> Point a
Point Double
0.0 ((Double
y forall a. Subtractive a => a -> a -> a
- Double
w) forall a. Divisive a => a -> a -> a
/ Double
2.0)
  | forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "anchor" a => a
#anchor TitleOptions
t forall a. Eq a => a -> a -> Bool
== Anchor
AnchorStart
      Bool -> Bool -> Bool
&& forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "place" a => a
#place TitleOptions
t forall a. Eq a => a -> a -> Bool
== Place
PlaceRight =
      forall a. a -> a -> Point a
Point Double
0.0 ((Double
y forall a. Subtractive a => a -> a -> a
- Double
w) forall a. Divisive a => a -> a -> a
/ Double
2.0)
  | forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "anchor" a => a
#anchor TitleOptions
t forall a. Eq a => a -> a -> Bool
== Anchor
AnchorEnd
      Bool -> Bool -> Bool
&& (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "place" a => a
#place TitleOptions
t forall a. Eq a => a -> a -> Bool
== Place
PlaceTop Bool -> Bool -> Bool
|| forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "place" a => a
#place TitleOptions
t forall a. Eq a => a -> a -> Bool
== Place
PlaceBottom) =
      forall a. a -> a -> Point a
Point ((-Double
x forall a. Additive a => a -> a -> a
+ Double
z) forall a. Divisive a => a -> a -> a
/ Double
2.0) Double
0.0
  | forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "anchor" a => a
#anchor TitleOptions
t forall a. Eq a => a -> a -> Bool
== Anchor
AnchorEnd
      Bool -> Bool -> Bool
&& forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "place" a => a
#place TitleOptions
t forall a. Eq a => a -> a -> Bool
== Place
PlaceLeft =
      forall a. a -> a -> Point a
Point Double
0.0 ((-Double
y forall a. Additive a => a -> a -> a
+ Double
w) forall a. Divisive a => a -> a -> a
/ Double
2.0)
  | forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "anchor" a => a
#anchor TitleOptions
t forall a. Eq a => a -> a -> Bool
== Anchor
AnchorEnd
      Bool -> Bool -> Bool
&& forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "place" a => a
#place TitleOptions
t forall a. Eq a => a -> a -> Bool
== Place
PlaceRight =
      forall a. a -> a -> Point a
Point Double
0.0 ((-Double
y forall a. Additive a => a -> a -> a
+ Double
w) forall a. Divisive a => a -> a -> a
/ Double
2.0)
  | Bool
otherwise = forall a. a -> a -> Point a
Point Double
0.0 Double
0.0

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

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 -> forall a. a -> a -> Point a
Point Double
0 (Double
b forall a. Subtractive a => a -> a -> a
- forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "vshift" a => a
#vshift Style
tt forall a. Multiplicative a => a -> a -> a
* forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "vsize" a => a
#vsize Style
tt forall a. Multiplicative a => a -> a -> a
* forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "size" a => a
#size Style
tt)
  Place
PlaceBottom -> forall a. a -> a -> Point a
Point Double
0 (-Double
b forall a. Subtractive a => a -> a -> a
- forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "vshift" a => a
#vshift Style
tt forall a. Multiplicative a => a -> a -> a
* forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "vsize" a => a
#vsize Style
tt forall a. Multiplicative a => a -> a -> a
* forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "size" a => a
#size Style
tt forall a. Subtractive a => a -> a -> a
- forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "vsize" a => a
#vsize Style
tt forall a. Multiplicative a => a -> a -> a
* forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "size" a => a
#size Style
tt)
  Place
PlaceLeft ->
    forall a. a -> a -> Point a
Point
      (-Double
b)
      (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "vshift" a => a
#vshift Style
tt forall a. Multiplicative a => a -> a -> a
* forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "vsize" a => a
#vsize Style
tt forall a. Multiplicative a => a -> a -> a
* forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "size" a => a
#size Style
tt)
  Place
PlaceRight ->
    forall a. a -> a -> Point a
Point
      Double
b
      (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "vshift" a => a
#vshift Style
tt forall a. Multiplicative a => a -> a -> a
* forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "vsize" a => a
#vsize Style
tt forall a. Multiplicative a => a -> a -> a
* forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "size" a => a
#size Style
tt)
  PlaceAbsolute Point Double
p -> Point Double
p

placeTextAnchor :: Place -> (Style -> Style)
placeTextAnchor :: Place -> Style -> Style
placeTextAnchor Place
pl
  | Place
pl forall a. Eq a => a -> a -> Bool
== Place
PlaceLeft = forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set forall a. IsLabel "anchor" a => a
#anchor Anchor
AnchorEnd
  | Place
pl forall a. Eq a => a -> a -> Bool
== Place
PlaceRight = forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set forall a. IsLabel "anchor" a => a
#anchor Anchor
AnchorStart
  | Bool
otherwise = 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 -> forall a. Monoid a => a
mempty
    Just Rect Double
r' -> case forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "frame" a => a
#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 = forall a. Subtractive a => a -> Rect a -> Rect a
padRect (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "buffer" a => a
#buffer FrameOptions
o) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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' (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "anchorTo" a => a
#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 = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty (\Rect Double
b -> LegendOptions -> Rect Double -> ChartTree -> ChartTree
placeLegend_ LegendOptions
o Rect Double
b (forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over Traversal' ChartTree Chart
chart' (Double -> Chart -> Chart
scaleChart (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "scaleChartsBy" a => a
#scaleChartsBy LegendOptions
o)) ChartTree
lcs)) (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
    lcs :: ChartTree
lcs = LegendOptions -> ChartTree
legendChart LegendOptions
o forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (Traversal' ChartTree [Chart]
charts' forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall i s t a b. Each i s t a b => IxTraversal i s t a b
each forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a. IsLabel "chartStyle" a => a
#chartStyle forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a. IsLabel "scaleP" a => a
#scaleP) (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "scaleP" a => a
#scaleP LegendOptions
o)

placeLegend_ :: LegendOptions -> ChartBox -> ChartTree -> ChartTree
placeLegend_ :: LegendOptions -> Rect Double -> ChartTree -> ChartTree
placeLegend_ LegendOptions
o Rect Double
hb ChartTree
t = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty (\Rect Double
b -> ChartTree
t forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over Traversal' ChartTree Chart
chart' (Point Double -> Chart -> Chart
moveChart (Place -> Double -> Rect Double -> Rect Double -> Point Double
placeBeside_ (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "place" a => a
#place LegendOptions
o) (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "buffer" a => a
#buffer LegendOptions
o) Rect Double
hb Rect Double
b))) (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Lens' ChartTree (Maybe (Rect Double))
styleBox' ChartTree
t)

placeBeside_ :: Place -> Double -> Rect Double -> Rect Double -> Point Double
placeBeside_ :: Place -> Double -> Rect Double -> Rect Double -> Point Double
placeBeside_ Place
pl Double
buff (Rect Double
x Double
z Double
y Double
w) (Rect Double
x' Double
z' Double
y' Double
w') =
  case Place
pl of
    Place
PlaceTop -> forall a. a -> a -> Point a
Point ((Double
x forall a. Additive a => a -> a -> a
+ Double
z) forall a. Divisive a => a -> a -> a
/ Double
2.0) (Double
buff forall a. Additive a => a -> a -> a
+ Double
w forall a. Additive a => a -> a -> a
+ (Double
w' forall a. Subtractive a => a -> a -> a
- Double
y') forall a. Divisive a => a -> a -> a
/ Double
2.0)
    Place
PlaceBottom -> forall a. a -> a -> Point a
Point ((Double
x forall a. Additive a => a -> a -> a
+ Double
z) forall a. Divisive a => a -> a -> a
/ Double
2.0) (Double
y forall a. Subtractive a => a -> a -> a
- Double
buff forall a. Subtractive a => a -> a -> a
- (Double
w' forall a. Subtractive a => a -> a -> a
- Double
y'))
    Place
PlaceLeft -> forall a. a -> a -> Point a
Point (Double
x forall a. Subtractive a => a -> a -> a
- Double
buff forall a. Subtractive a => a -> a -> a
- (Double
z' forall a. Subtractive a => a -> a -> a
- Double
x')) ((Double
y forall a. Additive a => a -> a -> a
+ Double
w) forall a. Divisive a => a -> a -> a
/ Double
2.0)
    Place
PlaceRight -> forall a. a -> a -> Point a
Point (Double
z forall a. Additive a => a -> a -> a
+ Double
buff) ((Double
y forall a. Additive a => a -> a -> a
+ Double
w) forall a. Divisive a => a -> a -> a
/ Double
2.0)
    PlaceAbsolute Point Double
p -> Point Double
p

-- | frame a legend
legendFrame :: LegendOptions -> ChartTree -> ChartTree
legendFrame :: LegendOptions -> ChartTree -> ChartTree
legendFrame LegendOptions
l ChartTree
content' =
  Maybe Text -> [ChartTree] -> ChartTree
group (forall a. a -> Maybe a
Just Text
"legend") [ChartTree
borders, Maybe Text -> ChartTree -> ChartTree
rename (forall a. a -> Maybe a
Just Text
"legendContent") ChartTree
content']
  where
    borders :: ChartTree
borders = forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ [ChartTree
outer, ChartTree
inner] forall a. Semigroup a => a -> a -> a
<> [ChartTree]
frame'
    outer :: ChartTree
outer = Double -> ChartTree -> ChartTree
padChart (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "outerPad" a => a
#outerPad LegendOptions
l) ChartTree
inner
    frame' :: [ChartTree]
frame' = 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]) (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "frame" a => a
#frame LegendOptions
l)
    inner :: ChartTree
inner = Double -> ChartTree -> ChartTree
padChart (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "innerPad" a => a
#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' =
      Double -> [ChartTree] -> ChartTree
vert
        (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "hgap" a => a
#hgap LegendOptions
l)
        ( ( \(Chart
t, [Chart]
a) ->
              Double -> [ChartTree] -> ChartTree
hori
                (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "vgap" a => a
#vgap LegendOptions
l forall a. Additive a => a -> a -> a
+ Double
twidth forall a. Subtractive a => a -> a -> a
- Chart -> Double
gapwidth Chart
t)
                (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Chart] -> ChartTree
unnamed [[Chart
t], [Chart]
a])
          )
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Chart, [Chart])]
es
        )
    es :: [(Chart, [Chart])]
es = forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (LegendOptions -> Text -> [Chart] -> (Chart, [Chart])
legendEntry LegendOptions
l) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "legendCharts" a => a
#legendCharts LegendOptions
l
    twidth :: Double
twidth = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Additive a => a
zero (\(Rect Double
x Double
z Double
_ Double
_) -> Double
z forall a. Subtractive a => a -> a -> a
- Double
x) ([Chart] -> Maybe (Rect Double)
styleBoxes (forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Chart, [Chart])]
es))
    gapwidth :: Chart -> Double
gapwidth Chart
t = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Double
0 (\(Rect Double
x Double
z Double
_ Double
_) -> Double
z 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 (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "textStyle" a => a
#textStyle LegendOptions
l forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set forall a. IsLabel "anchor" a => a
#anchor Anchor
AnchorStart) ([(Text, Point Double)] -> ChartData
TextData [(Text
t, 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 [forall a. a -> a -> a -> a -> Rect a
Rect Double
0 (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "legendSize" a => a
#legendSize LegendOptions
l) Double
0 (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "legendSize" a => a
#legendSize LegendOptions
l)])
    (Chart Style
ts (TextData [(Text, Point Double)]
t)) -> let txt :: Text
txt = forall a. a -> Maybe a -> a
fromMaybe Text
"text" (forall a. [a] -> Maybe a
listToMaybe (forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, Point Double)]
t)) in Style -> ChartData -> Chart
Chart (Style
ts forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set forall a. IsLabel "size" a => a
#size (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "legendSize" a => a
#legendSize LegendOptions
l forall a. Divisive a => a -> a -> a
/ forall a b. FromIntegral a b => b -> a
fromIntegral (Text -> Int
Text.length Text
txt))) ([(Text, Point Double)] -> ChartData
TextData [(Text
txt, forall a. a -> a -> Point a
Point (Double
0.5 forall a. Multiplicative a => a -> a -> a
* forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "legendSize" a => a
#legendSize LegendOptions
l) (Double
0.33 forall a. Multiplicative a => a -> a -> a
* forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "legendSize" a => a
#legendSize LegendOptions
l))])
    (Chart Style
gs (GlyphData [Point Double]
_)) -> Style -> ChartData -> Chart
Chart (Style
gs forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set forall a. IsLabel "size" a => a
#size (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "legendSize" a => a
#legendSize LegendOptions
l)) ([Point Double] -> ChartData
GlyphData [forall a. a -> a -> Point a
Point (Double
0.5 forall a. Multiplicative a => a -> a -> a
* forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "legendSize" a => a
#legendSize LegendOptions
l) (Double
0.33 forall a. Multiplicative a => a -> a -> a
* forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "legendSize" a => a
#legendSize LegendOptions
l)])
    (Chart Style
ls (LineData [[Point Double]]
_)) ->
      Style -> ChartData -> Chart
Chart
        (Style
ls forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over forall a. IsLabel "size" a => a
#size (forall a. Divisive a => a -> a -> a
/ forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "scaleChartsBy" a => a
#scaleChartsBy LegendOptions
l))
        ([[Point Double]] -> ChartData
LineData [[forall a. a -> a -> Point a
Point Double
0 (Double
1 forall a. Multiplicative a => a -> a -> a
* forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "legendSize" a => a
#legendSize LegendOptions
l), forall a. a -> a -> Point a
Point (Double
2 forall a. Multiplicative a => a -> a -> a
* forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "legendSize" a => a
#legendSize LegendOptions
l) (Double
1 forall a. Multiplicative a => a -> a -> a
* forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "legendSize" a => a
#legendSize LegendOptions
l)]])
    (Chart Style
ps (PathData [PathData Double]
_)) ->
      ( let cs :: [PathData Double]
cs =
              QuadPosition Double -> [PathData Double]
singletonQuad
                ( forall a. Point a -> Point a -> Point a -> QuadPosition a
QuadPosition
                    (forall a. a -> a -> Point a
Point Double
0 Double
0)
                    (forall a. a -> a -> Point a
Point (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "legendSize" a => a
#legendSize LegendOptions
l) (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "legendSize" a => a
#legendSize LegendOptions
l))
                    (forall a. a -> a -> Point a
Point (Double
2 forall a. Multiplicative a => a -> a -> a
* forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "legendSize" a => a
#legendSize LegendOptions
l) ((-Double
1) forall a. Multiplicative a => a -> a -> a
* forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "legendSize" a => a
#legendSize LegendOptions
l))
                )
         in Style -> ChartData -> Chart
Chart (Style
ps forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set forall a. IsLabel "borderSize" a => a
#borderSize (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "legendSize" a => a
#legendSize LegendOptions
l)) ([PathData Double] -> ChartData
PathData [PathData Double]
cs)
      )
    Chart
_ -> Rect Double -> Chart
blankChart1 (forall a. a -> a -> a -> a -> Rect a
Rect Double
0 (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "legendSize" a => a
#legendSize LegendOptions
l) Double
0 (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "legendSize" a => a
#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, forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (LegendOptions -> Chart -> Chart
legendizeChart LegendOptions
l) [Chart]
cs)