{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}
{-# OPTIONS_GHC -Wall #-}

-- | 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,
    HudBox,
    CanvasBox,
    DataBox,
    HudChart (..),
    canvasBox',
    canvasStyleBox',
    hudBox',
    hudStyleBox',

    -- * Hud Processing
    runHudWith,
    runHud,

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

    -- * Hud Effects
    closes,
    fromEffect,
    applyChartAspect,
    getHudBox,

    -- * Hud primitives
    AxisOptions (..),
    defaultAxisOptions,
    flipAxis,
    FrameOptions (..),
    defaultFrameOptions,
    Place (..),
    placeText,
    AxisBar (..),
    defaultAxisBar,
    Title (..),
    defaultTitle,
    Ticks (..),
    defaultGlyphTick,
    defaultTextTick,
    defaultLineTick,
    defaultTicks,
    TickStyle (..),
    defaultTickStyle,
    tickStyleText,
    TickExtend (..),
    adjustTicks,
    Adjustments (..),
    defaultAdjustments,
    LegendOptions (..),
    defaultLegendOptions,

    -- * Option to Hud
    frameHud,
    legend,
    legendHud,
    legendFrame,
  )
where

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

-- $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.
--
-- Equal priority values will be placed in the same process step.
type Priority = Double

-- | Heads-up display additions to charts
--
-- A Hud is composed of:
--
-- - A priority for the hud element in the chart folding process.
--
-- - A chart tree with a state dependency on the chart being created.
data Hud = Hud
  { -- | priority for ordering of transformations
    Hud -> Priority
priority :: Priority,
    -- | additional charts
    Hud -> State HudChart ChartTree
hud :: State HudChart ChartTree
  }
  deriving ((forall x. Hud -> Rep Hud x)
-> (forall x. Rep Hud x -> Hud) -> Generic Hud
forall x. Rep Hud x -> Hud
forall x. Hud -> Rep Hud x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Hud x -> Hud
$cfrom :: forall x. Hud -> Rep Hud x
Generic)

-- | 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.
--
-- - dataBox: The bounding box of the underlying data domain.
--
-- This is done to support functionality where we can choose whether to normalise the chart aspect based on the entire chart (FixedAspect) or on just the data visualisation space (CanvasAspect).
data HudChart = HudChart
  { HudChart -> ChartTree
chart :: ChartTree,
    HudChart -> ChartTree
hud :: ChartTree,
    HudChart -> DataBox
dataBox :: DataBox
  }
  deriving (HudChart -> HudChart -> Bool
(HudChart -> HudChart -> Bool)
-> (HudChart -> HudChart -> Bool) -> Eq HudChart
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
(Int -> HudChart -> ShowS)
-> (HudChart -> String) -> ([HudChart] -> ShowS) -> Show HudChart
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. HudChart -> Rep HudChart x)
-> (forall x. Rep HudChart x -> HudChart) -> Generic HudChart
forall x. Rep HudChart x -> HudChart
forall x. HudChart -> Rep HudChart x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HudChart x -> HudChart
$cfrom :: forall x. HudChart -> Rep HudChart x
Generic)

-- | A type for Rect to represent the entire bounding box of a chart, including the Hud
type HudBox = Rect Double

-- | A type for Rect to represent the bounding box of the canvas portion of a chart, excluding Hud elements
type CanvasBox = Rect Double

-- | A type for Rect to represent the bounding box of the data elements a chart, which can be a different metric to Canvas and Hud Rects
type DataBox = Rect Double

canvasBox_ :: HudChart -> Maybe CanvasBox
canvasBox_ :: HudChart -> Maybe DataBox
canvasBox_ = [Chart] -> Maybe DataBox
boxes ([Chart] -> Maybe DataBox)
-> (HudChart -> [Chart]) -> HudChart -> Maybe DataBox
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Optic' A_Traversal NoIx HudChart [Chart] -> HudChart -> [Chart]
forall k a (is :: IxList) s.
(Is k A_Fold, Monoid a) =>
Optic' k is s a -> s -> a
foldOf (IsLabel
  "chart" (Optic A_Lens NoIx HudChart HudChart ChartTree ChartTree)
Optic A_Lens NoIx HudChart HudChart ChartTree ChartTree
#chart Optic A_Lens NoIx HudChart HudChart ChartTree ChartTree
-> Optic A_Traversal NoIx ChartTree ChartTree [Chart] [Chart]
-> Optic' A_Traversal NoIx HudChart [Chart]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Traversal NoIx ChartTree ChartTree [Chart] [Chart]
charts')

canvasRebox_ :: HudChart -> Maybe (Rect Double) -> HudChart
canvasRebox_ :: HudChart -> Maybe DataBox -> HudChart
canvasRebox_ HudChart
cs Maybe DataBox
r =
  HudChart
cs
    HudChart -> (HudChart -> HudChart) -> HudChart
forall a b. a -> (a -> b) -> b
& Optic A_Traversal NoIx HudChart HudChart Chart Chart
-> (Chart -> Chart) -> HudChart -> HudChart
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over (IsLabel
  "chart" (Optic A_Lens NoIx HudChart HudChart ChartTree ChartTree)
Optic A_Lens NoIx HudChart HudChart ChartTree ChartTree
#chart Optic A_Lens NoIx HudChart HudChart ChartTree ChartTree
-> Optic A_Traversal NoIx ChartTree ChartTree Chart Chart
-> Optic A_Traversal NoIx HudChart HudChart Chart Chart
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Traversal NoIx ChartTree ChartTree Chart Chart
chart') (Maybe DataBox -> Maybe DataBox -> Chart -> Chart
maybeProjectWith Maybe DataBox
r (HudChart -> Maybe DataBox
canvasBox_ HudChart
cs))
    HudChart -> (HudChart -> HudChart) -> HudChart
forall a b. a -> (a -> b) -> b
& Optic A_Traversal NoIx HudChart HudChart Chart Chart
-> (Chart -> Chart) -> HudChart -> HudChart
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over (IsLabel
  "hud" (Optic A_Lens NoIx HudChart HudChart ChartTree ChartTree)
Optic A_Lens NoIx HudChart HudChart ChartTree ChartTree
#hud Optic A_Lens NoIx HudChart HudChart ChartTree ChartTree
-> Optic A_Traversal NoIx ChartTree ChartTree Chart Chart
-> Optic A_Traversal NoIx HudChart HudChart Chart Chart
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Traversal NoIx ChartTree ChartTree Chart Chart
chart') (Maybe DataBox -> Maybe DataBox -> Chart -> Chart
maybeProjectWith Maybe DataBox
r (HudChart -> Maybe DataBox
canvasBox_ HudChart
cs))

-- | A lens between a HudChart and the bounding box of the canvas
canvasBox' :: Lens' HudChart (Maybe CanvasBox)
canvasBox' :: Lens' HudChart (Maybe DataBox)
canvasBox' =
  (HudChart -> Maybe DataBox)
-> (HudChart -> Maybe DataBox -> HudChart)
-> Lens' HudChart (Maybe DataBox)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens HudChart -> Maybe DataBox
canvasBox_ HudChart -> Maybe DataBox -> HudChart
canvasRebox_

-- | A lens between a HudChart and the bounding box of the canvas, including style extensions.
canvasStyleBox' :: Getter HudChart (Maybe CanvasBox)
canvasStyleBox' :: Getter HudChart (Maybe DataBox)
canvasStyleBox' = (HudChart -> Maybe DataBox) -> Getter HudChart (Maybe DataBox)
forall s a. (s -> a) -> Getter s a
to ([Chart] -> Maybe DataBox
styleBoxes ([Chart] -> Maybe DataBox)
-> (HudChart -> [Chart]) -> HudChart -> Maybe DataBox
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Optic' A_Traversal NoIx HudChart [Chart] -> HudChart -> [Chart]
forall k a (is :: IxList) s.
(Is k A_Fold, Monoid a) =>
Optic' k is s a -> s -> a
foldOf (IsLabel
  "chart" (Optic A_Lens NoIx HudChart HudChart ChartTree ChartTree)
Optic A_Lens NoIx HudChart HudChart ChartTree ChartTree
#chart Optic A_Lens NoIx HudChart HudChart ChartTree ChartTree
-> Optic A_Traversal NoIx ChartTree ChartTree [Chart] [Chart]
-> Optic' A_Traversal NoIx HudChart [Chart]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Traversal NoIx ChartTree ChartTree [Chart] [Chart]
charts'))

hudStyleBox_ :: HudChart -> Maybe HudBox
hudStyleBox_ :: HudChart -> Maybe DataBox
hudStyleBox_ = [Chart] -> Maybe DataBox
styleBoxes ([Chart] -> Maybe DataBox)
-> (HudChart -> [Chart]) -> HudChart -> Maybe DataBox
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\HudChart
x -> Optic' A_Traversal NoIx HudChart [Chart] -> HudChart -> [Chart]
forall k a (is :: IxList) s.
(Is k A_Fold, Monoid a) =>
Optic' k is s a -> s -> a
foldOf (IsLabel
  "chart" (Optic A_Lens NoIx HudChart HudChart ChartTree ChartTree)
Optic A_Lens NoIx HudChart HudChart ChartTree ChartTree
#chart Optic A_Lens NoIx HudChart HudChart ChartTree ChartTree
-> Optic A_Traversal NoIx ChartTree ChartTree [Chart] [Chart]
-> Optic' A_Traversal NoIx HudChart [Chart]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Traversal NoIx ChartTree ChartTree [Chart] [Chart]
charts') HudChart
x [Chart] -> [Chart] -> [Chart]
forall a. Semigroup a => a -> a -> a
<> Optic' A_Traversal NoIx HudChart [Chart] -> HudChart -> [Chart]
forall k a (is :: IxList) s.
(Is k A_Fold, Monoid a) =>
Optic' k is s a -> s -> a
foldOf (IsLabel
  "hud" (Optic A_Lens NoIx HudChart HudChart ChartTree ChartTree)
Optic A_Lens NoIx HudChart HudChart ChartTree ChartTree
#hud Optic A_Lens NoIx HudChart HudChart ChartTree ChartTree
-> Optic A_Traversal NoIx ChartTree ChartTree [Chart] [Chart]
-> Optic' A_Traversal NoIx HudChart [Chart]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Traversal NoIx ChartTree ChartTree [Chart] [Chart]
charts') HudChart
x)

-- | a lens between a HudChart and the bounding box of the hud.
hudStyleBox' :: Getter HudChart (Maybe HudBox)
hudStyleBox' :: Getter HudChart (Maybe DataBox)
hudStyleBox' = (HudChart -> Maybe DataBox) -> Getter HudChart (Maybe DataBox)
forall s a. (s -> a) -> Getter s a
to HudChart -> Maybe DataBox
hudStyleBox_

hudBox_ :: HudChart -> Maybe HudBox
hudBox_ :: HudChart -> Maybe DataBox
hudBox_ = [Chart] -> Maybe DataBox
boxes ([Chart] -> Maybe DataBox)
-> (HudChart -> [Chart]) -> HudChart -> Maybe DataBox
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\HudChart
x -> Optic' A_Traversal NoIx HudChart [Chart] -> HudChart -> [Chart]
forall k a (is :: IxList) s.
(Is k A_Fold, Monoid a) =>
Optic' k is s a -> s -> a
foldOf (IsLabel
  "chart" (Optic A_Lens NoIx HudChart HudChart ChartTree ChartTree)
Optic A_Lens NoIx HudChart HudChart ChartTree ChartTree
#chart Optic A_Lens NoIx HudChart HudChart ChartTree ChartTree
-> Optic A_Traversal NoIx ChartTree ChartTree [Chart] [Chart]
-> Optic' A_Traversal NoIx HudChart [Chart]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Traversal NoIx ChartTree ChartTree [Chart] [Chart]
charts') HudChart
x [Chart] -> [Chart] -> [Chart]
forall a. Semigroup a => a -> a -> a
<> Optic' A_Traversal NoIx HudChart [Chart] -> HudChart -> [Chart]
forall k a (is :: IxList) s.
(Is k A_Fold, Monoid a) =>
Optic' k is s a -> s -> a
foldOf (IsLabel
  "hud" (Optic A_Lens NoIx HudChart HudChart ChartTree ChartTree)
Optic A_Lens NoIx HudChart HudChart ChartTree ChartTree
#hud Optic A_Lens NoIx HudChart HudChart ChartTree ChartTree
-> Optic A_Traversal NoIx ChartTree ChartTree [Chart] [Chart]
-> Optic' A_Traversal NoIx HudChart [Chart]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Traversal NoIx ChartTree ChartTree [Chart] [Chart]
charts') HudChart
x)

hudRebox_ :: HudChart -> Maybe HudBox -> HudChart
hudRebox_ :: HudChart -> Maybe DataBox -> HudChart
hudRebox_ HudChart
cs Maybe DataBox
r =
  HudChart
cs
    HudChart -> (HudChart -> HudChart) -> HudChart
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx HudChart HudChart ChartTree ChartTree
-> (ChartTree -> ChartTree) -> HudChart -> HudChart
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over IsLabel
  "chart" (Optic A_Lens NoIx HudChart HudChart ChartTree ChartTree)
Optic A_Lens NoIx HudChart HudChart ChartTree ChartTree
#chart (Optic A_Traversal NoIx ChartTree ChartTree Chart Chart
-> (Chart -> Chart) -> ChartTree -> ChartTree
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over Optic A_Traversal NoIx ChartTree ChartTree Chart Chart
chart' (Maybe DataBox -> Maybe DataBox -> Chart -> Chart
maybeProjectWith Maybe DataBox
r' (HudChart -> Maybe DataBox
hudBox_ HudChart
cs)))
    HudChart -> (HudChart -> HudChart) -> HudChart
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx HudChart HudChart ChartTree ChartTree
-> (ChartTree -> ChartTree) -> HudChart -> HudChart
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over IsLabel
  "hud" (Optic A_Lens NoIx HudChart HudChart ChartTree ChartTree)
Optic A_Lens NoIx HudChart HudChart ChartTree ChartTree
#hud (Optic A_Traversal NoIx ChartTree ChartTree Chart Chart
-> (Chart -> Chart) -> ChartTree -> ChartTree
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over Optic A_Traversal NoIx ChartTree ChartTree Chart Chart
chart' (Maybe DataBox -> Maybe DataBox -> Chart -> Chart
maybeProjectWith Maybe DataBox
r' (HudChart -> Maybe DataBox
hudBox_ HudChart
cs)))
  where
    r' :: Maybe DataBox
r' = DataBox -> DataBox -> DataBox
forall a. Subtractive a => a -> a -> a
(NH.-) (DataBox -> DataBox -> DataBox)
-> Maybe DataBox -> Maybe (DataBox -> DataBox)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe DataBox
r Maybe (DataBox -> DataBox) -> Maybe DataBox -> Maybe DataBox
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (DataBox -> DataBox -> DataBox
forall a. Subtractive a => a -> a -> a
(NH.-) (DataBox -> DataBox -> DataBox)
-> Maybe DataBox -> Maybe (DataBox -> DataBox)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HudChart -> Maybe DataBox
hudStyleBox_ HudChart
cs Maybe (DataBox -> DataBox) -> Maybe DataBox -> Maybe DataBox
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> HudChart -> Maybe DataBox
hudBox_ HudChart
cs)

-- | lens between a HudChart and its hud bounding box, not including style.
hudBox' :: Lens' HudChart (Maybe HudBox)
hudBox' :: Lens' HudChart (Maybe DataBox)
hudBox' =
  (HudChart -> Maybe DataBox)
-> (HudChart -> Maybe DataBox -> HudChart)
-> Lens' HudChart (Maybe DataBox)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens HudChart -> Maybe DataBox
hudBox_ HudChart -> Maybe DataBox -> HudChart
hudRebox_

appendHud :: ChartTree -> HudChart -> HudChart
appendHud :: ChartTree -> HudChart -> HudChart
appendHud ChartTree
cs HudChart
x =
  HudChart
x HudChart -> (HudChart -> HudChart) -> HudChart
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx HudChart HudChart ChartTree ChartTree
-> (ChartTree -> ChartTree) -> HudChart -> HudChart
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over IsLabel
  "hud" (Optic A_Lens NoIx HudChart HudChart ChartTree ChartTree)
Optic A_Lens NoIx HudChart HudChart ChartTree ChartTree
#hud (ChartTree -> ChartTree -> ChartTree
forall a. Semigroup a => a -> a -> a
<> ChartTree
cs)

-- | Absorb a series of state-dependent tress into state.
closes :: (Traversable f) => f (State HudChart ChartTree) -> State HudChart ()
closes :: f (State HudChart ChartTree) -> State HudChart ()
closes f (State HudChart ChartTree)
xs = do
  ChartTree
xs' <- (f ChartTree -> ChartTree)
-> StateT HudChart Identity (f ChartTree)
-> State HudChart ChartTree
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([ChartTree] -> ChartTree
forall a. Monoid a => [a] -> a
mconcat ([ChartTree] -> ChartTree)
-> (f ChartTree -> [ChartTree]) -> f ChartTree -> ChartTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f ChartTree -> [ChartTree]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList) (StateT HudChart Identity (f ChartTree)
 -> State HudChart ChartTree)
-> StateT HudChart Identity (f ChartTree)
-> State HudChart ChartTree
forall a b. (a -> b) -> a -> b
$ f (State HudChart ChartTree)
-> StateT HudChart Identity (f ChartTree)
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence f (State HudChart ChartTree)
xs
  (HudChart -> HudChart) -> State HudChart ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (ChartTree -> HudChart -> HudChart
appendHud ChartTree
xs')

-- | Wrap a state effect into a Hud
fromEffect :: Priority -> State HudChart () -> Hud
fromEffect :: Priority -> State HudChart () -> Hud
fromEffect Priority
p State HudChart ()
s = Priority -> State HudChart ChartTree -> Hud
Hud Priority
p (State HudChart ()
s State HudChart ()
-> State HudChart ChartTree -> State HudChart ChartTree
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ChartTree -> State HudChart ChartTree
forall (f :: * -> *) a. Applicative f => a -> f a
pure ChartTree
forall a. Monoid a => a
mempty)

-- | Apply a ChartAspect
applyChartAspect :: ChartAspect -> State HudChart ()
applyChartAspect :: ChartAspect -> State HudChart ()
applyChartAspect ChartAspect
fa = do
  HudChart
hc <- StateT HudChart Identity HudChart
forall s (m :: * -> *). MonadState s m => m s
get
  case ChartAspect
fa of
    ChartAspect
ChartAspect -> () -> State HudChart ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    ChartAspect
_ -> (HudChart -> HudChart) -> State HudChart ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (Lens' HudChart (Maybe DataBox)
-> Maybe DataBox -> HudChart -> HudChart
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Lens' HudChart (Maybe DataBox)
hudBox' (ChartAspect -> HudChart -> Maybe DataBox
getHudBox ChartAspect
fa HudChart
hc))

-- | Supply the bounding box of the HudChart given a ChartAspect.
getHudBox :: ChartAspect -> HudChart -> Maybe HudBox
getHudBox :: ChartAspect -> HudChart -> Maybe DataBox
getHudBox ChartAspect
fa HudChart
c =
  case ChartAspect
fa of
    FixedAspect Priority
a -> DataBox -> Maybe DataBox
forall a. a -> Maybe a
Just (Priority -> DataBox
aspect Priority
a)
    CanvasAspect Priority
a ->
      case (Lens' HudChart (Maybe DataBox) -> HudChart -> Maybe DataBox
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Lens' HudChart (Maybe DataBox)
hudBox' HudChart
c, Lens' HudChart (Maybe DataBox) -> HudChart -> Maybe DataBox
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Lens' HudChart (Maybe DataBox)
canvasBox' HudChart
c) of
        (Maybe DataBox
Nothing, Maybe DataBox
_) -> Maybe DataBox
forall a. Maybe a
Nothing
        (Maybe DataBox
_, Maybe DataBox
Nothing) -> Maybe DataBox
forall a. Maybe a
Nothing
        (Just DataBox
hb, Just DataBox
cb) -> DataBox -> Maybe DataBox
forall a. a -> Maybe a
Just (Priority -> DataBox
aspect (Priority
a Priority -> Priority -> Priority
forall a. Num a => a -> a -> a
* DataBox -> Priority
forall a. Field a => Rect a -> a
ratio DataBox
hb Priority -> Priority -> Priority
forall a. Fractional a => a -> a -> a
/ DataBox -> Priority
forall a. Field a => Rect a -> a
ratio DataBox
cb))
    ChartAspect
ChartAspect -> Lens' HudChart (Maybe DataBox) -> HudChart -> Maybe DataBox
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Lens' HudChart (Maybe DataBox)
hudBox' HudChart
c

-- | 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
  CanvasBox ->
  -- | initial data space
  DataBox ->
  -- | huds to add
  [Hud] ->
  -- | underlying chart
  ChartTree ->
  -- | integrated chart tree
  ChartTree
runHudWith :: DataBox -> DataBox -> [Hud] -> ChartTree -> ChartTree
runHudWith DataBox
cb DataBox
db [Hud]
hs ChartTree
cs =
  [Hud]
hs
    [Hud] -> ([Hud] -> [Hud]) -> [Hud]
forall a b. a -> (a -> b) -> b
& (Hud -> Priority) -> [Hud] -> [Hud]
forall b a. Ord b => (a -> b) -> [a] -> [a]
List.sortOn (Optic' A_Lens NoIx Hud Priority -> Hud -> Priority
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view IsLabel "priority" (Optic' A_Lens NoIx Hud Priority)
Optic' A_Lens NoIx Hud Priority
#priority)
    [Hud] -> ([Hud] -> [[Hud]]) -> [[Hud]]
forall a b. a -> (a -> b) -> b
& (Hud -> Hud -> Bool) -> [Hud] -> [[Hud]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
List.groupBy (\Hud
a Hud
b -> Optic' A_Lens NoIx Hud Priority -> Hud -> Priority
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view IsLabel "priority" (Optic' A_Lens NoIx Hud Priority)
Optic' A_Lens NoIx Hud Priority
#priority Hud
a Priority -> Priority -> Bool
forall a. Eq a => a -> a -> Bool
== Optic' A_Lens NoIx Hud Priority -> Hud -> Priority
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view IsLabel "priority" (Optic' A_Lens NoIx Hud Priority)
Optic' A_Lens NoIx Hud Priority
#priority Hud
b)
    [[Hud]] -> ([[Hud]] -> State HudChart ()) -> State HudChart ()
forall a b. a -> (a -> b) -> b
& ([Hud] -> State HudChart ()) -> [[Hud]] -> State HudChart ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ([State HudChart ChartTree] -> State HudChart ()
forall (f :: * -> *).
Traversable f =>
f (State HudChart ChartTree) -> State HudChart ()
closes ([State HudChart ChartTree] -> State HudChart ())
-> ([Hud] -> [State HudChart ChartTree])
-> [Hud]
-> State HudChart ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Hud -> State HudChart ChartTree)
-> [Hud] -> [State HudChart ChartTree]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Optic' A_Lens NoIx Hud (State HudChart ChartTree)
-> Hud -> State HudChart ChartTree
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view IsLabel "hud" (Optic' A_Lens NoIx Hud (State HudChart ChartTree))
Optic' A_Lens NoIx Hud (State HudChart ChartTree)
#hud))
    State HudChart () -> (State HudChart () -> HudChart) -> HudChart
forall a b. a -> (a -> b) -> b
& (State HudChart () -> HudChart -> HudChart)
-> HudChart -> State HudChart () -> HudChart
forall a b c. (a -> b -> c) -> b -> a -> c
flip
      State HudChart () -> HudChart -> HudChart
forall s a. State s a -> s -> s
execState
      ( ChartTree -> ChartTree -> DataBox -> HudChart
HudChart
          (ChartTree
cs ChartTree -> (ChartTree -> ChartTree) -> ChartTree
forall a b. a -> (a -> b) -> b
& Optic A_Traversal NoIx ChartTree ChartTree Chart Chart
-> (Chart -> Chart) -> ChartTree -> ChartTree
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over Optic A_Traversal NoIx ChartTree ChartTree Chart Chart
chart' (DataBox -> DataBox -> Chart -> Chart
projectWith DataBox
cb DataBox
db))
          ChartTree
forall a. Monoid a => a
mempty
          DataBox
db
      )
    HudChart -> (HudChart -> ChartTree) -> ChartTree
forall a b. a -> (a -> b) -> b
& (\HudChart
x -> Maybe Text -> [ChartTree] -> ChartTree
group (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"chart") [Optic A_Lens NoIx HudChart HudChart ChartTree ChartTree
-> HudChart -> ChartTree
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view IsLabel
  "chart" (Optic A_Lens NoIx HudChart HudChart ChartTree ChartTree)
Optic A_Lens NoIx HudChart HudChart ChartTree ChartTree
#chart HudChart
x] ChartTree -> ChartTree -> ChartTree
forall a. Semigroup a => a -> a -> a
<> Maybe Text -> [ChartTree] -> ChartTree
group (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"hud") [Optic A_Lens NoIx HudChart HudChart ChartTree ChartTree
-> HudChart -> ChartTree
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view IsLabel
  "hud" (Optic A_Lens NoIx HudChart HudChart ChartTree ChartTree)
Optic A_Lens NoIx HudChart HudChart ChartTree ChartTree
#hud HudChart
x])

-- | Combine huds and charts to form a new ChartTree with a supplied initial canvas dimension.
--
-- Note that the original chart data are transformed and irrevocably forgotten by this computation.
runHud ::
  -- | initial canvas dimension
  CanvasBox ->
  -- | huds
  [Hud] ->
  -- | underlying charts
  ChartTree ->
  -- | integrated chart list
  ChartTree
runHud :: DataBox -> [Hud] -> ChartTree -> ChartTree
runHud DataBox
ca [Hud]
hs ChartTree
cs = DataBox -> DataBox -> [Hud] -> ChartTree -> ChartTree
runHudWith DataBox
ca (Maybe DataBox -> DataBox
singletonGuard (Maybe DataBox -> DataBox) -> Maybe DataBox -> DataBox
forall a b. (a -> b) -> a -> b
$ [Chart] -> Maybe DataBox
boxes (Optic A_Traversal NoIx ChartTree ChartTree [Chart] [Chart]
-> ChartTree -> [Chart]
forall k a (is :: IxList) s.
(Is k A_Fold, Monoid a) =>
Optic' k is s a -> s -> a
foldOf Optic A_Traversal NoIx ChartTree ChartTree [Chart] [Chart]
charts' ChartTree
cs)) [Hud]
hs ChartTree
cs

-- | Typical, configurable hud elements. Anything else can be hand-coded as a 'Hud'.
--
-- ![hud example](other/hudoptions.svg)
data HudOptions = HudOptions
  { HudOptions -> ChartAspect
chartAspect :: ChartAspect,
    HudOptions -> [(Priority, AxisOptions)]
axes :: [(Priority, AxisOptions)],
    HudOptions -> [(Priority, FrameOptions)]
frames :: [(Priority, FrameOptions)],
    HudOptions -> [(Priority, LegendOptions)]
legends :: [(Priority, LegendOptions)],
    HudOptions -> [(Priority, Title)]
titles :: [(Priority, Title)]
  }
  deriving (HudOptions -> HudOptions -> Bool
(HudOptions -> HudOptions -> Bool)
-> (HudOptions -> HudOptions -> Bool) -> Eq HudOptions
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
(Int -> HudOptions -> ShowS)
-> (HudOptions -> String)
-> ([HudOptions] -> ShowS)
-> Show HudOptions
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. HudOptions -> Rep HudOptions x)
-> (forall x. Rep HudOptions x -> HudOptions) -> Generic HudOptions
forall x. Rep HudOptions x -> HudOptions
forall x. HudOptions -> Rep HudOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HudOptions x -> HudOptions
$cfrom :: forall x. HudOptions -> Rep HudOptions x
Generic)

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

instance Monoid HudOptions where
  mempty :: HudOptions
mempty = ChartAspect
-> [(Priority, AxisOptions)]
-> [(Priority, FrameOptions)]
-> [(Priority, LegendOptions)]
-> [(Priority, Title)]
-> HudOptions
HudOptions (Priority -> ChartAspect
FixedAspect Priority
1.5) [] [] [] []

-- | The official hud options.
defaultHudOptions :: HudOptions
defaultHudOptions :: HudOptions
defaultHudOptions =
  ChartAspect
-> [(Priority, AxisOptions)]
-> [(Priority, FrameOptions)]
-> [(Priority, LegendOptions)]
-> [(Priority, Title)]
-> HudOptions
HudOptions
    (Priority -> ChartAspect
FixedAspect Priority
1.5)
    [ (Priority
5, AxisOptions
defaultAxisOptions),
      (Priority
5, AxisOptions
defaultAxisOptions AxisOptions -> (AxisOptions -> AxisOptions) -> AxisOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx AxisOptions AxisOptions Place Place
-> Place -> AxisOptions -> AxisOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set IsLabel
  "place" (Optic A_Lens NoIx AxisOptions AxisOptions Place Place)
Optic A_Lens NoIx AxisOptions AxisOptions Place Place
#place Place
PlaceLeft)
    ]
    [(Priority
1, FrameOptions
defaultFrameOptions)]
    []
    []

priorities :: HudOptions -> [Priority]
priorities :: HudOptions -> [Priority]
priorities HudOptions
o =
  ((Priority, AxisOptions) -> Priority
forall a b. (a, b) -> a
fst ((Priority, AxisOptions) -> Priority)
-> [(Priority, AxisOptions)] -> [Priority]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Optic' A_Lens NoIx HudOptions [(Priority, AxisOptions)]
-> HudOptions -> [(Priority, AxisOptions)]
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view IsLabel
  "axes" (Optic' A_Lens NoIx HudOptions [(Priority, AxisOptions)])
Optic' A_Lens NoIx HudOptions [(Priority, AxisOptions)]
#axes HudOptions
o)
    [Priority] -> [Priority] -> [Priority]
forall a. Semigroup a => a -> a -> a
<> ((Priority, FrameOptions) -> Priority
forall a b. (a, b) -> a
fst ((Priority, FrameOptions) -> Priority)
-> [(Priority, FrameOptions)] -> [Priority]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Optic' A_Lens NoIx HudOptions [(Priority, FrameOptions)]
-> HudOptions -> [(Priority, FrameOptions)]
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view IsLabel
  "frames" (Optic' A_Lens NoIx HudOptions [(Priority, FrameOptions)])
Optic' A_Lens NoIx HudOptions [(Priority, FrameOptions)]
#frames HudOptions
o)
    [Priority] -> [Priority] -> [Priority]
forall a. Semigroup a => a -> a -> a
<> ((Priority, LegendOptions) -> Priority
forall a b. (a, b) -> a
fst ((Priority, LegendOptions) -> Priority)
-> [(Priority, LegendOptions)] -> [Priority]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Optic' A_Lens NoIx HudOptions [(Priority, LegendOptions)]
-> HudOptions -> [(Priority, LegendOptions)]
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view IsLabel
  "legends"
  (Optic' A_Lens NoIx HudOptions [(Priority, LegendOptions)])
Optic' A_Lens NoIx HudOptions [(Priority, LegendOptions)]
#legends HudOptions
o)
    [Priority] -> [Priority] -> [Priority]
forall a. Semigroup a => a -> a -> a
<> ((Priority, Title) -> Priority
forall a b. (a, b) -> a
fst ((Priority, Title) -> Priority)
-> [(Priority, Title)] -> [Priority]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Optic' A_Lens NoIx HudOptions [(Priority, Title)]
-> HudOptions -> [(Priority, Title)]
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view IsLabel
  "titles" (Optic' A_Lens NoIx HudOptions [(Priority, Title)])
Optic' A_Lens NoIx HudOptions [(Priority, Title)]
#titles HudOptions
o)

lastPriority :: HudOptions -> Priority
lastPriority :: HudOptions -> Priority
lastPriority HudOptions
o = case HudOptions -> [Priority]
priorities HudOptions
o of
  [] -> Priority
0
  [Priority]
xs -> [Priority] -> Priority
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Priority]
xs

-- | Make Huds and potential data box extension; from a HudOption and an initial data box.
toHuds :: HudOptions -> DataBox -> ([Hud], DataBox)
toHuds :: HudOptions -> DataBox -> ([Hud], DataBox)
toHuds HudOptions
o DataBox
db =
  (,DataBox
db''') ([Hud] -> ([Hud], DataBox)) -> [Hud] -> ([Hud], DataBox)
forall a b. (a -> b) -> a -> b
$
    ([(Priority, AxisOptions)]
as' [(Priority, AxisOptions)]
-> ([(Priority, AxisOptions)] -> [Hud]) -> [Hud]
forall a b. a -> (a -> b) -> b
& ((Priority, AxisOptions) -> Hud)
-> [(Priority, AxisOptions)] -> [Hud]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Priority -> State HudChart ChartTree -> Hud)
-> (Priority, State HudChart ChartTree) -> Hud
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Priority -> State HudChart ChartTree -> Hud
Hud ((Priority, State HudChart ChartTree) -> Hud)
-> ((Priority, AxisOptions)
    -> (Priority, State HudChart ChartTree))
-> (Priority, AxisOptions)
-> Hud
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AxisOptions -> State HudChart ChartTree)
-> (Priority, AxisOptions) -> (Priority, State HudChart ChartTree)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second AxisOptions -> State HudChart ChartTree
axis))
      [Hud] -> [Hud] -> [Hud]
forall a. Semigroup a => a -> a -> a
<> (Optic' A_Lens NoIx HudOptions [(Priority, FrameOptions)]
-> HudOptions -> [(Priority, FrameOptions)]
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view IsLabel
  "frames" (Optic' A_Lens NoIx HudOptions [(Priority, FrameOptions)])
Optic' A_Lens NoIx HudOptions [(Priority, FrameOptions)]
#frames HudOptions
o [(Priority, FrameOptions)]
-> ([(Priority, FrameOptions)] -> [Hud]) -> [Hud]
forall a b. a -> (a -> b) -> b
& ((Priority, FrameOptions) -> Hud)
-> [(Priority, FrameOptions)] -> [Hud]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Priority -> State HudChart ChartTree -> Hud)
-> (Priority, State HudChart ChartTree) -> Hud
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Priority -> State HudChart ChartTree -> Hud
Hud ((Priority, State HudChart ChartTree) -> Hud)
-> ((Priority, FrameOptions)
    -> (Priority, State HudChart ChartTree))
-> (Priority, FrameOptions)
-> Hud
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FrameOptions -> State HudChart ChartTree)
-> (Priority, FrameOptions) -> (Priority, State HudChart ChartTree)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second FrameOptions -> State HudChart ChartTree
frameHud))
      [Hud] -> [Hud] -> [Hud]
forall a. Semigroup a => a -> a -> a
<> (Optic' A_Lens NoIx HudOptions [(Priority, LegendOptions)]
-> HudOptions -> [(Priority, LegendOptions)]
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view IsLabel
  "legends"
  (Optic' A_Lens NoIx HudOptions [(Priority, LegendOptions)])
Optic' A_Lens NoIx HudOptions [(Priority, LegendOptions)]
#legends HudOptions
o [(Priority, LegendOptions)]
-> ([(Priority, LegendOptions)] -> [Hud]) -> [Hud]
forall a b. a -> (a -> b) -> b
& ((Priority, LegendOptions) -> Hud)
-> [(Priority, LegendOptions)] -> [Hud]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Priority -> State HudChart ChartTree -> Hud)
-> (Priority, State HudChart ChartTree) -> Hud
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Priority -> State HudChart ChartTree -> Hud
Hud ((Priority, State HudChart ChartTree) -> Hud)
-> ((Priority, LegendOptions)
    -> (Priority, State HudChart ChartTree))
-> (Priority, LegendOptions)
-> Hud
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LegendOptions -> State HudChart ChartTree)
-> (Priority, LegendOptions)
-> (Priority, State HudChart ChartTree)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second LegendOptions -> State HudChart ChartTree
legend))
      [Hud] -> [Hud] -> [Hud]
forall a. Semigroup a => a -> a -> a
<> (Optic' A_Lens NoIx HudOptions [(Priority, Title)]
-> HudOptions -> [(Priority, Title)]
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view IsLabel
  "titles" (Optic' A_Lens NoIx HudOptions [(Priority, Title)])
Optic' A_Lens NoIx HudOptions [(Priority, Title)]
#titles HudOptions
o [(Priority, Title)] -> ([(Priority, Title)] -> [Hud]) -> [Hud]
forall a b. a -> (a -> b) -> b
& ((Priority, Title) -> Hud) -> [(Priority, Title)] -> [Hud]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Priority -> State HudChart ChartTree -> Hud)
-> (Priority, State HudChart ChartTree) -> Hud
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Priority -> State HudChart ChartTree -> Hud
Hud ((Priority, State HudChart ChartTree) -> Hud)
-> ((Priority, Title) -> (Priority, State HudChart ChartTree))
-> (Priority, Title)
-> Hud
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Title -> State HudChart ChartTree)
-> (Priority, Title) -> (Priority, State HudChart ChartTree)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second Title -> State HudChart ChartTree
title))
      [Hud] -> [Hud] -> [Hud]
forall a. Semigroup a => a -> a -> a
<> [ Priority -> State HudChart () -> Hud
fromEffect (HudOptions -> Priority
lastPriority HudOptions
o Priority -> Priority -> Priority
forall a. Num a => a -> a -> a
+ Priority
1) (State HudChart () -> Hud) -> State HudChart () -> Hud
forall a b. (a -> b) -> a -> b
$
             ChartAspect -> State HudChart ()
applyChartAspect (Optic' A_Lens NoIx HudOptions ChartAspect
-> HudOptions -> ChartAspect
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view IsLabel "chartAspect" (Optic' A_Lens NoIx HudOptions ChartAspect)
Optic' A_Lens NoIx HudOptions ChartAspect
#chartAspect HudOptions
o)
         ]
  where
    ([(Priority, AxisOptions)]
as', DataBox
db''') =
      ((Priority, AxisOptions)
 -> ([(Priority, AxisOptions)], DataBox)
 -> ([(Priority, AxisOptions)], DataBox))
-> ([(Priority, AxisOptions)], DataBox)
-> [(Priority, AxisOptions)]
-> ([(Priority, AxisOptions)], DataBox)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
        ( \(Priority, AxisOptions)
a ([(Priority, AxisOptions)]
as, DataBox
db') ->
            let (DataBox
db'', AxisOptions
a') = DataBox -> AxisOptions -> (DataBox, AxisOptions)
freezeTicks DataBox
db' ((Priority, AxisOptions) -> AxisOptions
forall a b. (a, b) -> b
snd (Priority, AxisOptions)
a)
             in ([(Priority, AxisOptions)]
as [(Priority, AxisOptions)]
-> [(Priority, AxisOptions)] -> [(Priority, AxisOptions)]
forall a. Semigroup a => a -> a -> a
<> [((Priority, AxisOptions) -> Priority
forall a b. (a, b) -> a
fst (Priority, AxisOptions)
a, AxisOptions
a')], DataBox
db'')
        )
        ([], DataBox
db)
        (Optic' A_Lens NoIx HudOptions [(Priority, AxisOptions)]
-> HudOptions -> [(Priority, AxisOptions)]
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view IsLabel
  "axes" (Optic' A_Lens NoIx HudOptions [(Priority, AxisOptions)])
Optic' A_Lens NoIx HudOptions [(Priority, AxisOptions)]
#axes HudOptions
o)

freezeTicks :: DataBox -> AxisOptions -> (DataBox, AxisOptions)
freezeTicks :: DataBox -> AxisOptions -> (DataBox, AxisOptions)
freezeTicks DataBox
db AxisOptions
a =
  (Range Priority -> DataBox)
-> (TickStyle -> AxisOptions)
-> (Range Priority, TickStyle)
-> (DataBox, AxisOptions)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap
    (\Range Priority
x -> Place -> Range Priority -> DataBox -> DataBox
placeRect (Optic A_Lens NoIx AxisOptions AxisOptions Place Place
-> AxisOptions -> Place
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view IsLabel
  "place" (Optic A_Lens NoIx AxisOptions AxisOptions Place Place)
Optic A_Lens NoIx AxisOptions AxisOptions Place Place
#place AxisOptions
a) Range Priority
x DataBox
db)
    (\TickStyle
x -> AxisOptions
a AxisOptions -> (AxisOptions -> AxisOptions) -> AxisOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx AxisOptions AxisOptions TickStyle TickStyle
-> TickStyle -> AxisOptions -> AxisOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (IsLabel
  "ticks" (Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks)
Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
#ticks Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
-> Optic A_Lens NoIx Ticks Ticks TickStyle TickStyle
-> Optic A_Lens NoIx AxisOptions AxisOptions TickStyle TickStyle
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% IsLabel "style" (Optic A_Lens NoIx Ticks Ticks TickStyle TickStyle)
Optic A_Lens NoIx Ticks Ticks TickStyle TickStyle
#style) TickStyle
x)
    (Range Priority -> TickStyle -> (Range Priority, TickStyle)
toTickPlaced (Place -> DataBox -> Range Priority
placeRange (Optic A_Lens NoIx AxisOptions AxisOptions Place Place
-> AxisOptions -> Place
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view IsLabel
  "place" (Optic A_Lens NoIx AxisOptions AxisOptions Place Place)
Optic A_Lens NoIx AxisOptions AxisOptions Place Place
#place AxisOptions
a) DataBox
db) (Optic A_Lens NoIx AxisOptions AxisOptions TickStyle TickStyle
-> AxisOptions -> TickStyle
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view (IsLabel
  "ticks" (Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks)
Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
#ticks Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
-> Optic A_Lens NoIx Ticks Ticks TickStyle TickStyle
-> Optic A_Lens NoIx AxisOptions AxisOptions TickStyle TickStyle
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% IsLabel "style" (Optic A_Lens NoIx Ticks Ticks TickStyle TickStyle)
Optic A_Lens NoIx Ticks Ticks TickStyle TickStyle
#style) AxisOptions
a))

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

toTickPlaced :: Range Double -> TickStyle -> (Range Double, TickStyle)
toTickPlaced :: Range Priority -> TickStyle -> (Range Priority, TickStyle)
toTickPlaced Range Priority
r t :: TickStyle
t@TickRound {} = (Range Priority -> Maybe (Range Priority) -> Range Priority
forall a. a -> Maybe a -> a
fromMaybe Range Priority
r Maybe (Range Priority)
ext, [(Priority, Text)] -> TickStyle
TickPlaced [(Priority, Text)]
ts)
  where
    ([(Priority, Text)]
ts, Maybe (Range Priority)
ext) = TickStyle
-> Range Priority -> ([(Priority, Text)], Maybe (Range Priority))
makePlacedTicks TickStyle
t Range Priority
r
toTickPlaced Range Priority
r TickStyle
t = (Range Priority
r, TickStyle
t)

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

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

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

axis :: AxisOptions -> State HudChart ChartTree
axis :: AxisOptions -> State HudChart ChartTree
axis AxisOptions
a = do
  ChartTree
t <- AxisOptions -> State HudChart ChartTree
makeTick AxisOptions
a
  ChartTree
b <- State HudChart ChartTree
-> (AxisBar -> State HudChart ChartTree)
-> Maybe AxisBar
-> State HudChart ChartTree
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ChartTree -> State HudChart ChartTree
forall (f :: * -> *) a. Applicative f => a -> f a
pure ChartTree
forall a. Monoid a => a
mempty) (Place -> AxisBar -> State HudChart ChartTree
makeAxisBar (Optic A_Lens NoIx AxisOptions AxisOptions Place Place
-> AxisOptions -> Place
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view IsLabel
  "place" (Optic A_Lens NoIx AxisOptions AxisOptions Place Place)
Optic A_Lens NoIx AxisOptions AxisOptions Place Place
#place AxisOptions
a)) (Optic' A_Lens NoIx AxisOptions (Maybe AxisBar)
-> AxisOptions -> Maybe AxisBar
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view IsLabel "bar" (Optic' A_Lens NoIx AxisOptions (Maybe AxisBar))
Optic' A_Lens NoIx AxisOptions (Maybe AxisBar)
#bar AxisOptions
a)
  ChartTree -> State HudChart ChartTree
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Text -> [ChartTree] -> ChartTree
group (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"axis") [ChartTree
t, ChartTree
b])

-- | alter a colour with a function
colourHudOptions :: (Colour -> Colour) -> HudOptions -> HudOptions
colourHudOptions :: (Colour -> Colour) -> HudOptions -> HudOptions
colourHudOptions Colour -> Colour
f HudOptions
o =
  HudOptions
o
    HudOptions -> (HudOptions -> HudOptions) -> HudOptions
forall a b. a -> (a -> b) -> b
& Optic' A_Lens NoIx HudOptions [(Priority, FrameOptions)]
-> ([(Priority, FrameOptions)] -> [(Priority, FrameOptions)])
-> HudOptions
-> HudOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over IsLabel
  "frames" (Optic' A_Lens NoIx HudOptions [(Priority, FrameOptions)])
Optic' A_Lens NoIx HudOptions [(Priority, FrameOptions)]
#frames (((Priority, FrameOptions) -> (Priority, FrameOptions))
-> [(Priority, FrameOptions)] -> [(Priority, FrameOptions)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((FrameOptions -> FrameOptions)
-> (Priority, FrameOptions) -> (Priority, FrameOptions)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second FrameOptions -> FrameOptions
fFrame))
    HudOptions -> (HudOptions -> HudOptions) -> HudOptions
forall a b. a -> (a -> b) -> b
& Optic' A_Lens NoIx HudOptions [(Priority, Title)]
-> ([(Priority, Title)] -> [(Priority, Title)])
-> HudOptions
-> HudOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over IsLabel
  "titles" (Optic' A_Lens NoIx HudOptions [(Priority, Title)])
Optic' A_Lens NoIx HudOptions [(Priority, Title)]
#titles (((Priority, Title) -> (Priority, Title))
-> [(Priority, Title)] -> [(Priority, Title)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Title -> Title) -> (Priority, Title) -> (Priority, Title)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (Optic A_Lens NoIx Title Title Colour Colour
-> (Colour -> Colour) -> Title -> Title
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over (IsLabel "style" (Optic A_Lens NoIx Title Title TextStyle TextStyle)
Optic A_Lens NoIx Title Title TextStyle TextStyle
#style Optic A_Lens NoIx Title Title TextStyle TextStyle
-> Optic A_Lens NoIx TextStyle TextStyle Colour Colour
-> Optic A_Lens NoIx Title Title Colour Colour
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% IsLabel
  "color" (Optic A_Lens NoIx TextStyle TextStyle Colour Colour)
Optic A_Lens NoIx TextStyle TextStyle Colour Colour
#color) Colour -> Colour
f)))
    HudOptions -> (HudOptions -> HudOptions) -> HudOptions
forall a b. a -> (a -> b) -> b
& Optic' A_Lens NoIx HudOptions [(Priority, AxisOptions)]
-> ([(Priority, AxisOptions)] -> [(Priority, AxisOptions)])
-> HudOptions
-> HudOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over IsLabel
  "axes" (Optic' A_Lens NoIx HudOptions [(Priority, AxisOptions)])
Optic' A_Lens NoIx HudOptions [(Priority, AxisOptions)]
#axes (((Priority, AxisOptions) -> (Priority, AxisOptions))
-> [(Priority, AxisOptions)] -> [(Priority, AxisOptions)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((AxisOptions -> AxisOptions)
-> (Priority, AxisOptions) -> (Priority, AxisOptions)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second AxisOptions -> AxisOptions
fAxis))
    HudOptions -> (HudOptions -> HudOptions) -> HudOptions
forall a b. a -> (a -> b) -> b
& Optic' A_Lens NoIx HudOptions [(Priority, LegendOptions)]
-> ([(Priority, LegendOptions)] -> [(Priority, LegendOptions)])
-> HudOptions
-> HudOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over IsLabel
  "legends"
  (Optic' A_Lens NoIx HudOptions [(Priority, LegendOptions)])
Optic' A_Lens NoIx HudOptions [(Priority, LegendOptions)]
#legends (((Priority, LegendOptions) -> (Priority, LegendOptions))
-> [(Priority, LegendOptions)] -> [(Priority, LegendOptions)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((LegendOptions -> LegendOptions)
-> (Priority, LegendOptions) -> (Priority, LegendOptions)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second LegendOptions -> LegendOptions
fLegend))
  where
    fAxis :: AxisOptions -> AxisOptions
    fAxis :: AxisOptions -> AxisOptions
fAxis AxisOptions
a =
      AxisOptions
a
        AxisOptions -> (AxisOptions -> AxisOptions) -> AxisOptions
forall a b. a -> (a -> b) -> b
& Optic' A_Lens NoIx AxisOptions (Maybe AxisBar)
-> (Maybe AxisBar -> Maybe AxisBar) -> AxisOptions -> AxisOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over IsLabel "bar" (Optic' A_Lens NoIx AxisOptions (Maybe AxisBar))
Optic' A_Lens NoIx AxisOptions (Maybe AxisBar)
#bar ((AxisBar -> AxisBar) -> Maybe AxisBar -> Maybe AxisBar
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Optic A_Lens NoIx AxisBar AxisBar Colour Colour
-> (Colour -> Colour) -> AxisBar -> AxisBar
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over (IsLabel
  "style" (Optic A_Lens NoIx AxisBar AxisBar RectStyle RectStyle)
Optic A_Lens NoIx AxisBar AxisBar RectStyle RectStyle
#style Optic A_Lens NoIx AxisBar AxisBar RectStyle RectStyle
-> Optic A_Lens NoIx RectStyle RectStyle Colour Colour
-> Optic A_Lens NoIx AxisBar AxisBar Colour Colour
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% IsLabel
  "color" (Optic A_Lens NoIx RectStyle RectStyle Colour Colour)
Optic A_Lens NoIx RectStyle RectStyle Colour Colour
#color) Colour -> Colour
f))
        AxisOptions -> (AxisOptions -> AxisOptions) -> AxisOptions
forall a b. a -> (a -> b) -> b
& Optic
  A_Lens
  NoIx
  AxisOptions
  AxisOptions
  (Maybe (GlyphStyle, Priority))
  (Maybe (GlyphStyle, Priority))
-> (Maybe (GlyphStyle, Priority) -> Maybe (GlyphStyle, Priority))
-> AxisOptions
-> AxisOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over
          (IsLabel
  "ticks" (Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks)
Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
#ticks Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
-> Optic
     A_Lens
     NoIx
     Ticks
     Ticks
     (Maybe (GlyphStyle, Priority))
     (Maybe (GlyphStyle, Priority))
-> Optic
     A_Lens
     NoIx
     AxisOptions
     AxisOptions
     (Maybe (GlyphStyle, Priority))
     (Maybe (GlyphStyle, Priority))
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% IsLabel
  "gtick"
  (Optic
     A_Lens
     NoIx
     Ticks
     Ticks
     (Maybe (GlyphStyle, Priority))
     (Maybe (GlyphStyle, Priority)))
Optic
  A_Lens
  NoIx
  Ticks
  Ticks
  (Maybe (GlyphStyle, Priority))
  (Maybe (GlyphStyle, Priority))
#gtick)
          (((GlyphStyle, Priority) -> (GlyphStyle, Priority))
-> Maybe (GlyphStyle, Priority) -> Maybe (GlyphStyle, Priority)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((GlyphStyle -> GlyphStyle)
-> (GlyphStyle, Priority) -> (GlyphStyle, Priority)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Optic A_Lens NoIx GlyphStyle GlyphStyle Colour Colour
-> (Colour -> Colour) -> GlyphStyle -> GlyphStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over IsLabel
  "color" (Optic A_Lens NoIx GlyphStyle GlyphStyle Colour Colour)
Optic A_Lens NoIx GlyphStyle GlyphStyle Colour Colour
#color Colour -> Colour
f (GlyphStyle -> GlyphStyle)
-> (GlyphStyle -> GlyphStyle) -> GlyphStyle -> GlyphStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Optic A_Lens NoIx GlyphStyle GlyphStyle Colour Colour
-> (Colour -> Colour) -> GlyphStyle -> GlyphStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over IsLabel
  "borderColor"
  (Optic A_Lens NoIx GlyphStyle GlyphStyle Colour Colour)
Optic A_Lens NoIx GlyphStyle GlyphStyle Colour Colour
#borderColor Colour -> Colour
f)))
        AxisOptions -> (AxisOptions -> AxisOptions) -> AxisOptions
forall a b. a -> (a -> b) -> b
& Optic
  A_Lens
  NoIx
  AxisOptions
  AxisOptions
  (Maybe (TextStyle, Priority))
  (Maybe (TextStyle, Priority))
-> (Maybe (TextStyle, Priority) -> Maybe (TextStyle, Priority))
-> AxisOptions
-> AxisOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over
          (IsLabel
  "ticks" (Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks)
Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
#ticks Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
-> Optic
     A_Lens
     NoIx
     Ticks
     Ticks
     (Maybe (TextStyle, Priority))
     (Maybe (TextStyle, Priority))
-> Optic
     A_Lens
     NoIx
     AxisOptions
     AxisOptions
     (Maybe (TextStyle, Priority))
     (Maybe (TextStyle, Priority))
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% IsLabel
  "ttick"
  (Optic
     A_Lens
     NoIx
     Ticks
     Ticks
     (Maybe (TextStyle, Priority))
     (Maybe (TextStyle, Priority)))
Optic
  A_Lens
  NoIx
  Ticks
  Ticks
  (Maybe (TextStyle, Priority))
  (Maybe (TextStyle, Priority))
#ttick)
          (((TextStyle, Priority) -> (TextStyle, Priority))
-> Maybe (TextStyle, Priority) -> Maybe (TextStyle, Priority)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((TextStyle -> TextStyle)
-> (TextStyle, Priority) -> (TextStyle, Priority)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Optic A_Lens NoIx TextStyle TextStyle Colour Colour
-> (Colour -> Colour) -> TextStyle -> 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 IsLabel
  "color" (Optic A_Lens NoIx TextStyle TextStyle Colour Colour)
Optic A_Lens NoIx TextStyle TextStyle Colour Colour
#color Colour -> Colour
f)))
        AxisOptions -> (AxisOptions -> AxisOptions) -> AxisOptions
forall a b. a -> (a -> b) -> b
& Optic
  A_Lens
  NoIx
  AxisOptions
  AxisOptions
  (Maybe (LineStyle, Priority))
  (Maybe (LineStyle, Priority))
-> (Maybe (LineStyle, Priority) -> Maybe (LineStyle, Priority))
-> AxisOptions
-> AxisOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over
          (IsLabel
  "ticks" (Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks)
Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
#ticks Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
-> Optic
     A_Lens
     NoIx
     Ticks
     Ticks
     (Maybe (LineStyle, Priority))
     (Maybe (LineStyle, Priority))
-> Optic
     A_Lens
     NoIx
     AxisOptions
     AxisOptions
     (Maybe (LineStyle, Priority))
     (Maybe (LineStyle, Priority))
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% IsLabel
  "ltick"
  (Optic
     A_Lens
     NoIx
     Ticks
     Ticks
     (Maybe (LineStyle, Priority))
     (Maybe (LineStyle, Priority)))
Optic
  A_Lens
  NoIx
  Ticks
  Ticks
  (Maybe (LineStyle, Priority))
  (Maybe (LineStyle, Priority))
#ltick)
          (((LineStyle, Priority) -> (LineStyle, Priority))
-> Maybe (LineStyle, Priority) -> Maybe (LineStyle, Priority)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((LineStyle -> LineStyle)
-> (LineStyle, Priority) -> (LineStyle, Priority)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Optic A_Lens NoIx LineStyle LineStyle Colour Colour
-> (Colour -> Colour) -> LineStyle -> LineStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over IsLabel
  "color" (Optic A_Lens NoIx LineStyle LineStyle Colour Colour)
Optic A_Lens NoIx LineStyle LineStyle Colour Colour
#color Colour -> Colour
f)))
    fLegend :: LegendOptions -> LegendOptions
    fLegend :: LegendOptions -> LegendOptions
fLegend LegendOptions
a =
      LegendOptions
a
        LegendOptions -> (LegendOptions -> LegendOptions) -> LegendOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx LegendOptions LegendOptions TextStyle TextStyle
-> (TextStyle -> TextStyle) -> LegendOptions -> LegendOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over IsLabel
  "textStyle"
  (Optic A_Lens NoIx LegendOptions LegendOptions TextStyle TextStyle)
Optic A_Lens NoIx LegendOptions LegendOptions TextStyle TextStyle
#textStyle (Optic A_Lens NoIx TextStyle TextStyle Colour Colour
-> (Colour -> Colour) -> TextStyle -> 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 IsLabel
  "color" (Optic A_Lens NoIx TextStyle TextStyle Colour Colour)
Optic A_Lens NoIx TextStyle TextStyle Colour Colour
#color Colour -> Colour
f)
        LegendOptions -> (LegendOptions -> LegendOptions) -> LegendOptions
forall a b. a -> (a -> b) -> b
& Optic
  A_Lens
  NoIx
  LegendOptions
  LegendOptions
  (Maybe RectStyle)
  (Maybe RectStyle)
-> (Maybe RectStyle -> Maybe RectStyle)
-> LegendOptions
-> LegendOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over IsLabel
  "frame"
  (Optic
     A_Lens
     NoIx
     LegendOptions
     LegendOptions
     (Maybe RectStyle)
     (Maybe RectStyle))
Optic
  A_Lens
  NoIx
  LegendOptions
  LegendOptions
  (Maybe RectStyle)
  (Maybe RectStyle)
#frame ((RectStyle -> RectStyle) -> Maybe RectStyle -> Maybe RectStyle
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Optic A_Lens NoIx RectStyle RectStyle Colour Colour
-> (Colour -> Colour) -> RectStyle -> RectStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over IsLabel
  "color" (Optic A_Lens NoIx RectStyle RectStyle Colour Colour)
Optic A_Lens NoIx RectStyle RectStyle Colour Colour
#color Colour -> Colour
f (RectStyle -> RectStyle)
-> (RectStyle -> RectStyle) -> RectStyle -> RectStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Optic A_Lens NoIx RectStyle RectStyle Colour Colour
-> (Colour -> Colour) -> RectStyle -> RectStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over IsLabel
  "borderColor" (Optic A_Lens NoIx RectStyle RectStyle Colour Colour)
Optic A_Lens NoIx RectStyle RectStyle Colour Colour
#borderColor Colour -> Colour
f))
    fFrame :: FrameOptions -> FrameOptions
    fFrame :: FrameOptions -> FrameOptions
fFrame FrameOptions
a =
      FrameOptions
a
        FrameOptions -> (FrameOptions -> FrameOptions) -> FrameOptions
forall a b. a -> (a -> b) -> b
& Optic
  A_Lens
  NoIx
  FrameOptions
  FrameOptions
  (Maybe RectStyle)
  (Maybe RectStyle)
-> (Maybe RectStyle -> Maybe RectStyle)
-> FrameOptions
-> FrameOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over IsLabel
  "frame"
  (Optic
     A_Lens
     NoIx
     FrameOptions
     FrameOptions
     (Maybe RectStyle)
     (Maybe RectStyle))
Optic
  A_Lens
  NoIx
  FrameOptions
  FrameOptions
  (Maybe RectStyle)
  (Maybe RectStyle)
#frame ((RectStyle -> RectStyle) -> Maybe RectStyle -> Maybe RectStyle
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Optic A_Lens NoIx RectStyle RectStyle Colour Colour
-> (Colour -> Colour) -> RectStyle -> RectStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over IsLabel
  "color" (Optic A_Lens NoIx RectStyle RectStyle Colour Colour)
Optic A_Lens NoIx RectStyle RectStyle Colour Colour
#color Colour -> Colour
f (RectStyle -> RectStyle)
-> (RectStyle -> RectStyle) -> RectStyle -> RectStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Optic A_Lens NoIx RectStyle RectStyle Colour Colour
-> (Colour -> Colour) -> RectStyle -> RectStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over IsLabel
  "borderColor" (Optic A_Lens NoIx RectStyle RectStyle Colour Colour)
Optic A_Lens NoIx RectStyle RectStyle Colour Colour
#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
(Int -> Place -> ShowS)
-> (Place -> String) -> ([Place] -> ShowS) -> Show Place
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
(Place -> Place -> Bool) -> (Place -> Place -> Bool) -> Eq Place
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. Place -> Rep Place x)
-> (forall x. Rep Place x -> Place) -> Generic Place
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)

-- | textifier
placeText :: Place -> Text
placeText :: Place -> Text
placeText Place
p =
  case Place
p of
    Place
PlaceTop -> Text
"Top"
    Place
PlaceBottom -> Text
"Bottom"
    Place
PlaceLeft -> Text
"Left"
    Place
PlaceRight -> Text
"Right"
    PlaceAbsolute Point Priority
_ -> Text
"Absolute"

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

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

-- | The bar on an axis representing the x or y plane.
--
-- >>> defaultAxisBar
-- AxisBar {style = RectStyle {borderSize = 0.0, borderColor = Colour 0.00 0.00 0.00 0.00, color = Colour 0.05 0.05 0.05 0.40}, size = 4.0e-3, buffer = 1.0e-2, overhang = 2.0e-3}
data AxisBar = AxisBar
  { AxisBar -> RectStyle
style :: RectStyle,
    AxisBar -> Priority
size :: Double,
    AxisBar -> Priority
buffer :: Double,
    -- | extension over the edges of the axis range
    AxisBar -> Priority
overhang :: Double
  }
  deriving (Int -> AxisBar -> ShowS
[AxisBar] -> ShowS
AxisBar -> String
(Int -> AxisBar -> ShowS)
-> (AxisBar -> String) -> ([AxisBar] -> ShowS) -> Show AxisBar
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AxisBar] -> ShowS
$cshowList :: [AxisBar] -> ShowS
show :: AxisBar -> String
$cshow :: AxisBar -> String
showsPrec :: Int -> AxisBar -> ShowS
$cshowsPrec :: Int -> AxisBar -> ShowS
Show, AxisBar -> AxisBar -> Bool
(AxisBar -> AxisBar -> Bool)
-> (AxisBar -> AxisBar -> Bool) -> Eq AxisBar
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. AxisBar -> Rep AxisBar x)
-> (forall x. Rep AxisBar x -> AxisBar) -> Generic AxisBar
forall x. Rep AxisBar x -> AxisBar
forall x. AxisBar -> Rep AxisBar x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AxisBar x -> AxisBar
$cfrom :: forall x. AxisBar -> Rep AxisBar x
Generic)

-- | The official axis bar
defaultAxisBar :: AxisBar
defaultAxisBar :: AxisBar
defaultAxisBar = RectStyle -> Priority -> Priority -> Priority -> AxisBar
AxisBar (Priority -> Colour -> Colour -> RectStyle
RectStyle Priority
0 Colour
transparent (Optic A_Lens NoIx Colour Colour Priority Priority
-> Priority -> Colour -> Colour
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Colour Colour Priority Priority
opac' Priority
0.4 Colour
dark)) Priority
0.004 Priority
0.01 Priority
0.002

-- | Options for titles.  Defaults to center aligned, and placed at Top of the hud
--
-- >>> defaultTitle "title"
-- Title {text = "title", style = TextStyle {size = 0.12, color = Colour 0.05 0.05 0.05 1.00, anchor = AnchorMiddle, hsize = 0.45, vsize = 1.1, vshift = -0.25, rotation = Nothing, scalex = ScaleX, frame = Nothing}, place = PlaceTop, anchor = AnchorMiddle, buffer = 4.0e-2}
data Title = Title
  { Title -> Text
text :: Text,
    Title -> TextStyle
style :: TextStyle,
    Title -> Place
place :: Place,
    Title -> Anchor
anchor :: Anchor,
    Title -> Priority
buffer :: Double
  }
  deriving (Int -> Title -> ShowS
[Title] -> ShowS
Title -> String
(Int -> Title -> ShowS)
-> (Title -> String) -> ([Title] -> ShowS) -> Show Title
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Title] -> ShowS
$cshowList :: [Title] -> ShowS
show :: Title -> String
$cshow :: Title -> String
showsPrec :: Int -> Title -> ShowS
$cshowsPrec :: Int -> Title -> ShowS
Show, Title -> Title -> Bool
(Title -> Title -> Bool) -> (Title -> Title -> Bool) -> Eq Title
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Title -> Title -> Bool
$c/= :: Title -> Title -> Bool
== :: Title -> Title -> Bool
$c== :: Title -> Title -> Bool
Eq, (forall x. Title -> Rep Title x)
-> (forall x. Rep Title x -> Title) -> Generic Title
forall x. Rep Title x -> Title
forall x. Title -> Rep Title x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Title x -> Title
$cfrom :: forall x. Title -> Rep Title x
Generic)

-- | The official hud title
defaultTitle :: Text -> Title
defaultTitle :: Text -> Title
defaultTitle Text
txt =
  Text -> TextStyle -> Place -> Anchor -> Priority -> Title
Title
    Text
txt
    ( TextStyle
defaultTextStyle
        TextStyle -> (TextStyle -> TextStyle) -> TextStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "size" (Optic A_Lens NoIx TextStyle TextStyle Priority Priority)
Optic A_Lens NoIx TextStyle TextStyle Priority Priority
#size Optic A_Lens NoIx TextStyle TextStyle Priority Priority
-> Priority -> TextStyle -> TextStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Priority
0.12
    )
    Place
PlaceTop
    Anchor
AnchorMiddle
    Priority
0.04

-- | xy coordinate markings
--
-- >>> defaultTicks
-- Ticks {style = TickRound (FormatN {fstyle = FSCommaPrec, sigFigs = Just 2, addLPad = True}) 8 TickExtend, gtick = Just (GlyphStyle {size = 3.0e-2, color = Colour 0.05 0.05 0.05 0.40, borderColor = Colour 0.05 0.05 0.05 0.40, borderSize = 4.0e-3, shape = VLineGlyph, rotation = Nothing, translate = Nothing},3.0e-2), ttick = Just (TextStyle {size = 5.0e-2, color = Colour 0.05 0.05 0.05 1.00, anchor = AnchorMiddle, hsize = 0.45, vsize = 1.1, vshift = -0.25, rotation = Nothing, scalex = ScaleX, frame = Nothing},3.3e-2), ltick = Just (LineStyle {size = 5.0e-3, color = Colour 0.05 0.05 0.05 0.05, linecap = Nothing, linejoin = Nothing, dasharray = Nothing, dashoffset = Nothing},0.0)}
data Ticks = Ticks
  { Ticks -> TickStyle
style :: TickStyle,
    Ticks -> Maybe (GlyphStyle, Priority)
gtick :: Maybe (GlyphStyle, Double),
    Ticks -> Maybe (TextStyle, Priority)
ttick :: Maybe (TextStyle, Double),
    Ticks -> Maybe (LineStyle, Priority)
ltick :: Maybe (LineStyle, Double)
  }
  deriving (Int -> Ticks -> ShowS
[Ticks] -> ShowS
Ticks -> String
(Int -> Ticks -> ShowS)
-> (Ticks -> String) -> ([Ticks] -> ShowS) -> Show Ticks
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Ticks] -> ShowS
$cshowList :: [Ticks] -> ShowS
show :: Ticks -> String
$cshow :: Ticks -> String
showsPrec :: Int -> Ticks -> ShowS
$cshowsPrec :: Int -> Ticks -> ShowS
Show, Ticks -> Ticks -> Bool
(Ticks -> Ticks -> Bool) -> (Ticks -> Ticks -> Bool) -> Eq Ticks
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. Ticks -> Rep Ticks x)
-> (forall x. Rep Ticks x -> Ticks) -> Generic Ticks
forall x. Rep Ticks x -> Ticks
forall x. Ticks -> Rep Ticks x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Ticks x -> Ticks
$cfrom :: forall x. Ticks -> Rep Ticks x
Generic)

-- | The official glyph tick
defaultGlyphTick :: GlyphStyle
defaultGlyphTick :: GlyphStyle
defaultGlyphTick =
  GlyphStyle
defaultGlyphStyle
    GlyphStyle -> (GlyphStyle -> GlyphStyle) -> GlyphStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "borderSize"
  (Optic A_Lens NoIx GlyphStyle GlyphStyle Priority Priority)
Optic A_Lens NoIx GlyphStyle GlyphStyle Priority Priority
#borderSize Optic A_Lens NoIx GlyphStyle GlyphStyle Priority Priority
-> Priority -> GlyphStyle -> GlyphStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Priority
0.004
    GlyphStyle -> (GlyphStyle -> GlyphStyle) -> GlyphStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "shape"
  (Optic A_Lens NoIx GlyphStyle GlyphStyle GlyphShape GlyphShape)
Optic A_Lens NoIx GlyphStyle GlyphStyle GlyphShape GlyphShape
#shape Optic A_Lens NoIx GlyphStyle GlyphStyle GlyphShape GlyphShape
-> GlyphShape -> GlyphStyle -> GlyphStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ GlyphShape
VLineGlyph
    GlyphStyle -> (GlyphStyle -> GlyphStyle) -> GlyphStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "color" (Optic A_Lens NoIx GlyphStyle GlyphStyle Colour Colour)
Optic A_Lens NoIx GlyphStyle GlyphStyle Colour Colour
#color Optic A_Lens NoIx GlyphStyle GlyphStyle Colour Colour
-> Colour -> GlyphStyle -> GlyphStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Optic A_Lens NoIx Colour Colour Priority Priority
-> Priority -> Colour -> Colour
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Colour Colour Priority Priority
opac' Priority
0.4 Colour
dark
    GlyphStyle -> (GlyphStyle -> GlyphStyle) -> GlyphStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "borderColor"
  (Optic A_Lens NoIx GlyphStyle GlyphStyle Colour Colour)
Optic A_Lens NoIx GlyphStyle GlyphStyle Colour Colour
#borderColor Optic A_Lens NoIx GlyphStyle GlyphStyle Colour Colour
-> Colour -> GlyphStyle -> GlyphStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Optic A_Lens NoIx Colour Colour Priority Priority
-> Priority -> Colour -> Colour
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Colour Colour Priority Priority
opac' Priority
0.4 Colour
dark

-- | The official text tick
defaultTextTick :: TextStyle
defaultTextTick :: TextStyle
defaultTextTick =
  TextStyle
defaultTextStyle TextStyle -> (TextStyle -> TextStyle) -> TextStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "size" (Optic A_Lens NoIx TextStyle TextStyle Priority Priority)
Optic A_Lens NoIx TextStyle TextStyle Priority Priority
#size Optic A_Lens NoIx TextStyle TextStyle Priority Priority
-> Priority -> TextStyle -> TextStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Priority
0.05

-- | The official line tick
defaultLineTick :: LineStyle
defaultLineTick :: LineStyle
defaultLineTick =
  LineStyle
defaultLineStyle
    LineStyle -> (LineStyle -> LineStyle) -> LineStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "size" (Optic A_Lens NoIx LineStyle LineStyle Priority Priority)
Optic A_Lens NoIx LineStyle LineStyle Priority Priority
#size Optic A_Lens NoIx LineStyle LineStyle Priority Priority
-> Priority -> LineStyle -> LineStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Priority
5.0e-3
    LineStyle -> (LineStyle -> LineStyle) -> LineStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "color" (Optic A_Lens NoIx LineStyle LineStyle Colour Colour)
Optic A_Lens NoIx LineStyle LineStyle Colour Colour
#color Optic A_Lens NoIx LineStyle LineStyle Colour Colour
-> (Colour -> Colour) -> LineStyle -> LineStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ Optic A_Lens NoIx Colour Colour Priority Priority
-> Priority -> Colour -> Colour
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Colour Colour Priority Priority
opac' Priority
0.05

-- | The official tick
defaultTicks :: Ticks
defaultTicks :: Ticks
defaultTicks =
  TickStyle
-> Maybe (GlyphStyle, Priority)
-> Maybe (TextStyle, Priority)
-> Maybe (LineStyle, Priority)
-> Ticks
Ticks
    TickStyle
defaultTickStyle
    ((GlyphStyle, Priority) -> Maybe (GlyphStyle, Priority)
forall a. a -> Maybe a
Just (GlyphStyle
defaultGlyphTick, Priority
0.03))
    ((TextStyle, Priority) -> Maybe (TextStyle, Priority)
forall a. a -> Maybe a
Just (TextStyle
defaultTextTick, Priority
0.033))
    ((LineStyle, Priority) -> Maybe (LineStyle, Priority)
forall a. a -> Maybe a
Just (LineStyle
defaultLineTick, Priority
0))

-- | Style of tick marks on an axis.
data TickStyle
  = -- | 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 -> TickStyle -> ShowS
[TickStyle] -> ShowS
TickStyle -> String
(Int -> TickStyle -> ShowS)
-> (TickStyle -> String)
-> ([TickStyle] -> ShowS)
-> Show TickStyle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TickStyle] -> ShowS
$cshowList :: [TickStyle] -> ShowS
show :: TickStyle -> String
$cshow :: TickStyle -> String
showsPrec :: Int -> TickStyle -> ShowS
$cshowsPrec :: Int -> TickStyle -> ShowS
Show, TickStyle -> TickStyle -> Bool
(TickStyle -> TickStyle -> Bool)
-> (TickStyle -> TickStyle -> Bool) -> Eq TickStyle
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. TickStyle -> Rep TickStyle x)
-> (forall x. Rep TickStyle x -> TickStyle) -> Generic TickStyle
forall x. Rep TickStyle x -> TickStyle
forall x. TickStyle -> Rep TickStyle x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TickStyle x -> TickStyle
$cfrom :: forall x. TickStyle -> Rep TickStyle x
Generic)

-- | The official tick style
defaultTickStyle :: TickStyle
defaultTickStyle :: TickStyle
defaultTickStyle = FormatN -> Int -> TickExtend -> TickStyle
TickRound FormatN
defaultFormatN Int
8 TickExtend
TickExtend

-- | textifier
tickStyleText :: TickStyle -> Text
tickStyleText :: TickStyle -> Text
tickStyleText TickStyle
TickNone = Text
"TickNone"
tickStyleText TickLabels {} = Text
"TickLabels"
tickStyleText TickRound {} = Text
"TickRound"
tickStyleText TickExact {} = Text
"TickExact"
tickStyleText TickPlaced {} = Text
"TickPlaced"

-- | Whether Ticks are allowed to extend the data range
data TickExtend = TickExtend | NoTickExtend deriving (TickExtend -> TickExtend -> Bool
(TickExtend -> TickExtend -> Bool)
-> (TickExtend -> TickExtend -> Bool) -> Eq TickExtend
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TickExtend -> TickExtend -> Bool
$c/= :: TickExtend -> TickExtend -> Bool
== :: TickExtend -> TickExtend -> Bool
$c== :: TickExtend -> TickExtend -> Bool
Eq, Int -> TickExtend -> ShowS
[TickExtend] -> ShowS
TickExtend -> String
(Int -> TickExtend -> ShowS)
-> (TickExtend -> String)
-> ([TickExtend] -> ShowS)
-> Show TickExtend
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TickExtend] -> ShowS
$cshowList :: [TickExtend] -> ShowS
show :: TickExtend -> String
$cshow :: TickExtend -> String
showsPrec :: Int -> TickExtend -> ShowS
$cshowsPrec :: Int -> TickExtend -> ShowS
Show, (forall x. TickExtend -> Rep TickExtend x)
-> (forall x. Rep TickExtend x -> TickExtend) -> Generic TickExtend
forall x. Rep TickExtend x -> TickExtend
forall x. TickExtend -> Rep TickExtend x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$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 -> Priority
maxXRatio :: Double,
    Adjustments -> Priority
maxYRatio :: Double,
    Adjustments -> Priority
angledRatio :: Double,
    Adjustments -> Bool
allowDiagonal :: Bool
  }
  deriving (Int -> Adjustments -> ShowS
[Adjustments] -> ShowS
Adjustments -> String
(Int -> Adjustments -> ShowS)
-> (Adjustments -> String)
-> ([Adjustments] -> ShowS)
-> Show Adjustments
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Adjustments] -> ShowS
$cshowList :: [Adjustments] -> ShowS
show :: Adjustments -> String
$cshow :: Adjustments -> String
showsPrec :: Int -> Adjustments -> ShowS
$cshowsPrec :: Int -> Adjustments -> ShowS
Show, Adjustments -> Adjustments -> Bool
(Adjustments -> Adjustments -> Bool)
-> (Adjustments -> Adjustments -> Bool) -> Eq Adjustments
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. Adjustments -> Rep Adjustments x)
-> (forall x. Rep Adjustments x -> Adjustments)
-> Generic Adjustments
forall x. Rep Adjustments x -> Adjustments
forall x. Adjustments -> Rep Adjustments x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Adjustments x -> Adjustments
$cfrom :: forall x. Adjustments -> Rep Adjustments x
Generic)

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

-- | Legend options
--
-- >>> defaultLegendOptions
-- LegendOptions {size = 0.3, buffer = 0.1, vgap = 0.2, hgap = 0.1, textStyle = TextStyle {size = 0.18, color = Colour 0.05 0.05 0.05 1.00, anchor = AnchorMiddle, hsize = 0.45, vsize = 1.1, vshift = -0.25, rotation = Nothing, scalex = ScaleX, frame = Nothing}, innerPad = 0.1, outerPad = 2.0e-2, frame = Just (RectStyle {borderSize = 1.0e-2, borderColor = Colour 0.05 0.05 0.05 1.00, color = Colour 0.05 0.05 0.05 0.00}), place = PlaceRight, overallScale = 0.25, content = []}
--
data LegendOptions = LegendOptions
  { LegendOptions -> Priority
size :: Double,
    LegendOptions -> Priority
buffer :: Double,
    LegendOptions -> Priority
vgap :: Double,
    LegendOptions -> Priority
hgap :: Double,
    LegendOptions -> TextStyle
textStyle :: TextStyle,
    LegendOptions -> Priority
innerPad :: Double,
    LegendOptions -> Priority
outerPad :: Double,
    LegendOptions -> Maybe RectStyle
frame :: Maybe RectStyle,
    LegendOptions -> Place
place :: Place,
    LegendOptions -> Priority
overallScale :: Double,
    LegendOptions -> [(Text, Chart)]
content :: [(Text, Chart)]
  }
  deriving (Int -> LegendOptions -> ShowS
[LegendOptions] -> ShowS
LegendOptions -> String
(Int -> LegendOptions -> ShowS)
-> (LegendOptions -> String)
-> ([LegendOptions] -> ShowS)
-> Show LegendOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LegendOptions] -> ShowS
$cshowList :: [LegendOptions] -> ShowS
show :: LegendOptions -> String
$cshow :: LegendOptions -> String
showsPrec :: Int -> LegendOptions -> ShowS
$cshowsPrec :: Int -> LegendOptions -> ShowS
Show, LegendOptions -> LegendOptions -> Bool
(LegendOptions -> LegendOptions -> Bool)
-> (LegendOptions -> LegendOptions -> Bool) -> Eq LegendOptions
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. LegendOptions -> Rep LegendOptions x)
-> (forall x. Rep LegendOptions x -> LegendOptions)
-> Generic LegendOptions
forall x. Rep LegendOptions x -> LegendOptions
forall x. LegendOptions -> Rep LegendOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LegendOptions x -> LegendOptions
$cfrom :: forall x. LegendOptions -> Rep LegendOptions x
Generic)

-- | The official legend options
defaultLegendOptions :: LegendOptions
defaultLegendOptions :: LegendOptions
defaultLegendOptions =
  Priority
-> Priority
-> Priority
-> Priority
-> TextStyle
-> Priority
-> Priority
-> Maybe RectStyle
-> Place
-> Priority
-> [(Text, Chart)]
-> LegendOptions
LegendOptions
    Priority
0.3
    Priority
0.1
    Priority
0.2
    Priority
0.1
    ( TextStyle
defaultTextStyle
        TextStyle -> (TextStyle -> TextStyle) -> TextStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "size" (Optic A_Lens NoIx TextStyle TextStyle Priority Priority)
Optic A_Lens NoIx TextStyle TextStyle Priority Priority
#size Optic A_Lens NoIx TextStyle TextStyle Priority Priority
-> Priority -> TextStyle -> TextStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Priority
0.18
    )
    Priority
0.1
    Priority
0.02
    (RectStyle -> Maybe RectStyle
forall a. a -> Maybe a
Just (Priority -> Colour -> Colour -> RectStyle
RectStyle Priority
0.01 (Optic A_Lens NoIx Colour Colour Priority Priority
-> Priority -> Colour -> Colour
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Colour Colour Priority Priority
opac' Priority
1 Colour
dark) (Optic A_Lens NoIx Colour Colour Priority Priority
-> Priority -> Colour -> Colour
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Colour Colour Priority Priority
opac' Priority
0 Colour
dark)))
    Place
PlaceRight
    Priority
0.25
    []

-- | flip an axis from being an X dimension to a Y one or vice-versa.
flipAxis :: AxisOptions -> AxisOptions
flipAxis :: AxisOptions -> AxisOptions
flipAxis AxisOptions
ac = case AxisOptions
ac AxisOptions
-> Optic A_Lens NoIx AxisOptions AxisOptions Place Place -> Place
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel
  "place" (Optic A_Lens NoIx AxisOptions AxisOptions Place Place)
Optic A_Lens NoIx AxisOptions AxisOptions Place Place
#place of
  Place
PlaceBottom -> AxisOptions
ac AxisOptions -> (AxisOptions -> AxisOptions) -> AxisOptions
forall a b. a -> (a -> b) -> b
& IsLabel
  "place" (Optic A_Lens NoIx AxisOptions AxisOptions Place Place)
Optic A_Lens NoIx AxisOptions AxisOptions Place Place
#place Optic A_Lens NoIx AxisOptions AxisOptions Place Place
-> Place -> AxisOptions -> AxisOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Place
PlaceLeft
  Place
PlaceTop -> AxisOptions
ac AxisOptions -> (AxisOptions -> AxisOptions) -> AxisOptions
forall a b. a -> (a -> b) -> b
& IsLabel
  "place" (Optic A_Lens NoIx AxisOptions AxisOptions Place Place)
Optic A_Lens NoIx AxisOptions AxisOptions Place Place
#place Optic A_Lens NoIx AxisOptions AxisOptions Place Place
-> Place -> AxisOptions -> AxisOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Place
PlaceRight
  Place
PlaceLeft -> AxisOptions
ac AxisOptions -> (AxisOptions -> AxisOptions) -> AxisOptions
forall a b. a -> (a -> b) -> b
& IsLabel
  "place" (Optic A_Lens NoIx AxisOptions AxisOptions Place Place)
Optic A_Lens NoIx AxisOptions AxisOptions Place Place
#place Optic A_Lens NoIx AxisOptions AxisOptions Place Place
-> Place -> AxisOptions -> AxisOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Place
PlaceBottom
  Place
PlaceRight -> AxisOptions
ac AxisOptions -> (AxisOptions -> AxisOptions) -> AxisOptions
forall a b. a -> (a -> b) -> b
& IsLabel
  "place" (Optic A_Lens NoIx AxisOptions AxisOptions Place Place)
Optic A_Lens NoIx AxisOptions AxisOptions Place Place
#place Optic A_Lens NoIx AxisOptions AxisOptions Place Place
-> Place -> AxisOptions -> AxisOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Place
PlaceTop
  PlaceAbsolute Point Priority
_ -> AxisOptions
ac

-- | Options for hud frames
--
-- >>> defaultFrameOptions
-- FrameOptions {frame = Just (RectStyle {borderSize = 0.0, borderColor = Colour 0.00 0.00 0.00 0.00, color = Colour 1.00 1.00 1.00 0.02}), buffer = 0.0}
data FrameOptions = FrameOptions
  { FrameOptions -> Maybe RectStyle
frame :: Maybe RectStyle,
    FrameOptions -> Priority
buffer :: Double
  }
  deriving (FrameOptions -> FrameOptions -> Bool
(FrameOptions -> FrameOptions -> Bool)
-> (FrameOptions -> FrameOptions -> Bool) -> Eq FrameOptions
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
(Int -> FrameOptions -> ShowS)
-> (FrameOptions -> String)
-> ([FrameOptions] -> ShowS)
-> Show FrameOptions
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. FrameOptions -> Rep FrameOptions x)
-> (forall x. Rep FrameOptions x -> FrameOptions)
-> Generic FrameOptions
forall x. Rep FrameOptions x -> FrameOptions
forall x. FrameOptions -> Rep FrameOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$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 RectStyle -> Priority -> FrameOptions
FrameOptions (RectStyle -> Maybe RectStyle
forall a. a -> Maybe a
Just (Colour -> RectStyle
blob (Priority -> Priority -> Colour
grey Priority
1 Priority
0.02))) Priority
0

-- | Make a frame hud transformation.
frameHud :: FrameOptions -> State HudChart ChartTree
frameHud :: FrameOptions -> State HudChart ChartTree
frameHud FrameOptions
o = do
  HudChart
hc <- StateT HudChart Identity HudChart
forall s (m :: * -> *). MonadState s m => m s
get
  let r :: Maybe DataBox
r = Priority -> DataBox -> DataBox
forall a. Subtractive a => a -> Rect a -> Rect a
padRect (Optic' A_Lens NoIx FrameOptions Priority
-> FrameOptions -> Priority
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view IsLabel "buffer" (Optic' A_Lens NoIx FrameOptions Priority)
Optic' A_Lens NoIx FrameOptions Priority
#buffer FrameOptions
o) (DataBox -> DataBox) -> Maybe DataBox -> Maybe DataBox
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getter HudChart (Maybe DataBox) -> HudChart -> Maybe DataBox
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Getter HudChart (Maybe DataBox)
hudStyleBox' HudChart
hc
  case Maybe DataBox
r of
    Maybe DataBox
Nothing -> ChartTree -> State HudChart ChartTree
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Chart] -> ChartTree
unnamed [])
    Just DataBox
r' -> ChartTree -> State HudChart ChartTree
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChartTree -> State HudChart ChartTree)
-> ChartTree -> State HudChart ChartTree
forall a b. (a -> b) -> a -> b
$ case Optic
  A_Lens
  NoIx
  FrameOptions
  FrameOptions
  (Maybe RectStyle)
  (Maybe RectStyle)
-> FrameOptions -> Maybe RectStyle
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view IsLabel
  "frame"
  (Optic
     A_Lens
     NoIx
     FrameOptions
     FrameOptions
     (Maybe RectStyle)
     (Maybe RectStyle))
Optic
  A_Lens
  NoIx
  FrameOptions
  FrameOptions
  (Maybe RectStyle)
  (Maybe RectStyle)
#frame FrameOptions
o of
      Maybe RectStyle
Nothing -> DataBox -> ChartTree
blank DataBox
r'
      Just RectStyle
rs -> Text -> [Chart] -> ChartTree
named Text
"frame" [RectStyle -> [DataBox] -> Chart
RectChart RectStyle
rs [DataBox
r']]

bar_ :: Place -> AxisBar -> CanvasBox -> HudBox -> Chart
bar_ :: Place -> AxisBar -> DataBox -> DataBox -> Chart
bar_ Place
pl AxisBar
b (Rect Priority
x Priority
z Priority
y Priority
w) (Rect Priority
x' Priority
z' Priority
y' Priority
w') =
  RectStyle -> [DataBox] -> Chart
RectChart (Optic A_Lens NoIx AxisBar AxisBar RectStyle RectStyle
-> AxisBar -> RectStyle
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view IsLabel
  "style" (Optic A_Lens NoIx AxisBar AxisBar RectStyle RectStyle)
Optic A_Lens NoIx AxisBar AxisBar RectStyle RectStyle
#style AxisBar
b) ([DataBox] -> Chart) -> [DataBox] -> Chart
forall a b. (a -> b) -> a -> b
$
    case Place
pl of
      Place
PlaceTop ->
        [ Priority -> Priority -> Priority -> Priority -> DataBox
forall a. a -> a -> a -> a -> Rect a
Rect
            (Priority
x Priority -> Priority -> Priority
forall a. Num a => a -> a -> a
- AxisBar
b AxisBar -> Optic' A_Lens NoIx AxisBar Priority -> Priority
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "overhang" (Optic' A_Lens NoIx AxisBar Priority)
Optic' A_Lens NoIx AxisBar Priority
#overhang)
            (Priority
z Priority -> Priority -> Priority
forall a. Num a => a -> a -> a
+ AxisBar
b AxisBar -> Optic' A_Lens NoIx AxisBar Priority -> Priority
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "overhang" (Optic' A_Lens NoIx AxisBar Priority)
Optic' A_Lens NoIx AxisBar Priority
#overhang)
            (Priority
w' Priority -> Priority -> Priority
forall a. Num a => a -> a -> a
+ AxisBar
b AxisBar -> Optic' A_Lens NoIx AxisBar Priority -> Priority
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "buffer" (Optic' A_Lens NoIx AxisBar Priority)
Optic' A_Lens NoIx AxisBar Priority
#buffer)
            (Priority
w' Priority -> Priority -> Priority
forall a. Num a => a -> a -> a
+ AxisBar
b AxisBar -> Optic' A_Lens NoIx AxisBar Priority -> Priority
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "buffer" (Optic' A_Lens NoIx AxisBar Priority)
Optic' A_Lens NoIx AxisBar Priority
#buffer Priority -> Priority -> Priority
forall a. Num a => a -> a -> a
+ AxisBar
b AxisBar -> Optic' A_Lens NoIx AxisBar Priority -> Priority
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "size" (Optic' A_Lens NoIx AxisBar Priority)
Optic' A_Lens NoIx AxisBar Priority
#size)
        ]
      Place
PlaceBottom ->
        [ Priority -> Priority -> Priority -> Priority -> DataBox
forall a. a -> a -> a -> a -> Rect a
Rect
            (Priority
x Priority -> Priority -> Priority
forall a. Num a => a -> a -> a
- AxisBar
b AxisBar -> Optic' A_Lens NoIx AxisBar Priority -> Priority
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "overhang" (Optic' A_Lens NoIx AxisBar Priority)
Optic' A_Lens NoIx AxisBar Priority
#overhang)
            (Priority
z Priority -> Priority -> Priority
forall a. Num a => a -> a -> a
+ AxisBar
b AxisBar -> Optic' A_Lens NoIx AxisBar Priority -> Priority
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "overhang" (Optic' A_Lens NoIx AxisBar Priority)
Optic' A_Lens NoIx AxisBar Priority
#overhang)
            (Priority
y' Priority -> Priority -> Priority
forall a. Num a => a -> a -> a
- AxisBar
b AxisBar -> Optic' A_Lens NoIx AxisBar Priority -> Priority
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "size" (Optic' A_Lens NoIx AxisBar Priority)
Optic' A_Lens NoIx AxisBar Priority
#size Priority -> Priority -> Priority
forall a. Num a => a -> a -> a
- AxisBar
b AxisBar -> Optic' A_Lens NoIx AxisBar Priority -> Priority
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "buffer" (Optic' A_Lens NoIx AxisBar Priority)
Optic' A_Lens NoIx AxisBar Priority
#buffer)
            (Priority
y' Priority -> Priority -> Priority
forall a. Num a => a -> a -> a
- AxisBar
b AxisBar -> Optic' A_Lens NoIx AxisBar Priority -> Priority
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "buffer" (Optic' A_Lens NoIx AxisBar Priority)
Optic' A_Lens NoIx AxisBar Priority
#buffer)
        ]
      Place
PlaceLeft ->
        [ Priority -> Priority -> Priority -> Priority -> DataBox
forall a. a -> a -> a -> a -> Rect a
Rect
            (Priority
x' Priority -> Priority -> Priority
forall a. Num a => a -> a -> a
- AxisBar
b AxisBar -> Optic' A_Lens NoIx AxisBar Priority -> Priority
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "size" (Optic' A_Lens NoIx AxisBar Priority)
Optic' A_Lens NoIx AxisBar Priority
#size Priority -> Priority -> Priority
forall a. Num a => a -> a -> a
- AxisBar
b AxisBar -> Optic' A_Lens NoIx AxisBar Priority -> Priority
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "buffer" (Optic' A_Lens NoIx AxisBar Priority)
Optic' A_Lens NoIx AxisBar Priority
#buffer)
            (Priority
x' Priority -> Priority -> Priority
forall a. Num a => a -> a -> a
- AxisBar
b AxisBar -> Optic' A_Lens NoIx AxisBar Priority -> Priority
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "buffer" (Optic' A_Lens NoIx AxisBar Priority)
Optic' A_Lens NoIx AxisBar Priority
#buffer)
            (Priority
y Priority -> Priority -> Priority
forall a. Num a => a -> a -> a
- AxisBar
b AxisBar -> Optic' A_Lens NoIx AxisBar Priority -> Priority
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "overhang" (Optic' A_Lens NoIx AxisBar Priority)
Optic' A_Lens NoIx AxisBar Priority
#overhang)
            (Priority
w Priority -> Priority -> Priority
forall a. Num a => a -> a -> a
+ AxisBar
b AxisBar -> Optic' A_Lens NoIx AxisBar Priority -> Priority
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "overhang" (Optic' A_Lens NoIx AxisBar Priority)
Optic' A_Lens NoIx AxisBar Priority
#overhang)
        ]
      Place
PlaceRight ->
        [ Priority -> Priority -> Priority -> Priority -> DataBox
forall a. a -> a -> a -> a -> Rect a
Rect
            (Priority
z' Priority -> Priority -> Priority
forall a. Num a => a -> a -> a
+ (AxisBar
b AxisBar -> Optic' A_Lens NoIx AxisBar Priority -> Priority
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "buffer" (Optic' A_Lens NoIx AxisBar Priority)
Optic' A_Lens NoIx AxisBar Priority
#buffer))
            (Priority
z' Priority -> Priority -> Priority
forall a. Num a => a -> a -> a
+ (AxisBar
b AxisBar -> Optic' A_Lens NoIx AxisBar Priority -> Priority
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "buffer" (Optic' A_Lens NoIx AxisBar Priority)
Optic' A_Lens NoIx AxisBar Priority
#buffer) Priority -> Priority -> Priority
forall a. Num a => a -> a -> a
+ (AxisBar
b AxisBar -> Optic' A_Lens NoIx AxisBar Priority -> Priority
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "size" (Optic' A_Lens NoIx AxisBar Priority)
Optic' A_Lens NoIx AxisBar Priority
#size))
            (Priority
y Priority -> Priority -> Priority
forall a. Num a => a -> a -> a
- AxisBar
b AxisBar -> Optic' A_Lens NoIx AxisBar Priority -> Priority
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "overhang" (Optic' A_Lens NoIx AxisBar Priority)
Optic' A_Lens NoIx AxisBar Priority
#overhang)
            (Priority
w Priority -> Priority -> Priority
forall a. Num a => a -> a -> a
+ AxisBar
b AxisBar -> Optic' A_Lens NoIx AxisBar Priority -> Priority
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "overhang" (Optic' A_Lens NoIx AxisBar Priority)
Optic' A_Lens NoIx AxisBar Priority
#overhang)
        ]
      PlaceAbsolute (Point Priority
x'' Priority
_) ->
        [ Priority -> Priority -> Priority -> Priority -> DataBox
forall a. a -> a -> a -> a -> Rect a
Rect
            (Priority
x'' Priority -> Priority -> Priority
forall a. Num a => a -> a -> a
+ (AxisBar
b AxisBar -> Optic' A_Lens NoIx AxisBar Priority -> Priority
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "buffer" (Optic' A_Lens NoIx AxisBar Priority)
Optic' A_Lens NoIx AxisBar Priority
#buffer))
            (Priority
x'' Priority -> Priority -> Priority
forall a. Num a => a -> a -> a
+ (AxisBar
b AxisBar -> Optic' A_Lens NoIx AxisBar Priority -> Priority
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "buffer" (Optic' A_Lens NoIx AxisBar Priority)
Optic' A_Lens NoIx AxisBar Priority
#buffer) Priority -> Priority -> Priority
forall a. Num a => a -> a -> a
+ (AxisBar
b AxisBar -> Optic' A_Lens NoIx AxisBar Priority -> Priority
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "size" (Optic' A_Lens NoIx AxisBar Priority)
Optic' A_Lens NoIx AxisBar Priority
#size))
            (Priority
y Priority -> Priority -> Priority
forall a. Num a => a -> a -> a
- AxisBar
b AxisBar -> Optic' A_Lens NoIx AxisBar Priority -> Priority
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "overhang" (Optic' A_Lens NoIx AxisBar Priority)
Optic' A_Lens NoIx AxisBar Priority
#overhang)
            (Priority
w Priority -> Priority -> Priority
forall a. Num a => a -> a -> a
+ AxisBar
b AxisBar -> Optic' A_Lens NoIx AxisBar Priority -> Priority
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "overhang" (Optic' A_Lens NoIx AxisBar Priority)
Optic' A_Lens NoIx AxisBar Priority
#overhang)
        ]

makeAxisBar :: Place -> AxisBar -> State HudChart ChartTree
makeAxisBar :: Place -> AxisBar -> State HudChart ChartTree
makeAxisBar Place
pl AxisBar
b = do
  Maybe DataBox
cb <- (HudChart -> Maybe DataBox)
-> StateT HudChart Identity (Maybe DataBox)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Lens' HudChart (Maybe DataBox) -> HudChart -> Maybe DataBox
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Lens' HudChart (Maybe DataBox)
canvasBox')
  Maybe DataBox
hb <- (HudChart -> Maybe DataBox)
-> StateT HudChart Identity (Maybe DataBox)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Getter HudChart (Maybe DataBox) -> HudChart -> Maybe DataBox
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Getter HudChart (Maybe DataBox)
hudStyleBox')
  let c :: Maybe Chart
c = Place -> AxisBar -> DataBox -> DataBox -> Chart
bar_ Place
pl AxisBar
b (DataBox -> DataBox -> Chart)
-> Maybe DataBox -> Maybe (DataBox -> Chart)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe DataBox
cb Maybe (DataBox -> Chart) -> Maybe DataBox -> Maybe Chart
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe DataBox
hb
  ChartTree -> State HudChart ChartTree
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChartTree -> State HudChart ChartTree)
-> ChartTree -> State HudChart ChartTree
forall a b. (a -> b) -> a -> b
$ Text -> [Chart] -> ChartTree
named Text
"axisbar" (Maybe Chart -> [Chart]
forall a. Maybe a -> [a]
maybeToList Maybe Chart
c)

title_ :: Title -> HudBox -> Chart
title_ :: Title -> DataBox -> Chart
title_ Title
t DataBox
hb =
  TextStyle -> [(Text, Point Priority)] -> Chart
TextChart
    (TextStyle
style' TextStyle -> (TextStyle -> TextStyle) -> TextStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "rotation"
  (Optic
     A_Lens NoIx TextStyle TextStyle (Maybe Priority) (Maybe Priority))
Optic
  A_Lens NoIx TextStyle TextStyle (Maybe Priority) (Maybe Priority)
#rotation Optic
  A_Lens NoIx TextStyle TextStyle (Maybe Priority) (Maybe Priority)
-> Maybe Priority -> TextStyle -> TextStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Maybe Priority -> Maybe Priority -> Bool -> Maybe Priority
forall a. a -> a -> Bool -> a
bool (Priority -> Maybe Priority
forall a. a -> Maybe a
Just Priority
rot) Maybe Priority
forall a. Maybe a
Nothing (Priority
rot Priority -> Priority -> Bool
forall a. Eq a => a -> a -> Bool
== Priority
0))
    [(Title
t Title -> Optic' A_Lens NoIx Title Text -> Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "text" (Optic' A_Lens NoIx Title Text)
Optic' A_Lens NoIx Title Text
#text, Point Priority -> Point Priority -> Point Priority
addp (Title -> DataBox -> Point Priority
placePosTitle Title
t DataBox
hb) (Title -> DataBox -> Point Priority
alignPosTitle Title
t DataBox
hb))]
  where
    style' :: TextStyle
style'
      | Title
t Title -> Optic' A_Lens NoIx Title Anchor -> Anchor
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "anchor" (Optic' A_Lens NoIx Title Anchor)
Optic' A_Lens NoIx Title Anchor
#anchor Anchor -> Anchor -> Bool
forall a. Eq a => a -> a -> Bool
== Anchor
AnchorStart =
        #anchor .~ AnchorStart $ t ^. #style
      | Title
t Title -> Optic' A_Lens NoIx Title Anchor -> Anchor
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "anchor" (Optic' A_Lens NoIx Title Anchor)
Optic' A_Lens NoIx Title Anchor
#anchor Anchor -> Anchor -> Bool
forall a. Eq a => a -> a -> Bool
== Anchor
AnchorEnd =
        #anchor .~ AnchorEnd $ t ^. #style
      | Bool
otherwise = Title
t Title
-> Optic A_Lens NoIx Title Title TextStyle TextStyle -> TextStyle
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "style" (Optic A_Lens NoIx Title Title TextStyle TextStyle)
Optic A_Lens NoIx Title Title TextStyle TextStyle
#style
    rot' :: Priority
rot' = Priority -> Maybe Priority -> Priority
forall a. a -> Maybe a -> a
fromMaybe Priority
0 (Title
t Title
-> Optic' A_Lens NoIx Title (Maybe Priority) -> Maybe Priority
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "style" (Optic A_Lens NoIx Title Title TextStyle TextStyle)
Optic A_Lens NoIx Title Title TextStyle TextStyle
#style Optic A_Lens NoIx Title Title TextStyle TextStyle
-> Optic
     A_Lens NoIx TextStyle TextStyle (Maybe Priority) (Maybe Priority)
-> Optic' A_Lens NoIx Title (Maybe Priority)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% IsLabel
  "rotation"
  (Optic
     A_Lens NoIx TextStyle TextStyle (Maybe Priority) (Maybe Priority))
Optic
  A_Lens NoIx TextStyle TextStyle (Maybe Priority) (Maybe Priority)
#rotation)
    rot :: Priority
rot
      | Title
t Title -> Optic' A_Lens NoIx Title Place -> Place
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "place" (Optic' A_Lens NoIx Title Place)
Optic' A_Lens NoIx Title Place
#place Place -> Place -> Bool
forall a. Eq a => a -> a -> Bool
== Place
PlaceRight = Priority
forall a. Floating a => a
pi Priority -> Priority -> Priority
forall a. Fractional a => a -> a -> a
/ Priority
2 Priority -> Priority -> Priority
forall a. Num a => a -> a -> a
+ Priority
rot'
      | Title
t Title -> Optic' A_Lens NoIx Title Place -> Place
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "place" (Optic' A_Lens NoIx Title Place)
Optic' A_Lens NoIx Title Place
#place Place -> Place -> Bool
forall a. Eq a => a -> a -> Bool
== Place
PlaceLeft = Priority
forall a. Floating a => a
pi Priority -> Priority -> Priority
forall a. Fractional a => a -> a -> a
/ Priority
2 Priority -> Priority -> Priority
forall a. Num a => a -> a -> a
+ Priority
rot'
      | Bool
otherwise = Priority
rot'

placePosTitle :: Title -> HudBox -> Point Double
placePosTitle :: Title -> DataBox -> Point Priority
placePosTitle Title
t (Rect Priority
x Priority
z Priority
y Priority
w) =
  case Title
t Title -> Optic' A_Lens NoIx Title Place -> Place
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "place" (Optic' A_Lens NoIx Title Place)
Optic' A_Lens NoIx Title Place
#place of
    Place
PlaceTop -> Priority -> Priority -> Point Priority
forall a. a -> a -> Point a
Point ((Priority
x Priority -> Priority -> Priority
forall a. Num a => a -> a -> a
+ Priority
z) Priority -> Priority -> Priority
forall a. Fractional a => a -> a -> a
/ Priority
2.0) (Priority
w Priority -> Priority -> Priority
forall a. Num a => a -> a -> a
- Priority
y' Priority -> Priority -> Priority
forall a. Num a => a -> a -> a
+ (Title
t Title -> Optic' A_Lens NoIx Title Priority -> Priority
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "buffer" (Optic' A_Lens NoIx Title Priority)
Optic' A_Lens NoIx Title Priority
#buffer))
    Place
PlaceBottom -> Priority -> Priority -> Point Priority
forall a. a -> a -> Point a
Point ((Priority
x Priority -> Priority -> Priority
forall a. Num a => a -> a -> a
+ Priority
z) Priority -> Priority -> Priority
forall a. Fractional a => a -> a -> a
/ Priority
2.0) (Priority
y Priority -> Priority -> Priority
forall a. Num a => a -> a -> a
- Priority
w' Priority -> Priority -> Priority
forall a. Num a => a -> a -> a
- (Title
t Title -> Optic' A_Lens NoIx Title Priority -> Priority
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "buffer" (Optic' A_Lens NoIx Title Priority)
Optic' A_Lens NoIx Title Priority
#buffer))
    Place
PlaceLeft -> Priority -> Priority -> Point Priority
forall a. a -> a -> Point a
Point (Priority
x Priority -> Priority -> Priority
forall a. Num a => a -> a -> a
+ Priority
y' Priority -> Priority -> Priority
forall a. Num a => a -> a -> a
- (Title
t Title -> Optic' A_Lens NoIx Title Priority -> Priority
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "buffer" (Optic' A_Lens NoIx Title Priority)
Optic' A_Lens NoIx Title Priority
#buffer)) ((Priority
y Priority -> Priority -> Priority
forall a. Num a => a -> a -> a
+ Priority
w) Priority -> Priority -> Priority
forall a. Fractional a => a -> a -> a
/ Priority
2.0)
    Place
PlaceRight -> Priority -> Priority -> Point Priority
forall a. a -> a -> Point a
Point (Priority
z Priority -> Priority -> Priority
forall a. Num a => a -> a -> a
+ Priority
w' Priority -> Priority -> Priority
forall a. Num a => a -> a -> a
+ (Title
t Title -> Optic' A_Lens NoIx Title Priority -> Priority
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "buffer" (Optic' A_Lens NoIx Title Priority)
Optic' A_Lens NoIx Title Priority
#buffer)) ((Priority
y Priority -> Priority -> Priority
forall a. Num a => a -> a -> a
+ Priority
w) Priority -> Priority -> Priority
forall a. Fractional a => a -> a -> a
/ Priority
2.0)
    PlaceAbsolute Point Priority
p -> Point Priority
p
  where
    (Rect Priority
_ Priority
_ Priority
y' Priority
w') = TextStyle -> Text -> Point Priority -> DataBox
styleBoxText (Optic A_Lens NoIx Title Title TextStyle TextStyle
-> Title -> TextStyle
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view IsLabel "style" (Optic A_Lens NoIx Title Title TextStyle TextStyle)
Optic A_Lens NoIx Title Title TextStyle TextStyle
#style Title
t) (Optic' A_Lens NoIx Title Text -> Title -> Text
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view IsLabel "text" (Optic' A_Lens NoIx Title Text)
Optic' A_Lens NoIx Title Text
#text Title
t) Point Priority
forall a. Additive a => a
zero

alignPosTitle :: Title -> HudBox -> Point Double
alignPosTitle :: Title -> DataBox -> Point Priority
alignPosTitle Title
t (Rect Priority
x Priority
z Priority
y Priority
w)
  | Title
t Title -> Optic' A_Lens NoIx Title Anchor -> Anchor
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "anchor" (Optic' A_Lens NoIx Title Anchor)
Optic' A_Lens NoIx Title Anchor
#anchor Anchor -> Anchor -> Bool
forall a. Eq a => a -> a -> Bool
== Anchor
AnchorStart
      Bool -> Bool -> Bool
&& (Title
t Title -> Optic' A_Lens NoIx Title Place -> Place
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "place" (Optic' A_Lens NoIx Title Place)
Optic' A_Lens NoIx Title Place
#place Place -> Place -> Bool
forall a. Eq a => a -> a -> Bool
== Place
PlaceTop Bool -> Bool -> Bool
|| Title
t Title -> Optic' A_Lens NoIx Title Place -> Place
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "place" (Optic' A_Lens NoIx Title Place)
Optic' A_Lens NoIx Title Place
#place Place -> Place -> Bool
forall a. Eq a => a -> a -> Bool
== Place
PlaceBottom) =
    Priority -> Priority -> Point Priority
forall a. a -> a -> Point a
Point ((Priority
x Priority -> Priority -> Priority
forall a. Num a => a -> a -> a
- Priority
z) Priority -> Priority -> Priority
forall a. Fractional a => a -> a -> a
/ Priority
2.0) Priority
0.0
  | Title
t Title -> Optic' A_Lens NoIx Title Anchor -> Anchor
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "anchor" (Optic' A_Lens NoIx Title Anchor)
Optic' A_Lens NoIx Title Anchor
#anchor Anchor -> Anchor -> Bool
forall a. Eq a => a -> a -> Bool
== Anchor
AnchorStart
      Bool -> Bool -> Bool
&& Title
t Title -> Optic' A_Lens NoIx Title Place -> Place
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "place" (Optic' A_Lens NoIx Title Place)
Optic' A_Lens NoIx Title Place
#place Place -> Place -> Bool
forall a. Eq a => a -> a -> Bool
== Place
PlaceLeft =
    Priority -> Priority -> Point Priority
forall a. a -> a -> Point a
Point Priority
0.0 ((Priority
y Priority -> Priority -> Priority
forall a. Num a => a -> a -> a
- Priority
w) Priority -> Priority -> Priority
forall a. Fractional a => a -> a -> a
/ Priority
2.0)
  | Title
t Title -> Optic' A_Lens NoIx Title Anchor -> Anchor
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "anchor" (Optic' A_Lens NoIx Title Anchor)
Optic' A_Lens NoIx Title Anchor
#anchor Anchor -> Anchor -> Bool
forall a. Eq a => a -> a -> Bool
== Anchor
AnchorStart
      Bool -> Bool -> Bool
&& Title
t Title -> Optic' A_Lens NoIx Title Place -> Place
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "place" (Optic' A_Lens NoIx Title Place)
Optic' A_Lens NoIx Title Place
#place Place -> Place -> Bool
forall a. Eq a => a -> a -> Bool
== Place
PlaceRight =
    Priority -> Priority -> Point Priority
forall a. a -> a -> Point a
Point Priority
0.0 ((Priority
y Priority -> Priority -> Priority
forall a. Num a => a -> a -> a
- Priority
w) Priority -> Priority -> Priority
forall a. Fractional a => a -> a -> a
/ Priority
2.0)
  | Title
t Title -> Optic' A_Lens NoIx Title Anchor -> Anchor
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "anchor" (Optic' A_Lens NoIx Title Anchor)
Optic' A_Lens NoIx Title Anchor
#anchor Anchor -> Anchor -> Bool
forall a. Eq a => a -> a -> Bool
== Anchor
AnchorEnd
      Bool -> Bool -> Bool
&& (Title
t Title -> Optic' A_Lens NoIx Title Place -> Place
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "place" (Optic' A_Lens NoIx Title Place)
Optic' A_Lens NoIx Title Place
#place Place -> Place -> Bool
forall a. Eq a => a -> a -> Bool
== Place
PlaceTop Bool -> Bool -> Bool
|| Title
t Title -> Optic' A_Lens NoIx Title Place -> Place
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "place" (Optic' A_Lens NoIx Title Place)
Optic' A_Lens NoIx Title Place
#place Place -> Place -> Bool
forall a. Eq a => a -> a -> Bool
== Place
PlaceBottom) =
    Priority -> Priority -> Point Priority
forall a. a -> a -> Point a
Point ((-Priority
x Priority -> Priority -> Priority
forall a. Num a => a -> a -> a
+ Priority
z) Priority -> Priority -> Priority
forall a. Fractional a => a -> a -> a
/ Priority
2.0) Priority
0.0
  | Title
t Title -> Optic' A_Lens NoIx Title Anchor -> Anchor
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "anchor" (Optic' A_Lens NoIx Title Anchor)
Optic' A_Lens NoIx Title Anchor
#anchor Anchor -> Anchor -> Bool
forall a. Eq a => a -> a -> Bool
== Anchor
AnchorEnd
      Bool -> Bool -> Bool
&& Title
t Title -> Optic' A_Lens NoIx Title Place -> Place
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "place" (Optic' A_Lens NoIx Title Place)
Optic' A_Lens NoIx Title Place
#place Place -> Place -> Bool
forall a. Eq a => a -> a -> Bool
== Place
PlaceLeft =
    Priority -> Priority -> Point Priority
forall a. a -> a -> Point a
Point Priority
0.0 ((-Priority
y Priority -> Priority -> Priority
forall a. Num a => a -> a -> a
+ Priority
w) Priority -> Priority -> Priority
forall a. Fractional a => a -> a -> a
/ Priority
2.0)
  | Title
t Title -> Optic' A_Lens NoIx Title Anchor -> Anchor
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "anchor" (Optic' A_Lens NoIx Title Anchor)
Optic' A_Lens NoIx Title Anchor
#anchor Anchor -> Anchor -> Bool
forall a. Eq a => a -> a -> Bool
== Anchor
AnchorEnd
      Bool -> Bool -> Bool
&& Title
t Title -> Optic' A_Lens NoIx Title Place -> Place
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "place" (Optic' A_Lens NoIx Title Place)
Optic' A_Lens NoIx Title Place
#place Place -> Place -> Bool
forall a. Eq a => a -> a -> Bool
== Place
PlaceRight =
    Priority -> Priority -> Point Priority
forall a. a -> a -> Point a
Point Priority
0.0 ((-Priority
y Priority -> Priority -> Priority
forall a. Num a => a -> a -> a
+ Priority
w) Priority -> Priority -> Priority
forall a. Fractional a => a -> a -> a
/ Priority
2.0)
  | Bool
otherwise = Priority -> Priority -> Point Priority
forall a. a -> a -> Point a
Point Priority
0.0 Priority
0.0

-- | title append transformation.
title :: Title -> State HudChart ChartTree
title :: Title -> State HudChart ChartTree
title Title
t = do
  Maybe DataBox
hb <- (HudChart -> Maybe DataBox)
-> StateT HudChart Identity (Maybe DataBox)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Getter HudChart (Maybe DataBox) -> HudChart -> Maybe DataBox
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Getter HudChart (Maybe DataBox)
hudStyleBox')
  ChartTree -> State HudChart ChartTree
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChartTree -> State HudChart ChartTree)
-> ChartTree -> State HudChart ChartTree
forall a b. (a -> b) -> a -> b
$ Text -> [Chart] -> ChartTree
named Text
"title" (Maybe Chart -> [Chart]
forall a. Maybe a -> [a]
maybeToList (Maybe Chart -> [Chart]) -> Maybe Chart -> [Chart]
forall a b. (a -> b) -> a -> b
$ Title -> DataBox -> Chart
title_ Title
t (DataBox -> Chart) -> Maybe DataBox -> Maybe Chart
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe DataBox
hb)

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

placeRot :: Place -> Maybe Double
placeRot :: Place -> Maybe Priority
placeRot Place
pl = case Place
pl of
  Place
PlaceRight -> Priority -> Maybe Priority
forall a. a -> Maybe a
Just (Priority
forall a. Floating a => a
pi Priority -> Priority -> Priority
forall a. Fractional a => a -> a -> a
/ Priority
2)
  Place
PlaceLeft -> Priority -> Maybe Priority
forall a. a -> Maybe a
Just (Priority
forall a. Floating a => a
pi Priority -> Priority -> Priority
forall a. Fractional a => a -> a -> a
/ Priority
2)
  Place
_ -> Maybe Priority
forall a. Maybe a
Nothing

textPos :: Place -> TextStyle -> Double -> Point Double
textPos :: Place -> TextStyle -> Priority -> Point Priority
textPos Place
pl TextStyle
tt Priority
b = case Place
pl of
  Place
PlaceTop -> Priority -> Priority -> Point Priority
forall a. a -> a -> Point a
Point Priority
0 Priority
b
  Place
PlaceBottom -> Priority -> Priority -> Point Priority
forall a. a -> a -> Point a
Point Priority
0 (-Priority
b Priority -> Priority -> Priority
forall a. Num a => a -> a -> a
- Priority
0.5 Priority -> Priority -> Priority
forall a. Num a => a -> a -> a
* (TextStyle
tt TextStyle
-> Optic A_Lens NoIx TextStyle TextStyle Priority Priority
-> Priority
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel
  "vsize" (Optic A_Lens NoIx TextStyle TextStyle Priority Priority)
Optic A_Lens NoIx TextStyle TextStyle Priority Priority
#vsize) Priority -> Priority -> Priority
forall a. Num a => a -> a -> a
* (TextStyle
tt TextStyle
-> Optic A_Lens NoIx TextStyle TextStyle Priority Priority
-> Priority
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel
  "size" (Optic A_Lens NoIx TextStyle TextStyle Priority Priority)
Optic A_Lens NoIx TextStyle TextStyle Priority Priority
#size))
  Place
PlaceLeft ->
    Priority -> Priority -> Point Priority
forall a. a -> a -> Point a
Point
      (-Priority
b)
      ((TextStyle
tt TextStyle
-> Optic A_Lens NoIx TextStyle TextStyle Priority Priority
-> Priority
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel
  "vshift" (Optic A_Lens NoIx TextStyle TextStyle Priority Priority)
Optic A_Lens NoIx TextStyle TextStyle Priority Priority
#vshift) Priority -> Priority -> Priority
forall a. Num a => a -> a -> a
* (TextStyle
tt TextStyle
-> Optic A_Lens NoIx TextStyle TextStyle Priority Priority
-> Priority
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel
  "vsize" (Optic A_Lens NoIx TextStyle TextStyle Priority Priority)
Optic A_Lens NoIx TextStyle TextStyle Priority Priority
#vsize) Priority -> Priority -> Priority
forall a. Num a => a -> a -> a
* (TextStyle
tt TextStyle
-> Optic A_Lens NoIx TextStyle TextStyle Priority Priority
-> Priority
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel
  "size" (Optic A_Lens NoIx TextStyle TextStyle Priority Priority)
Optic A_Lens NoIx TextStyle TextStyle Priority Priority
#size))
  Place
PlaceRight ->
    Priority -> Priority -> Point Priority
forall a. a -> a -> Point a
Point
      Priority
b
      ((TextStyle
tt TextStyle
-> Optic A_Lens NoIx TextStyle TextStyle Priority Priority
-> Priority
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel
  "vshift" (Optic A_Lens NoIx TextStyle TextStyle Priority Priority)
Optic A_Lens NoIx TextStyle TextStyle Priority Priority
#vshift) Priority -> Priority -> Priority
forall a. Num a => a -> a -> a
* (TextStyle
tt TextStyle
-> Optic A_Lens NoIx TextStyle TextStyle Priority Priority
-> Priority
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel
  "vsize" (Optic A_Lens NoIx TextStyle TextStyle Priority Priority)
Optic A_Lens NoIx TextStyle TextStyle Priority Priority
#vsize) Priority -> Priority -> Priority
forall a. Num a => a -> a -> a
* (TextStyle
tt TextStyle
-> Optic A_Lens NoIx TextStyle TextStyle Priority Priority
-> Priority
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel
  "size" (Optic A_Lens NoIx TextStyle TextStyle Priority Priority)
Optic A_Lens NoIx TextStyle TextStyle Priority Priority
#size))
  PlaceAbsolute Point Priority
p -> Point Priority
p

placeTextAnchor :: Place -> (TextStyle -> TextStyle)
placeTextAnchor :: Place -> TextStyle -> TextStyle
placeTextAnchor Place
pl
  | Place
pl Place -> Place -> Bool
forall a. Eq a => a -> a -> Bool
== Place
PlaceLeft = IsLabel
  "anchor" (Optic A_Lens NoIx TextStyle TextStyle Anchor Anchor)
Optic A_Lens NoIx TextStyle TextStyle Anchor Anchor
#anchor Optic A_Lens NoIx TextStyle TextStyle Anchor Anchor
-> Anchor -> TextStyle -> TextStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Anchor
AnchorEnd
  | Place
pl Place -> Place -> Bool
forall a. Eq a => a -> a -> Bool
== Place
PlaceRight = IsLabel
  "anchor" (Optic A_Lens NoIx TextStyle TextStyle Anchor Anchor)
Optic A_Lens NoIx TextStyle TextStyle Anchor Anchor
#anchor Optic A_Lens NoIx TextStyle TextStyle Anchor Anchor
-> Anchor -> TextStyle -> TextStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Anchor
AnchorStart
  | Bool
otherwise = TextStyle -> TextStyle
forall a. a -> a
id

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

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

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

tickGlyph_ :: Place -> (GlyphStyle, Double) -> TickStyle -> CanvasBox -> CanvasBox -> DataBox -> Maybe Chart
tickGlyph_ :: Place
-> (GlyphStyle, Priority)
-> TickStyle
-> DataBox
-> DataBox
-> DataBox
-> Maybe Chart
tickGlyph_ Place
pl (GlyphStyle
g, Priority
b) TickStyle
ts DataBox
sb DataBox
cb DataBox
db =
  case [Point Priority]
l of
    [] -> Maybe Chart
forall a. Maybe a
Nothing
    [Point Priority]
l' -> Chart -> Maybe Chart
forall a. a -> Maybe a
Just (Chart -> Maybe Chart) -> Chart -> Maybe Chart
forall a b. (a -> b) -> a -> b
$ GlyphStyle -> [Point Priority] -> Chart
GlyphChart (GlyphStyle
g GlyphStyle -> (GlyphStyle -> GlyphStyle) -> GlyphStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "rotation"
  (Optic
     A_Lens
     NoIx
     GlyphStyle
     GlyphStyle
     (Maybe Priority)
     (Maybe Priority))
Optic
  A_Lens NoIx GlyphStyle GlyphStyle (Maybe Priority) (Maybe Priority)
#rotation Optic
  A_Lens NoIx GlyphStyle GlyphStyle (Maybe Priority) (Maybe Priority)
-> Maybe Priority -> GlyphStyle -> GlyphStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Place -> Maybe Priority
placeRot Place
pl) [Point Priority]
l'
  where
    l :: [Point Priority]
l =
      Point Priority -> Point Priority -> Point Priority
addp (Place -> Priority -> DataBox -> Point Priority
placePos Place
pl Priority
b DataBox
sb) (Point Priority -> Point Priority)
-> (Priority -> Point Priority) -> Priority -> Point Priority
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Place -> Priority -> Point Priority
placeOrigin Place
pl
        (Priority -> Point Priority) -> [Priority] -> [Point Priority]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Priority, Text) -> Priority) -> [(Priority, Text)] -> [Priority]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Priority, Text) -> Priority
forall a b. (a, b) -> a
fst (TickStyle -> Place -> DataBox -> DataBox -> [(Priority, Text)]
ticksPlacedCanvas TickStyle
ts Place
pl DataBox
cb DataBox
db)

-- | aka marks
tickGlyph ::
  Place ->
  (GlyphStyle, Double) ->
  TickStyle ->
  State HudChart ChartTree
tickGlyph :: Place
-> (GlyphStyle, Priority) -> TickStyle -> State HudChart ChartTree
tickGlyph Place
pl (GlyphStyle
g, Priority
b) TickStyle
ts = do
  Maybe DataBox
sb <- (HudChart -> Maybe DataBox)
-> StateT HudChart Identity (Maybe DataBox)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Getter HudChart (Maybe DataBox) -> HudChart -> Maybe DataBox
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Getter HudChart (Maybe DataBox)
canvasStyleBox')
  Maybe DataBox
cb <- (HudChart -> Maybe DataBox)
-> StateT HudChart Identity (Maybe DataBox)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Lens' HudChart (Maybe DataBox) -> HudChart -> Maybe DataBox
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Lens' HudChart (Maybe DataBox)
canvasBox')
  DataBox
db <- (HudChart -> DataBox) -> StateT HudChart Identity DataBox
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Optic' A_Lens NoIx HudChart DataBox -> HudChart -> DataBox
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view IsLabel "dataBox" (Optic' A_Lens NoIx HudChart DataBox)
Optic' A_Lens NoIx HudChart DataBox
#dataBox)
  let c :: Maybe (Maybe Chart)
c = Place
-> (GlyphStyle, Priority)
-> TickStyle
-> DataBox
-> DataBox
-> DataBox
-> Maybe Chart
tickGlyph_ Place
pl (GlyphStyle
g, Priority
b) TickStyle
ts (DataBox -> DataBox -> DataBox -> Maybe Chart)
-> Maybe DataBox -> Maybe (DataBox -> DataBox -> Maybe Chart)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe DataBox
sb Maybe (DataBox -> DataBox -> Maybe Chart)
-> Maybe DataBox -> Maybe (DataBox -> Maybe Chart)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe DataBox
cb Maybe (DataBox -> Maybe Chart)
-> Maybe DataBox -> Maybe (Maybe Chart)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> DataBox -> Maybe DataBox
forall (f :: * -> *) a. Applicative f => a -> f a
pure DataBox
db
  ChartTree -> State HudChart ChartTree
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChartTree -> State HudChart ChartTree)
-> ChartTree -> State HudChart ChartTree
forall a b. (a -> b) -> a -> b
$ Text -> [Chart] -> ChartTree
named Text
"tickglyph" ([Maybe Chart] -> [Chart]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Chart] -> [Chart]) -> [Maybe Chart] -> [Chart]
forall a b. (a -> b) -> a -> b
$ Maybe (Maybe Chart) -> [Maybe Chart]
forall a. Maybe a -> [a]
maybeToList Maybe (Maybe Chart)
c)

tickText_ ::
  Place ->
  (TextStyle, Double) ->
  TickStyle ->
  CanvasBox ->
  CanvasBox ->
  DataBox ->
  Maybe Chart
tickText_ :: Place
-> (TextStyle, Priority)
-> TickStyle
-> DataBox
-> DataBox
-> DataBox
-> Maybe Chart
tickText_ Place
pl (TextStyle
txts, Priority
b) TickStyle
ts DataBox
sb DataBox
cb DataBox
db =
  case [(Text, Point Priority)]
l of
    [] -> Maybe Chart
forall a. Maybe a
Nothing
    [(Text, Point Priority)]
_ -> Chart -> Maybe Chart
forall a. a -> Maybe a
Just (Chart -> Maybe Chart) -> Chart -> Maybe Chart
forall a b. (a -> b) -> a -> b
$ TextStyle -> [(Text, Point Priority)] -> Chart
TextChart (Place -> TextStyle -> TextStyle
placeTextAnchor Place
pl TextStyle
txts) [(Text, Point Priority)]
l
  where
    l :: [(Text, Point Priority)]
l =
      (Point Priority, Text) -> (Text, Point Priority)
forall a b. (a, b) -> (b, a)
swap ((Point Priority, Text) -> (Text, Point Priority))
-> ((Priority, Text) -> (Point Priority, Text))
-> (Priority, Text)
-> (Text, Point Priority)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Priority -> Point Priority)
-> (Priority, Text) -> (Point Priority, Text)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Point Priority -> Point Priority -> Point Priority
addp (Point Priority -> Point Priority -> Point Priority
addp (Place -> Priority -> DataBox -> Point Priority
placePos Place
pl Priority
b DataBox
sb) (Place -> TextStyle -> Priority -> Point Priority
textPos Place
pl TextStyle
txts Priority
b)) (Point Priority -> Point Priority)
-> (Priority -> Point Priority) -> Priority -> Point Priority
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Place -> Priority -> Point Priority
placeOrigin Place
pl)
        ((Priority, Text) -> (Text, Point Priority))
-> [(Priority, Text)] -> [(Text, Point Priority)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TickStyle -> Place -> DataBox -> DataBox -> [(Priority, Text)]
ticksPlacedCanvas TickStyle
ts Place
pl DataBox
cb DataBox
db

-- | aka tick labels
tickText ::
  Place ->
  (TextStyle, Double) ->
  TickStyle ->
  State HudChart ChartTree
tickText :: Place
-> (TextStyle, Priority) -> TickStyle -> State HudChart ChartTree
tickText Place
pl (TextStyle
txts, Priority
b) TickStyle
ts = do
  Maybe DataBox
sb <- (HudChart -> Maybe DataBox)
-> StateT HudChart Identity (Maybe DataBox)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Getter HudChart (Maybe DataBox) -> HudChart -> Maybe DataBox
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Getter HudChart (Maybe DataBox)
canvasStyleBox')
  Maybe DataBox
cb <- (HudChart -> Maybe DataBox)
-> StateT HudChart Identity (Maybe DataBox)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Lens' HudChart (Maybe DataBox) -> HudChart -> Maybe DataBox
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Lens' HudChart (Maybe DataBox)
canvasBox')
  DataBox
db <- (HudChart -> DataBox) -> StateT HudChart Identity DataBox
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Optic' A_Lens NoIx HudChart DataBox -> HudChart -> DataBox
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view IsLabel "dataBox" (Optic' A_Lens NoIx HudChart DataBox)
Optic' A_Lens NoIx HudChart DataBox
#dataBox)
  let c :: Maybe (Maybe Chart)
c = Place
-> (TextStyle, Priority)
-> TickStyle
-> DataBox
-> DataBox
-> DataBox
-> Maybe Chart
tickText_ Place
pl (TextStyle
txts, Priority
b) TickStyle
ts (DataBox -> DataBox -> DataBox -> Maybe Chart)
-> Maybe DataBox -> Maybe (DataBox -> DataBox -> Maybe Chart)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe DataBox
sb Maybe (DataBox -> DataBox -> Maybe Chart)
-> Maybe DataBox -> Maybe (DataBox -> Maybe Chart)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe DataBox
cb Maybe (DataBox -> Maybe Chart)
-> Maybe DataBox -> Maybe (Maybe Chart)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> DataBox -> Maybe DataBox
forall (f :: * -> *) a. Applicative f => a -> f a
pure DataBox
db
  ChartTree -> State HudChart ChartTree
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChartTree -> State HudChart ChartTree)
-> ChartTree -> State HudChart ChartTree
forall a b. (a -> b) -> a -> b
$ Text -> [Chart] -> ChartTree
named Text
"ticktext" ([Maybe Chart] -> [Chart]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Chart] -> [Chart]) -> [Maybe Chart] -> [Chart]
forall a b. (a -> b) -> a -> b
$ Maybe (Maybe Chart) -> [Maybe Chart]
forall a. Maybe a -> [a]
maybeToList Maybe (Maybe Chart)
c)

-- | aka grid lines
tickLine ::
  Place ->
  (LineStyle, Double) ->
  TickStyle ->
  State HudChart ChartTree
tickLine :: Place
-> (LineStyle, Priority) -> TickStyle -> State HudChart ChartTree
tickLine Place
pl (LineStyle
ls, Priority
b) TickStyle
ts = do
  Maybe DataBox
cb <- (HudChart -> Maybe DataBox)
-> StateT HudChart Identity (Maybe DataBox)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Lens' HudChart (Maybe DataBox) -> HudChart -> Maybe DataBox
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Lens' HudChart (Maybe DataBox)
canvasBox')
  DataBox
db <- (HudChart -> DataBox) -> StateT HudChart Identity DataBox
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Optic' A_Lens NoIx HudChart DataBox -> HudChart -> DataBox
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view IsLabel "dataBox" (Optic' A_Lens NoIx HudChart DataBox)
Optic' A_Lens NoIx HudChart DataBox
#dataBox)
  case Maybe DataBox
cb of
    Maybe DataBox
Nothing -> ChartTree -> State HudChart ChartTree
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChartTree -> State HudChart ChartTree)
-> ChartTree -> State HudChart ChartTree
forall a b. (a -> b) -> a -> b
$ Text -> [Chart] -> ChartTree
named Text
"ticklines" []
    Just DataBox
cb' -> do
      let l :: [[Point Priority]]
l = (\Priority
x -> Place -> DataBox -> Priority -> Priority -> [Point Priority]
placeGridLines Place
pl DataBox
cb' Priority
x Priority
b) (Priority -> [Point Priority]) -> [Priority] -> [[Point Priority]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Priority, Text) -> Priority) -> [(Priority, Text)] -> [Priority]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Priority, Text) -> Priority
forall a b. (a, b) -> a
fst (TickStyle -> Place -> DataBox -> DataBox -> [(Priority, Text)]
ticksPlacedCanvas TickStyle
ts Place
pl DataBox
cb' DataBox
db)
      ChartTree -> State HudChart ChartTree
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChartTree -> State HudChart ChartTree)
-> ChartTree -> State HudChart ChartTree
forall a b. (a -> b) -> a -> b
$ Text -> [Chart] -> ChartTree
named Text
"ticklines" ([Chart] -> [Chart] -> Bool -> [Chart]
forall a. a -> a -> Bool -> a
bool [LineStyle -> [[Point Priority]] -> Chart
LineChart LineStyle
ls [[Point Priority]]
l] [] ([[Point Priority]] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Point Priority]]
l))

-- | Create tick glyphs (marks), lines (grid) and text (labels)
applyTicks ::
  Place ->
  Ticks ->
  State HudChart ChartTree
applyTicks :: Place -> Ticks -> State HudChart ChartTree
applyTicks Place
pl Ticks
t = do
  ChartTree
g <- State HudChart ChartTree
-> ((GlyphStyle, Priority) -> State HudChart ChartTree)
-> Maybe (GlyphStyle, Priority)
-> State HudChart ChartTree
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ChartTree -> State HudChart ChartTree
forall (f :: * -> *) a. Applicative f => a -> f a
pure ChartTree
forall a. Monoid a => a
mempty) (\(GlyphStyle, Priority)
x -> Place
-> (GlyphStyle, Priority) -> TickStyle -> State HudChart ChartTree
tickGlyph Place
pl (GlyphStyle, Priority)
x (Ticks
t Ticks
-> Optic A_Lens NoIx Ticks Ticks TickStyle TickStyle -> TickStyle
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "style" (Optic A_Lens NoIx Ticks Ticks TickStyle TickStyle)
Optic A_Lens NoIx Ticks Ticks TickStyle TickStyle
#style)) (Ticks
t Ticks
-> Optic
     A_Lens
     NoIx
     Ticks
     Ticks
     (Maybe (GlyphStyle, Priority))
     (Maybe (GlyphStyle, Priority))
-> Maybe (GlyphStyle, Priority)
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel
  "gtick"
  (Optic
     A_Lens
     NoIx
     Ticks
     Ticks
     (Maybe (GlyphStyle, Priority))
     (Maybe (GlyphStyle, Priority)))
Optic
  A_Lens
  NoIx
  Ticks
  Ticks
  (Maybe (GlyphStyle, Priority))
  (Maybe (GlyphStyle, Priority))
#gtick)
  ChartTree
l <- State HudChart ChartTree
-> ((TextStyle, Priority) -> State HudChart ChartTree)
-> Maybe (TextStyle, Priority)
-> State HudChart ChartTree
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ChartTree -> State HudChart ChartTree
forall (f :: * -> *) a. Applicative f => a -> f a
pure ChartTree
forall a. Monoid a => a
mempty) (\(TextStyle, Priority)
x -> Place
-> (TextStyle, Priority) -> TickStyle -> State HudChart ChartTree
tickText Place
pl (TextStyle, Priority)
x (Ticks
t Ticks
-> Optic A_Lens NoIx Ticks Ticks TickStyle TickStyle -> TickStyle
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "style" (Optic A_Lens NoIx Ticks Ticks TickStyle TickStyle)
Optic A_Lens NoIx Ticks Ticks TickStyle TickStyle
#style)) (Ticks
t Ticks
-> Optic
     A_Lens
     NoIx
     Ticks
     Ticks
     (Maybe (TextStyle, Priority))
     (Maybe (TextStyle, Priority))
-> Maybe (TextStyle, Priority)
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel
  "ttick"
  (Optic
     A_Lens
     NoIx
     Ticks
     Ticks
     (Maybe (TextStyle, Priority))
     (Maybe (TextStyle, Priority)))
Optic
  A_Lens
  NoIx
  Ticks
  Ticks
  (Maybe (TextStyle, Priority))
  (Maybe (TextStyle, Priority))
#ttick)
  ChartTree
t' <- State HudChart ChartTree
-> ((LineStyle, Priority) -> State HudChart ChartTree)
-> Maybe (LineStyle, Priority)
-> State HudChart ChartTree
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ChartTree -> State HudChart ChartTree
forall (f :: * -> *) a. Applicative f => a -> f a
pure ChartTree
forall a. Monoid a => a
mempty) (\(LineStyle, Priority)
x -> Place
-> (LineStyle, Priority) -> TickStyle -> State HudChart ChartTree
tickLine Place
pl (LineStyle, Priority)
x (Ticks
t Ticks
-> Optic A_Lens NoIx Ticks Ticks TickStyle TickStyle -> TickStyle
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "style" (Optic A_Lens NoIx Ticks Ticks TickStyle TickStyle)
Optic A_Lens NoIx Ticks Ticks TickStyle TickStyle
#style)) (Ticks
t Ticks
-> Optic
     A_Lens
     NoIx
     Ticks
     Ticks
     (Maybe (LineStyle, Priority))
     (Maybe (LineStyle, Priority))
-> Maybe (LineStyle, Priority)
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel
  "ltick"
  (Optic
     A_Lens
     NoIx
     Ticks
     Ticks
     (Maybe (LineStyle, Priority))
     (Maybe (LineStyle, Priority)))
Optic
  A_Lens
  NoIx
  Ticks
  Ticks
  (Maybe (LineStyle, Priority))
  (Maybe (LineStyle, Priority))
#ltick)
  ChartTree -> State HudChart ChartTree
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChartTree -> State HudChart ChartTree)
-> ChartTree -> State HudChart ChartTree
forall a b. (a -> b) -> a -> b
$ Maybe Text -> [ChartTree] -> ChartTree
group (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"ticks") [ChartTree
g, ChartTree
l, ChartTree
t']

-- | adjust Tick for sane font sizes etc
adjustTicks ::
  Adjustments ->
  HudBox ->
  DataBox ->
  Place ->
  Ticks ->
  Ticks
adjustTicks :: Adjustments -> DataBox -> DataBox -> Place -> Ticks -> Ticks
adjustTicks (Adjustments Priority
mrx Priority
ma Priority
mry Bool
ad) DataBox
vb DataBox
cs Place
pl Ticks
t
  | Place
pl Place -> Place -> Bool
forall a. Eq a => a -> a -> Bool
== Place
PlaceBottom Bool -> Bool -> Bool
|| Place
pl Place -> Place -> Bool
forall a. Eq a => a -> a -> Bool
== Place
PlaceTop =
    if Bool
ad
      then
        ( case Priority
adjustSizeX Priority -> Priority -> Bool
forall a. Ord a => a -> a -> Bool
> Priority
1 of
            Bool
True ->
              ( case Place
pl of
                  Place
PlaceBottom -> IsLabel
  "ttick"
  (Optic
     A_Lens
     NoIx
     Ticks
     Ticks
     (Maybe (TextStyle, Priority))
     (Maybe (TextStyle, Priority)))
Optic
  A_Lens
  NoIx
  Ticks
  Ticks
  (Maybe (TextStyle, Priority))
  (Maybe (TextStyle, Priority))
#ttick Optic
  A_Lens
  NoIx
  Ticks
  Ticks
  (Maybe (TextStyle, Priority))
  (Maybe (TextStyle, Priority))
-> Optic
     A_Prism
     NoIx
     (Maybe (TextStyle, Priority))
     (Maybe (TextStyle, Priority))
     (TextStyle, Priority)
     (TextStyle, Priority)
-> Optic
     An_AffineTraversal
     NoIx
     Ticks
     Ticks
     (TextStyle, Priority)
     (TextStyle, Priority)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Prism
  NoIx
  (Maybe (TextStyle, Priority))
  (Maybe (TextStyle, Priority))
  (TextStyle, Priority)
  (TextStyle, Priority)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just Optic
  An_AffineTraversal
  NoIx
  Ticks
  Ticks
  (TextStyle, Priority)
  (TextStyle, Priority)
-> Optic
     A_Lens
     NoIx
     (TextStyle, Priority)
     (TextStyle, Priority)
     TextStyle
     TextStyle
-> Optic An_AffineTraversal NoIx Ticks Ticks TextStyle TextStyle
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  NoIx
  (TextStyle, Priority)
  (TextStyle, Priority)
  TextStyle
  TextStyle
forall s t a b. Field1 s t a b => Lens s t a b
_1 Optic An_AffineTraversal NoIx Ticks Ticks TextStyle TextStyle
-> Optic A_Lens NoIx TextStyle TextStyle Anchor Anchor
-> Optic An_AffineTraversal NoIx Ticks Ticks Anchor Anchor
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% IsLabel
  "anchor" (Optic A_Lens NoIx TextStyle TextStyle Anchor Anchor)
Optic A_Lens NoIx TextStyle TextStyle Anchor Anchor
#anchor Optic An_AffineTraversal NoIx Ticks Ticks Anchor Anchor
-> Anchor -> Ticks -> Ticks
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Anchor
AnchorEnd
                  Place
PlaceTop -> IsLabel
  "ttick"
  (Optic
     A_Lens
     NoIx
     Ticks
     Ticks
     (Maybe (TextStyle, Priority))
     (Maybe (TextStyle, Priority)))
Optic
  A_Lens
  NoIx
  Ticks
  Ticks
  (Maybe (TextStyle, Priority))
  (Maybe (TextStyle, Priority))
#ttick Optic
  A_Lens
  NoIx
  Ticks
  Ticks
  (Maybe (TextStyle, Priority))
  (Maybe (TextStyle, Priority))
-> Optic
     A_Prism
     NoIx
     (Maybe (TextStyle, Priority))
     (Maybe (TextStyle, Priority))
     (TextStyle, Priority)
     (TextStyle, Priority)
-> Optic
     An_AffineTraversal
     NoIx
     Ticks
     Ticks
     (TextStyle, Priority)
     (TextStyle, Priority)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Prism
  NoIx
  (Maybe (TextStyle, Priority))
  (Maybe (TextStyle, Priority))
  (TextStyle, Priority)
  (TextStyle, Priority)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just Optic
  An_AffineTraversal
  NoIx
  Ticks
  Ticks
  (TextStyle, Priority)
  (TextStyle, Priority)
-> Optic
     A_Lens
     NoIx
     (TextStyle, Priority)
     (TextStyle, Priority)
     TextStyle
     TextStyle
-> Optic An_AffineTraversal NoIx Ticks Ticks TextStyle TextStyle
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  NoIx
  (TextStyle, Priority)
  (TextStyle, Priority)
  TextStyle
  TextStyle
forall s t a b. Field1 s t a b => Lens s t a b
_1 Optic An_AffineTraversal NoIx Ticks Ticks TextStyle TextStyle
-> Optic A_Lens NoIx TextStyle TextStyle Anchor Anchor
-> Optic An_AffineTraversal NoIx Ticks Ticks Anchor Anchor
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% IsLabel
  "anchor" (Optic A_Lens NoIx TextStyle TextStyle Anchor Anchor)
Optic A_Lens NoIx TextStyle TextStyle Anchor Anchor
#anchor Optic An_AffineTraversal NoIx Ticks Ticks Anchor Anchor
-> Anchor -> Ticks -> Ticks
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Anchor
AnchorStart
                  Place
_ -> IsLabel
  "ttick"
  (Optic
     A_Lens
     NoIx
     Ticks
     Ticks
     (Maybe (TextStyle, Priority))
     (Maybe (TextStyle, Priority)))
Optic
  A_Lens
  NoIx
  Ticks
  Ticks
  (Maybe (TextStyle, Priority))
  (Maybe (TextStyle, Priority))
#ttick Optic
  A_Lens
  NoIx
  Ticks
  Ticks
  (Maybe (TextStyle, Priority))
  (Maybe (TextStyle, Priority))
-> Optic
     A_Prism
     NoIx
     (Maybe (TextStyle, Priority))
     (Maybe (TextStyle, Priority))
     (TextStyle, Priority)
     (TextStyle, Priority)
-> Optic
     An_AffineTraversal
     NoIx
     Ticks
     Ticks
     (TextStyle, Priority)
     (TextStyle, Priority)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Prism
  NoIx
  (Maybe (TextStyle, Priority))
  (Maybe (TextStyle, Priority))
  (TextStyle, Priority)
  (TextStyle, Priority)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just Optic
  An_AffineTraversal
  NoIx
  Ticks
  Ticks
  (TextStyle, Priority)
  (TextStyle, Priority)
-> Optic
     A_Lens
     NoIx
     (TextStyle, Priority)
     (TextStyle, Priority)
     TextStyle
     TextStyle
-> Optic An_AffineTraversal NoIx Ticks Ticks TextStyle TextStyle
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  NoIx
  (TextStyle, Priority)
  (TextStyle, Priority)
  TextStyle
  TextStyle
forall s t a b. Field1 s t a b => Lens s t a b
_1 Optic An_AffineTraversal NoIx Ticks Ticks TextStyle TextStyle
-> Optic A_Lens NoIx TextStyle TextStyle Anchor Anchor
-> Optic An_AffineTraversal NoIx Ticks Ticks Anchor Anchor
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% IsLabel
  "anchor" (Optic A_Lens NoIx TextStyle TextStyle Anchor Anchor)
Optic A_Lens NoIx TextStyle TextStyle Anchor Anchor
#anchor Optic An_AffineTraversal NoIx Ticks Ticks Anchor Anchor
-> Anchor -> Ticks -> Ticks
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Anchor
AnchorEnd
              )
                (Ticks -> Ticks) -> (Ticks -> Ticks) -> Ticks -> Ticks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IsLabel
  "ttick"
  (Optic
     A_Lens
     NoIx
     Ticks
     Ticks
     (Maybe (TextStyle, Priority))
     (Maybe (TextStyle, Priority)))
Optic
  A_Lens
  NoIx
  Ticks
  Ticks
  (Maybe (TextStyle, Priority))
  (Maybe (TextStyle, Priority))
#ttick Optic
  A_Lens
  NoIx
  Ticks
  Ticks
  (Maybe (TextStyle, Priority))
  (Maybe (TextStyle, Priority))
-> Optic
     A_Prism
     NoIx
     (Maybe (TextStyle, Priority))
     (Maybe (TextStyle, Priority))
     (TextStyle, Priority)
     (TextStyle, Priority)
-> Optic
     An_AffineTraversal
     NoIx
     Ticks
     Ticks
     (TextStyle, Priority)
     (TextStyle, Priority)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Prism
  NoIx
  (Maybe (TextStyle, Priority))
  (Maybe (TextStyle, Priority))
  (TextStyle, Priority)
  (TextStyle, Priority)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just Optic
  An_AffineTraversal
  NoIx
  Ticks
  Ticks
  (TextStyle, Priority)
  (TextStyle, Priority)
-> Optic
     A_Lens
     NoIx
     (TextStyle, Priority)
     (TextStyle, Priority)
     TextStyle
     TextStyle
-> Optic An_AffineTraversal NoIx Ticks Ticks TextStyle TextStyle
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  NoIx
  (TextStyle, Priority)
  (TextStyle, Priority)
  TextStyle
  TextStyle
forall s t a b. Field1 s t a b => Lens s t a b
_1 Optic An_AffineTraversal NoIx Ticks Ticks TextStyle TextStyle
-> Optic A_Lens NoIx TextStyle TextStyle Priority Priority
-> Optic An_AffineTraversal NoIx Ticks Ticks Priority Priority
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% IsLabel
  "size" (Optic A_Lens NoIx TextStyle TextStyle Priority Priority)
Optic A_Lens NoIx TextStyle TextStyle Priority Priority
#size Optic An_AffineTraversal NoIx Ticks Ticks Priority Priority
-> (Priority -> Priority) -> Ticks -> Ticks
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ (Priority -> Priority -> Priority
forall a. Fractional a => a -> a -> a
/ Priority
adjustSizeA))
                (Ticks -> Ticks) -> Ticks -> Ticks
forall a b. (a -> b) -> a -> b
$ (IsLabel
  "ttick"
  (Optic
     A_Lens
     NoIx
     Ticks
     Ticks
     (Maybe (TextStyle, Priority))
     (Maybe (TextStyle, Priority)))
Optic
  A_Lens
  NoIx
  Ticks
  Ticks
  (Maybe (TextStyle, Priority))
  (Maybe (TextStyle, Priority))
#ttick Optic
  A_Lens
  NoIx
  Ticks
  Ticks
  (Maybe (TextStyle, Priority))
  (Maybe (TextStyle, Priority))
-> Optic
     A_Prism
     NoIx
     (Maybe (TextStyle, Priority))
     (Maybe (TextStyle, Priority))
     (TextStyle, Priority)
     (TextStyle, Priority)
-> Optic
     An_AffineTraversal
     NoIx
     Ticks
     Ticks
     (TextStyle, Priority)
     (TextStyle, Priority)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Prism
  NoIx
  (Maybe (TextStyle, Priority))
  (Maybe (TextStyle, Priority))
  (TextStyle, Priority)
  (TextStyle, Priority)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just Optic
  An_AffineTraversal
  NoIx
  Ticks
  Ticks
  (TextStyle, Priority)
  (TextStyle, Priority)
-> Optic
     A_Lens
     NoIx
     (TextStyle, Priority)
     (TextStyle, Priority)
     TextStyle
     TextStyle
-> Optic An_AffineTraversal NoIx Ticks Ticks TextStyle TextStyle
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  NoIx
  (TextStyle, Priority)
  (TextStyle, Priority)
  TextStyle
  TextStyle
forall s t a b. Field1 s t a b => Lens s t a b
_1 Optic An_AffineTraversal NoIx Ticks Ticks TextStyle TextStyle
-> Optic
     A_Lens NoIx TextStyle TextStyle (Maybe Priority) (Maybe Priority)
-> Optic
     An_AffineTraversal
     NoIx
     Ticks
     Ticks
     (Maybe Priority)
     (Maybe Priority)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% IsLabel
  "rotation"
  (Optic
     A_Lens NoIx TextStyle TextStyle (Maybe Priority) (Maybe Priority))
Optic
  A_Lens NoIx TextStyle TextStyle (Maybe Priority) (Maybe Priority)
#rotation Optic
  An_AffineTraversal
  NoIx
  Ticks
  Ticks
  (Maybe Priority)
  (Maybe Priority)
-> Priority -> Ticks -> Ticks
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a (Maybe b) -> b -> s -> t
?~ Priority
forall a. Floating a => a
pi Priority -> Priority -> Priority
forall a. Fractional a => a -> a -> a
/ Priority
4) Ticks
t
            Bool
False -> (IsLabel
  "ttick"
  (Optic
     A_Lens
     NoIx
     Ticks
     Ticks
     (Maybe (TextStyle, Priority))
     (Maybe (TextStyle, Priority)))
Optic
  A_Lens
  NoIx
  Ticks
  Ticks
  (Maybe (TextStyle, Priority))
  (Maybe (TextStyle, Priority))
#ttick Optic
  A_Lens
  NoIx
  Ticks
  Ticks
  (Maybe (TextStyle, Priority))
  (Maybe (TextStyle, Priority))
-> Optic
     A_Prism
     NoIx
     (Maybe (TextStyle, Priority))
     (Maybe (TextStyle, Priority))
     (TextStyle, Priority)
     (TextStyle, Priority)
-> Optic
     An_AffineTraversal
     NoIx
     Ticks
     Ticks
     (TextStyle, Priority)
     (TextStyle, Priority)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Prism
  NoIx
  (Maybe (TextStyle, Priority))
  (Maybe (TextStyle, Priority))
  (TextStyle, Priority)
  (TextStyle, Priority)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just Optic
  An_AffineTraversal
  NoIx
  Ticks
  Ticks
  (TextStyle, Priority)
  (TextStyle, Priority)
-> Optic
     A_Lens
     NoIx
     (TextStyle, Priority)
     (TextStyle, Priority)
     TextStyle
     TextStyle
-> Optic An_AffineTraversal NoIx Ticks Ticks TextStyle TextStyle
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  NoIx
  (TextStyle, Priority)
  (TextStyle, Priority)
  TextStyle
  TextStyle
forall s t a b. Field1 s t a b => Lens s t a b
_1 Optic An_AffineTraversal NoIx Ticks Ticks TextStyle TextStyle
-> Optic A_Lens NoIx TextStyle TextStyle Priority Priority
-> Optic An_AffineTraversal NoIx Ticks Ticks Priority Priority
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% IsLabel
  "size" (Optic A_Lens NoIx TextStyle TextStyle Priority Priority)
Optic A_Lens NoIx TextStyle TextStyle Priority Priority
#size Optic An_AffineTraversal NoIx Ticks Ticks Priority Priority
-> (Priority -> Priority) -> Ticks -> Ticks
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ (Priority -> Priority -> Priority
forall a. Fractional a => a -> a -> a
/ Priority
adjustSizeA)) Ticks
t
        )
      else Ticks
t Ticks -> (Ticks -> Ticks) -> Ticks
forall a b. a -> (a -> b) -> b
& IsLabel
  "ttick"
  (Optic
     A_Lens
     NoIx
     Ticks
     Ticks
     (Maybe (TextStyle, Priority))
     (Maybe (TextStyle, Priority)))
Optic
  A_Lens
  NoIx
  Ticks
  Ticks
  (Maybe (TextStyle, Priority))
  (Maybe (TextStyle, Priority))
#ttick Optic
  A_Lens
  NoIx
  Ticks
  Ticks
  (Maybe (TextStyle, Priority))
  (Maybe (TextStyle, Priority))
-> Optic
     A_Prism
     NoIx
     (Maybe (TextStyle, Priority))
     (Maybe (TextStyle, Priority))
     (TextStyle, Priority)
     (TextStyle, Priority)
-> Optic
     An_AffineTraversal
     NoIx
     Ticks
     Ticks
     (TextStyle, Priority)
     (TextStyle, Priority)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Prism
  NoIx
  (Maybe (TextStyle, Priority))
  (Maybe (TextStyle, Priority))
  (TextStyle, Priority)
  (TextStyle, Priority)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just Optic
  An_AffineTraversal
  NoIx
  Ticks
  Ticks
  (TextStyle, Priority)
  (TextStyle, Priority)
-> Optic
     A_Lens
     NoIx
     (TextStyle, Priority)
     (TextStyle, Priority)
     TextStyle
     TextStyle
-> Optic An_AffineTraversal NoIx Ticks Ticks TextStyle TextStyle
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  NoIx
  (TextStyle, Priority)
  (TextStyle, Priority)
  TextStyle
  TextStyle
forall s t a b. Field1 s t a b => Lens s t a b
_1 Optic An_AffineTraversal NoIx Ticks Ticks TextStyle TextStyle
-> Optic A_Lens NoIx TextStyle TextStyle Priority Priority
-> Optic An_AffineTraversal NoIx Ticks Ticks Priority Priority
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% IsLabel
  "size" (Optic A_Lens NoIx TextStyle TextStyle Priority Priority)
Optic A_Lens NoIx TextStyle TextStyle Priority Priority
#size Optic An_AffineTraversal NoIx Ticks Ticks Priority Priority
-> (Priority -> Priority) -> Ticks -> Ticks
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ (Priority -> Priority -> Priority
forall a. Fractional a => a -> a -> a
/ Priority
adjustSizeX)
  | Bool
otherwise -- pl `elem` [PlaceLeft, PlaceRight]
    =
    (IsLabel
  "ttick"
  (Optic
     A_Lens
     NoIx
     Ticks
     Ticks
     (Maybe (TextStyle, Priority))
     (Maybe (TextStyle, Priority)))
Optic
  A_Lens
  NoIx
  Ticks
  Ticks
  (Maybe (TextStyle, Priority))
  (Maybe (TextStyle, Priority))
#ttick Optic
  A_Lens
  NoIx
  Ticks
  Ticks
  (Maybe (TextStyle, Priority))
  (Maybe (TextStyle, Priority))
-> Optic
     A_Prism
     NoIx
     (Maybe (TextStyle, Priority))
     (Maybe (TextStyle, Priority))
     (TextStyle, Priority)
     (TextStyle, Priority)
-> Optic
     An_AffineTraversal
     NoIx
     Ticks
     Ticks
     (TextStyle, Priority)
     (TextStyle, Priority)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Prism
  NoIx
  (Maybe (TextStyle, Priority))
  (Maybe (TextStyle, Priority))
  (TextStyle, Priority)
  (TextStyle, Priority)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just Optic
  An_AffineTraversal
  NoIx
  Ticks
  Ticks
  (TextStyle, Priority)
  (TextStyle, Priority)
-> Optic
     A_Lens
     NoIx
     (TextStyle, Priority)
     (TextStyle, Priority)
     TextStyle
     TextStyle
-> Optic An_AffineTraversal NoIx Ticks Ticks TextStyle TextStyle
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  NoIx
  (TextStyle, Priority)
  (TextStyle, Priority)
  TextStyle
  TextStyle
forall s t a b. Field1 s t a b => Lens s t a b
_1 Optic An_AffineTraversal NoIx Ticks Ticks TextStyle TextStyle
-> Optic A_Lens NoIx TextStyle TextStyle Priority Priority
-> Optic An_AffineTraversal NoIx Ticks Ticks Priority Priority
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% IsLabel
  "size" (Optic A_Lens NoIx TextStyle TextStyle Priority Priority)
Optic A_Lens NoIx TextStyle TextStyle Priority Priority
#size Optic An_AffineTraversal NoIx Ticks Ticks Priority Priority
-> (Priority -> Priority) -> Ticks -> Ticks
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ (Priority -> Priority -> Priority
forall a. Fractional a => a -> a -> a
/ Priority
adjustSizeY)) Ticks
t
  where
    max' :: [p] -> p
max' [] = p
1
    max' [p]
xs = [p] -> p
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [p]
xs
    ra :: Rect a -> Range a
ra (Rect a
x a
z a
y a
w)
      | Place
pl Place -> Place -> Bool
forall a. Eq a => a -> a -> Bool
== Place
PlaceTop Bool -> Bool -> Bool
|| Place
pl Place -> Place -> Bool
forall a. Eq a => a -> a -> Bool
== Place
PlaceBottom = a -> a -> Range a
forall a. a -> a -> Range a
Range a
x a
z
      | Bool
otherwise = a -> a -> Range a
forall a. a -> a -> Range a
Range a
y a
w
    asp :: Range Priority
asp = DataBox -> Range Priority
forall a. Rect a -> Range a
ra DataBox
vb
    r :: Range Priority
r = DataBox -> Range Priority
forall a. Rect a -> Range a
ra DataBox
cs
    tickl :: [Text]
tickl = (Priority, Text) -> Text
forall a b. (a, b) -> b
snd ((Priority, Text) -> Text) -> [(Priority, Text)] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TickStyle -> Range Priority -> Range Priority -> [(Priority, Text)]
ticksR (Ticks
t Ticks
-> Optic A_Lens NoIx Ticks Ticks TickStyle TickStyle -> TickStyle
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "style" (Optic A_Lens NoIx Ticks Ticks TickStyle TickStyle)
Optic A_Lens NoIx Ticks Ticks TickStyle TickStyle
#style) Range Priority
asp Range Priority
r
    maxWidth :: Double
    maxWidth :: Priority
maxWidth =
      Priority
-> ((TextStyle, Priority) -> Priority)
-> Maybe (TextStyle, Priority)
-> Priority
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
        Priority
1
        ( \(TextStyle, Priority)
tt ->
            [Priority] -> Priority
forall p. (Num p, Ord p) => [p] -> p
max' ([Priority] -> Priority) -> [Priority] -> Priority
forall a b. (a -> b) -> a -> b
$
              (\(Rect Priority
x Priority
z Priority
_ Priority
_) -> Priority
z Priority -> Priority -> Priority
forall a. Num a => a -> a -> a
- Priority
x)
                (DataBox -> Priority) -> (Text -> DataBox) -> Text -> Priority
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\Text
x -> TextStyle -> Text -> Point Priority -> DataBox
styleBoxText ((TextStyle, Priority) -> TextStyle
forall a b. (a, b) -> a
fst (TextStyle, Priority)
tt) Text
x (Priority -> Priority -> Point Priority
forall a. a -> a -> Point a
Point Priority
0 Priority
0))
                (Text -> Priority) -> [Text] -> [Priority]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
tickl
        )
        (Ticks
t Ticks
-> Optic
     A_Lens
     NoIx
     Ticks
     Ticks
     (Maybe (TextStyle, Priority))
     (Maybe (TextStyle, Priority))
-> Maybe (TextStyle, Priority)
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel
  "ttick"
  (Optic
     A_Lens
     NoIx
     Ticks
     Ticks
     (Maybe (TextStyle, Priority))
     (Maybe (TextStyle, Priority)))
Optic
  A_Lens
  NoIx
  Ticks
  Ticks
  (Maybe (TextStyle, Priority))
  (Maybe (TextStyle, Priority))
#ttick)
    maxHeight :: Priority
maxHeight =
      Priority
-> ((TextStyle, Priority) -> Priority)
-> Maybe (TextStyle, Priority)
-> Priority
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
        Priority
1
        ( \(TextStyle, Priority)
tt ->
            [Priority] -> Priority
forall p. (Num p, Ord p) => [p] -> p
max' ([Priority] -> Priority) -> [Priority] -> Priority
forall a b. (a -> b) -> a -> b
$
              (\(Rect Priority
_ Priority
_ Priority
y Priority
w) -> Priority
w Priority -> Priority -> Priority
forall a. Num a => a -> a -> a
- Priority
y)
                (DataBox -> Priority) -> (Text -> DataBox) -> Text -> Priority
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\Text
x -> TextStyle -> Text -> Point Priority -> DataBox
styleBoxText ((TextStyle, Priority) -> TextStyle
forall a b. (a, b) -> a
fst (TextStyle, Priority)
tt) Text
x (Priority -> Priority -> Point Priority
forall a. a -> a -> Point a
Point Priority
0 Priority
0))
                (Text -> Priority) -> [Text] -> [Priority]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
tickl
        )
        (Ticks
t Ticks
-> Optic
     A_Lens
     NoIx
     Ticks
     Ticks
     (Maybe (TextStyle, Priority))
     (Maybe (TextStyle, Priority))
-> Maybe (TextStyle, Priority)
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel
  "ttick"
  (Optic
     A_Lens
     NoIx
     Ticks
     Ticks
     (Maybe (TextStyle, Priority))
     (Maybe (TextStyle, Priority)))
Optic
  A_Lens
  NoIx
  Ticks
  Ticks
  (Maybe (TextStyle, Priority))
  (Maybe (TextStyle, Priority))
#ttick)
    adjustSizeX :: Double
    adjustSizeX :: Priority
adjustSizeX = Priority -> Priority -> Priority
forall a. Ord a => a -> a -> a
max ((Priority
maxWidth Priority -> Priority -> Priority
forall a. Fractional a => a -> a -> a
/ (Range Priority -> Element (Range Priority)
forall s. Space s => s -> Element s
upper Range Priority
asp Priority -> Priority -> Priority
forall a. Num a => a -> a -> a
- Range Priority -> Element (Range Priority)
forall s. Space s => s -> Element s
lower Range Priority
asp)) Priority -> Priority -> Priority
forall a. Fractional a => a -> a -> a
/ Priority
mrx) Priority
1
    adjustSizeY :: Priority
adjustSizeY = Priority -> Priority -> Priority
forall a. Ord a => a -> a -> a
max ((Priority
maxHeight Priority -> Priority -> Priority
forall a. Fractional a => a -> a -> a
/ (Range Priority -> Element (Range Priority)
forall s. Space s => s -> Element s
upper Range Priority
asp Priority -> Priority -> Priority
forall a. Num a => a -> a -> a
- Range Priority -> Element (Range Priority)
forall s. Space s => s -> Element s
lower Range Priority
asp)) Priority -> Priority -> Priority
forall a. Fractional a => a -> a -> a
/ Priority
mry) Priority
1
    adjustSizeA :: Priority
adjustSizeA = Priority -> Priority -> Priority
forall a. Ord a => a -> a -> a
max ((Priority
maxHeight Priority -> Priority -> Priority
forall a. Fractional a => a -> a -> a
/ (Range Priority -> Element (Range Priority)
forall s. Space s => s -> Element s
upper Range Priority
asp Priority -> Priority -> Priority
forall a. Num a => a -> a -> a
- Range Priority -> Element (Range Priority)
forall s. Space s => s -> Element s
lower Range Priority
asp)) Priority -> Priority -> Priority
forall a. Fractional a => a -> a -> a
/ Priority
ma) Priority
1

makeTick :: AxisOptions -> State HudChart ChartTree
makeTick :: AxisOptions -> State HudChart ChartTree
makeTick AxisOptions
c = do
  Maybe DataBox
hb <- (HudChart -> Maybe DataBox)
-> StateT HudChart Identity (Maybe DataBox)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Lens' HudChart (Maybe DataBox) -> HudChart -> Maybe DataBox
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Lens' HudChart (Maybe DataBox)
hudBox')
  DataBox
db <- (HudChart -> DataBox) -> StateT HudChart Identity DataBox
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Optic' A_Lens NoIx HudChart DataBox -> HudChart -> DataBox
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view IsLabel "dataBox" (Optic' A_Lens NoIx HudChart DataBox)
Optic' A_Lens NoIx HudChart DataBox
#dataBox)
  case Maybe DataBox
hb of
    Maybe DataBox
Nothing -> ChartTree -> State HudChart ChartTree
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> [Chart] -> ChartTree
named Text
"ticks" [])
    Just DataBox
hb' -> do
      let adjTick :: Ticks
adjTick = Ticks -> (Adjustments -> Ticks) -> Maybe Adjustments -> Ticks
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (AxisOptions
c AxisOptions
-> Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks -> Ticks
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel
  "ticks" (Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks)
Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
#ticks) (\Adjustments
x -> Adjustments -> DataBox -> DataBox -> Place -> Ticks -> Ticks
adjustTicks Adjustments
x DataBox
hb' DataBox
db (AxisOptions
c AxisOptions
-> Optic A_Lens NoIx AxisOptions AxisOptions Place Place -> Place
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel
  "place" (Optic A_Lens NoIx AxisOptions AxisOptions Place Place)
Optic A_Lens NoIx AxisOptions AxisOptions Place Place
#place) (AxisOptions
c AxisOptions
-> Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks -> Ticks
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel
  "ticks" (Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks)
Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
#ticks)) (AxisOptions
c AxisOptions
-> Optic' A_Lens NoIx AxisOptions (Maybe Adjustments)
-> Maybe Adjustments
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel
  "adjust" (Optic' A_Lens NoIx AxisOptions (Maybe Adjustments))
Optic' A_Lens NoIx AxisOptions (Maybe Adjustments)
#adjust)
      Place -> Ticks -> State HudChart ChartTree
applyTicks (AxisOptions
c AxisOptions
-> Optic A_Lens NoIx AxisOptions AxisOptions Place Place -> Place
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel
  "place" (Optic A_Lens NoIx AxisOptions AxisOptions Place Place)
Optic A_Lens NoIx AxisOptions AxisOptions Place Place
#place) Ticks
adjTick

-- | Make a legend from 'LegendOptions'
legend :: LegendOptions -> State HudChart ChartTree
legend :: LegendOptions -> State HudChart ChartTree
legend LegendOptions
o = LegendOptions -> ChartTree -> State HudChart ChartTree
legendHud LegendOptions
o (LegendOptions -> ChartTree
legendChart LegendOptions
o)

-- | Make a legend hud element, from a bespoke ChartTree.
legendHud :: LegendOptions -> ChartTree -> State HudChart ChartTree
legendHud :: LegendOptions -> ChartTree -> State HudChart ChartTree
legendHud LegendOptions
o ChartTree
lcs = do
  Maybe DataBox
sb <- (HudChart -> Maybe DataBox)
-> StateT HudChart Identity (Maybe DataBox)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Getter HudChart (Maybe DataBox) -> HudChart -> Maybe DataBox
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Getter HudChart (Maybe DataBox)
hudStyleBox')
  case Maybe DataBox
sb of
    Maybe DataBox
Nothing -> ChartTree -> State HudChart ChartTree
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> [Chart] -> ChartTree
named Text
"legend" [])
    Just DataBox
sb' -> ChartTree -> State HudChart ChartTree
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChartTree -> State HudChart ChartTree)
-> ChartTree -> State HudChart ChartTree
forall a b. (a -> b) -> a -> b
$ LegendOptions -> DataBox -> ChartTree -> ChartTree
placeLegend LegendOptions
o DataBox
sb' (Optic A_Traversal NoIx ChartTree ChartTree Chart Chart
-> (Chart -> Chart) -> ChartTree -> ChartTree
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over Optic A_Traversal NoIx ChartTree ChartTree Chart Chart
chart' (Priority -> Chart -> Chart
scaleChart (LegendOptions
o LegendOptions
-> Optic' A_Lens NoIx LegendOptions Priority -> Priority
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "overallScale" (Optic' A_Lens NoIx LegendOptions Priority)
Optic' A_Lens NoIx LegendOptions Priority
#overallScale)) ChartTree
lcs)

placeLegend :: LegendOptions -> HudBox -> ChartTree -> ChartTree
placeLegend :: LegendOptions -> DataBox -> ChartTree -> ChartTree
placeLegend LegendOptions
o DataBox
hb ChartTree
t =
  case Optic' A_Lens NoIx ChartTree (Maybe DataBox)
-> ChartTree -> Maybe DataBox
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx ChartTree (Maybe DataBox)
styleBox' ChartTree
t of
    Maybe DataBox
Nothing -> Text -> [Chart] -> ChartTree
named Text
"legend" []
    Just DataBox
sb -> ChartTree
t ChartTree -> (ChartTree -> ChartTree) -> ChartTree
forall a b. a -> (a -> b) -> b
& Optic A_Traversal NoIx ChartTree ChartTree Chart Chart
-> (Chart -> Chart) -> ChartTree -> ChartTree
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over Optic A_Traversal NoIx ChartTree ChartTree Chart Chart
chart' (Point Priority -> Chart -> Chart
moveChart (Place -> Priority -> DataBox -> DataBox -> Point Priority
placeBeside_ (LegendOptions
o LegendOptions -> Optic' A_Lens NoIx LegendOptions Place -> Place
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "place" (Optic' A_Lens NoIx LegendOptions Place)
Optic' A_Lens NoIx LegendOptions Place
#place) (Optic' A_Lens NoIx LegendOptions Priority
-> LegendOptions -> Priority
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view IsLabel "buffer" (Optic' A_Lens NoIx LegendOptions Priority)
Optic' A_Lens NoIx LegendOptions Priority
#buffer LegendOptions
o) DataBox
hb DataBox
sb))

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

-- | frame a legend
legendFrame :: LegendOptions -> ChartTree -> ChartTree
legendFrame :: LegendOptions -> ChartTree -> ChartTree
legendFrame LegendOptions
l ChartTree
content' =
  Maybe Text -> [ChartTree] -> ChartTree
group (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"legend") [Text -> [Chart] -> ChartTree
named Text
"legendBorder" [Chart]
borders, Maybe Text -> ChartTree -> ChartTree
rename (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"legendContent") ChartTree
content']
  where
    borders :: [Chart]
borders = [Chart
outer, Chart
inner] [Chart] -> [Chart] -> [Chart]
forall a. Semigroup a => a -> a -> a
<> [Chart]
frame'
    outer :: Chart
outer = Priority -> [Chart] -> Chart
padChart (Optic' A_Lens NoIx LegendOptions Priority
-> LegendOptions -> Priority
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view IsLabel "outerPad" (Optic' A_Lens NoIx LegendOptions Priority)
Optic' A_Lens NoIx LegendOptions Priority
#outerPad LegendOptions
l) [Chart
inner]
    frame' :: [Chart]
frame' = (RectStyle -> [Chart]) -> Maybe RectStyle -> [Chart]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\RectStyle
r -> [RectStyle -> Priority -> [Chart] -> Chart
frameChart RectStyle
r Priority
0 [Chart
inner]]) (Optic
  A_Lens
  NoIx
  LegendOptions
  LegendOptions
  (Maybe RectStyle)
  (Maybe RectStyle)
-> LegendOptions -> Maybe RectStyle
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view IsLabel
  "frame"
  (Optic
     A_Lens
     NoIx
     LegendOptions
     LegendOptions
     (Maybe RectStyle)
     (Maybe RectStyle))
Optic
  A_Lens
  NoIx
  LegendOptions
  LegendOptions
  (Maybe RectStyle)
  (Maybe RectStyle)
#frame LegendOptions
l)
    inner :: Chart
inner = Priority -> [Chart] -> Chart
padChart (Optic' A_Lens NoIx LegendOptions Priority
-> LegendOptions -> Priority
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view IsLabel "innerPad" (Optic' A_Lens NoIx LegendOptions Priority)
Optic' A_Lens NoIx LegendOptions Priority
#innerPad LegendOptions
l) (Optic A_Traversal NoIx ChartTree ChartTree [Chart] [Chart]
-> ChartTree -> [Chart]
forall k a (is :: IxList) s.
(Is k A_Fold, Monoid a) =>
Optic' k is s a -> s -> a
foldOf Optic A_Traversal NoIx ChartTree ChartTree [Chart] [Chart]
charts' 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' =
      Priority -> [ChartTree] -> ChartTree
vert
        (LegendOptions
l LegendOptions
-> Optic' A_Lens NoIx LegendOptions Priority -> Priority
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "hgap" (Optic' A_Lens NoIx LegendOptions Priority)
Optic' A_Lens NoIx LegendOptions Priority
#hgap)
        ( ( \(Chart
a, Chart
t) ->
              Priority -> [ChartTree] -> ChartTree
hori
                ((LegendOptions
l LegendOptions
-> Optic' A_Lens NoIx LegendOptions Priority -> Priority
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "vgap" (Optic' A_Lens NoIx LegendOptions Priority)
Optic' A_Lens NoIx LegendOptions Priority
#vgap) Priority -> Priority -> Priority
forall a. Num a => a -> a -> a
+ Priority
twidth Priority -> Priority -> Priority
forall a. Num a => a -> a -> a
- Chart -> Priority
gapwidth Chart
t)
                (([Chart] -> ChartTree) -> [[Chart]] -> [ChartTree]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Chart] -> ChartTree
unnamed [[Chart
t], [Chart
a]])
          )
            ((Chart, Chart) -> ChartTree) -> [(Chart, Chart)] -> [ChartTree]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Chart, Chart)]
es
        )
    es :: [(Chart, Chart)]
es = [(Chart, Chart)] -> [(Chart, Chart)]
forall a. [a] -> [a]
reverse ([(Chart, Chart)] -> [(Chart, Chart)])
-> [(Chart, Chart)] -> [(Chart, Chart)]
forall a b. (a -> b) -> a -> b
$ (Text -> Chart -> (Chart, Chart))
-> (Text, Chart) -> (Chart, Chart)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (LegendOptions -> Text -> Chart -> (Chart, Chart)
legendEntry LegendOptions
l) ((Text, Chart) -> (Chart, Chart))
-> [(Text, Chart)] -> [(Chart, Chart)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Optic' A_Lens NoIx LegendOptions [(Text, Chart)]
-> LegendOptions -> [(Text, Chart)]
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view IsLabel
  "content" (Optic' A_Lens NoIx LegendOptions [(Text, Chart)])
Optic' A_Lens NoIx LegendOptions [(Text, Chart)]
#content LegendOptions
l
    twidth :: Priority
twidth = Priority -> (DataBox -> Priority) -> Maybe DataBox -> Priority
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Priority
forall a. Additive a => a
zero (\(Rect Priority
_ Priority
z Priority
_ Priority
_) -> Priority
z) ([Chart] -> Maybe DataBox
styleBoxes ((Chart, Chart) -> Chart
forall a b. (a, b) -> b
snd ((Chart, Chart) -> Chart) -> [(Chart, Chart)] -> [Chart]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Chart, Chart)]
es))
    gapwidth :: Chart -> Priority
gapwidth Chart
t = Priority -> (DataBox -> Priority) -> Maybe DataBox -> Priority
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Priority
0 (\(Rect Priority
_ Priority
z Priority
_ Priority
_) -> Priority
z) (Chart -> Maybe DataBox
sbox Chart
t)

legendText ::
  LegendOptions ->
  Text ->
  Chart
legendText :: LegendOptions -> Text -> Chart
legendText LegendOptions
l Text
t =
  TextStyle -> [(Text, Point Priority)] -> Chart
TextChart (LegendOptions
l LegendOptions
-> Optic
     A_Lens NoIx LegendOptions LegendOptions TextStyle TextStyle
-> TextStyle
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel
  "textStyle"
  (Optic A_Lens NoIx LegendOptions LegendOptions TextStyle TextStyle)
Optic A_Lens NoIx LegendOptions LegendOptions TextStyle TextStyle
#textStyle TextStyle -> (TextStyle -> TextStyle) -> TextStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "anchor" (Optic A_Lens NoIx TextStyle TextStyle Anchor Anchor)
Optic A_Lens NoIx TextStyle TextStyle Anchor Anchor
#anchor Optic A_Lens NoIx TextStyle TextStyle Anchor Anchor
-> Anchor -> TextStyle -> TextStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Anchor
AnchorStart) [(Text
t, Point Priority
forall a. Additive a => a
zero)]

legendizeChart ::
  LegendOptions ->
  Chart ->
  Chart
legendizeChart :: LegendOptions -> Chart -> Chart
legendizeChart LegendOptions
l Chart
c =
  case Chart
c of
    (RectChart RectStyle
rs [DataBox]
_) -> RectStyle -> [DataBox] -> Chart
RectChart RectStyle
rs [Priority -> Priority -> Priority -> Priority -> DataBox
forall a. a -> a -> a -> a -> Rect a
Rect Priority
0 (LegendOptions
l LegendOptions
-> Optic' A_Lens NoIx LegendOptions Priority -> Priority
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "size" (Optic' A_Lens NoIx LegendOptions Priority)
Optic' A_Lens NoIx LegendOptions Priority
#size) Priority
0 (LegendOptions
l LegendOptions
-> Optic' A_Lens NoIx LegendOptions Priority -> Priority
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "size" (Optic' A_Lens NoIx LegendOptions Priority)
Optic' A_Lens NoIx LegendOptions Priority
#size)]
    (TextChart TextStyle
ts [(Text, Point Priority)]
_) -> TextStyle -> [(Text, Point Priority)] -> Chart
TextChart (TextStyle
ts TextStyle -> (TextStyle -> TextStyle) -> TextStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "size" (Optic A_Lens NoIx TextStyle TextStyle Priority Priority)
Optic A_Lens NoIx TextStyle TextStyle Priority Priority
#size Optic A_Lens NoIx TextStyle TextStyle Priority Priority
-> Priority -> TextStyle -> TextStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ (LegendOptions
l LegendOptions
-> Optic' A_Lens NoIx LegendOptions Priority -> Priority
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "size" (Optic' A_Lens NoIx LegendOptions Priority)
Optic' A_Lens NoIx LegendOptions Priority
#size)) [(Text
"text", Point Priority
forall a. Additive a => a
zero)]
    (GlyphChart GlyphStyle
gs [Point Priority]
_) -> GlyphStyle -> [Point Priority] -> Chart
GlyphChart (GlyphStyle
gs GlyphStyle -> (GlyphStyle -> GlyphStyle) -> GlyphStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "size" (Optic A_Lens NoIx GlyphStyle GlyphStyle Priority Priority)
Optic A_Lens NoIx GlyphStyle GlyphStyle Priority Priority
#size Optic A_Lens NoIx GlyphStyle GlyphStyle Priority Priority
-> Priority -> GlyphStyle -> GlyphStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ (LegendOptions
l LegendOptions
-> Optic' A_Lens NoIx LegendOptions Priority -> Priority
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "size" (Optic' A_Lens NoIx LegendOptions Priority)
Optic' A_Lens NoIx LegendOptions Priority
#size)) [Priority -> Priority -> Point Priority
forall a. a -> a -> Point a
Point (Priority
0.5 Priority -> Priority -> Priority
forall a. Num a => a -> a -> a
* LegendOptions
l LegendOptions
-> Optic' A_Lens NoIx LegendOptions Priority -> Priority
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "size" (Optic' A_Lens NoIx LegendOptions Priority)
Optic' A_Lens NoIx LegendOptions Priority
#size) (Priority
0.33 Priority -> Priority -> Priority
forall a. Num a => a -> a -> a
* LegendOptions
l LegendOptions
-> Optic' A_Lens NoIx LegendOptions Priority -> Priority
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "size" (Optic' A_Lens NoIx LegendOptions Priority)
Optic' A_Lens NoIx LegendOptions Priority
#size)]
    (LineChart LineStyle
ls [[Point Priority]]
_) ->
      LineStyle -> [[Point Priority]] -> Chart
LineChart
        (LineStyle
ls LineStyle -> (LineStyle -> LineStyle) -> LineStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "size" (Optic A_Lens NoIx LineStyle LineStyle Priority Priority)
Optic A_Lens NoIx LineStyle LineStyle Priority Priority
#size Optic A_Lens NoIx LineStyle LineStyle Priority Priority
-> (Priority -> Priority) -> LineStyle -> LineStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ (Priority -> Priority -> Priority
forall a. Fractional a => a -> a -> a
/ (LegendOptions
l LegendOptions
-> Optic' A_Lens NoIx LegendOptions Priority -> Priority
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "overallScale" (Optic' A_Lens NoIx LegendOptions Priority)
Optic' A_Lens NoIx LegendOptions Priority
#overallScale)))
        [[Priority -> Priority -> Point Priority
forall a. a -> a -> Point a
Point Priority
0 (Priority
1 Priority -> Priority -> Priority
forall a. Num a => a -> a -> a
* LegendOptions
l LegendOptions
-> Optic' A_Lens NoIx LegendOptions Priority -> Priority
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "size" (Optic' A_Lens NoIx LegendOptions Priority)
Optic' A_Lens NoIx LegendOptions Priority
#size), Priority -> Priority -> Point Priority
forall a. a -> a -> Point a
Point (Priority
2 Priority -> Priority -> Priority
forall a. Num a => a -> a -> a
* LegendOptions
l LegendOptions
-> Optic' A_Lens NoIx LegendOptions Priority -> Priority
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "size" (Optic' A_Lens NoIx LegendOptions Priority)
Optic' A_Lens NoIx LegendOptions Priority
#size) (Priority
1 Priority -> Priority -> Priority
forall a. Num a => a -> a -> a
* LegendOptions
l LegendOptions
-> Optic' A_Lens NoIx LegendOptions Priority -> Priority
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "size" (Optic' A_Lens NoIx LegendOptions Priority)
Optic' A_Lens NoIx LegendOptions Priority
#size)]]
    (PathChart PathStyle
ps [PathData Priority]
_) ->
      ( let cs :: [PathData Priority]
cs =
              QuadPosition Priority -> [PathData Priority]
singletonQuad
                ( Point Priority
-> Point Priority -> Point Priority -> QuadPosition Priority
forall a. Point a -> Point a -> Point a -> QuadPosition a
QuadPosition
                    (Priority -> Priority -> Point Priority
forall a. a -> a -> Point a
Point Priority
0 Priority
0)
                    (Priority -> Priority -> Point Priority
forall a. a -> a -> Point a
Point (LegendOptions
l LegendOptions
-> Optic' A_Lens NoIx LegendOptions Priority -> Priority
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "size" (Optic' A_Lens NoIx LegendOptions Priority)
Optic' A_Lens NoIx LegendOptions Priority
#size) (LegendOptions
l LegendOptions
-> Optic' A_Lens NoIx LegendOptions Priority -> Priority
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "size" (Optic' A_Lens NoIx LegendOptions Priority)
Optic' A_Lens NoIx LegendOptions Priority
#size))
                    (Priority -> Priority -> Point Priority
forall a. a -> a -> Point a
Point (Priority
2 Priority -> Priority -> Priority
forall a. Num a => a -> a -> a
* LegendOptions
l LegendOptions
-> Optic' A_Lens NoIx LegendOptions Priority -> Priority
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "size" (Optic' A_Lens NoIx LegendOptions Priority)
Optic' A_Lens NoIx LegendOptions Priority
#size) ((-Priority
1) Priority -> Priority -> Priority
forall a. Num a => a -> a -> a
* LegendOptions
l LegendOptions
-> Optic' A_Lens NoIx LegendOptions Priority -> Priority
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "size" (Optic' A_Lens NoIx LegendOptions Priority)
Optic' A_Lens NoIx LegendOptions Priority
#size))
                )
         in PathStyle -> [PathData Priority] -> Chart
PathChart (PathStyle
ps PathStyle -> (PathStyle -> PathStyle) -> PathStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "borderSize"
  (Optic A_Lens NoIx PathStyle PathStyle Priority Priority)
Optic A_Lens NoIx PathStyle PathStyle Priority Priority
#borderSize Optic A_Lens NoIx PathStyle PathStyle Priority Priority
-> Priority -> PathStyle -> PathStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ (LegendOptions
l LegendOptions
-> Optic' A_Lens NoIx LegendOptions Priority -> Priority
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "size" (Optic' A_Lens NoIx LegendOptions Priority)
Optic' A_Lens NoIx LegendOptions Priority
#size)) [PathData Priority]
cs
      )
    (BlankChart [DataBox]
_) -> [DataBox] -> Chart
BlankChart [Priority -> Priority -> Priority -> Priority -> DataBox
forall a. a -> a -> a -> a -> Rect a
Rect Priority
0 (LegendOptions
l LegendOptions
-> Optic' A_Lens NoIx LegendOptions Priority -> Priority
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "size" (Optic' A_Lens NoIx LegendOptions Priority)
Optic' A_Lens NoIx LegendOptions Priority
#size) Priority
0 (LegendOptions
l LegendOptions
-> Optic' A_Lens NoIx LegendOptions Priority -> Priority
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "size" (Optic' A_Lens NoIx LegendOptions Priority)
Optic' A_Lens NoIx LegendOptions Priority
#size)]

legendEntry ::
  LegendOptions ->
  Text ->
  Chart ->
  (Chart, Chart)
legendEntry :: LegendOptions -> Text -> Chart -> (Chart, Chart)
legendEntry LegendOptions
l Text
t Chart
c =
  ( LegendOptions -> Chart -> Chart
legendizeChart LegendOptions
l Chart
c,
    LegendOptions -> Text -> Chart
legendText LegendOptions
l Text
t
  )