{-# 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 -> Double
priority :: Priority,
    -- | additional charts
    Hud -> State HudChart ChartTree
hud :: State HudChart ChartTree
  }
  deriving (forall x. Rep Hud x -> Hud
forall x. Hud -> Rep Hud x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Hud x -> Hud
$cfrom :: forall x. Hud -> Rep Hud x
Generic)

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

-- | A type for Rect to represent the 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a (is :: IxList) s.
(Is k A_Fold, Monoid a) =>
Optic' k is s a -> s -> a
foldOf (forall a. IsLabel "chart" a => a
#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
% Traversal' ChartTree [Chart]
charts')

canvasRebox_ :: HudChart -> Maybe (Rect Double) -> HudChart
canvasRebox_ :: HudChart -> Maybe DataBox -> HudChart
canvasRebox_ HudChart
cs Maybe DataBox
r =
  HudChart
cs
    forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over (forall a. IsLabel "chart" a => a
#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
% Traversal' ChartTree Chart
chart') (Maybe DataBox -> Maybe DataBox -> Chart -> Chart
maybeProjectWith Maybe DataBox
r (HudChart -> Maybe DataBox
canvasBox_ HudChart
cs))
    forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over (forall a. IsLabel "hud" a => a
#hud forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Traversal' ChartTree Chart
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' =
  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' = forall s a. (s -> a) -> Getter s a
to ([Chart] -> Maybe DataBox
styleBoxes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a (is :: IxList) s.
(Is k A_Fold, Monoid a) =>
Optic' k is s a -> s -> a
foldOf (forall a. IsLabel "chart" a => a
#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
% Traversal' ChartTree [Chart]
charts'))

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

-- | a lens between a HudChart and the bounding box of the hud.
hudStyleBox' :: Getter HudChart (Maybe HudBox)
hudStyleBox' :: Getter HudChart (Maybe DataBox)
hudStyleBox' = 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\HudChart
x -> forall k a (is :: IxList) s.
(Is k A_Fold, Monoid a) =>
Optic' k is s a -> s -> a
foldOf (forall a. IsLabel "chart" a => a
#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
% Traversal' ChartTree [Chart]
charts') HudChart
x forall a. Semigroup a => a -> a -> a
<> forall k a (is :: IxList) s.
(Is k A_Fold, Monoid a) =>
Optic' k is s a -> s -> a
foldOf (forall a. IsLabel "hud" a => a
#hud forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Traversal' ChartTree [Chart]
charts') HudChart
x)

hudRebox_ :: HudChart -> Maybe HudBox -> HudChart
hudRebox_ :: HudChart -> Maybe DataBox -> HudChart
hudRebox_ HudChart
cs Maybe DataBox
r =
  HudChart
cs
    forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over forall a. IsLabel "chart" a => a
#chart (forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over Traversal' ChartTree Chart
chart' (Maybe DataBox -> Maybe DataBox -> Chart -> Chart
maybeProjectWith Maybe DataBox
r' (HudChart -> Maybe DataBox
hudBox_ HudChart
cs)))
    forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over forall a. IsLabel "hud" a => a
#hud (forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over Traversal' ChartTree Chart
chart' (Maybe DataBox -> Maybe DataBox -> Chart -> Chart
maybeProjectWith Maybe DataBox
r' (HudChart -> Maybe DataBox
hudBox_ HudChart
cs)))
  where
    r' :: Maybe DataBox
r' = forall a. Subtractive a => a -> a -> a
(NH.-) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe DataBox
r forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Subtractive a => a -> a -> a
(NH.-) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HudChart -> Maybe DataBox
hudStyleBox_ HudChart
cs 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' =
  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 forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over forall a. IsLabel "hud" a => a
#hud (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 :: forall (f :: * -> *).
Traversable f =>
f (State HudChart ChartTree) -> State HudChart ()
closes f (State HudChart ChartTree)
xs = do
  ChartTree
xs' <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
toList) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence f (State HudChart ChartTree)
xs
  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 :: Double -> State HudChart () -> Hud
fromEffect Double
p State HudChart ()
s = Double -> State HudChart ChartTree -> Hud
Hud Double
p (State HudChart ()
s forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty)

-- | Apply a ChartAspect
applyChartAspect :: ChartAspect -> State HudChart ()
applyChartAspect :: ChartAspect -> State HudChart ()
applyChartAspect ChartAspect
fa = do
  HudChart
hc <- forall s (m :: * -> *). MonadState s m => m s
get
  case ChartAspect
fa of
    ChartAspect
ChartAspect -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    ChartAspect
_ -> forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (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 Double
a -> forall a. a -> Maybe a
Just (Double -> DataBox
aspect Double
a)
    CanvasAspect Double
a ->
      case (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, 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
_) -> forall a. Maybe a
Nothing
        (Maybe DataBox
_, Maybe DataBox
Nothing) -> forall a. Maybe a
Nothing
        (Just DataBox
hb, Just DataBox
cb) -> forall a. a -> Maybe a
Just (Double -> DataBox
aspect (Double
a forall a. Num a => a -> a -> a
* forall a. Field a => Rect a -> a
ratio DataBox
hb forall a. Fractional a => a -> a -> a
/ forall a. Field a => Rect a -> a
ratio DataBox
cb))
    ChartAspect
ChartAspect -> 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
    forall a b. a -> (a -> b) -> b
& forall b a. Ord b => (a -> b) -> [a] -> [a]
List.sortOn (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "priority" a => a
#priority)
    forall a b. a -> (a -> b) -> b
& forall a. (a -> a -> Bool) -> [a] -> [[a]]
List.groupBy (\Hud
a Hud
b -> forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "priority" a => a
#priority Hud
a forall a. Eq a => a -> a -> Bool
== forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "priority" a => a
#priority Hud
b)
    forall a b. a -> (a -> b) -> b
& forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall (f :: * -> *).
Traversable f =>
f (State HudChart ChartTree) -> State HudChart ()
closes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "hud" a => a
#hud))
    forall a b. a -> (a -> b) -> b
& forall a b c. (a -> b -> c) -> b -> a -> c
flip
      forall s a. State s a -> s -> s
execState
      ( ChartTree -> ChartTree -> DataBox -> HudChart
HudChart
          (ChartTree
cs forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over Traversal' ChartTree Chart
chart' (DataBox -> DataBox -> Chart -> Chart
projectWith DataBox
cb DataBox
db))
          forall a. Monoid a => a
mempty
          DataBox
db
      )
    forall a b. a -> (a -> b) -> b
& (\HudChart
x -> Maybe Text -> [ChartTree] -> ChartTree
group (forall a. a -> Maybe a
Just Text
"chart") [forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "chart" a => a
#chart HudChart
x] forall a. Semigroup a => a -> a -> a
<> Maybe Text -> [ChartTree] -> ChartTree
group (forall a. a -> Maybe a
Just Text
"hud") [forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "hud" a => a
#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 forall a b. (a -> b) -> a -> b
$ [Chart] -> Maybe DataBox
boxes (forall k a (is :: IxList) s.
(Is k A_Fold, Monoid a) =>
Optic' k is s a -> s -> a
foldOf Traversal' ChartTree [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 -> [(Double, AxisOptions)]
axes :: [(Priority, AxisOptions)],
    HudOptions -> [(Double, FrameOptions)]
frames :: [(Priority, FrameOptions)],
    HudOptions -> [(Double, LegendOptions)]
legends :: [(Priority, LegendOptions)],
    HudOptions -> [(Double, Title)]
titles :: [(Priority, Title)]
  }
  deriving (HudOptions -> HudOptions -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HudOptions -> HudOptions -> Bool
$c/= :: HudOptions -> HudOptions -> Bool
== :: HudOptions -> HudOptions -> Bool
$c== :: HudOptions -> HudOptions -> Bool
Eq, Int -> HudOptions -> ShowS
[HudOptions] -> ShowS
HudOptions -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HudOptions] -> ShowS
$cshowList :: [HudOptions] -> ShowS
show :: HudOptions -> String
$cshow :: HudOptions -> String
showsPrec :: Int -> HudOptions -> ShowS
$cshowsPrec :: Int -> HudOptions -> ShowS
Show, forall x. Rep HudOptions x -> HudOptions
forall x. HudOptions -> Rep HudOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HudOptions x -> HudOptions
$cfrom :: forall x. HudOptions -> Rep HudOptions x
Generic)

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

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

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

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

lastPriority :: HudOptions -> Priority
lastPriority :: HudOptions -> Double
lastPriority HudOptions
o = case HudOptions -> [Double]
priorities HudOptions
o of
  [] -> Double
0
  [Double]
xs -> forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Double]
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''') forall a b. (a -> b) -> a -> b
$
    ([(Double, AxisOptions)]
as' forall a b. a -> (a -> b) -> b
& forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Double -> State HudChart ChartTree -> Hud
Hud forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second AxisOptions -> State HudChart ChartTree
axis))
      forall a. Semigroup a => a -> a -> a
<> (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "frames" a => a
#frames HudOptions
o forall a b. a -> (a -> b) -> b
& forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Double -> State HudChart ChartTree -> Hud
Hud forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second FrameOptions -> State HudChart ChartTree
frameHud))
      forall a. Semigroup a => a -> a -> a
<> (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "legends" a => a
#legends HudOptions
o forall a b. a -> (a -> b) -> b
& forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Double -> State HudChart ChartTree -> Hud
Hud forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second LegendOptions -> State HudChart ChartTree
legend))
      forall a. Semigroup a => a -> a -> a
<> (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "titles" a => a
#titles HudOptions
o forall a b. a -> (a -> b) -> b
& forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Double -> State HudChart ChartTree -> Hud
Hud forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second Title -> State HudChart ChartTree
title))
      forall a. Semigroup a => a -> a -> a
<> [ Double -> State HudChart () -> Hud
fromEffect (HudOptions -> Double
lastPriority HudOptions
o forall a. Num a => a -> a -> a
+ Double
1) forall a b. (a -> b) -> a -> b
$
             ChartAspect -> State HudChart ()
applyChartAspect (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "chartAspect" a => a
#chartAspect HudOptions
o)
         ]
  where
    ([(Double, AxisOptions)]
as', DataBox
db''') =
      forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
        ( \(Double, AxisOptions)
a ([(Double, AxisOptions)]
as, DataBox
db') ->
            let (DataBox
db'', AxisOptions
a') = DataBox -> AxisOptions -> (DataBox, AxisOptions)
freezeTicks DataBox
db' (forall a b. (a, b) -> b
snd (Double, AxisOptions)
a)
             in ([(Double, AxisOptions)]
as forall a. Semigroup a => a -> a -> a
<> [(forall a b. (a, b) -> a
fst (Double, AxisOptions)
a, AxisOptions
a')], DataBox
db'')
        )
        ([], DataBox
db)
        (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "axes" a => a
#axes HudOptions
o)

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

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

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

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

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

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

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 <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty) (Place -> AxisBar -> State HudChart ChartTree
makeAxisBar (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "place" a => a
#place AxisOptions
a)) (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "bar" a => a
#bar AxisOptions
a)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Text -> [ChartTree] -> ChartTree
group (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
    forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over forall a. IsLabel "frames" a => a
#frames (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second FrameOptions -> FrameOptions
fFrame))
    forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over forall a. IsLabel "titles" a => a
#titles (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over (forall a. IsLabel "style" a => a
#style forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a. IsLabel "color" a => a
#color) Colour -> Colour
f)))
    forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over forall a. IsLabel "axes" a => a
#axes (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second AxisOptions -> AxisOptions
fAxis))
    forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over forall a. IsLabel "legends" a => a
#legends (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second LegendOptions -> LegendOptions
fLegend))
  where
    fAxis :: AxisOptions -> AxisOptions
    fAxis :: AxisOptions -> AxisOptions
fAxis AxisOptions
a =
      AxisOptions
a
        forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over forall a. IsLabel "bar" a => a
#bar (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over (forall a. IsLabel "style" a => a
#style forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a. IsLabel "color" a => a
#color) Colour -> Colour
f))
        forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over
          (forall a. IsLabel "ticks" a => a
#ticks forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a. IsLabel "gtick" a => a
#gtick)
          (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over forall a. IsLabel "color" a => a
#color Colour -> Colour
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over forall a. IsLabel "borderColor" a => a
#borderColor Colour -> Colour
f)))
        forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over
          (forall a. IsLabel "ticks" a => a
#ticks forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a. IsLabel "ttick" a => a
#ttick)
          (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over forall a. IsLabel "color" a => a
#color Colour -> Colour
f)))
        forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over
          (forall a. IsLabel "ticks" a => a
#ticks forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a. IsLabel "ltick" a => a
#ltick)
          (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over forall a. IsLabel "color" a => a
#color Colour -> Colour
f)))
    fLegend :: LegendOptions -> LegendOptions
    fLegend :: LegendOptions -> LegendOptions
fLegend LegendOptions
a =
      LegendOptions
a
        forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over forall a. IsLabel "textStyle" a => a
#textStyle (forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over forall a. IsLabel "color" a => a
#color Colour -> Colour
f)
        forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over forall a. IsLabel "frame" a => a
#frame (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over forall a. IsLabel "color" a => a
#color Colour -> Colour
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over forall a. IsLabel "borderColor" a => a
#borderColor Colour -> Colour
f))
    fFrame :: FrameOptions -> FrameOptions
    fFrame :: FrameOptions -> FrameOptions
fFrame FrameOptions
a =
      FrameOptions
a
        forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over forall a. IsLabel "frame" a => a
#frame (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over forall a. IsLabel "color" a => a
#color Colour -> Colour
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over forall a. IsLabel "borderColor" a => a
#borderColor Colour -> Colour
f))

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

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

-- | The official axis
defaultAxisOptions :: AxisOptions
defaultAxisOptions :: AxisOptions
defaultAxisOptions = Maybe AxisBar -> Maybe Adjustments -> Ticks -> Place -> AxisOptions
AxisOptions (forall a. a -> Maybe a
Just AxisBar
defaultAxisBar) (forall a. a -> Maybe a
Just Adjustments
defaultAdjustments) Ticks
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 -> Double
size :: Double,
    AxisBar -> Double
buffer :: Double,
    -- | extension over the edges of the axis range
    AxisBar -> Double
overhang :: Double
  }
  deriving (Int -> AxisBar -> ShowS
[AxisBar] -> ShowS
AxisBar -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AxisBar] -> ShowS
$cshowList :: [AxisBar] -> ShowS
show :: AxisBar -> String
$cshow :: AxisBar -> String
showsPrec :: Int -> AxisBar -> ShowS
$cshowsPrec :: Int -> AxisBar -> ShowS
Show, AxisBar -> AxisBar -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AxisBar -> AxisBar -> Bool
$c/= :: AxisBar -> AxisBar -> Bool
== :: AxisBar -> AxisBar -> Bool
$c== :: AxisBar -> AxisBar -> Bool
Eq, forall x. Rep AxisBar x -> AxisBar
forall x. AxisBar -> Rep AxisBar x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AxisBar x -> AxisBar
$cfrom :: forall x. AxisBar -> Rep AxisBar x
Generic)

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

-- | 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 -> Double
buffer :: Double
  }
  deriving (Int -> Title -> ShowS
[Title] -> ShowS
Title -> String
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
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. 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 -> Double -> Title
Title
    Text
txt
    ( TextStyle
defaultTextStyle
        forall a b. a -> (a -> b) -> b
& forall a. IsLabel "size" a => a
#size forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Double
0.12
    )
    Place
PlaceTop
    Anchor
AnchorMiddle
    Double
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, Double)
gtick :: Maybe (GlyphStyle, Double),
    Ticks -> Maybe (TextStyle, Double)
ttick :: Maybe (TextStyle, Double),
    Ticks -> Maybe (LineStyle, Double)
ltick :: Maybe (LineStyle, Double)
  }
  deriving (Int -> Ticks -> ShowS
[Ticks] -> ShowS
Ticks -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Ticks] -> ShowS
$cshowList :: [Ticks] -> ShowS
show :: Ticks -> String
$cshow :: Ticks -> String
showsPrec :: Int -> Ticks -> ShowS
$cshowsPrec :: Int -> Ticks -> ShowS
Show, Ticks -> Ticks -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Ticks -> Ticks -> Bool
$c/= :: Ticks -> Ticks -> Bool
== :: Ticks -> Ticks -> Bool
$c== :: Ticks -> Ticks -> Bool
Eq, forall x. Rep Ticks x -> Ticks
forall x. Ticks -> Rep Ticks x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Ticks x -> Ticks
$cfrom :: forall x. Ticks -> Rep Ticks x
Generic)

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

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

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

-- | The official tick
defaultTicks :: Ticks
defaultTicks :: Ticks
defaultTicks =
  TickStyle
-> Maybe (GlyphStyle, Double)
-> Maybe (TextStyle, Double)
-> Maybe (LineStyle, Double)
-> Ticks
Ticks
    TickStyle
defaultTickStyle
    (forall a. a -> Maybe a
Just (GlyphStyle
defaultGlyphTick, Double
0.03))
    (forall a. a -> Maybe a
Just (TextStyle
defaultTextTick, Double
0.033))
    (forall a. a -> Maybe a
Just (LineStyle
defaultLineTick, Double
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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TickStyle] -> ShowS
$cshowList :: [TickStyle] -> ShowS
show :: TickStyle -> String
$cshow :: TickStyle -> String
showsPrec :: Int -> TickStyle -> ShowS
$cshowsPrec :: Int -> TickStyle -> ShowS
Show, TickStyle -> TickStyle -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TickStyle -> TickStyle -> Bool
$c/= :: TickStyle -> TickStyle -> Bool
== :: TickStyle -> TickStyle -> Bool
$c== :: TickStyle -> TickStyle -> Bool
Eq, forall x. Rep TickStyle x -> TickStyle
forall x. TickStyle -> Rep TickStyle x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TickStyle x -> TickStyle
$cfrom :: forall x. TickStyle -> Rep TickStyle x
Generic)

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

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

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

-- | Legend options
--
-- >>> defaultLegendOptions
-- LegendOptions {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 -> Double
size :: Double,
    LegendOptions -> Double
buffer :: Double,
    LegendOptions -> Double
vgap :: Double,
    LegendOptions -> Double
hgap :: Double,
    LegendOptions -> TextStyle
textStyle :: TextStyle,
    LegendOptions -> Double
innerPad :: Double,
    LegendOptions -> Double
outerPad :: Double,
    LegendOptions -> Maybe RectStyle
frame :: Maybe RectStyle,
    LegendOptions -> Place
place :: Place,
    LegendOptions -> Double
overallScale :: Double,
    LegendOptions -> [(Text, Chart)]
content :: [(Text, Chart)]
  }
  deriving (Int -> LegendOptions -> ShowS
[LegendOptions] -> ShowS
LegendOptions -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LegendOptions] -> ShowS
$cshowList :: [LegendOptions] -> ShowS
show :: LegendOptions -> String
$cshow :: LegendOptions -> String
showsPrec :: Int -> LegendOptions -> ShowS
$cshowsPrec :: Int -> LegendOptions -> ShowS
Show, LegendOptions -> LegendOptions -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LegendOptions -> LegendOptions -> Bool
$c/= :: LegendOptions -> LegendOptions -> Bool
== :: LegendOptions -> LegendOptions -> Bool
$c== :: LegendOptions -> LegendOptions -> Bool
Eq, forall x. Rep LegendOptions x -> LegendOptions
forall x. LegendOptions -> Rep LegendOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LegendOptions x -> LegendOptions
$cfrom :: forall x. LegendOptions -> Rep LegendOptions x
Generic)

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

-- | 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 forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "place" a => a
#place of
  Place
PlaceBottom -> AxisOptions
ac forall a b. a -> (a -> b) -> b
& forall a. IsLabel "place" a => a
#place forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Place
PlaceLeft
  Place
PlaceTop -> AxisOptions
ac forall a b. a -> (a -> b) -> b
& forall a. IsLabel "place" a => a
#place forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Place
PlaceRight
  Place
PlaceLeft -> AxisOptions
ac forall a b. a -> (a -> b) -> b
& forall a. IsLabel "place" a => a
#place forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Place
PlaceBottom
  Place
PlaceRight -> AxisOptions
ac forall a b. a -> (a -> b) -> b
& forall a. IsLabel "place" a => a
#place forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Place
PlaceTop
  PlaceAbsolute Point Double
_ -> 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 -> Double
buffer :: Double
  }
  deriving (FrameOptions -> FrameOptions -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FrameOptions -> FrameOptions -> Bool
$c/= :: FrameOptions -> FrameOptions -> Bool
== :: FrameOptions -> FrameOptions -> Bool
$c== :: FrameOptions -> FrameOptions -> Bool
Eq, Int -> FrameOptions -> ShowS
[FrameOptions] -> ShowS
FrameOptions -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FrameOptions] -> ShowS
$cshowList :: [FrameOptions] -> ShowS
show :: FrameOptions -> String
$cshow :: FrameOptions -> String
showsPrec :: Int -> FrameOptions -> ShowS
$cshowsPrec :: Int -> FrameOptions -> ShowS
Show, forall x. Rep FrameOptions x -> FrameOptions
forall x. FrameOptions -> Rep FrameOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FrameOptions x -> FrameOptions
$cfrom :: forall x. FrameOptions -> Rep FrameOptions x
Generic)

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

-- | Make a frame hud transformation.
frameHud :: FrameOptions -> State HudChart ChartTree
frameHud :: FrameOptions -> State HudChart ChartTree
frameHud FrameOptions
o = do
  HudChart
hc <- forall s (m :: * -> *). MonadState s m => m s
get
  let r :: Maybe DataBox
r = forall a. Subtractive a => a -> Rect a -> Rect a
padRect (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "buffer" a => a
#buffer FrameOptions
o) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Getter HudChart (Maybe DataBox)
hudStyleBox' HudChart
hc
  case Maybe DataBox
r of
    Maybe DataBox
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Chart] -> ChartTree
unnamed [])
    Just DataBox
r' -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ case forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "frame" a => a
#frame FrameOptions
o of
      Maybe 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 Double
x Double
z Double
y Double
w) (Rect Double
x' Double
z' Double
y' Double
w') =
  RectStyle -> [DataBox] -> Chart
RectChart (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "style" a => a
#style AxisBar
b) forall a b. (a -> b) -> a -> b
$
    case Place
pl of
      Place
PlaceTop ->
        [ forall a. a -> a -> a -> a -> Rect a
Rect
            (Double
x forall a. Num a => a -> a -> a
- AxisBar
b forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "overhang" a => a
#overhang)
            (Double
z forall a. Num a => a -> a -> a
+ AxisBar
b forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "overhang" a => a
#overhang)
            (Double
w' forall a. Num a => a -> a -> a
+ AxisBar
b forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "buffer" a => a
#buffer)
            (Double
w' forall a. Num a => a -> a -> a
+ AxisBar
b forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "buffer" a => a
#buffer forall a. Num a => a -> a -> a
+ AxisBar
b forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "size" a => a
#size)
        ]
      Place
PlaceBottom ->
        [ forall a. a -> a -> a -> a -> Rect a
Rect
            (Double
x forall a. Num a => a -> a -> a
- AxisBar
b forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "overhang" a => a
#overhang)
            (Double
z forall a. Num a => a -> a -> a
+ AxisBar
b forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "overhang" a => a
#overhang)
            (Double
y' forall a. Num a => a -> a -> a
- AxisBar
b forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "size" a => a
#size forall a. Num a => a -> a -> a
- AxisBar
b forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "buffer" a => a
#buffer)
            (Double
y' forall a. Num a => a -> a -> a
- AxisBar
b forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "buffer" a => a
#buffer)
        ]
      Place
PlaceLeft ->
        [ forall a. a -> a -> a -> a -> Rect a
Rect
            (Double
x' forall a. Num a => a -> a -> a
- AxisBar
b forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "size" a => a
#size forall a. Num a => a -> a -> a
- AxisBar
b forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "buffer" a => a
#buffer)
            (Double
x' forall a. Num a => a -> a -> a
- AxisBar
b forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "buffer" a => a
#buffer)
            (Double
y forall a. Num a => a -> a -> a
- AxisBar
b forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "overhang" a => a
#overhang)
            (Double
w forall a. Num a => a -> a -> a
+ AxisBar
b forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "overhang" a => a
#overhang)
        ]
      Place
PlaceRight ->
        [ forall a. a -> a -> a -> a -> Rect a
Rect
            (Double
z' forall a. Num a => a -> a -> a
+ (AxisBar
b forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "buffer" a => a
#buffer))
            (Double
z' forall a. Num a => a -> a -> a
+ (AxisBar
b forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "buffer" a => a
#buffer) forall a. Num a => a -> a -> a
+ (AxisBar
b forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "size" a => a
#size))
            (Double
y forall a. Num a => a -> a -> a
- AxisBar
b forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "overhang" a => a
#overhang)
            (Double
w forall a. Num a => a -> a -> a
+ AxisBar
b forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "overhang" a => a
#overhang)
        ]
      PlaceAbsolute (Point Double
x'' Double
_) ->
        [ forall a. a -> a -> a -> a -> Rect a
Rect
            (Double
x'' forall a. Num a => a -> a -> a
+ (AxisBar
b forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "buffer" a => a
#buffer))
            (Double
x'' forall a. Num a => a -> a -> a
+ (AxisBar
b forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "buffer" a => a
#buffer) forall a. Num a => a -> a -> a
+ (AxisBar
b forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "size" a => a
#size))
            (Double
y forall a. Num a => a -> a -> a
- AxisBar
b forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "overhang" a => a
#overhang)
            (Double
w forall a. Num a => a -> a -> a
+ AxisBar
b forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "overhang" a => a
#overhang)
        ]

makeAxisBar :: Place -> AxisBar -> State HudChart ChartTree
makeAxisBar :: Place -> AxisBar -> State HudChart ChartTree
makeAxisBar Place
pl AxisBar
b = do
  Maybe DataBox
cb <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (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 <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe DataBox
cb forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe DataBox
hb
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> [Chart] -> ChartTree
named Text
"axisbar" (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 Double)] -> Chart
TextChart
    (TextStyle
style' forall a b. a -> (a -> b) -> b
& forall a. IsLabel "rotation" a => a
#rotation forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ forall a. a -> a -> Bool -> a
bool (forall a. a -> Maybe a
Just Double
rot) forall a. Maybe a
Nothing (Double
rot forall a. Eq a => a -> a -> Bool
== Double
0))
    [(Title
t forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "text" a => a
#text, Point Double -> Point Double -> Point Double
addp (Title -> DataBox -> Point Double
placePosTitle Title
t DataBox
hb) (Title -> DataBox -> Point Double
alignPosTitle Title
t DataBox
hb))]
  where
    style' :: TextStyle
style'
      | Title
t forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "anchor" a => a
#anchor forall a. Eq a => a -> a -> Bool
== Anchor
AnchorStart =
        #anchor .~ AnchorStart $ t ^. #style
      | Title
t forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "anchor" a => a
#anchor forall a. Eq a => a -> a -> Bool
== Anchor
AnchorEnd =
        #anchor .~ AnchorEnd $ t ^. #style
      | Bool
otherwise = Title
t forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "style" a => a
#style
    rot' :: Double
rot' = forall a. a -> Maybe a -> a
fromMaybe Double
0 (Title
t forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "style" a => a
#style forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a. IsLabel "rotation" a => a
#rotation)
    rot :: Double
rot
      | Title
t forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "place" a => a
#place forall a. Eq a => a -> a -> Bool
== Place
PlaceRight = forall a. Floating a => a
pi forall a. Fractional a => a -> a -> a
/ Double
2 forall a. Num a => a -> a -> a
+ Double
rot'
      | Title
t forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "place" a => a
#place forall a. Eq a => a -> a -> Bool
== Place
PlaceLeft = forall a. Floating a => a
pi forall a. Fractional a => a -> a -> a
/ Double
2 forall a. Num a => a -> a -> a
+ Double
rot'
      | Bool
otherwise = Double
rot'

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

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

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

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

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

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

placeTextAnchor :: Place -> (TextStyle -> TextStyle)
placeTextAnchor :: Place -> TextStyle -> TextStyle
placeTextAnchor Place
pl
  | Place
pl forall a. Eq a => a -> a -> Bool
== Place
PlaceLeft = forall a. IsLabel "anchor" a => a
#anchor 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 forall a. Eq a => a -> a -> Bool
== Place
PlaceRight = forall a. IsLabel "anchor" a => a
#anchor 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 = forall a. a -> a
id

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

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

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

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

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

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

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

-- | aka grid lines
tickLine ::
  Place ->
  (LineStyle, Double) ->
  TickStyle ->
  State HudChart ChartTree
tickLine :: Place
-> (LineStyle, Double) -> TickStyle -> State HudChart ChartTree
tickLine Place
pl (LineStyle
ls, Double
b) TickStyle
ts = do
  Maybe DataBox
cb <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (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 <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "dataBox" a => a
#dataBox)
  case Maybe DataBox
cb of
    Maybe DataBox
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> [Chart] -> ChartTree
named Text
"ticklines" []
    Just DataBox
cb' -> do
      let l :: [[Point Double]]
l = (\Double
x -> Place -> DataBox -> Double -> Double -> [Point Double]
placeGridLines Place
pl DataBox
cb' Double
x Double
b) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst (TickStyle -> Place -> DataBox -> DataBox -> [(Double, Text)]
ticksPlacedCanvas TickStyle
ts Place
pl DataBox
cb' DataBox
db)
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> [Chart] -> ChartTree
named Text
"ticklines" (forall a. a -> a -> Bool -> a
bool [LineStyle -> [[Point Double]] -> Chart
LineChart LineStyle
ls [[Point Double]]
l] [] (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Point Double]]
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 <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty) (\(GlyphStyle, Double)
x -> Place
-> (GlyphStyle, Double) -> TickStyle -> State HudChart ChartTree
tickGlyph Place
pl (GlyphStyle, Double)
x (Ticks
t forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "style" a => a
#style)) (Ticks
t forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "gtick" a => a
#gtick)
  ChartTree
l <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty) (\(TextStyle, Double)
x -> Place
-> (TextStyle, Double) -> TickStyle -> State HudChart ChartTree
tickText Place
pl (TextStyle, Double)
x (Ticks
t forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "style" a => a
#style)) (Ticks
t forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "ttick" a => a
#ttick)
  ChartTree
t' <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty) (\(LineStyle, Double)
x -> Place
-> (LineStyle, Double) -> TickStyle -> State HudChart ChartTree
tickLine Place
pl (LineStyle, Double)
x (Ticks
t forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "style" a => a
#style)) (Ticks
t forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "ltick" a => a
#ltick)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Maybe Text -> [ChartTree] -> ChartTree
group (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 Double
mrx Double
ma Double
mry Bool
ad) DataBox
vb DataBox
cs Place
pl Ticks
t
  | Place
pl forall a. Eq a => a -> a -> Bool
== Place
PlaceBottom Bool -> Bool -> Bool
|| Place
pl forall a. Eq a => a -> a -> Bool
== Place
PlaceTop =
    if Bool
ad
      then
        ( case Double
adjustSizeX forall a. Ord a => a -> a -> Bool
> Double
1 of
            Bool
True ->
              ( case Place
pl of
                  Place
PlaceBottom -> forall a. IsLabel "ttick" a => a
#ttick forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall s t a b. Field1 s t a b => Lens s t a b
_1 forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a. IsLabel "anchor" a => a
#anchor 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 -> forall a. IsLabel "ttick" a => a
#ttick forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall s t a b. Field1 s t a b => Lens s t a b
_1 forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a. IsLabel "anchor" a => a
#anchor 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
_ -> forall a. IsLabel "ttick" a => a
#ttick forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall s t a b. Field1 s t a b => Lens s t a b
_1 forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a. IsLabel "anchor" a => a
#anchor forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Anchor
AnchorEnd
              )
                forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. IsLabel "ttick" a => a
#ttick forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall s t a b. Field1 s t a b => Lens s t a b
_1 forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a. IsLabel "size" a => a
#size forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ (forall a. Fractional a => a -> a -> a
/ Double
adjustSizeA))
                forall a b. (a -> b) -> a -> b
$ (forall a. IsLabel "ttick" a => a
#ttick forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall s t a b. Field1 s t a b => Lens s t a b
_1 forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a. IsLabel "rotation" a => a
#rotation forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a (Maybe b) -> b -> s -> t
?~ forall a. Floating a => a
pi forall a. Fractional a => a -> a -> a
/ Double
4) Ticks
t
            Bool
False -> (forall a. IsLabel "ttick" a => a
#ttick forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall s t a b. Field1 s t a b => Lens s t a b
_1 forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a. IsLabel "size" a => a
#size forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ (forall a. Fractional a => a -> a -> a
/ Double
adjustSizeA)) Ticks
t
        )
      else Ticks
t forall a b. a -> (a -> b) -> b
& forall a. IsLabel "ttick" a => a
#ttick forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall s t a b. Field1 s t a b => Lens s t a b
_1 forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a. IsLabel "size" a => a
#size forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ (forall a. Fractional a => a -> a -> a
/ Double
adjustSizeX)
  | Bool
otherwise -- pl `elem` [PlaceLeft, PlaceRight]
    =
    (forall a. IsLabel "ttick" a => a
#ttick forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall s t a b. Field1 s t a b => Lens s t a b
_1 forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a. IsLabel "size" a => a
#size forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ (forall a. Fractional a => a -> a -> a
/ Double
adjustSizeY)) Ticks
t
  where
    max' :: [a] -> a
max' [] = a
1
    max' [a]
xs = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [a]
xs
    ra :: Rect a -> Range a
ra (Rect a
x a
z a
y a
w)
      | Place
pl forall a. Eq a => a -> a -> Bool
== Place
PlaceTop Bool -> Bool -> Bool
|| Place
pl forall a. Eq a => a -> a -> Bool
== Place
PlaceBottom = forall a. a -> a -> Range a
Range a
x a
z
      | Bool
otherwise = forall a. a -> a -> Range a
Range a
y a
w
    asp :: Range Double
asp = forall {a}. Rect a -> Range a
ra DataBox
vb
    r :: Range Double
r = forall {a}. Rect a -> Range a
ra DataBox
cs
    tickl :: [Text]
tickl = forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TickStyle -> Range Double -> Range Double -> [(Double, Text)]
ticksR (Ticks
t forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "style" a => a
#style) Range Double
asp Range Double
r
    maxWidth :: Double
    maxWidth :: Double
maxWidth =
      forall b a. b -> (a -> b) -> Maybe a -> b
maybe
        Double
1
        ( \(TextStyle, Double)
tt ->
            forall {a}. (Num a, Ord a) => [a] -> a
max' forall a b. (a -> b) -> a -> b
$
              (\(Rect Double
x Double
z Double
_ Double
_) -> Double
z forall a. Num a => a -> a -> a
- Double
x)
                forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\Text
x -> TextStyle -> Text -> Point Double -> DataBox
styleBoxText (forall a b. (a, b) -> a
fst (TextStyle, Double)
tt) Text
x (forall a. a -> a -> Point a
Point Double
0 Double
0))
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
tickl
        )
        (Ticks
t forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "ttick" a => a
#ttick)
    maxHeight :: Double
maxHeight =
      forall b a. b -> (a -> b) -> Maybe a -> b
maybe
        Double
1
        ( \(TextStyle, Double)
tt ->
            forall {a}. (Num a, Ord a) => [a] -> a
max' forall a b. (a -> b) -> a -> b
$
              (\(Rect Double
_ Double
_ Double
y Double
w) -> Double
w forall a. Num a => a -> a -> a
- Double
y)
                forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\Text
x -> TextStyle -> Text -> Point Double -> DataBox
styleBoxText (forall a b. (a, b) -> a
fst (TextStyle, Double)
tt) Text
x (forall a. a -> a -> Point a
Point Double
0 Double
0))
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
tickl
        )
        (Ticks
t forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "ttick" a => a
#ttick)
    adjustSizeX :: Double
    adjustSizeX :: Double
adjustSizeX = forall a. Ord a => a -> a -> a
max ((Double
maxWidth forall a. Fractional a => a -> a -> a
/ (forall s. Space s => s -> Element s
upper Range Double
asp forall a. Num a => a -> a -> a
- forall s. Space s => s -> Element s
lower Range Double
asp)) forall a. Fractional a => a -> a -> a
/ Double
mrx) Double
1
    adjustSizeY :: Double
adjustSizeY = forall a. Ord a => a -> a -> a
max ((Double
maxHeight forall a. Fractional a => a -> a -> a
/ (forall s. Space s => s -> Element s
upper Range Double
asp forall a. Num a => a -> a -> a
- forall s. Space s => s -> Element s
lower Range Double
asp)) forall a. Fractional a => a -> a -> a
/ Double
mry) Double
1
    adjustSizeA :: Double
adjustSizeA = forall a. Ord a => a -> a -> a
max ((Double
maxHeight forall a. Fractional a => a -> a -> a
/ (forall s. Space s => s -> Element s
upper Range Double
asp forall a. Num a => a -> a -> a
- forall s. Space s => s -> Element s
lower Range Double
asp)) forall a. Fractional a => a -> a -> a
/ Double
ma) Double
1

makeTick :: AxisOptions -> State HudChart ChartTree
makeTick :: AxisOptions -> State HudChart ChartTree
makeTick AxisOptions
c = do
  Maybe DataBox
hb <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (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 <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "dataBox" a => a
#dataBox)
  case Maybe DataBox
hb of
    Maybe DataBox
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> [Chart] -> ChartTree
named Text
"ticks" [])
    Just DataBox
hb' -> do
      let adjTick :: Ticks
adjTick = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (AxisOptions
c forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "ticks" a => a
#ticks) (\Adjustments
x -> Adjustments -> DataBox -> DataBox -> Place -> Ticks -> Ticks
adjustTicks Adjustments
x DataBox
hb' DataBox
db (AxisOptions
c forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "place" a => a
#place) (AxisOptions
c forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "ticks" a => a
#ticks)) (AxisOptions
c forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "adjust" a => a
#adjust)
      Place -> Ticks -> State HudChart ChartTree
applyTicks (AxisOptions
c forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "place" a => a
#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 <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (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 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> [Chart] -> ChartTree
named Text
"legend" [])
    Just DataBox
sb' -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ LegendOptions -> DataBox -> ChartTree -> ChartTree
placeLegend LegendOptions
o DataBox
sb' (forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over Traversal' ChartTree Chart
chart' (Double -> Chart -> Chart
scaleChart (LegendOptions
o forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "overallScale" a => a
#overallScale)) ChartTree
lcs)

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

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

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

legendText ::
  LegendOptions ->
  Text ->
  Chart
legendText :: LegendOptions -> Text -> Chart
legendText LegendOptions
l Text
t =
  TextStyle -> [(Text, Point Double)] -> Chart
TextChart (LegendOptions
l forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "textStyle" a => a
#textStyle forall a b. a -> (a -> b) -> b
& forall a. IsLabel "anchor" a => a
#anchor 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, 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 [forall a. a -> a -> a -> a -> Rect a
Rect Double
0 (LegendOptions
l forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "size" a => a
#size) Double
0 (LegendOptions
l forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "size" a => a
#size)]
    (TextChart TextStyle
ts [(Text, Point Double)]
_) -> TextStyle -> [(Text, Point Double)] -> Chart
TextChart (TextStyle
ts forall a b. a -> (a -> b) -> b
& forall a. IsLabel "size" a => a
#size forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ (LegendOptions
l forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "size" a => a
#size)) [(Text
"text", forall a. Additive a => a
zero)]
    (GlyphChart GlyphStyle
gs [Point Double]
_) -> GlyphStyle -> [Point Double] -> Chart
GlyphChart (GlyphStyle
gs forall a b. a -> (a -> b) -> b
& forall a. IsLabel "size" a => a
#size forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ (LegendOptions
l forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "size" a => a
#size)) [forall a. a -> a -> Point a
Point (Double
0.5 forall a. Num a => a -> a -> a
* LegendOptions
l forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "size" a => a
#size) (Double
0.33 forall a. Num a => a -> a -> a
* LegendOptions
l forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "size" a => a
#size)]
    (LineChart LineStyle
ls [[Point Double]]
_) ->
      LineStyle -> [[Point Double]] -> Chart
LineChart
        (LineStyle
ls forall a b. a -> (a -> b) -> b
& forall a. IsLabel "size" a => a
#size forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ (forall a. Fractional a => a -> a -> a
/ (LegendOptions
l forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "overallScale" a => a
#overallScale)))
        [[forall a. a -> a -> Point a
Point Double
0 (Double
1 forall a. Num a => a -> a -> a
* LegendOptions
l forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "size" a => a
#size), forall a. a -> a -> Point a
Point (Double
2 forall a. Num a => a -> a -> a
* LegendOptions
l forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "size" a => a
#size) (Double
1 forall a. Num a => a -> a -> a
* LegendOptions
l forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "size" a => a
#size)]]
    (PathChart PathStyle
ps [PathData Double]
_) ->
      ( let cs :: [PathData Double]
cs =
              QuadPosition Double -> [PathData Double]
singletonQuad
                ( forall a. Point a -> Point a -> Point a -> QuadPosition a
QuadPosition
                    (forall a. a -> a -> Point a
Point Double
0 Double
0)
                    (forall a. a -> a -> Point a
Point (LegendOptions
l forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "size" a => a
#size) (LegendOptions
l forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "size" a => a
#size))
                    (forall a. a -> a -> Point a
Point (Double
2 forall a. Num a => a -> a -> a
* LegendOptions
l forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "size" a => a
#size) ((-Double
1) forall a. Num a => a -> a -> a
* LegendOptions
l forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "size" a => a
#size))
                )
         in PathStyle -> [PathData Double] -> Chart
PathChart (PathStyle
ps forall a b. a -> (a -> b) -> b
& forall a. IsLabel "borderSize" a => a
#borderSize forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ (LegendOptions
l forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "size" a => a
#size)) [PathData Double]
cs
      )
    (BlankChart [DataBox]
_) -> [DataBox] -> Chart
BlankChart [forall a. a -> a -> a -> a -> Rect a
Rect Double
0 (LegendOptions
l forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "size" a => a
#size) Double
0 (LegendOptions
l forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "size" a => a
#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
  )