{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NegativeLiterals #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RebindableSyntax #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -Wall #-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{-# OPTIONS_GHC -fno-warn-overlapping-patterns #-}
{-# OPTIONS_GHC -fno-warn-type-defaults #-}

-- | Chart API
module Chart.Types
  ( -- * Chart
    Chart (..),
    moveChart,
    projectXYs,
    projectXYsWith,
    projectArcPosition,

    -- * Annotation
    Annotation (..),
    annotationText,
    scaleAnn,
    scaleOpacAnn,
    colourAnn,
    padRect,

    -- * Styles
    RectStyle (..),
    defaultRectStyle,
    blob,
    clear,
    border,
    TextStyle (..),
    defaultTextStyle,
    GlyphStyle (..),
    defaultGlyphStyle,
    GlyphShape (..),
    glyphText,
    LineStyle (..),
    defaultLineStyle,
    LineCap (..),
    fromLineCap,
    toLineCap,
    LineJoin (..),
    fromLineJoin,
    toLineJoin,
    fromDashArray,
    Anchor (..),
    fromAnchor,
    toAnchor,
    PathStyle (..),
    toPathChart,
    defaultPathStyle,

    -- * Hud types
    ChartDims (..),
    HudT (..),
    Hud,
    simulHud,
    HudOptions (..),
    defaultHudOptions,
    colourHudOptions,
    scaleOpacHudOptions,
    defaultCanvas,
    runHudWith,
    runHud,
    makeHud,
    ChartAspect (..),
    toChartAspect,
    fromChartAspect,
    initialCanvas,
    chartAspectHud,
    canvas,
    title,
    tick,

    -- * Hud primitives
    AxisOptions (..),
    defaultAxisOptions,
    flipAxis,
    Place (..),
    placeText,
    AxisBar (..),
    defaultAxisBar,
    Title (..),
    defaultTitle,
    Tick (..),
    defaultGlyphTick,
    defaultTextTick,
    defaultLineTick,
    defaultTick,
    TickStyle (..),
    defaultTickStyle,
    tickStyleText,
    TickExtend (..),
    adjustTick,
    makeTickDates,
    makeTickDatesContinuous,
    Adjustments (..),
    defaultAdjustments,
    LegendOptions (..),
    defaultLegendOptions,
    legendHud,
    Orientation (..),
    fromOrientation,
    toOrientation,

    -- * SVG primitives
    CssOptions (..),
    SvgOptions (..),
    defaultSvgOptions,
    defaultSvgFrame,

    -- * Chart manipulation
    padChart,
    frameChart,
    frameAllCharts,
    hori,
    vert,
    stack,

    -- * Bounding box calculation
    padBox,
    dataBox,
    dataBoxes,
    dataBoxesS,
    styleBox,
    styleBoxes,
    styleBoxesS,
    styleBoxText,
    styleBoxGlyph,
  )
where

import Control.Lens
import Data.Colour
import Data.FormatN
import Data.Generics.Labels ()
import Data.Path
import qualified Data.Text as Text
import Data.Time
import NumHask.Prelude
import NumHask.Space as NH hiding (Element)
import Text.HTML.TagSoup hiding (Attribute)
import qualified Prelude as P

-- $setup
--
-- >>> :set -XOverloadedLabels
-- >>> :set -XNoImplicitPrelude
-- >>> -- import NumHask.Prelude
-- >>> import Control.Lens
-- >>> import Chart.Render

-- * Chart

-- | A `Chart` is annotated xy-data.
data Chart a = Chart
  { -- | annotation style for the data
    Chart a -> Annotation
annotation :: Annotation,
    -- | list of data elements, either points or rectangles.
    Chart a -> [XY a]
xys :: [XY a]
  }
  deriving (Chart a -> Chart a -> Bool
(Chart a -> Chart a -> Bool)
-> (Chart a -> Chart a -> Bool) -> Eq (Chart a)
forall a. Eq a => Chart a -> Chart a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Chart a -> Chart a -> Bool
$c/= :: forall a. Eq a => Chart a -> Chart a -> Bool
== :: Chart a -> Chart a -> Bool
$c== :: forall a. Eq a => Chart a -> Chart a -> Bool
Eq, Int -> Chart a -> ShowS
[Chart a] -> ShowS
Chart a -> String
(Int -> Chart a -> ShowS)
-> (Chart a -> String) -> ([Chart a] -> ShowS) -> Show (Chart a)
forall a. Show a => Int -> Chart a -> ShowS
forall a. Show a => [Chart a] -> ShowS
forall a. Show a => Chart a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Chart a] -> ShowS
$cshowList :: forall a. Show a => [Chart a] -> ShowS
show :: Chart a -> String
$cshow :: forall a. Show a => Chart a -> String
showsPrec :: Int -> Chart a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Chart a -> ShowS
Show, (forall x. Chart a -> Rep (Chart a) x)
-> (forall x. Rep (Chart a) x -> Chart a) -> Generic (Chart a)
forall x. Rep (Chart a) x -> Chart a
forall x. Chart a -> Rep (Chart a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Chart a) x -> Chart a
forall a x. Chart a -> Rep (Chart a) x
$cto :: forall a x. Rep (Chart a) x -> Chart a
$cfrom :: forall a x. Chart a -> Rep (Chart a) x
Generic)

-- | How data will be represented onscreen.
--
-- The definition of what might be an Annotation type is opinionated.
--
-- More complex combinations across Annotations can be constructed from combining charts.  See 'Chart.Example.glinesExample', 'Chart.Examples.lglyphExample' and "Chart.Bar" for examples.
--
-- There may be exceptions, but the approximate magnitude of annotation values are in reference to the size of the screen.  For example, a size of 0.01 (say), will means about 1% of the height and/or width of the screen height or width.
data Annotation
  = RectA RectStyle
  | TextA TextStyle [Text]
  | GlyphA GlyphStyle
  | LineA LineStyle
  | PathA PathStyle [PathInfo Double]
  | BlankA
  deriving (Annotation -> Annotation -> Bool
(Annotation -> Annotation -> Bool)
-> (Annotation -> Annotation -> Bool) -> Eq Annotation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Annotation -> Annotation -> Bool
$c/= :: Annotation -> Annotation -> Bool
== :: Annotation -> Annotation -> Bool
$c== :: Annotation -> Annotation -> Bool
Eq, Int -> Annotation -> ShowS
[Annotation] -> ShowS
Annotation -> String
(Int -> Annotation -> ShowS)
-> (Annotation -> String)
-> ([Annotation] -> ShowS)
-> Show Annotation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Annotation] -> ShowS
$cshowList :: [Annotation] -> ShowS
show :: Annotation -> String
$cshow :: Annotation -> String
showsPrec :: Int -> Annotation -> ShowS
$cshowsPrec :: Int -> Annotation -> ShowS
Show, (forall x. Annotation -> Rep Annotation x)
-> (forall x. Rep Annotation x -> Annotation) -> Generic Annotation
forall x. Rep Annotation x -> Annotation
forall x. Annotation -> Rep Annotation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Annotation x -> Annotation
$cfrom :: forall x. Annotation -> Rep Annotation x
Generic)

-- | textifier
annotationText :: Annotation -> Text
annotationText :: Annotation -> Text
annotationText (RectA RectStyle
_) = Text
"RectA"
annotationText TextA {} = Text
"TextA"
annotationText (GlyphA GlyphStyle
_) = Text
"GlyphA"
annotationText (LineA LineStyle
_) = Text
"LineA"
annotationText PathA {} = Text
"PathA"
annotationText Annotation
BlankA = Text
"BlankA"

-- | dim (or brighten) the opacity of an Annotation by a scale
scaleOpacAnn :: Double -> Annotation -> Annotation
scaleOpacAnn :: Double -> Annotation -> Annotation
scaleOpacAnn Double
x (RectA RectStyle
s) = RectStyle -> Annotation
RectA RectStyle
s'
  where
    s' :: RectStyle
s' = RectStyle
s RectStyle -> (RectStyle -> RectStyle) -> RectStyle
forall a b. a -> (a -> b) -> b
& (Colour -> Identity Colour) -> RectStyle -> Identity RectStyle
forall a. IsLabel "color" a => a
forall (x :: Symbol) a. IsLabel x a => a
#color ((Colour -> Identity Colour) -> RectStyle -> Identity RectStyle)
-> (Colour -> Colour) -> RectStyle -> RectStyle
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Double -> Colour -> Colour
scaleOpac Double
x RectStyle -> (RectStyle -> RectStyle) -> RectStyle
forall a b. a -> (a -> b) -> b
& (Colour -> Identity Colour) -> RectStyle -> Identity RectStyle
forall a. IsLabel "borderColor" a => a
forall (x :: Symbol) a. IsLabel x a => a
#borderColor ((Colour -> Identity Colour) -> RectStyle -> Identity RectStyle)
-> (Colour -> Colour) -> RectStyle -> RectStyle
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Double -> Colour -> Colour
scaleOpac Double
x
scaleOpacAnn Double
x (TextA TextStyle
s [Text]
ts) = TextStyle -> [Text] -> Annotation
TextA TextStyle
s' [Text]
ts
  where
    s' :: TextStyle
s' = TextStyle
s TextStyle -> (TextStyle -> TextStyle) -> TextStyle
forall a b. a -> (a -> b) -> b
& (Colour -> Identity Colour) -> TextStyle -> Identity TextStyle
forall a. IsLabel "color" a => a
forall (x :: Symbol) a. IsLabel x a => a
#color ((Colour -> Identity Colour) -> TextStyle -> Identity TextStyle)
-> (Colour -> Colour) -> TextStyle -> TextStyle
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Double -> Colour -> Colour
scaleOpac Double
x
scaleOpacAnn Double
x (LineA LineStyle
s) = LineStyle -> Annotation
LineA LineStyle
s'
  where
    s' :: LineStyle
s' = LineStyle
s LineStyle -> (LineStyle -> LineStyle) -> LineStyle
forall a b. a -> (a -> b) -> b
& (Colour -> Identity Colour) -> LineStyle -> Identity LineStyle
forall a. IsLabel "color" a => a
forall (x :: Symbol) a. IsLabel x a => a
#color ((Colour -> Identity Colour) -> LineStyle -> Identity LineStyle)
-> (Colour -> Colour) -> LineStyle -> LineStyle
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Double -> Colour -> Colour
scaleOpac Double
x
scaleOpacAnn Double
x (GlyphA GlyphStyle
s) = GlyphStyle -> Annotation
GlyphA GlyphStyle
s'
  where
    s' :: GlyphStyle
s' = GlyphStyle
s GlyphStyle -> (GlyphStyle -> GlyphStyle) -> GlyphStyle
forall a b. a -> (a -> b) -> b
& (Colour -> Identity Colour) -> GlyphStyle -> Identity GlyphStyle
forall a. IsLabel "color" a => a
forall (x :: Symbol) a. IsLabel x a => a
#color ((Colour -> Identity Colour) -> GlyphStyle -> Identity GlyphStyle)
-> (Colour -> Colour) -> GlyphStyle -> GlyphStyle
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Double -> Colour -> Colour
scaleOpac Double
x GlyphStyle -> (GlyphStyle -> GlyphStyle) -> GlyphStyle
forall a b. a -> (a -> b) -> b
& (Colour -> Identity Colour) -> GlyphStyle -> Identity GlyphStyle
forall a. IsLabel "borderColor" a => a
forall (x :: Symbol) a. IsLabel x a => a
#borderColor ((Colour -> Identity Colour) -> GlyphStyle -> Identity GlyphStyle)
-> (Colour -> Colour) -> GlyphStyle -> GlyphStyle
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Double -> Colour -> Colour
scaleOpac Double
x
scaleOpacAnn Double
x (PathA PathStyle
s [PathInfo Double]
pis) = PathStyle -> [PathInfo Double] -> Annotation
PathA PathStyle
s' [PathInfo Double]
pis
  where
    s' :: PathStyle
s' = PathStyle
s PathStyle -> (PathStyle -> PathStyle) -> PathStyle
forall a b. a -> (a -> b) -> b
& (Colour -> Identity Colour) -> PathStyle -> Identity PathStyle
forall a. IsLabel "color" a => a
forall (x :: Symbol) a. IsLabel x a => a
#color ((Colour -> Identity Colour) -> PathStyle -> Identity PathStyle)
-> (Colour -> Colour) -> PathStyle -> PathStyle
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Double -> Colour -> Colour
scaleOpac Double
x PathStyle -> (PathStyle -> PathStyle) -> PathStyle
forall a b. a -> (a -> b) -> b
& (Colour -> Identity Colour) -> PathStyle -> Identity PathStyle
forall a. IsLabel "borderColor" a => a
forall (x :: Symbol) a. IsLabel x a => a
#borderColor ((Colour -> Identity Colour) -> PathStyle -> Identity PathStyle)
-> (Colour -> Colour) -> PathStyle -> PathStyle
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Double -> Colour -> Colour
scaleOpac Double
x
scaleOpacAnn Double
_ Annotation
BlankA = Annotation
BlankA

scaleOpac :: Double -> Colour -> Colour
scaleOpac :: Double -> Colour -> Colour
scaleOpac Double
x (Colour Double
r Double
g Double
b Double
o') = Double -> Double -> Double -> Double -> Colour
Colour Double
r Double
g Double
b (Double
o' Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Double
x)

-- | select a main colour
colourAnn :: Colour -> Annotation -> Annotation
colourAnn :: Colour -> Annotation -> Annotation
colourAnn Colour
c (RectA RectStyle
s) = RectStyle -> Annotation
RectA RectStyle
s'
  where
    s' :: RectStyle
s' = RectStyle
s RectStyle -> (RectStyle -> RectStyle) -> RectStyle
forall a b. a -> (a -> b) -> b
& (Colour -> Identity Colour) -> RectStyle -> Identity RectStyle
forall a. IsLabel "color" a => a
forall (x :: Symbol) a. IsLabel x a => a
#color ((Colour -> Identity Colour) -> RectStyle -> Identity RectStyle)
-> (Colour -> Colour) -> RectStyle -> RectStyle
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Colour -> Colour -> Colour
mix Colour
c RectStyle -> (RectStyle -> RectStyle) -> RectStyle
forall a b. a -> (a -> b) -> b
& (Colour -> Identity Colour) -> RectStyle -> Identity RectStyle
forall a. IsLabel "borderColor" a => a
forall (x :: Symbol) a. IsLabel x a => a
#borderColor ((Colour -> Identity Colour) -> RectStyle -> Identity RectStyle)
-> (Colour -> Colour) -> RectStyle -> RectStyle
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Colour -> Colour -> Colour
mix Colour
c
colourAnn Colour
c (TextA TextStyle
s [Text]
ts) = TextStyle -> [Text] -> Annotation
TextA TextStyle
s' [Text]
ts
  where
    s' :: TextStyle
s' = TextStyle
s TextStyle -> (TextStyle -> TextStyle) -> TextStyle
forall a b. a -> (a -> b) -> b
& (Colour -> Identity Colour) -> TextStyle -> Identity TextStyle
forall a. IsLabel "color" a => a
forall (x :: Symbol) a. IsLabel x a => a
#color ((Colour -> Identity Colour) -> TextStyle -> Identity TextStyle)
-> (Colour -> Colour) -> TextStyle -> TextStyle
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Colour -> Colour -> Colour
mix Colour
c
colourAnn Colour
c (LineA LineStyle
s) = LineStyle -> Annotation
LineA LineStyle
s'
  where
    s' :: LineStyle
s' = LineStyle
s LineStyle -> (LineStyle -> LineStyle) -> LineStyle
forall a b. a -> (a -> b) -> b
& (Colour -> Identity Colour) -> LineStyle -> Identity LineStyle
forall a. IsLabel "color" a => a
forall (x :: Symbol) a. IsLabel x a => a
#color ((Colour -> Identity Colour) -> LineStyle -> Identity LineStyle)
-> (Colour -> Colour) -> LineStyle -> LineStyle
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Colour -> Colour -> Colour
mix Colour
c
colourAnn Colour
c (GlyphA GlyphStyle
s) = GlyphStyle -> Annotation
GlyphA GlyphStyle
s'
  where
    s' :: GlyphStyle
s' = GlyphStyle
s GlyphStyle -> (GlyphStyle -> GlyphStyle) -> GlyphStyle
forall a b. a -> (a -> b) -> b
& (Colour -> Identity Colour) -> GlyphStyle -> Identity GlyphStyle
forall a. IsLabel "color" a => a
forall (x :: Symbol) a. IsLabel x a => a
#color ((Colour -> Identity Colour) -> GlyphStyle -> Identity GlyphStyle)
-> (Colour -> Colour) -> GlyphStyle -> GlyphStyle
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Colour -> Colour -> Colour
mix Colour
c GlyphStyle -> (GlyphStyle -> GlyphStyle) -> GlyphStyle
forall a b. a -> (a -> b) -> b
& (Colour -> Identity Colour) -> GlyphStyle -> Identity GlyphStyle
forall a. IsLabel "borderColor" a => a
forall (x :: Symbol) a. IsLabel x a => a
#borderColor ((Colour -> Identity Colour) -> GlyphStyle -> Identity GlyphStyle)
-> (Colour -> Colour) -> GlyphStyle -> GlyphStyle
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Colour -> Colour -> Colour
mix Colour
c
colourAnn Colour
c (PathA PathStyle
s [PathInfo Double]
pis) = PathStyle -> [PathInfo Double] -> Annotation
PathA PathStyle
s' [PathInfo Double]
pis
  where
    s' :: PathStyle
s' = PathStyle
s PathStyle -> (PathStyle -> PathStyle) -> PathStyle
forall a b. a -> (a -> b) -> b
& (Colour -> Identity Colour) -> PathStyle -> Identity PathStyle
forall a. IsLabel "color" a => a
forall (x :: Symbol) a. IsLabel x a => a
#color ((Colour -> Identity Colour) -> PathStyle -> Identity PathStyle)
-> (Colour -> Colour) -> PathStyle -> PathStyle
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Colour -> Colour -> Colour
mix Colour
c PathStyle -> (PathStyle -> PathStyle) -> PathStyle
forall a b. a -> (a -> b) -> b
& (Colour -> Identity Colour) -> PathStyle -> Identity PathStyle
forall a. IsLabel "borderColor" a => a
forall (x :: Symbol) a. IsLabel x a => a
#borderColor ((Colour -> Identity Colour) -> PathStyle -> Identity PathStyle)
-> (Colour -> Colour) -> PathStyle -> PathStyle
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Colour -> Colour -> Colour
mix Colour
c
colourAnn Colour
_ Annotation
BlankA = Annotation
BlankA

-- | Rectangle styling
--
-- >>> defaultRectStyle
-- RectStyle {borderSize = 1.0e-2, borderColor = Colour 0.65 0.81 0.89 1.00, color = Colour 0.12 0.47 0.71 1.00}
--
-- ![unit example](other/unit.svg)
data RectStyle = RectStyle
  { RectStyle -> Double
borderSize :: Double,
    RectStyle -> Colour
borderColor :: Colour,
    RectStyle -> Colour
color :: Colour
  }
  deriving (Int -> RectStyle -> ShowS
[RectStyle] -> ShowS
RectStyle -> String
(Int -> RectStyle -> ShowS)
-> (RectStyle -> String)
-> ([RectStyle] -> ShowS)
-> Show RectStyle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RectStyle] -> ShowS
$cshowList :: [RectStyle] -> ShowS
show :: RectStyle -> String
$cshow :: RectStyle -> String
showsPrec :: Int -> RectStyle -> ShowS
$cshowsPrec :: Int -> RectStyle -> ShowS
Show, RectStyle -> RectStyle -> Bool
(RectStyle -> RectStyle -> Bool)
-> (RectStyle -> RectStyle -> Bool) -> Eq RectStyle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RectStyle -> RectStyle -> Bool
$c/= :: RectStyle -> RectStyle -> Bool
== :: RectStyle -> RectStyle -> Bool
$c== :: RectStyle -> RectStyle -> Bool
Eq, (forall x. RectStyle -> Rep RectStyle x)
-> (forall x. Rep RectStyle x -> RectStyle) -> Generic RectStyle
forall x. Rep RectStyle x -> RectStyle
forall x. RectStyle -> Rep RectStyle x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RectStyle x -> RectStyle
$cfrom :: forall x. RectStyle -> Rep RectStyle x
Generic)

-- | the style
defaultRectStyle :: RectStyle
defaultRectStyle :: RectStyle
defaultRectStyle = Double -> Colour -> Colour -> RectStyle
RectStyle Double
0.01 (Int -> Colour
palette1 Int
1) (Int -> Colour
palette1 Int
2)

-- | solid rectangle, no border
--
-- >>> blob black
-- RectStyle {borderSize = 0.0, borderColor = Colour 0.00 0.00 0.00 0.00, color = Colour 0.00 0.00 0.00 1.00}
blob :: Colour -> RectStyle
blob :: Colour -> RectStyle
blob = Double -> Colour -> Colour -> RectStyle
RectStyle Double
0 Colour
transparent

-- | transparent rect
--
-- >>> clear
-- RectStyle {borderSize = 0.0, borderColor = Colour 0.00 0.00 0.00 0.00, color = Colour 0.00 0.00 0.00 0.00}
clear :: RectStyle
clear :: RectStyle
clear = Double -> Colour -> Colour -> RectStyle
RectStyle Double
0 Colour
transparent Colour
transparent

-- | transparent rectangle, with border
--
-- >>> border 0.01 transparent
-- RectStyle {borderSize = 1.0e-2, borderColor = Colour 0.00 0.00 0.00 0.00, color = Colour 0.00 0.00 0.00 0.00}
border :: Double -> Colour -> RectStyle
border :: Double -> Colour -> RectStyle
border Double
s Colour
c = Double -> Colour -> Colour -> RectStyle
RectStyle Double
s Colour
c Colour
transparent

-- | Text styling
--
-- >>> defaultTextStyle
-- TextStyle {size = 8.0e-2, color = Colour 0.05 0.05 0.05 1.00, anchor = AnchorMiddle, hsize = 0.5, vsize = 1.45, nudge1 = -0.2, rotation = Nothing}
--
-- >>> let t = zipWith (\x y -> Chart (TextA (defaultTextStyle & (#size .~ (0.05 :: Double))) [x]) [PointXY y]) (fmap Text.singleton ['a' .. 'y']) [Point (sin (x * 0.1)) x | x <- [0 .. 25]]
--
-- ![text example](other/text.svg)
data TextStyle = TextStyle
  { TextStyle -> Double
size :: Double,
    TextStyle -> Colour
color :: Colour,
    TextStyle -> Anchor
anchor :: Anchor,
    TextStyle -> Double
hsize :: Double,
    TextStyle -> Double
vsize :: Double,
    TextStyle -> Double
nudge1 :: Double,
    TextStyle -> Maybe Double
rotation :: Maybe Double
  }
  deriving (Int -> TextStyle -> ShowS
[TextStyle] -> ShowS
TextStyle -> String
(Int -> TextStyle -> ShowS)
-> (TextStyle -> String)
-> ([TextStyle] -> ShowS)
-> Show TextStyle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TextStyle] -> ShowS
$cshowList :: [TextStyle] -> ShowS
show :: TextStyle -> String
$cshow :: TextStyle -> String
showsPrec :: Int -> TextStyle -> ShowS
$cshowsPrec :: Int -> TextStyle -> ShowS
Show, TextStyle -> TextStyle -> Bool
(TextStyle -> TextStyle -> Bool)
-> (TextStyle -> TextStyle -> Bool) -> Eq TextStyle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TextStyle -> TextStyle -> Bool
$c/= :: TextStyle -> TextStyle -> Bool
== :: TextStyle -> TextStyle -> Bool
$c== :: TextStyle -> TextStyle -> Bool
Eq, (forall x. TextStyle -> Rep TextStyle x)
-> (forall x. Rep TextStyle x -> TextStyle) -> Generic TextStyle
forall x. Rep TextStyle x -> TextStyle
forall x. TextStyle -> Rep TextStyle x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TextStyle x -> TextStyle
$cfrom :: forall x. TextStyle -> Rep TextStyle x
Generic)

-- | position anchor
data Anchor = AnchorMiddle | AnchorStart | AnchorEnd deriving (Anchor -> Anchor -> Bool
(Anchor -> Anchor -> Bool)
-> (Anchor -> Anchor -> Bool) -> Eq Anchor
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Anchor -> Anchor -> Bool
$c/= :: Anchor -> Anchor -> Bool
== :: Anchor -> Anchor -> Bool
$c== :: Anchor -> Anchor -> Bool
Eq, Int -> Anchor -> ShowS
[Anchor] -> ShowS
Anchor -> String
(Int -> Anchor -> ShowS)
-> (Anchor -> String) -> ([Anchor] -> ShowS) -> Show Anchor
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Anchor] -> ShowS
$cshowList :: [Anchor] -> ShowS
show :: Anchor -> String
$cshow :: Anchor -> String
showsPrec :: Int -> Anchor -> ShowS
$cshowsPrec :: Int -> Anchor -> ShowS
Show, (forall x. Anchor -> Rep Anchor x)
-> (forall x. Rep Anchor x -> Anchor) -> Generic Anchor
forall x. Rep Anchor x -> Anchor
forall x. Anchor -> Rep Anchor x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Anchor x -> Anchor
$cfrom :: forall x. Anchor -> Rep Anchor x
Generic)

-- | text
fromAnchor :: (IsString s) => Anchor -> s
fromAnchor :: Anchor -> s
fromAnchor Anchor
AnchorMiddle = s
"Middle"
fromAnchor Anchor
AnchorStart = s
"Start"
fromAnchor Anchor
AnchorEnd = s
"End"

-- | from text
toAnchor :: (Eq s, IsString s) => s -> Anchor
toAnchor :: s -> Anchor
toAnchor s
"Middle" = Anchor
AnchorMiddle
toAnchor s
"Start" = Anchor
AnchorStart
toAnchor s
"End" = Anchor
AnchorEnd
toAnchor s
_ = Anchor
AnchorMiddle

-- | the offical text style
defaultTextStyle :: TextStyle
defaultTextStyle :: TextStyle
defaultTextStyle =
  Double
-> Colour
-> Anchor
-> Double
-> Double
-> Double
-> Maybe Double
-> TextStyle
TextStyle Double
0.08 Colour
dark Anchor
AnchorMiddle Double
0.5 Double
1.45 Double
-0.2 Maybe Double
forall a. Maybe a
Nothing

-- | Glyph styling
--
-- >>> defaultGlyphStyle
-- GlyphStyle {size = 3.0e-2, color = Colour 0.65 0.81 0.89 1.00, borderColor = Colour 0.12 0.47 0.71 1.00, borderSize = 3.0e-3, shape = SquareGlyph, rotation = Nothing, translate = Nothing}
--
-- ![glyph example](other/glyphs.svg)
data GlyphStyle = GlyphStyle
  { -- | glyph radius
    GlyphStyle -> Double
size :: Double,
    -- | fill color
    GlyphStyle -> Colour
color :: Colour,
    -- | stroke color
    GlyphStyle -> Colour
borderColor :: Colour,
    -- | stroke width (adds a bit to the bounding box)
    GlyphStyle -> Double
borderSize :: Double,
    GlyphStyle -> GlyphShape
shape :: GlyphShape,
    GlyphStyle -> Maybe Double
rotation :: Maybe Double,
    GlyphStyle -> Maybe (Point Double)
translate :: Maybe (Point Double)
  }
  deriving (Int -> GlyphStyle -> ShowS
[GlyphStyle] -> ShowS
GlyphStyle -> String
(Int -> GlyphStyle -> ShowS)
-> (GlyphStyle -> String)
-> ([GlyphStyle] -> ShowS)
-> Show GlyphStyle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GlyphStyle] -> ShowS
$cshowList :: [GlyphStyle] -> ShowS
show :: GlyphStyle -> String
$cshow :: GlyphStyle -> String
showsPrec :: Int -> GlyphStyle -> ShowS
$cshowsPrec :: Int -> GlyphStyle -> ShowS
Show, GlyphStyle -> GlyphStyle -> Bool
(GlyphStyle -> GlyphStyle -> Bool)
-> (GlyphStyle -> GlyphStyle -> Bool) -> Eq GlyphStyle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GlyphStyle -> GlyphStyle -> Bool
$c/= :: GlyphStyle -> GlyphStyle -> Bool
== :: GlyphStyle -> GlyphStyle -> Bool
$c== :: GlyphStyle -> GlyphStyle -> Bool
Eq, (forall x. GlyphStyle -> Rep GlyphStyle x)
-> (forall x. Rep GlyphStyle x -> GlyphStyle) -> Generic GlyphStyle
forall x. Rep GlyphStyle x -> GlyphStyle
forall x. GlyphStyle -> Rep GlyphStyle x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GlyphStyle x -> GlyphStyle
$cfrom :: forall x. GlyphStyle -> Rep GlyphStyle x
Generic)

-- | the offical glyph style
defaultGlyphStyle :: GlyphStyle
defaultGlyphStyle :: GlyphStyle
defaultGlyphStyle =
  Double
-> Colour
-> Colour
-> Double
-> GlyphShape
-> Maybe Double
-> Maybe (Point Double)
-> GlyphStyle
GlyphStyle
    Double
0.03
    (Int -> Colour
palette1 Int
1)
    (Int -> Colour
palette1 Int
2)
    Double
0.003
    GlyphShape
SquareGlyph
    Maybe Double
forall a. Maybe a
Nothing
    Maybe (Point Double)
forall a. Maybe a
Nothing

-- | glyph shapes
data GlyphShape
  = CircleGlyph
  | SquareGlyph
  | EllipseGlyph Double
  | RectSharpGlyph Double
  | RectRoundedGlyph Double Double Double
  | TriangleGlyph (Point Double) (Point Double) (Point Double)
  | VLineGlyph Double
  | HLineGlyph Double
  | PathGlyph Text
  deriving (Int -> GlyphShape -> ShowS
[GlyphShape] -> ShowS
GlyphShape -> String
(Int -> GlyphShape -> ShowS)
-> (GlyphShape -> String)
-> ([GlyphShape] -> ShowS)
-> Show GlyphShape
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GlyphShape] -> ShowS
$cshowList :: [GlyphShape] -> ShowS
show :: GlyphShape -> String
$cshow :: GlyphShape -> String
showsPrec :: Int -> GlyphShape -> ShowS
$cshowsPrec :: Int -> GlyphShape -> ShowS
Show, GlyphShape -> GlyphShape -> Bool
(GlyphShape -> GlyphShape -> Bool)
-> (GlyphShape -> GlyphShape -> Bool) -> Eq GlyphShape
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GlyphShape -> GlyphShape -> Bool
$c/= :: GlyphShape -> GlyphShape -> Bool
== :: GlyphShape -> GlyphShape -> Bool
$c== :: GlyphShape -> GlyphShape -> Bool
Eq, (forall x. GlyphShape -> Rep GlyphShape x)
-> (forall x. Rep GlyphShape x -> GlyphShape) -> Generic GlyphShape
forall x. Rep GlyphShape x -> GlyphShape
forall x. GlyphShape -> Rep GlyphShape x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GlyphShape x -> GlyphShape
$cfrom :: forall x. GlyphShape -> Rep GlyphShape x
Generic)

-- | textifier
glyphText :: GlyphShape -> Text
glyphText :: GlyphShape -> Text
glyphText GlyphShape
sh =
  case GlyphShape
sh of
    GlyphShape
CircleGlyph -> Text
"Circle"
    GlyphShape
SquareGlyph -> Text
"Square"
    TriangleGlyph {} -> Text
"Triangle"
    EllipseGlyph Double
_ -> Text
"Ellipse"
    RectSharpGlyph Double
_ -> Text
"RectSharp"
    RectRoundedGlyph {} -> Text
"RectRounded"
    VLineGlyph Double
_ -> Text
"VLine"
    HLineGlyph Double
_ -> Text
"HLine"
    PathGlyph Text
_ -> Text
"Path"

-- | line cap style
data LineCap = LineCapButt | LineCapRound | LineCapSquare deriving (LineCap -> LineCap -> Bool
(LineCap -> LineCap -> Bool)
-> (LineCap -> LineCap -> Bool) -> Eq LineCap
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LineCap -> LineCap -> Bool
$c/= :: LineCap -> LineCap -> Bool
== :: LineCap -> LineCap -> Bool
$c== :: LineCap -> LineCap -> Bool
Eq, Int -> LineCap -> ShowS
[LineCap] -> ShowS
LineCap -> String
(Int -> LineCap -> ShowS)
-> (LineCap -> String) -> ([LineCap] -> ShowS) -> Show LineCap
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LineCap] -> ShowS
$cshowList :: [LineCap] -> ShowS
show :: LineCap -> String
$cshow :: LineCap -> String
showsPrec :: Int -> LineCap -> ShowS
$cshowsPrec :: Int -> LineCap -> ShowS
Show, (forall x. LineCap -> Rep LineCap x)
-> (forall x. Rep LineCap x -> LineCap) -> Generic LineCap
forall x. Rep LineCap x -> LineCap
forall x. LineCap -> Rep LineCap x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LineCap x -> LineCap
$cfrom :: forall x. LineCap -> Rep LineCap x
Generic)

-- | textifier
fromLineCap :: (IsString s) => LineCap -> s
fromLineCap :: LineCap -> s
fromLineCap LineCap
LineCapButt = s
"butt"
fromLineCap LineCap
LineCapRound = s
"round"
fromLineCap LineCap
LineCapSquare = s
"square"

-- | readifier
toLineCap :: (Eq s, IsString s) => s -> LineCap
toLineCap :: s -> LineCap
toLineCap s
"butt" = LineCap
LineCapButt
toLineCap s
"round" = LineCap
LineCapRound
toLineCap s
"square" = LineCap
LineCapSquare
toLineCap s
_ = LineCap
LineCapButt

-- | line cap style
data LineJoin = LineJoinMiter | LineJoinBevel | LineJoinRound deriving (LineJoin -> LineJoin -> Bool
(LineJoin -> LineJoin -> Bool)
-> (LineJoin -> LineJoin -> Bool) -> Eq LineJoin
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LineJoin -> LineJoin -> Bool
$c/= :: LineJoin -> LineJoin -> Bool
== :: LineJoin -> LineJoin -> Bool
$c== :: LineJoin -> LineJoin -> Bool
Eq, Int -> LineJoin -> ShowS
[LineJoin] -> ShowS
LineJoin -> String
(Int -> LineJoin -> ShowS)
-> (LineJoin -> String) -> ([LineJoin] -> ShowS) -> Show LineJoin
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LineJoin] -> ShowS
$cshowList :: [LineJoin] -> ShowS
show :: LineJoin -> String
$cshow :: LineJoin -> String
showsPrec :: Int -> LineJoin -> ShowS
$cshowsPrec :: Int -> LineJoin -> ShowS
Show, (forall x. LineJoin -> Rep LineJoin x)
-> (forall x. Rep LineJoin x -> LineJoin) -> Generic LineJoin
forall x. Rep LineJoin x -> LineJoin
forall x. LineJoin -> Rep LineJoin x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LineJoin x -> LineJoin
$cfrom :: forall x. LineJoin -> Rep LineJoin x
Generic)

-- | textifier
fromLineJoin :: (IsString s) => LineJoin -> s
fromLineJoin :: LineJoin -> s
fromLineJoin LineJoin
LineJoinMiter = s
"miter"
fromLineJoin LineJoin
LineJoinBevel = s
"bevel"
fromLineJoin LineJoin
LineJoinRound = s
"round"

-- | readifier
toLineJoin :: (Eq s, IsString s) => s -> LineJoin
toLineJoin :: s -> LineJoin
toLineJoin s
"miter" = LineJoin
LineJoinMiter
toLineJoin s
"bevel" = LineJoin
LineJoinBevel
toLineJoin s
"round" = LineJoin
LineJoinRound
toLineJoin s
_ = LineJoin
LineJoinMiter

-- | Convert a dash representation from a list to text
fromDashArray :: [Double] -> Text
fromDashArray :: [Double] -> Text
fromDashArray [Double]
xs = Text -> [Text] -> Text
Text.intercalate Text
" " ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Double -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show (Double -> Text) -> [Double] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Double]
xs

-- | line style
--
-- >>> defaultLineStyle
-- LineStyle {width = 1.2e-2, color = Colour 0.05 0.05 0.05 1.00, linecap = Nothing, linejoin = Nothing, dasharray = Nothing, dashoffset = Nothing}
--
-- ![line example](other/line.svg)
--
-- See also <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute>
data LineStyle = LineStyle
  { LineStyle -> Double
width :: Double,
    LineStyle -> Colour
color :: Colour,
    LineStyle -> Maybe LineCap
linecap :: Maybe LineCap,
    LineStyle -> Maybe LineJoin
linejoin :: Maybe LineJoin,
    LineStyle -> Maybe [Double]
dasharray :: Maybe [Double],
    LineStyle -> Maybe Double
dashoffset :: Maybe Double
  }
  deriving (Int -> LineStyle -> ShowS
[LineStyle] -> ShowS
LineStyle -> String
(Int -> LineStyle -> ShowS)
-> (LineStyle -> String)
-> ([LineStyle] -> ShowS)
-> Show LineStyle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LineStyle] -> ShowS
$cshowList :: [LineStyle] -> ShowS
show :: LineStyle -> String
$cshow :: LineStyle -> String
showsPrec :: Int -> LineStyle -> ShowS
$cshowsPrec :: Int -> LineStyle -> ShowS
Show, LineStyle -> LineStyle -> Bool
(LineStyle -> LineStyle -> Bool)
-> (LineStyle -> LineStyle -> Bool) -> Eq LineStyle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LineStyle -> LineStyle -> Bool
$c/= :: LineStyle -> LineStyle -> Bool
== :: LineStyle -> LineStyle -> Bool
$c== :: LineStyle -> LineStyle -> Bool
Eq, (forall x. LineStyle -> Rep LineStyle x)
-> (forall x. Rep LineStyle x -> LineStyle) -> Generic LineStyle
forall x. Rep LineStyle x -> LineStyle
forall x. LineStyle -> Rep LineStyle x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LineStyle x -> LineStyle
$cfrom :: forall x. LineStyle -> Rep LineStyle x
Generic)

-- | the official default line style
defaultLineStyle :: LineStyle
defaultLineStyle :: LineStyle
defaultLineStyle = Double
-> Colour
-> Maybe LineCap
-> Maybe LineJoin
-> Maybe [Double]
-> Maybe Double
-> LineStyle
LineStyle Double
0.012 Colour
dark Maybe LineCap
forall a. Maybe a
Nothing Maybe LineJoin
forall a. Maybe a
Nothing Maybe [Double]
forall a. Maybe a
Nothing Maybe Double
forall a. Maybe a
Nothing

-- | Path styling
--
-- >>> defaultPathStyle
-- PathStyle {borderSize = 1.0e-2, borderColor = Colour 0.65 0.81 0.89 1.00, color = Colour 0.12 0.47 0.71 1.00}
data PathStyle = PathStyle
  { PathStyle -> Double
borderSize :: Double,
    PathStyle -> Colour
borderColor :: Colour,
    PathStyle -> Colour
color :: Colour
  }
  deriving (Int -> PathStyle -> ShowS
[PathStyle] -> ShowS
PathStyle -> String
(Int -> PathStyle -> ShowS)
-> (PathStyle -> String)
-> ([PathStyle] -> ShowS)
-> Show PathStyle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PathStyle] -> ShowS
$cshowList :: [PathStyle] -> ShowS
show :: PathStyle -> String
$cshow :: PathStyle -> String
showsPrec :: Int -> PathStyle -> ShowS
$cshowsPrec :: Int -> PathStyle -> ShowS
Show, PathStyle -> PathStyle -> Bool
(PathStyle -> PathStyle -> Bool)
-> (PathStyle -> PathStyle -> Bool) -> Eq PathStyle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PathStyle -> PathStyle -> Bool
$c/= :: PathStyle -> PathStyle -> Bool
== :: PathStyle -> PathStyle -> Bool
$c== :: PathStyle -> PathStyle -> Bool
Eq, (forall x. PathStyle -> Rep PathStyle x)
-> (forall x. Rep PathStyle x -> PathStyle) -> Generic PathStyle
forall x. Rep PathStyle x -> PathStyle
forall x. PathStyle -> Rep PathStyle x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PathStyle x -> PathStyle
$cfrom :: forall x. PathStyle -> Rep PathStyle x
Generic)

-- | the style
defaultPathStyle :: PathStyle
defaultPathStyle :: PathStyle
defaultPathStyle =
  Double -> Colour -> Colour -> PathStyle
PathStyle Double
0.01 (Int -> Colour
palette1 Int
1) (Int -> Colour
palette1 Int
2)

-- | Convert from a path command list to a PathA chart
toPathChart :: PathStyle -> [(PathInfo Double, Point Double)] -> Chart Double
toPathChart :: PathStyle -> [(PathInfo Double, Point Double)] -> Chart Double
toPathChart PathStyle
ps [(PathInfo Double, Point Double)]
xs = Annotation -> [XY Double] -> Chart Double
forall a. Annotation -> [XY a] -> Chart a
Chart (PathStyle -> [PathInfo Double] -> Annotation
PathA PathStyle
ps ((PathInfo Double, Point Double) -> PathInfo Double
forall a b. (a, b) -> a
fst ((PathInfo Double, Point Double) -> PathInfo Double)
-> [(PathInfo Double, Point Double)] -> [PathInfo Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(PathInfo Double, Point Double)]
xs)) (Point Double -> XY Double
forall a. Point a -> XY a
PointXY (Point Double -> XY Double)
-> ((PathInfo Double, Point Double) -> Point Double)
-> (PathInfo Double, Point Double)
-> XY Double
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (PathInfo Double, Point Double) -> Point Double
forall a b. (a, b) -> b
snd ((PathInfo Double, Point Double) -> XY Double)
-> [(PathInfo Double, Point Double)] -> [XY Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(PathInfo Double, Point Double)]
xs)

-- | Verticle or Horizontal
data Orientation = Vert | Hori deriving (Orientation -> Orientation -> Bool
(Orientation -> Orientation -> Bool)
-> (Orientation -> Orientation -> Bool) -> Eq Orientation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Orientation -> Orientation -> Bool
$c/= :: Orientation -> Orientation -> Bool
== :: Orientation -> Orientation -> Bool
$c== :: Orientation -> Orientation -> Bool
Eq, Int -> Orientation -> ShowS
[Orientation] -> ShowS
Orientation -> String
(Int -> Orientation -> ShowS)
-> (Orientation -> String)
-> ([Orientation] -> ShowS)
-> Show Orientation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Orientation] -> ShowS
$cshowList :: [Orientation] -> ShowS
show :: Orientation -> String
$cshow :: Orientation -> String
showsPrec :: Int -> Orientation -> ShowS
$cshowsPrec :: Int -> Orientation -> ShowS
Show, (forall x. Orientation -> Rep Orientation x)
-> (forall x. Rep Orientation x -> Orientation)
-> Generic Orientation
forall x. Rep Orientation x -> Orientation
forall x. Orientation -> Rep Orientation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Orientation x -> Orientation
$cfrom :: forall x. Orientation -> Rep Orientation x
Generic)

-- | textifier
fromOrientation :: (IsString s) => Orientation -> s
fromOrientation :: Orientation -> s
fromOrientation Orientation
Hori = s
"Hori"
fromOrientation Orientation
Vert = s
"Vert"

-- | readifier
toOrientation :: (Eq s, IsString s) => s -> Orientation
toOrientation :: s -> Orientation
toOrientation s
"Hori" = Orientation
Hori
toOrientation s
"Vert" = Orientation
Vert
toOrientation s
_ = Orientation
Hori

-- | additive padding
padRect :: (Num a) => a -> Rect a -> Rect a
padRect :: a -> Rect a -> Rect a
padRect a
p (Rect a
x a
z a
y a
w) = a -> a -> a -> a -> Rect a
forall a. a -> a -> a -> a -> Rect a
Rect (a
x a -> a -> a
forall a. Num a => a -> a -> a
P.- a
p) (a
z a -> a -> a
forall a. Num a => a -> a -> a
P.+ a
p) (a
y a -> a -> a
forall a. Num a => a -> a -> a
P.- a
p) (a
w a -> a -> a
forall a. Num a => a -> a -> a
P.+ a
p)

-- |
data CssOptions = UseGeometricPrecision | UseCssCrisp | NoCssOptions deriving (Int -> CssOptions -> ShowS
[CssOptions] -> ShowS
CssOptions -> String
(Int -> CssOptions -> ShowS)
-> (CssOptions -> String)
-> ([CssOptions] -> ShowS)
-> Show CssOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CssOptions] -> ShowS
$cshowList :: [CssOptions] -> ShowS
show :: CssOptions -> String
$cshow :: CssOptions -> String
showsPrec :: Int -> CssOptions -> ShowS
$cshowsPrec :: Int -> CssOptions -> ShowS
Show, CssOptions -> CssOptions -> Bool
(CssOptions -> CssOptions -> Bool)
-> (CssOptions -> CssOptions -> Bool) -> Eq CssOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CssOptions -> CssOptions -> Bool
$c/= :: CssOptions -> CssOptions -> Bool
== :: CssOptions -> CssOptions -> Bool
$c== :: CssOptions -> CssOptions -> Bool
Eq, (forall x. CssOptions -> Rep CssOptions x)
-> (forall x. Rep CssOptions x -> CssOptions) -> Generic CssOptions
forall x. Rep CssOptions x -> CssOptions
forall x. CssOptions -> Rep CssOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CssOptions x -> CssOptions
$cfrom :: forall x. CssOptions -> Rep CssOptions x
Generic)

-- | The basis for the x-y ratio of the final chart
--
-- Default style features tend towards assuming that the usual height of the overall svg image is around 1, and ChartAspect is based on this assumption, so that a ChartAspect of "FixedAspect 1.5", say, means a height of 1 and a width of 1.5.
data ChartAspect
  = -- | Rescale charts to a fixed x-y ratio, inclusive of hud and style features
    FixedAspect Double
  | -- | Rescale charts to an overall height of 1, preserving the x-y ratio of the data canvas.
    CanvasAspect Double
  | -- | Rescale charts to a height of 1, preserving the existing x-y ratio of the underlying charts, inclusive of hud and style.
    ChartAspect
  | -- | Do not rescale.
    UnadjustedAspect
  deriving (Int -> ChartAspect -> ShowS
[ChartAspect] -> ShowS
ChartAspect -> String
(Int -> ChartAspect -> ShowS)
-> (ChartAspect -> String)
-> ([ChartAspect] -> ShowS)
-> Show ChartAspect
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChartAspect] -> ShowS
$cshowList :: [ChartAspect] -> ShowS
show :: ChartAspect -> String
$cshow :: ChartAspect -> String
showsPrec :: Int -> ChartAspect -> ShowS
$cshowsPrec :: Int -> ChartAspect -> ShowS
Show, ChartAspect -> ChartAspect -> Bool
(ChartAspect -> ChartAspect -> Bool)
-> (ChartAspect -> ChartAspect -> Bool) -> Eq ChartAspect
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChartAspect -> ChartAspect -> Bool
$c/= :: ChartAspect -> ChartAspect -> Bool
== :: ChartAspect -> ChartAspect -> Bool
$c== :: ChartAspect -> ChartAspect -> Bool
Eq, (forall x. ChartAspect -> Rep ChartAspect x)
-> (forall x. Rep ChartAspect x -> ChartAspect)
-> Generic ChartAspect
forall x. Rep ChartAspect x -> ChartAspect
forall x. ChartAspect -> Rep ChartAspect x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ChartAspect x -> ChartAspect
$cfrom :: forall x. ChartAspect -> Rep ChartAspect x
Generic)

-- | textifier
fromChartAspect :: (IsString s) => ChartAspect -> s
fromChartAspect :: ChartAspect -> s
fromChartAspect (FixedAspect Double
_) = s
"FixedAspect"
fromChartAspect (CanvasAspect Double
_) = s
"CanvasAspect"
fromChartAspect ChartAspect
ChartAspect = s
"ChartAspect"
fromChartAspect ChartAspect
UnadjustedAspect = s
"UnadjustedAspect"

-- | readifier
toChartAspect :: (Eq s, IsString s) => s -> Double -> ChartAspect
toChartAspect :: s -> Double -> ChartAspect
toChartAspect s
"FixedAspect" Double
a = Double -> ChartAspect
FixedAspect Double
a
toChartAspect s
"CanvasAspect" Double
a = Double -> ChartAspect
CanvasAspect Double
a
toChartAspect s
"ChartAspect" Double
_ = ChartAspect
ChartAspect
toChartAspect s
"UnadjustedAspect" Double
_ = ChartAspect
UnadjustedAspect
toChartAspect s
_ Double
_ = ChartAspect
ChartAspect

-- | calculation of the canvas given the 'ChartAspect'
initialCanvas :: ChartAspect -> [Chart Double] -> Rect Double
initialCanvas :: ChartAspect -> [Chart Double] -> Rect Double
initialCanvas (FixedAspect Double
a) [Chart Double]
_ = Double -> Rect Double
aspect Double
a
initialCanvas (CanvasAspect Double
a) [Chart Double]
_ = Double -> Rect Double
aspect Double
a
initialCanvas ChartAspect
ChartAspect [Chart Double]
cs = Double -> Rect Double
aspect (Double -> Rect Double) -> Double -> Rect Double
forall a b. (a -> b) -> a -> b
$ Rect Double -> Double
forall a. Field a => Rect a -> a
ratio (Rect Double -> Double) -> Rect Double -> Double
forall a b. (a -> b) -> a -> b
$ [Chart Double] -> Rect Double
styleBoxesS [Chart Double]
cs
initialCanvas ChartAspect
UnadjustedAspect [Chart Double]
cs = [Chart Double] -> Rect Double
dataBoxesS [Chart Double]
cs

-- | SVG tag options.
--
-- >>> defaultSvgOptions
-- SvgOptions {svgHeight = 300.0, outerPad = Just 2.0e-2, innerPad = Nothing, chartFrame = Nothing, cssOptions = NoCssOptions, chartAspect = FixedAspect 1.5, background = Nothing}
--
--
-- ![svgoptions example](other/svgoptions.svg)
data SvgOptions = SvgOptions
  { SvgOptions -> Double
svgHeight :: Double,
    SvgOptions -> Maybe Double
outerPad :: Maybe Double,
    SvgOptions -> Maybe Double
innerPad :: Maybe Double,
    SvgOptions -> Maybe RectStyle
chartFrame :: Maybe RectStyle,
    SvgOptions -> CssOptions
cssOptions :: CssOptions,
    SvgOptions -> ChartAspect
chartAspect :: ChartAspect,
    SvgOptions -> Maybe Colour
background :: Maybe Colour
  }
  deriving (SvgOptions -> SvgOptions -> Bool
(SvgOptions -> SvgOptions -> Bool)
-> (SvgOptions -> SvgOptions -> Bool) -> Eq SvgOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SvgOptions -> SvgOptions -> Bool
$c/= :: SvgOptions -> SvgOptions -> Bool
== :: SvgOptions -> SvgOptions -> Bool
$c== :: SvgOptions -> SvgOptions -> Bool
Eq, Int -> SvgOptions -> ShowS
[SvgOptions] -> ShowS
SvgOptions -> String
(Int -> SvgOptions -> ShowS)
-> (SvgOptions -> String)
-> ([SvgOptions] -> ShowS)
-> Show SvgOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SvgOptions] -> ShowS
$cshowList :: [SvgOptions] -> ShowS
show :: SvgOptions -> String
$cshow :: SvgOptions -> String
showsPrec :: Int -> SvgOptions -> ShowS
$cshowsPrec :: Int -> SvgOptions -> ShowS
Show, (forall x. SvgOptions -> Rep SvgOptions x)
-> (forall x. Rep SvgOptions x -> SvgOptions) -> Generic SvgOptions
forall x. Rep SvgOptions x -> SvgOptions
forall x. SvgOptions -> Rep SvgOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SvgOptions x -> SvgOptions
$cfrom :: forall x. SvgOptions -> Rep SvgOptions x
Generic)

-- | The official svg options
defaultSvgOptions :: SvgOptions
defaultSvgOptions :: SvgOptions
defaultSvgOptions = Double
-> Maybe Double
-> Maybe Double
-> Maybe RectStyle
-> CssOptions
-> ChartAspect
-> Maybe Colour
-> SvgOptions
SvgOptions Double
300 (Double -> Maybe Double
forall a. a -> Maybe a
Just Double
0.02) Maybe Double
forall a. Maybe a
Nothing Maybe RectStyle
forall a. Maybe a
Nothing CssOptions
NoCssOptions (Double -> ChartAspect
FixedAspect Double
1.5) Maybe Colour
forall a. Maybe a
Nothing

-- | frame style
defaultSvgFrame :: RectStyle
defaultSvgFrame :: RectStyle
defaultSvgFrame = Double -> Colour -> RectStyle
border Double
0.01 Colour
dark

-- | Dimensions that are tracked in the 'HudT':
--
-- - chartDim: the rectangular dimension of the physical representation of a chart on the screen so that new hud elements can be appended. Adding a hud piece tends to expand the chart dimension.
--
-- - canvasDim: the rectangular dimension of the canvas on which data will be represented. At times appending a hud element will cause the canvas dimension to shift.
--
-- - dataDim: the rectangular dimension of the data being represented. Adding hud elements can cause this to change.
data ChartDims a = ChartDims
  { ChartDims a -> Rect a
chartDim :: Rect a,
    ChartDims a -> Rect a
canvasDim :: Rect a,
    ChartDims a -> Rect a
dataDim :: Rect a
  }
  deriving (ChartDims a -> ChartDims a -> Bool
(ChartDims a -> ChartDims a -> Bool)
-> (ChartDims a -> ChartDims a -> Bool) -> Eq (ChartDims a)
forall a. Eq a => ChartDims a -> ChartDims a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChartDims a -> ChartDims a -> Bool
$c/= :: forall a. Eq a => ChartDims a -> ChartDims a -> Bool
== :: ChartDims a -> ChartDims a -> Bool
$c== :: forall a. Eq a => ChartDims a -> ChartDims a -> Bool
Eq, Int -> ChartDims a -> ShowS
[ChartDims a] -> ShowS
ChartDims a -> String
(Int -> ChartDims a -> ShowS)
-> (ChartDims a -> String)
-> ([ChartDims a] -> ShowS)
-> Show (ChartDims a)
forall a. Show a => Int -> ChartDims a -> ShowS
forall a. Show a => [ChartDims a] -> ShowS
forall a. Show a => ChartDims a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChartDims a] -> ShowS
$cshowList :: forall a. Show a => [ChartDims a] -> ShowS
show :: ChartDims a -> String
$cshow :: forall a. Show a => ChartDims a -> String
showsPrec :: Int -> ChartDims a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> ChartDims a -> ShowS
Show, (forall x. ChartDims a -> Rep (ChartDims a) x)
-> (forall x. Rep (ChartDims a) x -> ChartDims a)
-> Generic (ChartDims a)
forall x. Rep (ChartDims a) x -> ChartDims a
forall x. ChartDims a -> Rep (ChartDims a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (ChartDims a) x -> ChartDims a
forall a x. ChartDims a -> Rep (ChartDims a) x
$cto :: forall a x. Rep (ChartDims a) x -> ChartDims a
$cfrom :: forall a x. ChartDims a -> Rep (ChartDims a) x
Generic)

-- | Hud monad transformer
newtype HudT m a = Hud {HudT m a -> [Chart a] -> StateT (ChartDims a) m [Chart a]
unhud :: [Chart a] -> StateT (ChartDims a) m [Chart a]}

-- | Heads-Up-Display for a 'Chart'
type Hud = HudT Identity

instance (Monad m) => Semigroup (HudT m a) where
  <> :: HudT m a -> HudT m a -> HudT m a
(<>) (Hud [Chart a] -> StateT (ChartDims a) m [Chart a]
h1) (Hud [Chart a] -> StateT (ChartDims a) m [Chart a]
h2) = ([Chart a] -> StateT (ChartDims a) m [Chart a]) -> HudT m a
forall (m :: * -> *) a.
([Chart a] -> StateT (ChartDims a) m [Chart a]) -> HudT m a
Hud (([Chart a] -> StateT (ChartDims a) m [Chart a]) -> HudT m a)
-> ([Chart a] -> StateT (ChartDims a) m [Chart a]) -> HudT m a
forall a b. (a -> b) -> a -> b
$ [Chart a] -> StateT (ChartDims a) m [Chart a]
h1 ([Chart a] -> StateT (ChartDims a) m [Chart a])
-> ([Chart a] -> StateT (ChartDims a) m [Chart a])
-> [Chart a]
-> StateT (ChartDims a) m [Chart a]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> [Chart a] -> StateT (ChartDims a) m [Chart a]
h2

instance (Monad m) => Monoid (HudT m a) where
  mempty :: HudT m a
mempty = ([Chart a] -> StateT (ChartDims a) m [Chart a]) -> HudT m a
forall (m :: * -> *) a.
([Chart a] -> StateT (ChartDims a) m [Chart a]) -> HudT m a
Hud [Chart a] -> StateT (ChartDims a) m [Chart a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | run two hud's simultaneously (using the same original ChartDims state) rather than sequentially (which is the <> operation).
simulHud :: (Ord a, Monad m) => HudT m a -> HudT m a -> HudT m a
simulHud :: HudT m a -> HudT m a -> HudT m a
simulHud (Hud [Chart a] -> StateT (ChartDims a) m [Chart a]
fa) (Hud [Chart a] -> StateT (ChartDims a) m [Chart a]
fb) = ([Chart a] -> StateT (ChartDims a) m [Chart a]) -> HudT m a
forall (m :: * -> *) a.
([Chart a] -> StateT (ChartDims a) m [Chart a]) -> HudT m a
Hud (([Chart a] -> StateT (ChartDims a) m [Chart a]) -> HudT m a)
-> ([Chart a] -> StateT (ChartDims a) m [Chart a]) -> HudT m a
forall a b. (a -> b) -> a -> b
$ \[Chart a]
cs -> do
  ChartDims a
s <- StateT (ChartDims a) m (ChartDims a)
forall s (m :: * -> *). MonadState s m => m s
get
  ([Chart a]
cs', ChartDims Rect a
ch Rect a
ca Rect a
d) <- m ([Chart a], ChartDims a)
-> StateT (ChartDims a) m ([Chart a], ChartDims a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ([Chart a], ChartDims a)
 -> StateT (ChartDims a) m ([Chart a], ChartDims a))
-> m ([Chart a], ChartDims a)
-> StateT (ChartDims a) m ([Chart a], ChartDims a)
forall a b. (a -> b) -> a -> b
$ StateT (ChartDims a) m [Chart a]
-> ChartDims a -> m ([Chart a], ChartDims a)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT ([Chart a] -> StateT (ChartDims a) m [Chart a]
fa [Chart a]
cs) ChartDims a
s
  ([Chart a]
cs'', ChartDims Rect a
ch' Rect a
ca' Rect a
d') <- m ([Chart a], ChartDims a)
-> StateT (ChartDims a) m ([Chart a], ChartDims a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ([Chart a], ChartDims a)
 -> StateT (ChartDims a) m ([Chart a], ChartDims a))
-> m ([Chart a], ChartDims a)
-> StateT (ChartDims a) m ([Chart a], ChartDims a)
forall a b. (a -> b) -> a -> b
$ StateT (ChartDims a) m [Chart a]
-> ChartDims a -> m ([Chart a], ChartDims a)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT ([Chart a] -> StateT (ChartDims a) m [Chart a]
fb [Chart a]
cs') ChartDims a
s
  ChartDims a -> StateT (ChartDims a) m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Rect a -> Rect a -> Rect a -> ChartDims a
forall a. Rect a -> Rect a -> Rect a -> ChartDims a
ChartDims (Rect a
ch Rect a -> Rect a -> Rect a
forall a. Semigroup a => a -> a -> a
<> Rect a
ch') (Rect a
ca Rect a -> Rect a -> Rect a
forall a. Semigroup a => a -> a -> a
<> Rect a
ca') (Rect a
d Rect a -> Rect a -> Rect a
forall a. Semigroup a => a -> a -> a
<> Rect a
d'))
  [Chart a] -> StateT (ChartDims a) m [Chart a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Chart a]
cs''

-- | Project the chart data given the ChartAspect
chartAspectHud :: (Monad m) => ChartAspect -> HudT m Double
chartAspectHud :: ChartAspect -> HudT m Double
chartAspectHud ChartAspect
fa = ([Chart Double] -> StateT (ChartDims Double) m [Chart Double])
-> HudT m Double
forall (m :: * -> *) a.
([Chart a] -> StateT (ChartDims a) m [Chart a]) -> HudT m a
Hud (([Chart Double] -> StateT (ChartDims Double) m [Chart Double])
 -> HudT m Double)
-> ([Chart Double] -> StateT (ChartDims Double) m [Chart Double])
-> HudT m Double
forall a b. (a -> b) -> a -> b
$ \[Chart Double]
cs -> do
  Rect Double
canvasd <- Getting (Rect Double) (ChartDims Double) (Rect Double)
-> StateT (ChartDims Double) m (Rect Double)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (Rect Double) (ChartDims Double) (Rect Double)
forall a. IsLabel "canvasDim" a => a
forall (x :: Symbol) a. IsLabel x a => a
#canvasDim
  Rect Double
chartd <- Getting (Rect Double) (ChartDims Double) (Rect Double)
-> StateT (ChartDims Double) m (Rect Double)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (Rect Double) (ChartDims Double) (Rect Double)
forall a. IsLabel "chartDim" a => a
forall (x :: Symbol) a. IsLabel x a => a
#chartDim
  case ChartAspect
fa of
    FixedAspect Double
a -> [Chart Double] -> StateT (ChartDims Double) m [Chart Double]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Chart Double] -> StateT (ChartDims Double) m [Chart Double])
-> [Chart Double] -> StateT (ChartDims Double) m [Chart Double]
forall a b. (a -> b) -> a -> b
$ Rect Double -> [Chart Double] -> [Chart Double]
projectXYs (Double -> Rect Double
aspect Double
a) [Chart Double]
cs
    CanvasAspect Double
a ->
      [Chart Double] -> StateT (ChartDims Double) m [Chart Double]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Chart Double] -> StateT (ChartDims Double) m [Chart Double])
-> [Chart Double] -> StateT (ChartDims Double) m [Chart Double]
forall a b. (a -> b) -> a -> b
$
        Rect Double -> [Chart Double] -> [Chart Double]
projectXYs (Double -> Rect Double
aspect (Double
a Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Rect Double -> Double
forall a. Field a => Rect a -> a
ratio Rect Double
canvasd Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ Rect Double -> Double
forall a. Field a => Rect a -> a
ratio Rect Double
chartd)) [Chart Double]
cs
    ChartAspect
ChartAspect -> [Chart Double] -> StateT (ChartDims Double) m [Chart Double]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Chart Double] -> StateT (ChartDims Double) m [Chart Double])
-> [Chart Double] -> StateT (ChartDims Double) m [Chart Double]
forall a b. (a -> b) -> a -> b
$ Rect Double -> [Chart Double] -> [Chart Double]
projectXYs (Double -> Rect Double
aspect (Double -> Rect Double) -> Double -> Rect Double
forall a b. (a -> b) -> a -> b
$ Rect Double -> Double
forall a. Field a => Rect a -> a
ratio Rect Double
chartd) [Chart Double]
cs
    ChartAspect
UnadjustedAspect -> [Chart Double] -> StateT (ChartDims Double) m [Chart Double]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Chart Double]
cs

-- | 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 (and the use of a linear type is an open question).
runHudWith ::
  -- | initial canvas dimension
  Rect Double ->
  -- | initial data dimension
  Rect Double ->
  -- | huds to add
  [Hud Double] ->
  -- | underlying chart
  [Chart Double] ->
  -- | integrated chart list
  [Chart Double]
runHudWith :: Rect Double
-> Rect Double -> [Hud Double] -> [Chart Double] -> [Chart Double]
runHudWith Rect Double
ca Rect Double
xs [Hud Double]
hs [Chart Double]
cs =
  State (ChartDims Double) [Chart Double]
-> ChartDims Double -> [Chart Double]
forall s a. State s a -> s -> a
evalState
    ((Hud Double
-> [Chart Double] -> State (ChartDims Double) [Chart Double]
forall (m :: * -> *) a.
HudT m a -> [Chart a] -> StateT (ChartDims a) m [Chart a]
unhud (Hud Double
 -> [Chart Double] -> State (ChartDims Double) [Chart Double])
-> Hud Double
-> [Chart Double]
-> State (ChartDims Double) [Chart Double]
forall a b. (a -> b) -> a -> b
$ [Hud Double] -> Hud Double
forall a. Monoid a => [a] -> a
mconcat [Hud Double]
hs) [Chart Double]
cs')
    (Rect Double -> Rect Double -> Rect Double -> ChartDims Double
forall a. Rect a -> Rect a -> Rect a -> ChartDims a
ChartDims Rect Double
ca' Rect Double
da' Rect Double
xs)
  where
    da' :: Rect Double
da' = Rect Double -> Maybe (Rect Double) -> Rect Double
forall a. a -> Maybe a -> a
fromMaybe Rect Double
forall a. Multiplicative a => a
one (Maybe (Rect Double) -> Rect Double)
-> Maybe (Rect Double) -> Rect Double
forall a b. (a -> b) -> a -> b
$ [Chart Double] -> Maybe (Rect Double)
dataBoxes [Chart Double]
cs'
    ca' :: Rect Double
ca' = Rect Double -> Maybe (Rect Double) -> Rect Double
forall a. a -> Maybe a -> a
fromMaybe Rect Double
forall a. Multiplicative a => a
one (Maybe (Rect Double) -> Rect Double)
-> Maybe (Rect Double) -> Rect Double
forall a b. (a -> b) -> a -> b
$ [Chart Double] -> Maybe (Rect Double)
styleBoxes [Chart Double]
cs'
    cs' :: [Chart Double]
cs' = Rect Double -> Rect Double -> [Chart Double] -> [Chart Double]
projectXYsWith Rect Double
ca Rect Double
xs [Chart Double]
cs

-- | Combine huds and charts to form a new [Chart] using the supplied canvas and the actual data dimension.
--
-- Note that the original chart data are transformed and irrevocably lost by this computation.
runHud ::
  -- | initial canvas dimension
  Rect Double ->
  -- | huds
  [Hud Double] ->
  -- | underlying charts
  [Chart Double] ->
  -- | integrated chart list
  [Chart Double]
runHud :: Rect Double -> [Hud Double] -> [Chart Double] -> [Chart Double]
runHud Rect Double
ca [Hud Double]
hs [Chart Double]
cs = Rect Double
-> Rect Double -> [Hud Double] -> [Chart Double] -> [Chart Double]
runHudWith Rect Double
ca (Maybe (Rect Double) -> Rect Double
padBox (Maybe (Rect Double) -> Rect Double)
-> Maybe (Rect Double) -> Rect Double
forall a b. (a -> b) -> a -> b
$ [Chart Double] -> Maybe (Rect Double)
dataBoxes [Chart Double]
cs) [Hud Double]
hs [Chart Double]
cs

-- | Typical configurable hud elements. Anything else can be hand-coded as a 'HudT'.
--
-- ![hud example](other/hudoptions.svg)
data HudOptions = HudOptions
  { HudOptions -> Maybe RectStyle
hudCanvas :: Maybe RectStyle,
    HudOptions -> [Title]
hudTitles :: [Title],
    HudOptions -> [AxisOptions]
hudAxes :: [AxisOptions],
    HudOptions -> Maybe (LegendOptions, [(Annotation, Text)])
hudLegend :: Maybe (LegendOptions, [(Annotation, Text)])
  }
  deriving (HudOptions -> HudOptions -> Bool
(HudOptions -> HudOptions -> Bool)
-> (HudOptions -> HudOptions -> Bool) -> Eq HudOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HudOptions -> HudOptions -> Bool
$c/= :: HudOptions -> HudOptions -> Bool
== :: HudOptions -> HudOptions -> Bool
$c== :: HudOptions -> HudOptions -> Bool
Eq, Int -> HudOptions -> ShowS
[HudOptions] -> ShowS
HudOptions -> String
(Int -> HudOptions -> ShowS)
-> (HudOptions -> String)
-> ([HudOptions] -> ShowS)
-> Show HudOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HudOptions] -> ShowS
$cshowList :: [HudOptions] -> ShowS
show :: HudOptions -> String
$cshow :: HudOptions -> String
showsPrec :: Int -> HudOptions -> ShowS
$cshowsPrec :: Int -> HudOptions -> ShowS
Show, (forall x. HudOptions -> Rep HudOptions x)
-> (forall x. Rep HudOptions x -> HudOptions) -> Generic HudOptions
forall x. Rep HudOptions x -> HudOptions
forall x. HudOptions -> Rep HudOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HudOptions x -> HudOptions
$cfrom :: forall x. HudOptions -> Rep HudOptions x
Generic)

instance Semigroup HudOptions where
  <> :: HudOptions -> HudOptions -> HudOptions
(<>) (HudOptions Maybe RectStyle
c [Title]
t [AxisOptions]
a Maybe (LegendOptions, [(Annotation, Text)])
l) (HudOptions Maybe RectStyle
c' [Title]
t' [AxisOptions]
a' Maybe (LegendOptions, [(Annotation, Text)])
l') =
    Maybe RectStyle
-> [Title]
-> [AxisOptions]
-> Maybe (LegendOptions, [(Annotation, Text)])
-> HudOptions
HudOptions ([RectStyle] -> Maybe RectStyle
forall a. [a] -> Maybe a
listToMaybe ([RectStyle] -> Maybe RectStyle) -> [RectStyle] -> Maybe RectStyle
forall a b. (a -> b) -> a -> b
$ [Maybe RectStyle] -> [RectStyle]
forall a. [Maybe a] -> [a]
catMaybes [Maybe RectStyle
c, Maybe RectStyle
c']) ([Title]
t [Title] -> [Title] -> [Title]
forall a. Semigroup a => a -> a -> a
<> [Title]
t') ([AxisOptions]
a [AxisOptions] -> [AxisOptions] -> [AxisOptions]
forall a. Semigroup a => a -> a -> a
<> [AxisOptions]
a') ([(LegendOptions, [(Annotation, Text)])]
-> Maybe (LegendOptions, [(Annotation, Text)])
forall a. [a] -> Maybe a
listToMaybe ([(LegendOptions, [(Annotation, Text)])]
 -> Maybe (LegendOptions, [(Annotation, Text)]))
-> [(LegendOptions, [(Annotation, Text)])]
-> Maybe (LegendOptions, [(Annotation, Text)])
forall a b. (a -> b) -> a -> b
$ [Maybe (LegendOptions, [(Annotation, Text)])]
-> [(LegendOptions, [(Annotation, Text)])]
forall a. [Maybe a] -> [a]
catMaybes [Maybe (LegendOptions, [(Annotation, Text)])
l, Maybe (LegendOptions, [(Annotation, Text)])
l'])

instance Monoid HudOptions where
  mempty :: HudOptions
mempty = Maybe RectStyle
-> [Title]
-> [AxisOptions]
-> Maybe (LegendOptions, [(Annotation, Text)])
-> HudOptions
HudOptions Maybe RectStyle
forall a. Maybe a
Nothing [] [] Maybe (LegendOptions, [(Annotation, Text)])
forall a. Maybe a
Nothing

-- | The official hud options.
defaultHudOptions :: HudOptions
defaultHudOptions :: HudOptions
defaultHudOptions =
  Maybe RectStyle
-> [Title]
-> [AxisOptions]
-> Maybe (LegendOptions, [(Annotation, Text)])
-> HudOptions
HudOptions
    (RectStyle -> Maybe RectStyle
forall a. a -> Maybe a
Just RectStyle
defaultCanvas)
    []
    [ AxisOptions
defaultAxisOptions,
      AxisOptions
defaultAxisOptions AxisOptions -> (AxisOptions -> AxisOptions) -> AxisOptions
forall a b. a -> (a -> b) -> b
& (Place -> Identity Place) -> AxisOptions -> Identity AxisOptions
forall a. IsLabel "place" a => a
forall (x :: Symbol) a. IsLabel x a => a
#place ((Place -> Identity Place) -> AxisOptions -> Identity AxisOptions)
-> Place -> AxisOptions -> AxisOptions
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Place
PlaceLeft
    ]
    Maybe (LegendOptions, [(Annotation, Text)])
forall a. Maybe a
Nothing

-- | alter the colour
colourHudOptions :: Colour -> HudOptions -> HudOptions
colourHudOptions :: Colour -> HudOptions -> HudOptions
colourHudOptions Colour
c HudOptions
ho =
  HudOptions
ho
    HudOptions -> (HudOptions -> HudOptions) -> HudOptions
forall a b. a -> (a -> b) -> b
& (Maybe RectStyle -> Identity (Maybe RectStyle))
-> HudOptions -> Identity HudOptions
forall a. IsLabel "hudCanvas" a => a
forall (x :: Symbol) a. IsLabel x a => a
#hudCanvas ((Maybe RectStyle -> Identity (Maybe RectStyle))
 -> HudOptions -> Identity HudOptions)
-> (Maybe RectStyle -> Maybe RectStyle) -> HudOptions -> HudOptions
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (RectStyle -> RectStyle) -> Maybe RectStyle -> Maybe RectStyle
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Colour -> Identity Colour) -> RectStyle -> Identity RectStyle
forall a. IsLabel "color" a => a
forall (x :: Symbol) a. IsLabel x a => a
#color ((Colour -> Identity Colour) -> RectStyle -> Identity RectStyle)
-> (Colour -> Colour) -> RectStyle -> RectStyle
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Colour -> Colour -> Colour
mix Colour
c)
    HudOptions -> (HudOptions -> HudOptions) -> HudOptions
forall a b. a -> (a -> b) -> b
& ([Title] -> Identity [Title]) -> HudOptions -> Identity HudOptions
forall a. IsLabel "hudTitles" a => a
forall (x :: Symbol) a. IsLabel x a => a
#hudTitles (([Title] -> Identity [Title])
 -> HudOptions -> Identity HudOptions)
-> ([Title] -> [Title]) -> HudOptions -> HudOptions
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Title -> Title) -> [Title] -> [Title]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((TextStyle -> Identity TextStyle) -> Title -> Identity Title
forall a. IsLabel "style" a => a
forall (x :: Symbol) a. IsLabel x a => a
#style ((TextStyle -> Identity TextStyle) -> Title -> Identity Title)
-> ((Colour -> Identity Colour) -> TextStyle -> Identity TextStyle)
-> (Colour -> Identity Colour)
-> Title
-> Identity Title
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Colour -> Identity Colour) -> TextStyle -> Identity TextStyle
forall a. IsLabel "color" a => a
forall (x :: Symbol) a. IsLabel x a => a
#color ((Colour -> Identity Colour) -> Title -> Identity Title)
-> (Colour -> Colour) -> Title -> Title
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Colour -> Colour -> Colour
mix Colour
c)
    HudOptions -> (HudOptions -> HudOptions) -> HudOptions
forall a b. a -> (a -> b) -> b
& ([AxisOptions] -> Identity [AxisOptions])
-> HudOptions -> Identity HudOptions
forall a. IsLabel "hudAxes" a => a
forall (x :: Symbol) a. IsLabel x a => a
#hudAxes (([AxisOptions] -> Identity [AxisOptions])
 -> HudOptions -> Identity HudOptions)
-> ([AxisOptions] -> [AxisOptions]) -> HudOptions -> HudOptions
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (AxisOptions -> AxisOptions) -> [AxisOptions] -> [AxisOptions]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Maybe AxisBar -> Identity (Maybe AxisBar))
-> AxisOptions -> Identity AxisOptions
forall a. IsLabel "axisBar" a => a
forall (x :: Symbol) a. IsLabel x a => a
#axisBar ((Maybe AxisBar -> Identity (Maybe AxisBar))
 -> AxisOptions -> Identity AxisOptions)
-> (Maybe AxisBar -> Maybe AxisBar) -> AxisOptions -> AxisOptions
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (AxisBar -> AxisBar) -> Maybe AxisBar -> Maybe AxisBar
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((RectStyle -> Identity RectStyle) -> AxisBar -> Identity AxisBar
forall a. IsLabel "rstyle" a => a
forall (x :: Symbol) a. IsLabel x a => a
#rstyle ((RectStyle -> Identity RectStyle) -> AxisBar -> Identity AxisBar)
-> ((Colour -> Identity Colour) -> RectStyle -> Identity RectStyle)
-> (Colour -> Identity Colour)
-> AxisBar
-> Identity AxisBar
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Colour -> Identity Colour) -> RectStyle -> Identity RectStyle
forall a. IsLabel "color" a => a
forall (x :: Symbol) a. IsLabel x a => a
#color ((Colour -> Identity Colour) -> AxisBar -> Identity AxisBar)
-> (Colour -> Colour) -> AxisBar -> AxisBar
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Colour -> Colour -> Colour
mix Colour
c))
    HudOptions -> (HudOptions -> HudOptions) -> HudOptions
forall a b. a -> (a -> b) -> b
& ([AxisOptions] -> Identity [AxisOptions])
-> HudOptions -> Identity HudOptions
forall a. IsLabel "hudAxes" a => a
forall (x :: Symbol) a. IsLabel x a => a
#hudAxes (([AxisOptions] -> Identity [AxisOptions])
 -> HudOptions -> Identity HudOptions)
-> ([AxisOptions] -> [AxisOptions]) -> HudOptions -> HudOptions
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (AxisOptions -> AxisOptions) -> [AxisOptions] -> [AxisOptions]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Tick -> Identity Tick) -> AxisOptions -> Identity AxisOptions
forall a. IsLabel "axisTick" a => a
forall (x :: Symbol) a. IsLabel x a => a
#axisTick ((Tick -> Identity Tick) -> AxisOptions -> Identity AxisOptions)
-> ((Maybe (GlyphStyle, Double)
     -> Identity (Maybe (GlyphStyle, Double)))
    -> Tick -> Identity Tick)
-> (Maybe (GlyphStyle, Double)
    -> Identity (Maybe (GlyphStyle, Double)))
-> AxisOptions
-> Identity AxisOptions
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Maybe (GlyphStyle, Double)
 -> Identity (Maybe (GlyphStyle, Double)))
-> Tick -> Identity Tick
forall a. IsLabel "gtick" a => a
forall (x :: Symbol) a. IsLabel x a => a
#gtick ((Maybe (GlyphStyle, Double)
  -> Identity (Maybe (GlyphStyle, Double)))
 -> AxisOptions -> Identity AxisOptions)
-> (Maybe (GlyphStyle, Double) -> Maybe (GlyphStyle, Double))
-> AxisOptions
-> AxisOptions
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ((GlyphStyle, Double) -> (GlyphStyle, Double))
-> Maybe (GlyphStyle, Double) -> Maybe (GlyphStyle, Double)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((GlyphStyle -> GlyphStyle)
-> (GlyphStyle, Double) -> (GlyphStyle, Double)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (((Colour -> Identity Colour) -> GlyphStyle -> Identity GlyphStyle
forall a. IsLabel "color" a => a
forall (x :: Symbol) a. IsLabel x a => a
#color ((Colour -> Identity Colour) -> GlyphStyle -> Identity GlyphStyle)
-> (Colour -> Colour) -> GlyphStyle -> GlyphStyle
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Colour -> Colour -> Colour
mix Colour
c) (GlyphStyle -> GlyphStyle)
-> (GlyphStyle -> GlyphStyle) -> GlyphStyle -> GlyphStyle
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ((Colour -> Identity Colour) -> GlyphStyle -> Identity GlyphStyle
forall a. IsLabel "borderColor" a => a
forall (x :: Symbol) a. IsLabel x a => a
#borderColor ((Colour -> Identity Colour) -> GlyphStyle -> Identity GlyphStyle)
-> (Colour -> Colour) -> GlyphStyle -> GlyphStyle
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Colour -> Colour -> Colour
mix Colour
c))))
    HudOptions -> (HudOptions -> HudOptions) -> HudOptions
forall a b. a -> (a -> b) -> b
& ([AxisOptions] -> Identity [AxisOptions])
-> HudOptions -> Identity HudOptions
forall a. IsLabel "hudAxes" a => a
forall (x :: Symbol) a. IsLabel x a => a
#hudAxes (([AxisOptions] -> Identity [AxisOptions])
 -> HudOptions -> Identity HudOptions)
-> ([AxisOptions] -> [AxisOptions]) -> HudOptions -> HudOptions
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (AxisOptions -> AxisOptions) -> [AxisOptions] -> [AxisOptions]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Tick -> Identity Tick) -> AxisOptions -> Identity AxisOptions
forall a. IsLabel "axisTick" a => a
forall (x :: Symbol) a. IsLabel x a => a
#axisTick ((Tick -> Identity Tick) -> AxisOptions -> Identity AxisOptions)
-> ((Maybe (TextStyle, Double)
     -> Identity (Maybe (TextStyle, Double)))
    -> Tick -> Identity Tick)
-> (Maybe (TextStyle, Double)
    -> Identity (Maybe (TextStyle, Double)))
-> AxisOptions
-> Identity AxisOptions
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Maybe (TextStyle, Double) -> Identity (Maybe (TextStyle, Double)))
-> Tick -> Identity Tick
forall a. IsLabel "ttick" a => a
forall (x :: Symbol) a. IsLabel x a => a
#ttick ((Maybe (TextStyle, Double)
  -> Identity (Maybe (TextStyle, Double)))
 -> AxisOptions -> Identity AxisOptions)
-> (Maybe (TextStyle, Double) -> Maybe (TextStyle, Double))
-> AxisOptions
-> AxisOptions
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ((TextStyle, Double) -> (TextStyle, Double))
-> Maybe (TextStyle, Double) -> Maybe (TextStyle, Double)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((TextStyle -> TextStyle)
-> (TextStyle, Double) -> (TextStyle, Double)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((Colour -> Identity Colour) -> TextStyle -> Identity TextStyle
forall a. IsLabel "color" a => a
forall (x :: Symbol) a. IsLabel x a => a
#color ((Colour -> Identity Colour) -> TextStyle -> Identity TextStyle)
-> (Colour -> Colour) -> TextStyle -> TextStyle
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Colour -> Colour -> Colour
mix Colour
c)))
    HudOptions -> (HudOptions -> HudOptions) -> HudOptions
forall a b. a -> (a -> b) -> b
& ([AxisOptions] -> Identity [AxisOptions])
-> HudOptions -> Identity HudOptions
forall a. IsLabel "hudAxes" a => a
forall (x :: Symbol) a. IsLabel x a => a
#hudAxes (([AxisOptions] -> Identity [AxisOptions])
 -> HudOptions -> Identity HudOptions)
-> ([AxisOptions] -> [AxisOptions]) -> HudOptions -> HudOptions
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (AxisOptions -> AxisOptions) -> [AxisOptions] -> [AxisOptions]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Tick -> Identity Tick) -> AxisOptions -> Identity AxisOptions
forall a. IsLabel "axisTick" a => a
forall (x :: Symbol) a. IsLabel x a => a
#axisTick ((Tick -> Identity Tick) -> AxisOptions -> Identity AxisOptions)
-> ((Maybe (LineStyle, Double)
     -> Identity (Maybe (LineStyle, Double)))
    -> Tick -> Identity Tick)
-> (Maybe (LineStyle, Double)
    -> Identity (Maybe (LineStyle, Double)))
-> AxisOptions
-> Identity AxisOptions
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Maybe (LineStyle, Double) -> Identity (Maybe (LineStyle, Double)))
-> Tick -> Identity Tick
forall a. IsLabel "ltick" a => a
forall (x :: Symbol) a. IsLabel x a => a
#ltick ((Maybe (LineStyle, Double)
  -> Identity (Maybe (LineStyle, Double)))
 -> AxisOptions -> Identity AxisOptions)
-> (Maybe (LineStyle, Double) -> Maybe (LineStyle, Double))
-> AxisOptions
-> AxisOptions
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ((LineStyle, Double) -> (LineStyle, Double))
-> Maybe (LineStyle, Double) -> Maybe (LineStyle, Double)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((LineStyle -> LineStyle)
-> (LineStyle, Double) -> (LineStyle, Double)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((Colour -> Identity Colour) -> LineStyle -> Identity LineStyle
forall a. IsLabel "color" a => a
forall (x :: Symbol) a. IsLabel x a => a
#color ((Colour -> Identity Colour) -> LineStyle -> Identity LineStyle)
-> (Colour -> Colour) -> LineStyle -> LineStyle
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Colour -> Colour -> Colour
mix Colour
c)))
    HudOptions -> (HudOptions -> HudOptions) -> HudOptions
forall a b. a -> (a -> b) -> b
& (Maybe (LegendOptions, [(Annotation, Text)])
 -> Identity (Maybe (LegendOptions, [(Annotation, Text)])))
-> HudOptions -> Identity HudOptions
forall a. IsLabel "hudLegend" a => a
forall (x :: Symbol) a. IsLabel x a => a
#hudLegend ((Maybe (LegendOptions, [(Annotation, Text)])
  -> Identity (Maybe (LegendOptions, [(Annotation, Text)])))
 -> HudOptions -> Identity HudOptions)
-> (Maybe (LegendOptions, [(Annotation, Text)])
    -> Maybe (LegendOptions, [(Annotation, Text)]))
-> HudOptions
-> HudOptions
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ((LegendOptions, [(Annotation, Text)])
 -> (LegendOptions, [(Annotation, Text)]))
-> Maybe (LegendOptions, [(Annotation, Text)])
-> Maybe (LegendOptions, [(Annotation, Text)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((LegendOptions -> LegendOptions)
-> (LegendOptions, [(Annotation, Text)])
-> (LegendOptions, [(Annotation, Text)])
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((TextStyle -> Identity TextStyle)
-> LegendOptions -> Identity LegendOptions
forall a. IsLabel "ltext" a => a
forall (x :: Symbol) a. IsLabel x a => a
#ltext ((TextStyle -> Identity TextStyle)
 -> LegendOptions -> Identity LegendOptions)
-> (TextStyle -> TextStyle) -> LegendOptions -> LegendOptions
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ((Colour -> Identity Colour) -> TextStyle -> Identity TextStyle
forall a. IsLabel "color" a => a
forall (x :: Symbol) a. IsLabel x a => a
#color ((Colour -> Identity Colour) -> TextStyle -> Identity TextStyle)
-> (Colour -> Colour) -> TextStyle -> TextStyle
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Colour -> Colour -> Colour
mix Colour
c)))
    HudOptions -> (HudOptions -> HudOptions) -> HudOptions
forall a b. a -> (a -> b) -> b
& (Maybe (LegendOptions, [(Annotation, Text)])
 -> Identity (Maybe (LegendOptions, [(Annotation, Text)])))
-> HudOptions -> Identity HudOptions
forall a. IsLabel "hudLegend" a => a
forall (x :: Symbol) a. IsLabel x a => a
#hudLegend ((Maybe (LegendOptions, [(Annotation, Text)])
  -> Identity (Maybe (LegendOptions, [(Annotation, Text)])))
 -> HudOptions -> Identity HudOptions)
-> (Maybe (LegendOptions, [(Annotation, Text)])
    -> Maybe (LegendOptions, [(Annotation, Text)]))
-> HudOptions
-> HudOptions
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ((LegendOptions, [(Annotation, Text)])
 -> (LegendOptions, [(Annotation, Text)]))
-> Maybe (LegendOptions, [(Annotation, Text)])
-> Maybe (LegendOptions, [(Annotation, Text)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((LegendOptions -> LegendOptions)
-> (LegendOptions, [(Annotation, Text)])
-> (LegendOptions, [(Annotation, Text)])
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((Maybe RectStyle -> Identity (Maybe RectStyle))
-> LegendOptions -> Identity LegendOptions
forall a. IsLabel "legendFrame" a => a
forall (x :: Symbol) a. IsLabel x a => a
#legendFrame ((Maybe RectStyle -> Identity (Maybe RectStyle))
 -> LegendOptions -> Identity LegendOptions)
-> (Maybe RectStyle -> Maybe RectStyle)
-> LegendOptions
-> LegendOptions
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (RectStyle -> RectStyle) -> Maybe RectStyle -> Maybe RectStyle
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((Colour -> Identity Colour) -> RectStyle -> Identity RectStyle
forall a. IsLabel "color" a => a
forall (x :: Symbol) a. IsLabel x a => a
#color ((Colour -> Identity Colour) -> RectStyle -> Identity RectStyle)
-> (Colour -> Colour) -> RectStyle -> RectStyle
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Colour -> Colour -> Colour
mix Colour
c) (RectStyle -> RectStyle)
-> (RectStyle -> RectStyle) -> RectStyle -> RectStyle
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ((Colour -> Identity Colour) -> RectStyle -> Identity RectStyle
forall a. IsLabel "borderColor" a => a
forall (x :: Symbol) a. IsLabel x a => a
#borderColor ((Colour -> Identity Colour) -> RectStyle -> Identity RectStyle)
-> (Colour -> Colour) -> RectStyle -> RectStyle
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Colour -> Colour -> Colour
mix Colour
c))))

-- | adjust the opacity of HudOptions up or down geometrically (scaling by (*o))
scaleOpacHudOptions :: HudOptions -> Double -> HudOptions
scaleOpacHudOptions :: HudOptions -> Double -> HudOptions
scaleOpacHudOptions HudOptions
ho Double
o =
  HudOptions
ho
    HudOptions -> (HudOptions -> HudOptions) -> HudOptions
forall a b. a -> (a -> b) -> b
& (Maybe RectStyle -> Identity (Maybe RectStyle))
-> HudOptions -> Identity HudOptions
forall a. IsLabel "hudCanvas" a => a
forall (x :: Symbol) a. IsLabel x a => a
#hudCanvas ((Maybe RectStyle -> Identity (Maybe RectStyle))
 -> HudOptions -> Identity HudOptions)
-> (Maybe RectStyle -> Maybe RectStyle) -> HudOptions -> HudOptions
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (RectStyle -> RectStyle) -> Maybe RectStyle -> Maybe RectStyle
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Colour -> Identity Colour) -> RectStyle -> Identity RectStyle
forall a. IsLabel "color" a => a
forall (x :: Symbol) a. IsLabel x a => a
#color ((Colour -> Identity Colour) -> RectStyle -> Identity RectStyle)
-> (Colour -> Colour) -> RectStyle -> RectStyle
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Double -> Colour -> Colour
scaleOpac Double
o)
    HudOptions -> (HudOptions -> HudOptions) -> HudOptions
forall a b. a -> (a -> b) -> b
& ([Title] -> Identity [Title]) -> HudOptions -> Identity HudOptions
forall a. IsLabel "hudTitles" a => a
forall (x :: Symbol) a. IsLabel x a => a
#hudTitles (([Title] -> Identity [Title])
 -> HudOptions -> Identity HudOptions)
-> ([Title] -> [Title]) -> HudOptions -> HudOptions
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Title -> Title) -> [Title] -> [Title]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((TextStyle -> Identity TextStyle) -> Title -> Identity Title
forall a. IsLabel "style" a => a
forall (x :: Symbol) a. IsLabel x a => a
#style ((TextStyle -> Identity TextStyle) -> Title -> Identity Title)
-> ((Colour -> Identity Colour) -> TextStyle -> Identity TextStyle)
-> (Colour -> Identity Colour)
-> Title
-> Identity Title
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Colour -> Identity Colour) -> TextStyle -> Identity TextStyle
forall a. IsLabel "color" a => a
forall (x :: Symbol) a. IsLabel x a => a
#color ((Colour -> Identity Colour) -> Title -> Identity Title)
-> (Colour -> Colour) -> Title -> Title
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Double -> Colour -> Colour
scaleOpac Double
o)
    HudOptions -> (HudOptions -> HudOptions) -> HudOptions
forall a b. a -> (a -> b) -> b
& ([AxisOptions] -> Identity [AxisOptions])
-> HudOptions -> Identity HudOptions
forall a. IsLabel "hudAxes" a => a
forall (x :: Symbol) a. IsLabel x a => a
#hudAxes (([AxisOptions] -> Identity [AxisOptions])
 -> HudOptions -> Identity HudOptions)
-> ([AxisOptions] -> [AxisOptions]) -> HudOptions -> HudOptions
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (AxisOptions -> AxisOptions) -> [AxisOptions] -> [AxisOptions]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Maybe AxisBar -> Identity (Maybe AxisBar))
-> AxisOptions -> Identity AxisOptions
forall a. IsLabel "axisBar" a => a
forall (x :: Symbol) a. IsLabel x a => a
#axisBar ((Maybe AxisBar -> Identity (Maybe AxisBar))
 -> AxisOptions -> Identity AxisOptions)
-> (Maybe AxisBar -> Maybe AxisBar) -> AxisOptions -> AxisOptions
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (AxisBar -> AxisBar) -> Maybe AxisBar -> Maybe AxisBar
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((RectStyle -> Identity RectStyle) -> AxisBar -> Identity AxisBar
forall a. IsLabel "rstyle" a => a
forall (x :: Symbol) a. IsLabel x a => a
#rstyle ((RectStyle -> Identity RectStyle) -> AxisBar -> Identity AxisBar)
-> ((Colour -> Identity Colour) -> RectStyle -> Identity RectStyle)
-> (Colour -> Identity Colour)
-> AxisBar
-> Identity AxisBar
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Colour -> Identity Colour) -> RectStyle -> Identity RectStyle
forall a. IsLabel "color" a => a
forall (x :: Symbol) a. IsLabel x a => a
#color ((Colour -> Identity Colour) -> AxisBar -> Identity AxisBar)
-> (Colour -> Colour) -> AxisBar -> AxisBar
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Double -> Colour -> Colour
scaleOpac Double
o))
    HudOptions -> (HudOptions -> HudOptions) -> HudOptions
forall a b. a -> (a -> b) -> b
& ([AxisOptions] -> Identity [AxisOptions])
-> HudOptions -> Identity HudOptions
forall a. IsLabel "hudAxes" a => a
forall (x :: Symbol) a. IsLabel x a => a
#hudAxes (([AxisOptions] -> Identity [AxisOptions])
 -> HudOptions -> Identity HudOptions)
-> ([AxisOptions] -> [AxisOptions]) -> HudOptions -> HudOptions
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (AxisOptions -> AxisOptions) -> [AxisOptions] -> [AxisOptions]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Tick -> Identity Tick) -> AxisOptions -> Identity AxisOptions
forall a. IsLabel "axisTick" a => a
forall (x :: Symbol) a. IsLabel x a => a
#axisTick ((Tick -> Identity Tick) -> AxisOptions -> Identity AxisOptions)
-> ((Maybe (GlyphStyle, Double)
     -> Identity (Maybe (GlyphStyle, Double)))
    -> Tick -> Identity Tick)
-> (Maybe (GlyphStyle, Double)
    -> Identity (Maybe (GlyphStyle, Double)))
-> AxisOptions
-> Identity AxisOptions
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Maybe (GlyphStyle, Double)
 -> Identity (Maybe (GlyphStyle, Double)))
-> Tick -> Identity Tick
forall a. IsLabel "gtick" a => a
forall (x :: Symbol) a. IsLabel x a => a
#gtick ((Maybe (GlyphStyle, Double)
  -> Identity (Maybe (GlyphStyle, Double)))
 -> AxisOptions -> Identity AxisOptions)
-> (Maybe (GlyphStyle, Double) -> Maybe (GlyphStyle, Double))
-> AxisOptions
-> AxisOptions
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ((GlyphStyle, Double) -> (GlyphStyle, Double))
-> Maybe (GlyphStyle, Double) -> Maybe (GlyphStyle, Double)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((GlyphStyle -> GlyphStyle)
-> (GlyphStyle, Double) -> (GlyphStyle, Double)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (((Colour -> Identity Colour) -> GlyphStyle -> Identity GlyphStyle
forall a. IsLabel "color" a => a
forall (x :: Symbol) a. IsLabel x a => a
#color ((Colour -> Identity Colour) -> GlyphStyle -> Identity GlyphStyle)
-> (Colour -> Colour) -> GlyphStyle -> GlyphStyle
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Double -> Colour -> Colour
scaleOpac Double
o) (GlyphStyle -> GlyphStyle)
-> (GlyphStyle -> GlyphStyle) -> GlyphStyle -> GlyphStyle
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ((Colour -> Identity Colour) -> GlyphStyle -> Identity GlyphStyle
forall a. IsLabel "borderColor" a => a
forall (x :: Symbol) a. IsLabel x a => a
#borderColor ((Colour -> Identity Colour) -> GlyphStyle -> Identity GlyphStyle)
-> (Colour -> Colour) -> GlyphStyle -> GlyphStyle
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Double -> Colour -> Colour
scaleOpac Double
o))))
    HudOptions -> (HudOptions -> HudOptions) -> HudOptions
forall a b. a -> (a -> b) -> b
& ([AxisOptions] -> Identity [AxisOptions])
-> HudOptions -> Identity HudOptions
forall a. IsLabel "hudAxes" a => a
forall (x :: Symbol) a. IsLabel x a => a
#hudAxes (([AxisOptions] -> Identity [AxisOptions])
 -> HudOptions -> Identity HudOptions)
-> ([AxisOptions] -> [AxisOptions]) -> HudOptions -> HudOptions
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (AxisOptions -> AxisOptions) -> [AxisOptions] -> [AxisOptions]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Tick -> Identity Tick) -> AxisOptions -> Identity AxisOptions
forall a. IsLabel "axisTick" a => a
forall (x :: Symbol) a. IsLabel x a => a
#axisTick ((Tick -> Identity Tick) -> AxisOptions -> Identity AxisOptions)
-> ((Maybe (TextStyle, Double)
     -> Identity (Maybe (TextStyle, Double)))
    -> Tick -> Identity Tick)
-> (Maybe (TextStyle, Double)
    -> Identity (Maybe (TextStyle, Double)))
-> AxisOptions
-> Identity AxisOptions
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Maybe (TextStyle, Double) -> Identity (Maybe (TextStyle, Double)))
-> Tick -> Identity Tick
forall a. IsLabel "ttick" a => a
forall (x :: Symbol) a. IsLabel x a => a
#ttick ((Maybe (TextStyle, Double)
  -> Identity (Maybe (TextStyle, Double)))
 -> AxisOptions -> Identity AxisOptions)
-> (Maybe (TextStyle, Double) -> Maybe (TextStyle, Double))
-> AxisOptions
-> AxisOptions
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ((TextStyle, Double) -> (TextStyle, Double))
-> Maybe (TextStyle, Double) -> Maybe (TextStyle, Double)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((TextStyle -> TextStyle)
-> (TextStyle, Double) -> (TextStyle, Double)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((Colour -> Identity Colour) -> TextStyle -> Identity TextStyle
forall a. IsLabel "color" a => a
forall (x :: Symbol) a. IsLabel x a => a
#color ((Colour -> Identity Colour) -> TextStyle -> Identity TextStyle)
-> (Colour -> Colour) -> TextStyle -> TextStyle
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Double -> Colour -> Colour
scaleOpac Double
o)))
    HudOptions -> (HudOptions -> HudOptions) -> HudOptions
forall a b. a -> (a -> b) -> b
& ([AxisOptions] -> Identity [AxisOptions])
-> HudOptions -> Identity HudOptions
forall a. IsLabel "hudAxes" a => a
forall (x :: Symbol) a. IsLabel x a => a
#hudAxes (([AxisOptions] -> Identity [AxisOptions])
 -> HudOptions -> Identity HudOptions)
-> ([AxisOptions] -> [AxisOptions]) -> HudOptions -> HudOptions
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (AxisOptions -> AxisOptions) -> [AxisOptions] -> [AxisOptions]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Tick -> Identity Tick) -> AxisOptions -> Identity AxisOptions
forall a. IsLabel "axisTick" a => a
forall (x :: Symbol) a. IsLabel x a => a
#axisTick ((Tick -> Identity Tick) -> AxisOptions -> Identity AxisOptions)
-> ((Maybe (LineStyle, Double)
     -> Identity (Maybe (LineStyle, Double)))
    -> Tick -> Identity Tick)
-> (Maybe (LineStyle, Double)
    -> Identity (Maybe (LineStyle, Double)))
-> AxisOptions
-> Identity AxisOptions
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Maybe (LineStyle, Double) -> Identity (Maybe (LineStyle, Double)))
-> Tick -> Identity Tick
forall a. IsLabel "ltick" a => a
forall (x :: Symbol) a. IsLabel x a => a
#ltick ((Maybe (LineStyle, Double)
  -> Identity (Maybe (LineStyle, Double)))
 -> AxisOptions -> Identity AxisOptions)
-> (Maybe (LineStyle, Double) -> Maybe (LineStyle, Double))
-> AxisOptions
-> AxisOptions
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ((LineStyle, Double) -> (LineStyle, Double))
-> Maybe (LineStyle, Double) -> Maybe (LineStyle, Double)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((LineStyle -> LineStyle)
-> (LineStyle, Double) -> (LineStyle, Double)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((Colour -> Identity Colour) -> LineStyle -> Identity LineStyle
forall a. IsLabel "color" a => a
forall (x :: Symbol) a. IsLabel x a => a
#color ((Colour -> Identity Colour) -> LineStyle -> Identity LineStyle)
-> (Colour -> Colour) -> LineStyle -> LineStyle
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Double -> Colour -> Colour
scaleOpac Double
o)))
    HudOptions -> (HudOptions -> HudOptions) -> HudOptions
forall a b. a -> (a -> b) -> b
& (Maybe (LegendOptions, [(Annotation, Text)])
 -> Identity (Maybe (LegendOptions, [(Annotation, Text)])))
-> HudOptions -> Identity HudOptions
forall a. IsLabel "hudLegend" a => a
forall (x :: Symbol) a. IsLabel x a => a
#hudLegend ((Maybe (LegendOptions, [(Annotation, Text)])
  -> Identity (Maybe (LegendOptions, [(Annotation, Text)])))
 -> HudOptions -> Identity HudOptions)
-> (Maybe (LegendOptions, [(Annotation, Text)])
    -> Maybe (LegendOptions, [(Annotation, Text)]))
-> HudOptions
-> HudOptions
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ((LegendOptions, [(Annotation, Text)])
 -> (LegendOptions, [(Annotation, Text)]))
-> Maybe (LegendOptions, [(Annotation, Text)])
-> Maybe (LegendOptions, [(Annotation, Text)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((LegendOptions -> LegendOptions)
-> (LegendOptions, [(Annotation, Text)])
-> (LegendOptions, [(Annotation, Text)])
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((TextStyle -> Identity TextStyle)
-> LegendOptions -> Identity LegendOptions
forall a. IsLabel "ltext" a => a
forall (x :: Symbol) a. IsLabel x a => a
#ltext ((TextStyle -> Identity TextStyle)
 -> LegendOptions -> Identity LegendOptions)
-> (TextStyle -> TextStyle) -> LegendOptions -> LegendOptions
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ((Colour -> Identity Colour) -> TextStyle -> Identity TextStyle
forall a. IsLabel "color" a => a
forall (x :: Symbol) a. IsLabel x a => a
#color ((Colour -> Identity Colour) -> TextStyle -> Identity TextStyle)
-> (Colour -> Colour) -> TextStyle -> TextStyle
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Double -> Colour -> Colour
scaleOpac Double
o)))
    HudOptions -> (HudOptions -> HudOptions) -> HudOptions
forall a b. a -> (a -> b) -> b
& (Maybe (LegendOptions, [(Annotation, Text)])
 -> Identity (Maybe (LegendOptions, [(Annotation, Text)])))
-> HudOptions -> Identity HudOptions
forall a. IsLabel "hudLegend" a => a
forall (x :: Symbol) a. IsLabel x a => a
#hudLegend ((Maybe (LegendOptions, [(Annotation, Text)])
  -> Identity (Maybe (LegendOptions, [(Annotation, Text)])))
 -> HudOptions -> Identity HudOptions)
-> (Maybe (LegendOptions, [(Annotation, Text)])
    -> Maybe (LegendOptions, [(Annotation, Text)]))
-> HudOptions
-> HudOptions
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ((LegendOptions, [(Annotation, Text)])
 -> (LegendOptions, [(Annotation, Text)]))
-> Maybe (LegendOptions, [(Annotation, Text)])
-> Maybe (LegendOptions, [(Annotation, Text)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((LegendOptions -> LegendOptions)
-> (LegendOptions, [(Annotation, Text)])
-> (LegendOptions, [(Annotation, Text)])
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((Maybe RectStyle -> Identity (Maybe RectStyle))
-> LegendOptions -> Identity LegendOptions
forall a. IsLabel "legendFrame" a => a
forall (x :: Symbol) a. IsLabel x a => a
#legendFrame ((Maybe RectStyle -> Identity (Maybe RectStyle))
 -> LegendOptions -> Identity LegendOptions)
-> (Maybe RectStyle -> Maybe RectStyle)
-> LegendOptions
-> LegendOptions
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (RectStyle -> RectStyle) -> Maybe RectStyle -> Maybe RectStyle
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((Colour -> Identity Colour) -> RectStyle -> Identity RectStyle
forall a. IsLabel "color" a => a
forall (x :: Symbol) a. IsLabel x a => a
#color ((Colour -> Identity Colour) -> RectStyle -> Identity RectStyle)
-> (Colour -> Colour) -> RectStyle -> RectStyle
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Double -> Colour -> Colour
scaleOpac Double
o) (RectStyle -> RectStyle)
-> (RectStyle -> RectStyle) -> RectStyle -> RectStyle
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ((Colour -> Identity Colour) -> RectStyle -> Identity RectStyle
forall a. IsLabel "borderColor" a => a
forall (x :: Symbol) a. IsLabel x a => a
#borderColor ((Colour -> Identity Colour) -> RectStyle -> Identity RectStyle)
-> (Colour -> Colour) -> RectStyle -> RectStyle
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Double -> Colour -> Colour
scaleOpac Double
o))))
    HudOptions -> (HudOptions -> HudOptions) -> HudOptions
forall a b. a -> (a -> b) -> b
& (Maybe (LegendOptions, [(Annotation, Text)])
 -> Identity (Maybe (LegendOptions, [(Annotation, Text)])))
-> HudOptions -> Identity HudOptions
forall a. IsLabel "hudLegend" a => a
forall (x :: Symbol) a. IsLabel x a => a
#hudLegend ((Maybe (LegendOptions, [(Annotation, Text)])
  -> Identity (Maybe (LegendOptions, [(Annotation, Text)])))
 -> HudOptions -> Identity HudOptions)
-> (Maybe (LegendOptions, [(Annotation, Text)])
    -> Maybe (LegendOptions, [(Annotation, Text)]))
-> HudOptions
-> HudOptions
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ((LegendOptions, [(Annotation, Text)])
 -> (LegendOptions, [(Annotation, Text)]))
-> Maybe (LegendOptions, [(Annotation, Text)])
-> Maybe (LegendOptions, [(Annotation, Text)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([(Annotation, Text)] -> [(Annotation, Text)])
-> (LegendOptions, [(Annotation, Text)])
-> (LegendOptions, [(Annotation, Text)])
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (((Annotation, Text) -> (Annotation, Text))
-> [(Annotation, Text)] -> [(Annotation, Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Annotation -> Annotation)
-> (Annotation, Text) -> (Annotation, Text)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Double -> Annotation -> Annotation
scaleOpacAnn Double
o))))

-- | colour reset but scaling opacity
mix :: Colour -> Colour -> Colour
mix :: Colour -> Colour -> Colour
mix (Colour Double
r Double
g Double
b Double
o') (Colour Double
_ Double
_ Double
_ Double
o) = Double -> Double -> Double -> Double -> Colour
Colour Double
r Double
g Double
b (Double
o' Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Double
o)

-- | The official hud canvas
defaultCanvas :: RectStyle
defaultCanvas :: RectStyle
defaultCanvas = Colour -> RectStyle
blob (Double -> Colour -> Colour
setOpac Double
0.05 Colour
dark)

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

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

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

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

-- | The bar on an axis representing the x or y plane.
--
-- >>> defaultAxisBar
-- AxisBar {rstyle = RectStyle {borderSize = 0.0, borderColor = Colour 0.00 0.00 0.00 0.00, color = Colour 0.05 0.05 0.05 0.40}, wid = 4.0e-3, buff = 1.0e-2}
data AxisBar = AxisBar
  { AxisBar -> RectStyle
rstyle :: RectStyle,
    AxisBar -> Double
wid :: Double,
    AxisBar -> Double
buff :: Double
  }
  deriving (Int -> AxisBar -> ShowS
[AxisBar] -> ShowS
AxisBar -> String
(Int -> AxisBar -> ShowS)
-> (AxisBar -> String) -> ([AxisBar] -> ShowS) -> Show AxisBar
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AxisBar] -> ShowS
$cshowList :: [AxisBar] -> ShowS
show :: AxisBar -> String
$cshow :: AxisBar -> String
showsPrec :: Int -> AxisBar -> ShowS
$cshowsPrec :: Int -> AxisBar -> ShowS
Show, AxisBar -> AxisBar -> Bool
(AxisBar -> AxisBar -> Bool)
-> (AxisBar -> AxisBar -> Bool) -> Eq AxisBar
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AxisBar -> AxisBar -> Bool
$c/= :: AxisBar -> AxisBar -> Bool
== :: AxisBar -> AxisBar -> Bool
$c== :: AxisBar -> AxisBar -> Bool
Eq, (forall x. AxisBar -> Rep AxisBar x)
-> (forall x. Rep AxisBar x -> AxisBar) -> Generic AxisBar
forall x. Rep AxisBar x -> AxisBar
forall x. AxisBar -> Rep AxisBar x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AxisBar x -> AxisBar
$cfrom :: forall x. AxisBar -> Rep AxisBar x
Generic)

-- | The official axis bar
defaultAxisBar :: AxisBar
defaultAxisBar :: AxisBar
defaultAxisBar = RectStyle -> Double -> Double -> AxisBar
AxisBar (Double -> Colour -> Colour -> RectStyle
RectStyle Double
0 Colour
transparent (Double -> Colour -> Colour
setOpac Double
0.4 Colour
dark)) Double
0.004 Double
0.01

-- | 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.5, vsize = 1.45, nudge1 = -0.2, rotation = Nothing}, place = PlaceTop, anchor = AnchorMiddle, buff = 4.0e-2}
data Title = Title
  { Title -> Text
text :: Text,
    Title -> TextStyle
style :: TextStyle,
    Title -> Place
place :: Place,
    Title -> Anchor
anchor :: Anchor,
    Title -> Double
buff :: Double
  }
  deriving (Int -> Title -> ShowS
[Title] -> ShowS
Title -> String
(Int -> Title -> ShowS)
-> (Title -> String) -> ([Title] -> ShowS) -> Show Title
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Title] -> ShowS
$cshowList :: [Title] -> ShowS
show :: Title -> String
$cshow :: Title -> String
showsPrec :: Int -> Title -> ShowS
$cshowsPrec :: Int -> Title -> ShowS
Show, Title -> Title -> Bool
(Title -> Title -> Bool) -> (Title -> Title -> Bool) -> Eq Title
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Title -> Title -> Bool
$c/= :: Title -> Title -> Bool
== :: Title -> Title -> Bool
$c== :: Title -> Title -> Bool
Eq, (forall x. Title -> Rep Title x)
-> (forall x. Rep Title x -> Title) -> Generic Title
forall x. Rep Title x -> Title
forall x. Title -> Rep Title x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Title x -> Title
$cfrom :: forall x. Title -> Rep Title x
Generic)

-- | The official hud title
defaultTitle :: Text -> Title
defaultTitle :: Text -> Title
defaultTitle Text
txt =
  Text -> TextStyle -> Place -> Anchor -> Double -> Title
Title
    Text
txt
    ( TextStyle
defaultTextStyle
        TextStyle -> (TextStyle -> TextStyle) -> TextStyle
forall a b. a -> (a -> b) -> b
& (Double -> Identity Double) -> TextStyle -> Identity TextStyle
forall a. IsLabel "size" a => a
forall (x :: Symbol) a. IsLabel x a => a
#size ((Double -> Identity Double) -> TextStyle -> Identity TextStyle)
-> Double -> TextStyle -> TextStyle
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Double
0.12
    )
    Place
PlaceTop
    Anchor
AnchorMiddle
    Double
0.04

-- | xy coordinate markings
--
-- >>> defaultTick
-- Tick {tstyle = TickRound (FormatComma (Just 2)) 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 = 2.0e-3, shape = VLineGlyph 5.0e-3, rotation = Nothing, translate = Nothing},1.25e-2), ttick = Just (TextStyle {size = 5.0e-2, color = Colour 0.05 0.05 0.05 1.00, anchor = AnchorMiddle, hsize = 0.5, vsize = 1.45, nudge1 = -0.2, rotation = Nothing},1.5e-2), ltick = Just (LineStyle {width = 5.0e-3, color = Colour 0.05 0.05 0.05 0.05, linecap = Nothing, linejoin = Nothing, dasharray = Nothing, dashoffset = Nothing},0.0)}
data Tick = Tick
  { Tick -> TickStyle
tstyle :: TickStyle,
    Tick -> Maybe (GlyphStyle, Double)
gtick :: Maybe (GlyphStyle, Double),
    Tick -> Maybe (TextStyle, Double)
ttick :: Maybe (TextStyle, Double),
    Tick -> Maybe (LineStyle, Double)
ltick :: Maybe (LineStyle, Double)
  }
  deriving (Int -> Tick -> ShowS
[Tick] -> ShowS
Tick -> String
(Int -> Tick -> ShowS)
-> (Tick -> String) -> ([Tick] -> ShowS) -> Show Tick
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Tick] -> ShowS
$cshowList :: [Tick] -> ShowS
show :: Tick -> String
$cshow :: Tick -> String
showsPrec :: Int -> Tick -> ShowS
$cshowsPrec :: Int -> Tick -> ShowS
Show, Tick -> Tick -> Bool
(Tick -> Tick -> Bool) -> (Tick -> Tick -> Bool) -> Eq Tick
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Tick -> Tick -> Bool
$c/= :: Tick -> Tick -> Bool
== :: Tick -> Tick -> Bool
$c== :: Tick -> Tick -> Bool
Eq, (forall x. Tick -> Rep Tick x)
-> (forall x. Rep Tick x -> Tick) -> Generic Tick
forall x. Rep Tick x -> Tick
forall x. Tick -> Rep Tick x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Tick x -> Tick
$cfrom :: forall x. Tick -> Rep Tick x
Generic)

-- | The official glyph tick
defaultGlyphTick :: GlyphStyle
defaultGlyphTick :: GlyphStyle
defaultGlyphTick =
  GlyphStyle
defaultGlyphStyle
    GlyphStyle -> (GlyphStyle -> GlyphStyle) -> GlyphStyle
forall a b. a -> (a -> b) -> b
& (Double -> Identity Double) -> GlyphStyle -> Identity GlyphStyle
forall a. IsLabel "borderSize" a => a
forall (x :: Symbol) a. IsLabel x a => a
#borderSize ((Double -> Identity Double) -> GlyphStyle -> Identity GlyphStyle)
-> Double -> GlyphStyle -> GlyphStyle
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Double
0.002
    GlyphStyle -> (GlyphStyle -> GlyphStyle) -> GlyphStyle
forall a b. a -> (a -> b) -> b
& (GlyphShape -> Identity GlyphShape)
-> GlyphStyle -> Identity GlyphStyle
forall a. IsLabel "shape" a => a
forall (x :: Symbol) a. IsLabel x a => a
#shape ((GlyphShape -> Identity GlyphShape)
 -> GlyphStyle -> Identity GlyphStyle)
-> GlyphShape -> GlyphStyle -> GlyphStyle
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Double -> GlyphShape
VLineGlyph Double
0.005
    GlyphStyle -> (GlyphStyle -> GlyphStyle) -> GlyphStyle
forall a b. a -> (a -> b) -> b
& (Colour -> Identity Colour) -> GlyphStyle -> Identity GlyphStyle
forall a. IsLabel "color" a => a
forall (x :: Symbol) a. IsLabel x a => a
#color ((Colour -> Identity Colour) -> GlyphStyle -> Identity GlyphStyle)
-> Colour -> GlyphStyle -> GlyphStyle
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Double -> Colour -> Colour
setOpac Double
0.4 Colour
dark
    GlyphStyle -> (GlyphStyle -> GlyphStyle) -> GlyphStyle
forall a b. a -> (a -> b) -> b
& (Colour -> Identity Colour) -> GlyphStyle -> Identity GlyphStyle
forall a. IsLabel "borderColor" a => a
forall (x :: Symbol) a. IsLabel x a => a
#borderColor ((Colour -> Identity Colour) -> GlyphStyle -> Identity GlyphStyle)
-> Colour -> GlyphStyle -> GlyphStyle
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Double -> Colour -> Colour
setOpac Double
0.4 Colour
dark

-- | The official text tick
defaultTextTick :: TextStyle
defaultTextTick :: TextStyle
defaultTextTick =
  TextStyle
defaultTextStyle TextStyle -> (TextStyle -> TextStyle) -> TextStyle
forall a b. a -> (a -> b) -> b
& (Double -> Identity Double) -> TextStyle -> Identity TextStyle
forall a. IsLabel "size" a => a
forall (x :: Symbol) a. IsLabel x a => a
#size ((Double -> Identity Double) -> TextStyle -> Identity TextStyle)
-> Double -> TextStyle -> TextStyle
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Double
0.05

-- | The official line tick
defaultLineTick :: LineStyle
defaultLineTick :: LineStyle
defaultLineTick =
  LineStyle
defaultLineStyle
    LineStyle -> (LineStyle -> LineStyle) -> LineStyle
forall a b. a -> (a -> b) -> b
& (Double -> Identity Double) -> LineStyle -> Identity LineStyle
forall a. IsLabel "width" a => a
forall (x :: Symbol) a. IsLabel x a => a
#width ((Double -> Identity Double) -> LineStyle -> Identity LineStyle)
-> Double -> LineStyle -> LineStyle
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Double
5.0e-3
    LineStyle -> (LineStyle -> LineStyle) -> LineStyle
forall a b. a -> (a -> b) -> b
& (Colour -> Identity Colour) -> LineStyle -> Identity LineStyle
forall a. IsLabel "color" a => a
forall (x :: Symbol) a. IsLabel x a => a
#color ((Colour -> Identity Colour) -> LineStyle -> Identity LineStyle)
-> (Colour -> Colour) -> LineStyle -> LineStyle
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Double -> Colour -> Colour
setOpac Double
0.05

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

-- | The official tick style
defaultTickStyle :: TickStyle
defaultTickStyle :: TickStyle
defaultTickStyle = FormatN -> Int -> TickExtend -> TickStyle
TickRound (Maybe Int -> FormatN
FormatComma (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
2)) Int
8 TickExtend
TickExtend

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

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

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

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

-- | Legend options
--
-- >>> defaultLegendOptions
-- LegendOptions {lsize = 0.3, vgap = 0.2, hgap = 0.1, ltext = TextStyle {size = 0.12, color = Colour 0.05 0.05 0.05 1.00, anchor = AnchorMiddle, hsize = 0.5, vsize = 1.45, nudge1 = -0.2, rotation = Nothing}, lmax = 10, innerPad = 0.1, outerPad = 2.0e-2, legendFrame = 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}), lplace = PlaceRight, lscale = 0.25}
--
-- ![legend example](other/legend.svg)
data LegendOptions = LegendOptions
  { LegendOptions -> Double
lsize :: Double,
    LegendOptions -> Double
vgap :: Double,
    LegendOptions -> Double
hgap :: Double,
    LegendOptions -> TextStyle
ltext :: TextStyle,
    LegendOptions -> Int
lmax :: Int,
    LegendOptions -> Double
innerPad :: Double,
    LegendOptions -> Double
outerPad :: Double,
    LegendOptions -> Maybe RectStyle
legendFrame :: Maybe RectStyle,
    LegendOptions -> Place
lplace :: Place,
    LegendOptions -> Double
lscale :: Double
  }
  deriving (Int -> LegendOptions -> ShowS
[LegendOptions] -> ShowS
LegendOptions -> String
(Int -> LegendOptions -> ShowS)
-> (LegendOptions -> String)
-> ([LegendOptions] -> ShowS)
-> Show LegendOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LegendOptions] -> ShowS
$cshowList :: [LegendOptions] -> ShowS
show :: LegendOptions -> String
$cshow :: LegendOptions -> String
showsPrec :: Int -> LegendOptions -> ShowS
$cshowsPrec :: Int -> LegendOptions -> ShowS
Show, LegendOptions -> LegendOptions -> Bool
(LegendOptions -> LegendOptions -> Bool)
-> (LegendOptions -> LegendOptions -> Bool) -> Eq LegendOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LegendOptions -> LegendOptions -> Bool
$c/= :: LegendOptions -> LegendOptions -> Bool
== :: LegendOptions -> LegendOptions -> Bool
$c== :: LegendOptions -> LegendOptions -> Bool
Eq, (forall x. LegendOptions -> Rep LegendOptions x)
-> (forall x. Rep LegendOptions x -> LegendOptions)
-> Generic LegendOptions
forall x. Rep LegendOptions x -> LegendOptions
forall x. LegendOptions -> Rep LegendOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LegendOptions x -> LegendOptions
$cfrom :: forall x. LegendOptions -> Rep LegendOptions x
Generic)

-- | The official legend options
defaultLegendOptions :: LegendOptions
defaultLegendOptions :: LegendOptions
defaultLegendOptions =
  Double
-> Double
-> Double
-> TextStyle
-> Int
-> Double
-> Double
-> Maybe RectStyle
-> Place
-> Double
-> LegendOptions
LegendOptions
    Double
0.3
    Double
0.2
    Double
0.1
    ( TextStyle
defaultTextStyle
        TextStyle -> (TextStyle -> TextStyle) -> TextStyle
forall a b. a -> (a -> b) -> b
& (Double -> Identity Double) -> TextStyle -> Identity TextStyle
forall a. IsLabel "size" a => a
forall (x :: Symbol) a. IsLabel x a => a
#size ((Double -> Identity Double) -> TextStyle -> Identity TextStyle)
-> Double -> TextStyle -> TextStyle
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Double
0.12
    )
    Int
10
    Double
0.1
    Double
0.02
    (RectStyle -> Maybe RectStyle
forall a. a -> Maybe a
Just (Double -> Colour -> Colour -> RectStyle
RectStyle Double
0.01 (Double -> Colour -> Colour
setOpac Double
1 Colour
dark) (Double -> Colour -> Colour
setOpac Double
0 Colour
dark)))
    Place
PlaceRight
    Double
0.25

-- | Generically scale an Annotation.
scaleAnn :: Double -> Annotation -> Annotation
scaleAnn :: Double -> Annotation -> Annotation
scaleAnn Double
x (LineA LineStyle
a) = LineStyle -> Annotation
LineA (LineStyle -> Annotation) -> LineStyle -> Annotation
forall a b. (a -> b) -> a -> b
$ LineStyle
a LineStyle -> (LineStyle -> LineStyle) -> LineStyle
forall a b. a -> (a -> b) -> b
& (Double -> Identity Double) -> LineStyle -> Identity LineStyle
forall a. IsLabel "width" a => a
forall (x :: Symbol) a. IsLabel x a => a
#width ((Double -> Identity Double) -> LineStyle -> Identity LineStyle)
-> (Double -> Double) -> LineStyle -> LineStyle
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Double
x)
scaleAnn Double
x (RectA RectStyle
a) = RectStyle -> Annotation
RectA (RectStyle -> Annotation) -> RectStyle -> Annotation
forall a b. (a -> b) -> a -> b
$ RectStyle
a RectStyle -> (RectStyle -> RectStyle) -> RectStyle
forall a b. a -> (a -> b) -> b
& (Double -> Identity Double) -> RectStyle -> Identity RectStyle
forall a. IsLabel "borderSize" a => a
forall (x :: Symbol) a. IsLabel x a => a
#borderSize ((Double -> Identity Double) -> RectStyle -> Identity RectStyle)
-> (Double -> Double) -> RectStyle -> RectStyle
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Double
x)
scaleAnn Double
x (TextA TextStyle
a [Text]
txs) = TextStyle -> [Text] -> Annotation
TextA (TextStyle
a TextStyle -> (TextStyle -> TextStyle) -> TextStyle
forall a b. a -> (a -> b) -> b
& (Double -> Identity Double) -> TextStyle -> Identity TextStyle
forall a. IsLabel "size" a => a
forall (x :: Symbol) a. IsLabel x a => a
#size ((Double -> Identity Double) -> TextStyle -> Identity TextStyle)
-> (Double -> Double) -> TextStyle -> TextStyle
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Double
x)) [Text]
txs
scaleAnn Double
x (GlyphA GlyphStyle
a) = GlyphStyle -> Annotation
GlyphA (GlyphStyle
a GlyphStyle -> (GlyphStyle -> GlyphStyle) -> GlyphStyle
forall a b. a -> (a -> b) -> b
& (Double -> Identity Double) -> GlyphStyle -> Identity GlyphStyle
forall a. IsLabel "size" a => a
forall (x :: Symbol) a. IsLabel x a => a
#size ((Double -> Identity Double) -> GlyphStyle -> Identity GlyphStyle)
-> (Double -> Double) -> GlyphStyle -> GlyphStyle
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Double
x))
scaleAnn Double
x (PathA PathStyle
a [PathInfo Double]
pxs) = PathStyle -> [PathInfo Double] -> Annotation
PathA (PathStyle
a PathStyle -> (PathStyle -> PathStyle) -> PathStyle
forall a b. a -> (a -> b) -> b
& (Double -> Identity Double) -> PathStyle -> Identity PathStyle
forall a. IsLabel "borderSize" a => a
forall (x :: Symbol) a. IsLabel x a => a
#borderSize ((Double -> Identity Double) -> PathStyle -> Identity PathStyle)
-> (Double -> Double) -> PathStyle -> PathStyle
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Double
x)) [PathInfo Double]
pxs
scaleAnn Double
_ Annotation
BlankA = Annotation
BlankA

-- | Translate the data in a chart.
moveChart :: (Additive a) => XY a -> [Chart a] -> [Chart a]
moveChart :: XY a -> [Chart a] -> [Chart a]
moveChart XY a
sp = (Chart a -> Chart a) -> [Chart a] -> [Chart a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([XY a] -> Identity [XY a]) -> Chart a -> Identity (Chart a)
forall a. IsLabel "xys" a => a
forall (x :: Symbol) a. IsLabel x a => a
#xys (([XY a] -> Identity [XY a]) -> Chart a -> Identity (Chart a))
-> ([XY a] -> [XY a]) -> Chart a -> Chart a
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (XY a -> XY a) -> [XY a] -> [XY a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (XY a
sp XY a -> XY a -> XY a
forall a. Additive a => a -> a -> a
+))

-- | Make huds from a HudOptions.
--
-- Some huds, such as the creation of tick values, can extend the data dimension of a chart, so we return a blank chart with the new data dimension.
-- The complexity internally to this function is due to the creation of ticks and, specifically, 'gridSensible', which is not idempotent. As a result, a tick calculation that does extends the data area, can then lead to new tick values when applying TickRound etc.
makeHud :: Rect Double -> HudOptions -> ([Hud Double], [Chart Double])
makeHud :: Rect Double -> HudOptions -> ([Hud Double], [Chart Double])
makeHud Rect Double
xs HudOptions
cfg =
  ([Hud Double
axes] [Hud Double] -> [Hud Double] -> [Hud Double]
forall a. Semigroup a => a -> a -> a
<> [Hud Double]
can [Hud Double] -> [Hud Double] -> [Hud Double]
forall a. Semigroup a => a -> a -> a
<> [Hud Double]
titles [Hud Double] -> [Hud Double] -> [Hud Double]
forall a. Semigroup a => a -> a -> a
<> [Hud Double]
l, [Chart Double]
xsext)
  where
    xs' :: Rect Double
xs' = Maybe (Rect Double) -> Rect Double
padBox (Rect Double -> Maybe (Rect Double)
forall a. a -> Maybe a
Just Rect Double
xs)
    can :: [Hud Double]
can = [Hud Double]
-> (RectStyle -> [Hud Double]) -> Maybe RectStyle -> [Hud Double]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\RectStyle
x -> [RectStyle -> Hud Double
forall (m :: * -> *). Monad m => RectStyle -> HudT m Double
canvas RectStyle
x]) (HudOptions
cfg HudOptions
-> Getting (Maybe RectStyle) HudOptions (Maybe RectStyle)
-> Maybe RectStyle
forall s a. s -> Getting a s a -> a
^. Getting (Maybe RectStyle) HudOptions (Maybe RectStyle)
forall a. IsLabel "hudCanvas" a => a
forall (x :: Symbol) a. IsLabel x a => a
#hudCanvas)
    titles :: [Hud Double]
titles = Title -> Hud Double
forall (m :: * -> *). Monad m => Title -> HudT m Double
title (Title -> Hud Double) -> [Title] -> [Hud Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (HudOptions
cfg HudOptions -> Getting [Title] HudOptions [Title] -> [Title]
forall s a. s -> Getting a s a -> a
^. Getting [Title] HudOptions [Title]
forall a. IsLabel "hudTitles" a => a
forall (x :: Symbol) a. IsLabel x a => a
#hudTitles)
    ticks :: [(TickStyle, Maybe (Rect Double))]
ticks =
      (\AxisOptions
a -> Place
-> Rect Double -> TickStyle -> (TickStyle, Maybe (Rect Double))
freezeTicks (AxisOptions
a AxisOptions -> Getting Place AxisOptions Place -> Place
forall s a. s -> Getting a s a -> a
^. Getting Place AxisOptions Place
forall a. IsLabel "place" a => a
forall (x :: Symbol) a. IsLabel x a => a
#place) Rect Double
xs' (AxisOptions
a AxisOptions -> Getting TickStyle AxisOptions TickStyle -> TickStyle
forall s a. s -> Getting a s a -> a
^. (Tick -> Const TickStyle Tick)
-> AxisOptions -> Const TickStyle AxisOptions
forall a. IsLabel "axisTick" a => a
forall (x :: Symbol) a. IsLabel x a => a
#axisTick ((Tick -> Const TickStyle Tick)
 -> AxisOptions -> Const TickStyle AxisOptions)
-> ((TickStyle -> Const TickStyle TickStyle)
    -> Tick -> Const TickStyle Tick)
-> Getting TickStyle AxisOptions TickStyle
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (TickStyle -> Const TickStyle TickStyle)
-> Tick -> Const TickStyle Tick
forall a. IsLabel "tstyle" a => a
forall (x :: Symbol) a. IsLabel x a => a
#tstyle))
        (AxisOptions -> (TickStyle, Maybe (Rect Double)))
-> [AxisOptions] -> [(TickStyle, Maybe (Rect Double))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (HudOptions
cfg HudOptions
-> Getting [AxisOptions] HudOptions [AxisOptions] -> [AxisOptions]
forall s a. s -> Getting a s a -> a
^. Getting [AxisOptions] HudOptions [AxisOptions]
forall a. IsLabel "hudAxes" a => a
forall (x :: Symbol) a. IsLabel x a => a
#hudAxes)
    hudaxes :: [AxisOptions]
hudaxes =
      (AxisOptions -> (TickStyle, Maybe (Rect Double)) -> AxisOptions)
-> [AxisOptions]
-> [(TickStyle, Maybe (Rect Double))]
-> [AxisOptions]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith
        (\AxisOptions
c (TickStyle, Maybe (Rect Double))
t -> AxisOptions
c AxisOptions -> (AxisOptions -> AxisOptions) -> AxisOptions
forall a b. a -> (a -> b) -> b
& (Tick -> Identity Tick) -> AxisOptions -> Identity AxisOptions
forall a. IsLabel "axisTick" a => a
forall (x :: Symbol) a. IsLabel x a => a
#axisTick ((Tick -> Identity Tick) -> AxisOptions -> Identity AxisOptions)
-> ((TickStyle -> Identity TickStyle) -> Tick -> Identity Tick)
-> (TickStyle -> Identity TickStyle)
-> AxisOptions
-> Identity AxisOptions
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (TickStyle -> Identity TickStyle) -> Tick -> Identity Tick
forall a. IsLabel "tstyle" a => a
forall (x :: Symbol) a. IsLabel x a => a
#tstyle ((TickStyle -> Identity TickStyle)
 -> AxisOptions -> Identity AxisOptions)
-> TickStyle -> AxisOptions -> AxisOptions
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (TickStyle, Maybe (Rect Double)) -> TickStyle
forall a b. (a, b) -> a
fst (TickStyle, Maybe (Rect Double))
t)
        (HudOptions
cfg HudOptions
-> Getting [AxisOptions] HudOptions [AxisOptions] -> [AxisOptions]
forall s a. s -> Getting a s a -> a
^. Getting [AxisOptions] HudOptions [AxisOptions]
forall a. IsLabel "hudAxes" a => a
forall (x :: Symbol) a. IsLabel x a => a
#hudAxes)
        [(TickStyle, Maybe (Rect Double))]
ticks
    tickRects :: [Rect Double]
tickRects = [Maybe (Rect Double)] -> [Rect Double]
forall a. [Maybe a] -> [a]
catMaybes ((TickStyle, Maybe (Rect Double)) -> Maybe (Rect Double)
forall a b. (a, b) -> b
snd ((TickStyle, Maybe (Rect Double)) -> Maybe (Rect Double))
-> [(TickStyle, Maybe (Rect Double))] -> [Maybe (Rect Double)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(TickStyle, Maybe (Rect Double))]
ticks)
    xsext :: [Chart Double]
xsext = [Chart Double] -> [Chart Double] -> Bool -> [Chart Double]
forall a. a -> a -> Bool -> a
bool [Annotation -> [XY Double] -> Chart Double
forall a. Annotation -> [XY a] -> Chart a
Chart Annotation
BlankA (Rect Double -> XY Double
forall a. Rect a -> XY a
RectXY (Rect Double -> XY Double) -> [Rect Double] -> [XY Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Rect Double]
tickRects)] [] ([Rect Double]
tickRects [Rect Double] -> [Rect Double] -> Bool
forall a. Eq a => a -> a -> Bool
== [])
    axes :: Hud Double
axes =
      (Hud Double -> Hud Double -> Hud Double)
-> Hud Double -> [Hud Double] -> Hud Double
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Hud Double -> Hud Double -> Hud Double
forall a (m :: * -> *).
(Ord a, Monad m) =>
HudT m a -> HudT m a -> HudT m a
simulHud Hud Double
forall a. Monoid a => a
mempty ([Hud Double] -> Hud Double) -> [Hud Double] -> Hud Double
forall a b. (a -> b) -> a -> b
$
        ( \AxisOptions
x ->
            Hud Double
-> (AxisBar -> Hud Double) -> Maybe AxisBar -> Hud Double
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Hud Double
forall a. Monoid a => a
mempty (Place -> AxisBar -> Hud Double
forall (m :: * -> *). Monad m => Place -> AxisBar -> HudT m Double
makeAxisBar (AxisOptions
x AxisOptions -> Getting Place AxisOptions Place -> Place
forall s a. s -> Getting a s a -> a
^. Getting Place AxisOptions Place
forall a. IsLabel "place" a => a
forall (x :: Symbol) a. IsLabel x a => a
#place)) (AxisOptions
x AxisOptions
-> Getting (Maybe AxisBar) AxisOptions (Maybe AxisBar)
-> Maybe AxisBar
forall s a. s -> Getting a s a -> a
^. Getting (Maybe AxisBar) AxisOptions (Maybe AxisBar)
forall a. IsLabel "axisBar" a => a
forall (x :: Symbol) a. IsLabel x a => a
#axisBar)
              Hud Double -> Hud Double -> Hud Double
forall a. Semigroup a => a -> a -> a
<> AxisOptions -> Hud Double
forall (m :: * -> *). Monad m => AxisOptions -> HudT m Double
makeTick AxisOptions
x
        )
          (AxisOptions -> Hud Double) -> [AxisOptions] -> [Hud Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [AxisOptions]
hudaxes
    l :: [Hud Double]
l =
      [Hud Double]
-> ((LegendOptions, [(Annotation, Text)]) -> [Hud Double])
-> Maybe (LegendOptions, [(Annotation, Text)])
-> [Hud Double]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
        []
        (\(LegendOptions
lo, [(Annotation, Text)]
ats) -> [LegendOptions -> [Chart Double] -> Hud Double
legendHud LegendOptions
lo ([(Annotation, Text)] -> LegendOptions -> [Chart Double]
legendChart [(Annotation, Text)]
ats LegendOptions
lo)])
        (HudOptions
cfg HudOptions
-> Getting
     (Maybe (LegendOptions, [(Annotation, Text)]))
     HudOptions
     (Maybe (LegendOptions, [(Annotation, Text)]))
-> Maybe (LegendOptions, [(Annotation, Text)])
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (LegendOptions, [(Annotation, Text)]))
  HudOptions
  (Maybe (LegendOptions, [(Annotation, Text)]))
forall a. IsLabel "hudLegend" a => a
forall (x :: Symbol) a. IsLabel x a => a
#hudLegend)

-- | convert TickRound to TickPlaced
freezeTicks :: Place -> Rect Double -> TickStyle -> (TickStyle, Maybe (Rect Double))
freezeTicks :: Place
-> Rect Double -> TickStyle -> (TickStyle, Maybe (Rect Double))
freezeTicks Place
pl Rect Double
xs' ts :: TickStyle
ts@TickRound {} = (TickStyle, Maybe (Rect Double))
-> (Rect Double -> (TickStyle, Maybe (Rect Double)))
-> Maybe (Rect Double)
-> (TickStyle, Maybe (Rect Double))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (TickStyle
ts, Maybe (Rect Double)
forall a. Maybe a
Nothing) (\Rect Double
x -> ([(Double, Text)] -> TickStyle
TickPlaced ([Double] -> [Text] -> [(Double, Text)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Double]
ps [Text]
ls), Rect Double -> Maybe (Rect Double)
forall a. a -> Maybe a
Just Rect Double
x)) ((\Range Double
x -> Place -> Range Double -> Rect Double -> Rect Double
replaceRange Place
pl Range Double
x Rect Double
xs') (Range Double -> Rect Double)
-> Maybe (Range Double) -> Maybe (Rect Double)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Range Double)
ext)
  where
    (TickComponents [Double]
ps [Text]
ls Maybe (Range Double)
ext) = TickStyle -> Range Double -> TickComponents
makeTicks TickStyle
ts (Place -> Rect Double -> Range Double
placeRange Place
pl Rect Double
xs')
    replaceRange :: Place -> Range Double -> Rect Double -> Rect Double
    replaceRange :: Place -> Range Double -> Rect Double -> Rect Double
replaceRange Place
pl' (Range Double
a0 Double
a1) (Rect Double
x Double
z Double
y Double
w) = case Place
pl' of
      Place
PlaceRight -> Double -> Double -> Double -> Double -> Rect Double
forall a. a -> a -> a -> a -> Rect a
Rect Double
x Double
z Double
a0 Double
a1
      Place
PlaceLeft -> Double -> Double -> Double -> Double -> Rect Double
forall a. a -> a -> a -> a -> Rect a
Rect Double
x Double
z Double
a0 Double
a1
      Place
_ -> Double -> Double -> Double -> Double -> Rect Double
forall a. a -> a -> a -> a -> Rect a
Rect Double
a0 Double
a1 Double
y Double
w
freezeTicks Place
_ Rect Double
_ TickStyle
ts = (TickStyle
ts, Maybe (Rect Double)
forall a. Maybe a
Nothing)

-- | flip an axis from being an X dimension to a Y one or vice-versa.
flipAxis :: AxisOptions -> AxisOptions
flipAxis :: AxisOptions -> AxisOptions
flipAxis AxisOptions
ac = case AxisOptions
ac AxisOptions -> Getting Place AxisOptions Place -> Place
forall s a. s -> Getting a s a -> a
^. Getting Place AxisOptions Place
forall a. IsLabel "place" a => a
forall (x :: Symbol) a. IsLabel x a => a
#place of
  Place
PlaceBottom -> AxisOptions
ac AxisOptions -> (AxisOptions -> AxisOptions) -> AxisOptions
forall a b. a -> (a -> b) -> b
& (Place -> Identity Place) -> AxisOptions -> Identity AxisOptions
forall a. IsLabel "place" a => a
forall (x :: Symbol) a. IsLabel x a => a
#place ((Place -> Identity Place) -> AxisOptions -> Identity AxisOptions)
-> Place -> AxisOptions -> AxisOptions
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Place
PlaceLeft
  Place
PlaceTop -> AxisOptions
ac AxisOptions -> (AxisOptions -> AxisOptions) -> AxisOptions
forall a b. a -> (a -> b) -> b
& (Place -> Identity Place) -> AxisOptions -> Identity AxisOptions
forall a. IsLabel "place" a => a
forall (x :: Symbol) a. IsLabel x a => a
#place ((Place -> Identity Place) -> AxisOptions -> Identity AxisOptions)
-> Place -> AxisOptions -> AxisOptions
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Place
PlaceRight
  Place
PlaceLeft -> AxisOptions
ac AxisOptions -> (AxisOptions -> AxisOptions) -> AxisOptions
forall a b. a -> (a -> b) -> b
& (Place -> Identity Place) -> AxisOptions -> Identity AxisOptions
forall a. IsLabel "place" a => a
forall (x :: Symbol) a. IsLabel x a => a
#place ((Place -> Identity Place) -> AxisOptions -> Identity AxisOptions)
-> Place -> AxisOptions -> AxisOptions
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Place
PlaceBottom
  Place
PlaceRight -> AxisOptions
ac AxisOptions -> (AxisOptions -> AxisOptions) -> AxisOptions
forall a b. a -> (a -> b) -> b
& (Place -> Identity Place) -> AxisOptions -> Identity AxisOptions
forall a. IsLabel "place" a => a
forall (x :: Symbol) a. IsLabel x a => a
#place ((Place -> Identity Place) -> AxisOptions -> Identity AxisOptions)
-> Place -> AxisOptions -> AxisOptions
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Place
PlaceTop
  PlaceAbsolute Point Double
_ -> AxisOptions
ac

addToRect :: (Ord a) => Rect a -> Maybe (Rect a) -> Rect a
addToRect :: Rect a -> Maybe (Rect a) -> Rect a
addToRect Rect a
r Maybe (Rect a)
r' = NonEmpty (Rect a) -> Rect a
forall a. Semigroup a => NonEmpty a -> a
sconcat (NonEmpty (Rect a) -> Rect a) -> NonEmpty (Rect a) -> Rect a
forall a b. (a -> b) -> a -> b
$ Rect a
r Rect a -> [Rect a] -> NonEmpty (Rect a)
forall a. a -> [a] -> NonEmpty a
:| Maybe (Rect a) -> [Rect a]
forall a. Maybe a -> [a]
maybeToList Maybe (Rect a)
r'

-- | Make a canvas hud element.
canvas :: (Monad m) => RectStyle -> HudT m Double
canvas :: RectStyle -> HudT m Double
canvas RectStyle
s = ([Chart Double] -> StateT (ChartDims Double) m [Chart Double])
-> HudT m Double
forall (m :: * -> *) a.
([Chart a] -> StateT (ChartDims a) m [Chart a]) -> HudT m a
Hud (([Chart Double] -> StateT (ChartDims Double) m [Chart Double])
 -> HudT m Double)
-> ([Chart Double] -> StateT (ChartDims Double) m [Chart Double])
-> HudT m Double
forall a b. (a -> b) -> a -> b
$ \[Chart Double]
cs -> do
  Rect Double
a <- Getting (Rect Double) (ChartDims Double) (Rect Double)
-> StateT (ChartDims Double) m (Rect Double)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (Rect Double) (ChartDims Double) (Rect Double)
forall a. IsLabel "canvasDim" a => a
forall (x :: Symbol) a. IsLabel x a => a
#canvasDim
  let c :: Chart Double
c = Annotation -> [XY Double] -> Chart Double
forall a. Annotation -> [XY a] -> Chart a
Chart (RectStyle -> Annotation
RectA RectStyle
s) [Rect Double -> XY Double
forall a. Rect a -> XY a
RectXY Rect Double
a]
  #canvasDim .= addToRect a (styleBox c)
  [Chart Double] -> StateT (ChartDims Double) m [Chart Double]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Chart Double] -> StateT (ChartDims Double) m [Chart Double])
-> [Chart Double] -> StateT (ChartDims Double) m [Chart Double]
forall a b. (a -> b) -> a -> b
$ Chart Double
c Chart Double -> [Chart Double] -> [Chart Double]
forall a. a -> [a] -> [a]
: [Chart Double]
cs

axisBar_ :: Place -> AxisBar -> Rect Double -> Rect Double -> Chart Double
axisBar_ :: Place -> AxisBar -> Rect Double -> Rect Double -> Chart Double
axisBar_ Place
pl AxisBar
b (Rect Double
x Double
z Double
y Double
w) (Rect Double
x' Double
z' Double
y' Double
w') =
  case Place
pl of
    Place
PlaceTop ->
      Annotation -> [XY Double] -> Chart Double
forall a. Annotation -> [XY a] -> Chart a
Chart
        (RectStyle -> Annotation
RectA (AxisBar -> RectStyle
rstyle AxisBar
b))
        [ Double -> Double -> Double -> Double -> XY Double
forall a. a -> a -> a -> a -> XY a
R
            Double
x
            Double
z
            (Double
w' Double -> Double -> Double
forall a. Additive a => a -> a -> a
+ AxisBar
b AxisBar -> Getting Double AxisBar Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double AxisBar Double
forall a. IsLabel "buff" a => a
forall (x :: Symbol) a. IsLabel x a => a
#buff)
            (Double
w' Double -> Double -> Double
forall a. Additive a => a -> a -> a
+ AxisBar
b AxisBar -> Getting Double AxisBar Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double AxisBar Double
forall a. IsLabel "buff" a => a
forall (x :: Symbol) a. IsLabel x a => a
#buff Double -> Double -> Double
forall a. Additive a => a -> a -> a
+ AxisBar
b AxisBar -> Getting Double AxisBar Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double AxisBar Double
forall a. IsLabel "wid" a => a
forall (x :: Symbol) a. IsLabel x a => a
#wid)
        ]
    Place
PlaceBottom ->
      Annotation -> [XY Double] -> Chart Double
forall a. Annotation -> [XY a] -> Chart a
Chart
        (RectStyle -> Annotation
RectA (AxisBar -> RectStyle
rstyle AxisBar
b))
        [ Double -> Double -> Double -> Double -> XY Double
forall a. a -> a -> a -> a -> XY a
R
            Double
x
            Double
z
            (Double
y' Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- AxisBar
b AxisBar -> Getting Double AxisBar Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double AxisBar Double
forall a. IsLabel "wid" a => a
forall (x :: Symbol) a. IsLabel x a => a
#wid Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- AxisBar
b AxisBar -> Getting Double AxisBar Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double AxisBar Double
forall a. IsLabel "buff" a => a
forall (x :: Symbol) a. IsLabel x a => a
#buff)
            (Double
y' Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- AxisBar
b AxisBar -> Getting Double AxisBar Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double AxisBar Double
forall a. IsLabel "buff" a => a
forall (x :: Symbol) a. IsLabel x a => a
#buff)
        ]
    Place
PlaceLeft ->
      Annotation -> [XY Double] -> Chart Double
forall a. Annotation -> [XY a] -> Chart a
Chart
        (RectStyle -> Annotation
RectA (AxisBar -> RectStyle
rstyle AxisBar
b))
        [ Double -> Double -> Double -> Double -> XY Double
forall a. a -> a -> a -> a -> XY a
R
            (Double
x' Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- AxisBar
b AxisBar -> Getting Double AxisBar Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double AxisBar Double
forall a. IsLabel "wid" a => a
forall (x :: Symbol) a. IsLabel x a => a
#wid Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- AxisBar
b AxisBar -> Getting Double AxisBar Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double AxisBar Double
forall a. IsLabel "buff" a => a
forall (x :: Symbol) a. IsLabel x a => a
#buff)
            (Double
x' Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- AxisBar
b AxisBar -> Getting Double AxisBar Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double AxisBar Double
forall a. IsLabel "buff" a => a
forall (x :: Symbol) a. IsLabel x a => a
#buff)
            Double
y
            Double
w
        ]
    Place
PlaceRight ->
      Annotation -> [XY Double] -> Chart Double
forall a. Annotation -> [XY a] -> Chart a
Chart
        (RectStyle -> Annotation
RectA (AxisBar -> RectStyle
rstyle AxisBar
b))
        [ Double -> Double -> Double -> Double -> XY Double
forall a. a -> a -> a -> a -> XY a
R
            (Double
z' Double -> Double -> Double
forall a. Additive a => a -> a -> a
+ (AxisBar
b AxisBar -> Getting Double AxisBar Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double AxisBar Double
forall a. IsLabel "buff" a => a
forall (x :: Symbol) a. IsLabel x a => a
#buff))
            (Double
z' Double -> Double -> Double
forall a. Additive a => a -> a -> a
+ (AxisBar
b AxisBar -> Getting Double AxisBar Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double AxisBar Double
forall a. IsLabel "buff" a => a
forall (x :: Symbol) a. IsLabel x a => a
#buff) Double -> Double -> Double
forall a. Additive a => a -> a -> a
+ (AxisBar
b AxisBar -> Getting Double AxisBar Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double AxisBar Double
forall a. IsLabel "wid" a => a
forall (x :: Symbol) a. IsLabel x a => a
#wid))
            Double
y
            Double
w
        ]
    PlaceAbsolute (Point Double
x'' Double
_) ->
      Annotation -> [XY Double] -> Chart Double
forall a. Annotation -> [XY a] -> Chart a
Chart
        (RectStyle -> Annotation
RectA (AxisBar -> RectStyle
rstyle AxisBar
b))
        [ Double -> Double -> Double -> Double -> XY Double
forall a. a -> a -> a -> a -> XY a
R
            (Double
x'' Double -> Double -> Double
forall a. Additive a => a -> a -> a
+ (AxisBar
b AxisBar -> Getting Double AxisBar Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double AxisBar Double
forall a. IsLabel "buff" a => a
forall (x :: Symbol) a. IsLabel x a => a
#buff))
            (Double
x'' Double -> Double -> Double
forall a. Additive a => a -> a -> a
+ (AxisBar
b AxisBar -> Getting Double AxisBar Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double AxisBar Double
forall a. IsLabel "buff" a => a
forall (x :: Symbol) a. IsLabel x a => a
#buff) Double -> Double -> Double
forall a. Additive a => a -> a -> a
+ (AxisBar
b AxisBar -> Getting Double AxisBar Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double AxisBar Double
forall a. IsLabel "wid" a => a
forall (x :: Symbol) a. IsLabel x a => a
#wid))
            Double
y
            Double
w
        ]

makeAxisBar :: (Monad m) => Place -> AxisBar -> HudT m Double
makeAxisBar :: Place -> AxisBar -> HudT m Double
makeAxisBar Place
pl AxisBar
b = ([Chart Double] -> StateT (ChartDims Double) m [Chart Double])
-> HudT m Double
forall (m :: * -> *) a.
([Chart a] -> StateT (ChartDims a) m [Chart a]) -> HudT m a
Hud (([Chart Double] -> StateT (ChartDims Double) m [Chart Double])
 -> HudT m Double)
-> ([Chart Double] -> StateT (ChartDims Double) m [Chart Double])
-> HudT m Double
forall a b. (a -> b) -> a -> b
$ \[Chart Double]
cs -> do
  Rect Double
da <- Getting (Rect Double) (ChartDims Double) (Rect Double)
-> StateT (ChartDims Double) m (Rect Double)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (Rect Double) (ChartDims Double) (Rect Double)
forall a. IsLabel "chartDim" a => a
forall (x :: Symbol) a. IsLabel x a => a
#chartDim
  Rect Double
ca <- Getting (Rect Double) (ChartDims Double) (Rect Double)
-> StateT (ChartDims Double) m (Rect Double)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (Rect Double) (ChartDims Double) (Rect Double)
forall a. IsLabel "canvasDim" a => a
forall (x :: Symbol) a. IsLabel x a => a
#canvasDim
  let c :: Chart Double
c = Place -> AxisBar -> Rect Double -> Rect Double -> Chart Double
axisBar_ Place
pl AxisBar
b Rect Double
ca Rect Double
da
  #chartDim .= addChartBox c da
  [Chart Double] -> StateT (ChartDims Double) m [Chart Double]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Chart Double] -> StateT (ChartDims Double) m [Chart Double])
-> [Chart Double] -> StateT (ChartDims Double) m [Chart Double]
forall a b. (a -> b) -> a -> b
$ Chart Double
c Chart Double -> [Chart Double] -> [Chart Double]
forall a. a -> [a] -> [a]
: [Chart Double]
cs

title_ :: Title -> Rect Double -> Chart Double
title_ :: Title -> Rect Double -> Chart Double
title_ Title
t Rect Double
a =
  Annotation -> [XY Double] -> Chart Double
forall a. Annotation -> [XY a] -> Chart a
Chart
    ( TextStyle -> [Text] -> Annotation
TextA
        ( TextStyle
style'
            TextStyle -> (TextStyle -> TextStyle) -> TextStyle
forall a b. a -> (a -> b) -> b
& (Maybe Double -> Identity (Maybe Double))
-> TextStyle -> Identity TextStyle
forall a. IsLabel "rotation" a => a
forall (x :: Symbol) a. IsLabel x a => a
#rotation ((Maybe Double -> Identity (Maybe Double))
 -> TextStyle -> Identity TextStyle)
-> Double -> TextStyle -> TextStyle
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Double
rot
        )
        [Title
t Title -> Getting Text Title Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text Title Text
forall a. IsLabel "text" a => a
forall (x :: Symbol) a. IsLabel x a => a
#text]
    )
    [Point Double -> XY Double
forall a. Point a -> XY a
PointXY (Rect Double -> Point Double
placePos' Rect Double
a Point Double -> Point Double -> Point Double
forall a. Additive a => a -> a -> a
+ Rect Double -> Point Double
alignPos Rect Double
a)]
  where
    style' :: TextStyle
style'
      | Title
t Title -> Getting Anchor Title Anchor -> Anchor
forall s a. s -> Getting a s a -> a
^. Getting Anchor Title Anchor
forall a. IsLabel "anchor" a => a
forall (x :: Symbol) a. IsLabel x a => a
#anchor Anchor -> Anchor -> Bool
forall a. Eq a => a -> a -> Bool
== Anchor
AnchorStart =
        #anchor .~ AnchorStart $ t ^. #style
      | Title
t Title -> Getting Anchor Title Anchor -> Anchor
forall s a. s -> Getting a s a -> a
^. Getting Anchor Title Anchor
forall a. IsLabel "anchor" a => a
forall (x :: Symbol) a. IsLabel x a => a
#anchor Anchor -> Anchor -> Bool
forall a. Eq a => a -> a -> Bool
== Anchor
AnchorEnd =
        #anchor .~ AnchorEnd $ t ^. #style
      | Bool
otherwise = Title
t Title -> Getting TextStyle Title TextStyle -> TextStyle
forall s a. s -> Getting a s a -> a
^. Getting TextStyle Title TextStyle
forall a. IsLabel "style" a => a
forall (x :: Symbol) a. IsLabel x a => a
#style
    rot :: Double
rot
      | Title
t Title -> Getting Place Title Place -> Place
forall s a. s -> Getting a s a -> a
^. Getting Place Title Place
forall a. IsLabel "place" a => a
forall (x :: Symbol) a. IsLabel x a => a
#place Place -> Place -> Bool
forall a. Eq a => a -> a -> Bool
== Place
PlaceRight = Double
forall a. TrigField a => a
pi Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ Double
2
      | Title
t Title -> Getting Place Title Place -> Place
forall s a. s -> Getting a s a -> a
^. Getting Place Title Place
forall a. IsLabel "place" a => a
forall (x :: Symbol) a. IsLabel x a => a
#place Place -> Place -> Bool
forall a. Eq a => a -> a -> Bool
== Place
PlaceLeft = - Double
forall a. TrigField a => a
pi Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ Double
2
      | Bool
otherwise = Double
0
    placePos' :: Rect Double -> Point Double
placePos' (Rect Double
x Double
z Double
y Double
w) = case Title
t Title -> Getting Place Title Place -> Place
forall s a. s -> Getting a s a -> a
^. Getting Place Title Place
forall a. IsLabel "place" a => a
forall (x :: Symbol) a. IsLabel x a => a
#place of
      Place
PlaceTop -> Double -> Double -> Point Double
forall a. a -> a -> Point a
Point ((Double
x Double -> Double -> Double
forall a. Additive a => a -> a -> a
+ Double
z) Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ Double
2.0) (Double
w Double -> Double -> Double
forall a. Additive a => a -> a -> a
+ (Title
t Title -> Getting Double Title Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double Title Double
forall a. IsLabel "buff" a => a
forall (x :: Symbol) a. IsLabel x a => a
#buff))
      Place
PlaceBottom ->
        Double -> Double -> Point Double
forall a. a -> a -> Point a
Point
          ((Double
x Double -> Double -> Double
forall a. Additive a => a -> a -> a
+ Double
z) Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ Double
2.0)
          ( Double
y Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- (Title
t Title -> Getting Double Title Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double Title Double
forall a. IsLabel "buff" a => a
forall (x :: Symbol) a. IsLabel x a => a
#buff)
              Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- Double
0.5
              Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* (Title
t Title -> Getting Double Title Double -> Double
forall s a. s -> Getting a s a -> a
^. (TextStyle -> Const Double TextStyle)
-> Title -> Const Double Title
forall a. IsLabel "style" a => a
forall (x :: Symbol) a. IsLabel x a => a
#style ((TextStyle -> Const Double TextStyle)
 -> Title -> Const Double Title)
-> ((Double -> Const Double Double)
    -> TextStyle -> Const Double TextStyle)
-> Getting Double Title Double
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Double -> Const Double Double)
-> TextStyle -> Const Double TextStyle
forall a. IsLabel "vsize" a => a
forall (x :: Symbol) a. IsLabel x a => a
#vsize)
              Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* (Title
t Title -> Getting Double Title Double -> Double
forall s a. s -> Getting a s a -> a
^. (TextStyle -> Const Double TextStyle)
-> Title -> Const Double Title
forall a. IsLabel "style" a => a
forall (x :: Symbol) a. IsLabel x a => a
#style ((TextStyle -> Const Double TextStyle)
 -> Title -> Const Double Title)
-> ((Double -> Const Double Double)
    -> TextStyle -> Const Double TextStyle)
-> Getting Double Title Double
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Double -> Const Double Double)
-> TextStyle -> Const Double TextStyle
forall a. IsLabel "size" a => a
forall (x :: Symbol) a. IsLabel x a => a
#size)
          )
      Place
PlaceLeft -> Double -> Double -> Point Double
forall a. a -> a -> Point a
Point (Double
x Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- (Title
t Title -> Getting Double Title Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double Title Double
forall a. IsLabel "buff" a => a
forall (x :: Symbol) a. IsLabel x a => a
#buff)) ((Double
y Double -> Double -> Double
forall a. Additive a => a -> a -> a
+ Double
w) Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ Double
2.0)
      Place
PlaceRight -> Double -> Double -> Point Double
forall a. a -> a -> Point a
Point (Double
z Double -> Double -> Double
forall a. Additive a => a -> a -> a
+ (Title
t Title -> Getting Double Title Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double Title Double
forall a. IsLabel "buff" a => a
forall (x :: Symbol) a. IsLabel x a => a
#buff)) ((Double
y Double -> Double -> Double
forall a. Additive a => a -> a -> a
+ Double
w) Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ Double
2.0)
      PlaceAbsolute Point Double
p -> Point Double
p
    alignPos :: Rect Double -> Point Double
alignPos (Rect Double
x Double
z Double
y Double
w)
      | Title
t Title -> Getting Anchor Title Anchor -> Anchor
forall s a. s -> Getting a s a -> a
^. Getting Anchor Title Anchor
forall a. IsLabel "anchor" a => a
forall (x :: Symbol) a. IsLabel x a => a
#anchor Anchor -> Anchor -> Bool
forall a. Eq a => a -> a -> Bool
== Anchor
AnchorStart
          Bool -> Bool -> Bool
&& Title
t Title -> Getting Place Title Place -> Place
forall s a. s -> Getting a s a -> a
^. Getting Place Title Place
forall a. IsLabel "place" a => a
forall (x :: Symbol) a. IsLabel x a => a
#place Place -> [Place] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Place
PlaceTop, Place
PlaceBottom] =
        Double -> Double -> Point Double
forall a. a -> a -> Point a
Point ((Double
x Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- Double
z) Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ Double
2.0) Double
0.0
      | Title
t Title -> Getting Anchor Title Anchor -> Anchor
forall s a. s -> Getting a s a -> a
^. Getting Anchor Title Anchor
forall a. IsLabel "anchor" a => a
forall (x :: Symbol) a. IsLabel x a => a
#anchor Anchor -> Anchor -> Bool
forall a. Eq a => a -> a -> Bool
== Anchor
AnchorStart
          Bool -> Bool -> Bool
&& Title
t Title -> Getting Place Title Place -> Place
forall s a. s -> Getting a s a -> a
^. Getting Place Title Place
forall a. IsLabel "place" a => a
forall (x :: Symbol) a. IsLabel x a => a
#place Place -> Place -> Bool
forall a. Eq a => a -> a -> Bool
== Place
PlaceLeft =
        Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
0.0 ((Double
y Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- Double
w) Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ Double
2.0)
      | Title
t Title -> Getting Anchor Title Anchor -> Anchor
forall s a. s -> Getting a s a -> a
^. Getting Anchor Title Anchor
forall a. IsLabel "anchor" a => a
forall (x :: Symbol) a. IsLabel x a => a
#anchor Anchor -> Anchor -> Bool
forall a. Eq a => a -> a -> Bool
== Anchor
AnchorStart
          Bool -> Bool -> Bool
&& Title
t Title -> Getting Place Title Place -> Place
forall s a. s -> Getting a s a -> a
^. Getting Place Title Place
forall a. IsLabel "place" a => a
forall (x :: Symbol) a. IsLabel x a => a
#place Place -> Place -> Bool
forall a. Eq a => a -> a -> Bool
== Place
PlaceRight =
        Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
0.0 ((Double
w Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- Double
y) Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ Double
2.0)
      | Title
t Title -> Getting Anchor Title Anchor -> Anchor
forall s a. s -> Getting a s a -> a
^. Getting Anchor Title Anchor
forall a. IsLabel "anchor" a => a
forall (x :: Symbol) a. IsLabel x a => a
#anchor Anchor -> Anchor -> Bool
forall a. Eq a => a -> a -> Bool
== Anchor
AnchorEnd
          Bool -> Bool -> Bool
&& Title
t Title -> Getting Place Title Place -> Place
forall s a. s -> Getting a s a -> a
^. Getting Place Title Place
forall a. IsLabel "place" a => a
forall (x :: Symbol) a. IsLabel x a => a
#place Place -> [Place] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Place
PlaceTop, Place
PlaceBottom] =
        Double -> Double -> Point Double
forall a. a -> a -> Point a
Point ((- Double
x Double -> Double -> Double
forall a. Additive a => a -> a -> a
+ Double
z) Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ Double
2.0) Double
0.0
      | Title
t Title -> Getting Anchor Title Anchor -> Anchor
forall s a. s -> Getting a s a -> a
^. Getting Anchor Title Anchor
forall a. IsLabel "anchor" a => a
forall (x :: Symbol) a. IsLabel x a => a
#anchor Anchor -> Anchor -> Bool
forall a. Eq a => a -> a -> Bool
== Anchor
AnchorEnd
          Bool -> Bool -> Bool
&& Title
t Title -> Getting Place Title Place -> Place
forall s a. s -> Getting a s a -> a
^. Getting Place Title Place
forall a. IsLabel "place" a => a
forall (x :: Symbol) a. IsLabel x a => a
#place Place -> Place -> Bool
forall a. Eq a => a -> a -> Bool
== Place
PlaceLeft =
        Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
0.0 ((- Double
y Double -> Double -> Double
forall a. Additive a => a -> a -> a
+ Double
w) Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ Double
2.0)
      | Title
t Title -> Getting Anchor Title Anchor -> Anchor
forall s a. s -> Getting a s a -> a
^. Getting Anchor Title Anchor
forall a. IsLabel "anchor" a => a
forall (x :: Symbol) a. IsLabel x a => a
#anchor Anchor -> Anchor -> Bool
forall a. Eq a => a -> a -> Bool
== Anchor
AnchorEnd
          Bool -> Bool -> Bool
&& Title
t Title -> Getting Place Title Place -> Place
forall s a. s -> Getting a s a -> a
^. Getting Place Title Place
forall a. IsLabel "place" a => a
forall (x :: Symbol) a. IsLabel x a => a
#place Place -> Place -> Bool
forall a. Eq a => a -> a -> Bool
== Place
PlaceRight =
        Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
0.0 ((Double
y Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- Double
w) Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ Double
2.0)
      | Bool
otherwise = Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
0.0 Double
0.0

-- | Add a title to a chart. The logic used to work out placement is flawed due to being able to freely specify text rotation.  It works for specific rotations (Top, Bottom at 0, Left at 90, Right @ 270)
title :: (Monad m) => Title -> HudT m Double
title :: Title -> HudT m Double
title Title
t = ([Chart Double] -> StateT (ChartDims Double) m [Chart Double])
-> HudT m Double
forall (m :: * -> *) a.
([Chart a] -> StateT (ChartDims a) m [Chart a]) -> HudT m a
Hud (([Chart Double] -> StateT (ChartDims Double) m [Chart Double])
 -> HudT m Double)
-> ([Chart Double] -> StateT (ChartDims Double) m [Chart Double])
-> HudT m Double
forall a b. (a -> b) -> a -> b
$ \[Chart Double]
cs -> do
  Rect Double
ca <- Getting (Rect Double) (ChartDims Double) (Rect Double)
-> StateT (ChartDims Double) m (Rect Double)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (Rect Double) (ChartDims Double) (Rect Double)
forall a. IsLabel "chartDim" a => a
forall (x :: Symbol) a. IsLabel x a => a
#chartDim
  let c :: Chart Double
c = Title -> Rect Double -> Chart Double
title_ Title
t Rect Double
ca
  #chartDim .= addChartBox c ca
  [Chart Double] -> StateT (ChartDims Double) m [Chart Double]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Chart Double] -> StateT (ChartDims Double) m [Chart Double])
-> [Chart Double] -> StateT (ChartDims Double) m [Chart Double]
forall a b. (a -> b) -> a -> b
$ Chart Double
c Chart Double -> [Chart Double] -> [Chart Double]
forall a. a -> [a] -> [a]
: [Chart Double]
cs

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

placeRot :: Place -> Maybe Double
placeRot :: Place -> Maybe Double
placeRot Place
pl = case Place
pl of
  Place
PlaceRight -> Double -> Maybe Double
forall a. a -> Maybe a
Just (Double
forall a. TrigField a => a
pi Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ Double
2)
  Place
PlaceLeft -> Double -> Maybe Double
forall a. a -> Maybe a
Just (Double
forall a. TrigField a => a
pi Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ Double
2)
  Place
_ -> Maybe Double
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 -> Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
0 Double
b
  Place
PlaceBottom -> Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
0 (- Double
b Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- Double
0.5 Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* (TextStyle
tt TextStyle
-> ((Double -> Const Double Double)
    -> TextStyle -> Const Double TextStyle)
-> Double
forall s a. s -> Getting a s a -> a
^. (Double -> Const Double Double)
-> TextStyle -> Const Double TextStyle
forall a. IsLabel "vsize" a => a
forall (x :: Symbol) a. IsLabel x a => a
#vsize) Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* (TextStyle
tt TextStyle
-> ((Double -> Const Double Double)
    -> TextStyle -> Const Double TextStyle)
-> Double
forall s a. s -> Getting a s a -> a
^. (Double -> Const Double Double)
-> TextStyle -> Const Double TextStyle
forall a. IsLabel "size" a => a
forall (x :: Symbol) a. IsLabel x a => a
#size))
  Place
PlaceLeft ->
    Double -> Double -> Point Double
forall a. a -> a -> Point a
Point
      (- Double
b)
      ((TextStyle
tt TextStyle
-> ((Double -> Const Double Double)
    -> TextStyle -> Const Double TextStyle)
-> Double
forall s a. s -> Getting a s a -> a
^. (Double -> Const Double Double)
-> TextStyle -> Const Double TextStyle
forall a. IsLabel "nudge1" a => a
forall (x :: Symbol) a. IsLabel x a => a
#nudge1) Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* (TextStyle
tt TextStyle
-> ((Double -> Const Double Double)
    -> TextStyle -> Const Double TextStyle)
-> Double
forall s a. s -> Getting a s a -> a
^. (Double -> Const Double Double)
-> TextStyle -> Const Double TextStyle
forall a. IsLabel "vsize" a => a
forall (x :: Symbol) a. IsLabel x a => a
#vsize) Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* (TextStyle
tt TextStyle
-> ((Double -> Const Double Double)
    -> TextStyle -> Const Double TextStyle)
-> Double
forall s a. s -> Getting a s a -> a
^. (Double -> Const Double Double)
-> TextStyle -> Const Double TextStyle
forall a. IsLabel "size" a => a
forall (x :: Symbol) a. IsLabel x a => a
#size))
  Place
PlaceRight ->
    Double -> Double -> Point Double
forall a. a -> a -> Point a
Point
      Double
b
      ((TextStyle
tt TextStyle
-> ((Double -> Const Double Double)
    -> TextStyle -> Const Double TextStyle)
-> Double
forall s a. s -> Getting a s a -> a
^. (Double -> Const Double Double)
-> TextStyle -> Const Double TextStyle
forall a. IsLabel "nudge1" a => a
forall (x :: Symbol) a. IsLabel x a => a
#nudge1) Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* (TextStyle
tt TextStyle
-> ((Double -> Const Double Double)
    -> TextStyle -> Const Double TextStyle)
-> Double
forall s a. s -> Getting a s a -> a
^. (Double -> Const Double Double)
-> TextStyle -> Const Double TextStyle
forall a. IsLabel "vsize" a => a
forall (x :: Symbol) a. IsLabel x a => a
#vsize) Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* (TextStyle
tt TextStyle
-> ((Double -> Const Double Double)
    -> TextStyle -> Const Double TextStyle)
-> Double
forall s a. s -> Getting a s a -> a
^. (Double -> Const Double Double)
-> TextStyle -> Const Double TextStyle
forall a. IsLabel "size" a => a
forall (x :: Symbol) a. IsLabel x a => a
#size))
  PlaceAbsolute Point Double
p -> Point Double
p

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

placeOrigin :: Place -> Double -> Point Double
placeOrigin :: Place -> Double -> Point Double
placeOrigin Place
pl Double
x
  | Place
pl Place -> [Place] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Place
PlaceTop, Place
PlaceBottom] = Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
x Double
0
  | Bool
otherwise = Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
0 Double
x

placeTextAnchor :: Place -> (TextStyle -> TextStyle)
placeTextAnchor :: Place -> TextStyle -> TextStyle
placeTextAnchor Place
pl
  | Place
pl Place -> Place -> Bool
forall a. Eq a => a -> a -> Bool
== Place
PlaceLeft = (Anchor -> Identity Anchor) -> TextStyle -> Identity TextStyle
forall a. IsLabel "anchor" a => a
forall (x :: Symbol) a. IsLabel x a => a
#anchor ((Anchor -> Identity Anchor) -> TextStyle -> Identity TextStyle)
-> Anchor -> TextStyle -> TextStyle
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Anchor
AnchorEnd
  | Place
pl Place -> Place -> Bool
forall a. Eq a => a -> a -> Bool
== Place
PlaceRight = (Anchor -> Identity Anchor) -> TextStyle -> Identity TextStyle
forall a. IsLabel "anchor" a => a
forall (x :: Symbol) a. IsLabel x a => a
#anchor ((Anchor -> Identity Anchor) -> TextStyle -> Identity TextStyle)
-> Anchor -> TextStyle -> TextStyle
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Anchor
AnchorStart
  | Bool
otherwise = TextStyle -> TextStyle
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id

placeGridLines :: Place -> Rect Double -> Double -> Double -> [XY Double]
placeGridLines :: Place -> Rect Double -> Double -> Double -> [XY Double]
placeGridLines Place
pl (Rect Double
x Double
z Double
y Double
w) Double
a Double
b
  | Place
pl Place -> [Place] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Place
PlaceTop, Place
PlaceBottom] = [Double -> Double -> XY Double
forall a. a -> a -> XY a
P Double
a (Double
y Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- Double
b), Double -> Double -> XY Double
forall a. a -> a -> XY a
P Double
a (Double
w Double -> Double -> Double
forall a. Additive a => a -> a -> a
+ Double
b)]
  | Bool
otherwise = [Double -> Double -> XY Double
forall a. a -> a -> XY a
P (Double
x Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- Double
b) Double
a, Double -> Double -> XY Double
forall a. a -> a -> XY a
P (Double
z Double -> Double -> Double
forall a. Additive 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 -> [Double] -> [Text] -> [(Double, Text)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Range Double
-> Range Double -> Element (Range Double) -> Element (Range Double)
forall s.
(Space s, Field (Element s)) =>
s -> s -> Element s -> Element s
project Range Double
r Range Double
d (Double -> Double) -> [Double] -> [Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Double]
ticks0) (FormatN -> [Double] -> [Text]
formatNs FormatN
f [Double]
ticks0)
      where
        ticks0 :: [Double]
ticks0 = Pos -> Bool -> Range Double -> Integer -> [Double]
gridSensible Pos
OuterPos (TickExtend
e TickExtend -> TickExtend -> Bool
forall a. Eq a => a -> a -> Bool
== TickExtend
NoTickExtend) Range Double
r (Int -> Integer
forall a b. FromIntegral a b => b -> a
fromIntegral Int
n :: Integer)
    TickExact FormatN
f Int
n -> [Double] -> [Text] -> [(Double, Text)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Range Double
-> Range Double -> Element (Range Double) -> Element (Range Double)
forall s.
(Space s, Field (Element s)) =>
s -> s -> Element s -> Element s
project Range Double
r Range Double
d (Double -> Double) -> [Double] -> [Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Double]
[Element (Range Double)]
ticks0) (FormatN -> [Double] -> [Text]
formatNs FormatN
f [Double]
[Element (Range Double)]
ticks0)
      where
        ticks0 :: [Element (Range Double)]
ticks0 = Pos
-> Range Double -> Grid (Range Double) -> [Element (Range Double)]
forall s. FieldSpace s => Pos -> s -> Grid s -> [Element s]
grid Pos
OuterPos Range Double
r Int
Grid (Range Double)
n
    TickLabels [Text]
ls ->
      [Double] -> [Text] -> [(Double, Text)]
forall a b. [a] -> [b] -> [(a, b)]
zip
        ( Range Double
-> Range Double -> Element (Range Double) -> Element (Range Double)
forall s.
(Space s, Field (Element s)) =>
s -> s -> Element s -> Element s
project (Double -> Double -> Range Double
forall a. a -> a -> Range a
Range Double
0 (Int -> Double
forall a b. FromIntegral a b => b -> a
fromIntegral (Int -> Double) -> Int -> Double
forall a b. (a -> b) -> a -> b
$ [Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
ls)) Range Double
d
            (Double -> Double) -> [Double] -> [Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((\Double
x -> Double
x Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- Double
0.5) (Double -> Double) -> (Int -> Double) -> Int -> Double
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int -> Double
forall a b. FromIntegral a b => b -> a
fromIntegral (Int -> Double) -> [Int] -> [Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int
1 .. [Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
ls])
        )
        [Text]
ls
    TickPlaced [(Double, Text)]
xs -> [Double] -> [Text] -> [(Double, Text)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Range Double
-> Range Double -> Element (Range Double) -> Element (Range Double)
forall s.
(Space s, Field (Element s)) =>
s -> s -> Element s -> Element s
project Range Double
r Range Double
d (Double -> Double)
-> ((Double, Text) -> Double) -> (Double, Text) -> Double
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Double, Text) -> Double
forall a b. (a, b) -> a
fst ((Double, Text) -> Double) -> [(Double, Text)] -> [Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Double, Text)]
xs) ((Double, Text) -> Text
forall a b. (a, b) -> b
snd ((Double, Text) -> Text) -> [(Double, Text)] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Double, Text)]
xs)

data TickComponents = TickComponents
  { TickComponents -> [Double]
positions :: [Double],
    TickComponents -> [Text]
labels :: [Text],
    TickComponents -> Maybe (Range Double)
extension :: Maybe (Range Double)
  }
  deriving (TickComponents -> TickComponents -> Bool
(TickComponents -> TickComponents -> Bool)
-> (TickComponents -> TickComponents -> Bool) -> Eq TickComponents
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TickComponents -> TickComponents -> Bool
$c/= :: TickComponents -> TickComponents -> Bool
== :: TickComponents -> TickComponents -> Bool
$c== :: TickComponents -> TickComponents -> Bool
Eq, Int -> TickComponents -> ShowS
[TickComponents] -> ShowS
TickComponents -> String
(Int -> TickComponents -> ShowS)
-> (TickComponents -> String)
-> ([TickComponents] -> ShowS)
-> Show TickComponents
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TickComponents] -> ShowS
$cshowList :: [TickComponents] -> ShowS
show :: TickComponents -> String
$cshow :: TickComponents -> String
showsPrec :: Int -> TickComponents -> ShowS
$cshowsPrec :: Int -> TickComponents -> ShowS
Show, (forall x. TickComponents -> Rep TickComponents x)
-> (forall x. Rep TickComponents x -> TickComponents)
-> Generic TickComponents
forall x. Rep TickComponents x -> TickComponents
forall x. TickComponents -> Rep TickComponents x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TickComponents x -> TickComponents
$cfrom :: forall x. TickComponents -> Rep TickComponents x
Generic)

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

-- | compute tick values given placement, canvas dimension & data range
ticksPlaced :: TickStyle -> Place -> Rect Double -> Rect Double -> TickComponents
ticksPlaced :: TickStyle -> Place -> Rect Double -> Rect Double -> TickComponents
ticksPlaced TickStyle
ts Place
pl Rect Double
d Rect Double
xs = [Double] -> [Text] -> Maybe (Range Double) -> TickComponents
TickComponents (Range Double
-> Range Double -> Element (Range Double) -> Element (Range Double)
forall s.
(Space s, Field (Element s)) =>
s -> s -> Element s -> Element s
project (Place -> Rect Double -> Range Double
placeRange Place
pl Rect Double
xs) (Place -> Rect Double -> Range Double
placeRange Place
pl Rect Double
d) (Double -> Double) -> [Double] -> [Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Double]
ps) [Text]
ls Maybe (Range Double)
ext
  where
    (TickComponents [Double]
ps [Text]
ls Maybe (Range Double)
ext) = TickStyle -> Range Double -> TickComponents
makeTicks TickStyle
ts (Place -> Rect Double -> Range Double
placeRange Place
pl Rect Double
xs)

tickGlyph_ :: Place -> (GlyphStyle, Double) -> TickStyle -> Rect Double -> Rect Double -> Rect Double -> Chart Double
tickGlyph_ :: Place
-> (GlyphStyle, Double)
-> TickStyle
-> Rect Double
-> Rect Double
-> Rect Double
-> Chart Double
tickGlyph_ Place
pl (GlyphStyle
g, Double
b) TickStyle
ts Rect Double
ca Rect Double
da Rect Double
xs =
  Annotation -> [XY Double] -> Chart Double
forall a. Annotation -> [XY a] -> Chart a
Chart
    (GlyphStyle -> Annotation
GlyphA (GlyphStyle
g GlyphStyle -> (GlyphStyle -> GlyphStyle) -> GlyphStyle
forall a b. a -> (a -> b) -> b
& (Maybe Double -> Identity (Maybe Double))
-> GlyphStyle -> Identity GlyphStyle
forall a. IsLabel "rotation" a => a
forall (x :: Symbol) a. IsLabel x a => a
#rotation ((Maybe Double -> Identity (Maybe Double))
 -> GlyphStyle -> Identity GlyphStyle)
-> Maybe Double -> GlyphStyle -> GlyphStyle
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Place -> Maybe Double
placeRot Place
pl))
    ( Point Double -> XY Double
forall a. Point a -> XY a
PointXY (Point Double -> XY Double)
-> (Double -> Point Double) -> Double -> XY Double
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Place -> Double -> Rect Double -> Point Double
placePos Place
pl Double
b Rect Double
ca Point Double -> Point Double -> Point Double
forall a. Additive a => a -> a -> a
+) (Point Double -> Point Double)
-> (Double -> Point Double) -> Double -> Point Double
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Place -> Double -> Point Double
placeOrigin Place
pl
        (Double -> XY Double) -> [Double] -> [XY Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TickComponents -> [Double]
positions
          (TickStyle -> Place -> Rect Double -> Rect Double -> TickComponents
ticksPlaced TickStyle
ts Place
pl Rect Double
da Rect Double
xs)
    )

-- | aka marks
tickGlyph ::
  (Monad m) =>
  Place ->
  (GlyphStyle, Double) ->
  TickStyle ->
  HudT m Double
tickGlyph :: Place -> (GlyphStyle, Double) -> TickStyle -> HudT m Double
tickGlyph Place
pl (GlyphStyle
g, Double
b) TickStyle
ts = ([Chart Double] -> StateT (ChartDims Double) m [Chart Double])
-> HudT m Double
forall (m :: * -> *) a.
([Chart a] -> StateT (ChartDims a) m [Chart a]) -> HudT m a
Hud (([Chart Double] -> StateT (ChartDims Double) m [Chart Double])
 -> HudT m Double)
-> ([Chart Double] -> StateT (ChartDims Double) m [Chart Double])
-> HudT m Double
forall a b. (a -> b) -> a -> b
$ \[Chart Double]
cs -> do
  Rect Double
a <- Getting (Rect Double) (ChartDims Double) (Rect Double)
-> StateT (ChartDims Double) m (Rect Double)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (Rect Double) (ChartDims Double) (Rect Double)
forall a. IsLabel "chartDim" a => a
forall (x :: Symbol) a. IsLabel x a => a
#chartDim
  Rect Double
d <- Getting (Rect Double) (ChartDims Double) (Rect Double)
-> StateT (ChartDims Double) m (Rect Double)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (Rect Double) (ChartDims Double) (Rect Double)
forall a. IsLabel "canvasDim" a => a
forall (x :: Symbol) a. IsLabel x a => a
#canvasDim
  Rect Double
xs <- Getting (Rect Double) (ChartDims Double) (Rect Double)
-> StateT (ChartDims Double) m (Rect Double)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (Rect Double) (ChartDims Double) (Rect Double)
forall a. IsLabel "dataDim" a => a
forall (x :: Symbol) a. IsLabel x a => a
#dataDim
  let c :: Chart Double
c = Place
-> (GlyphStyle, Double)
-> TickStyle
-> Rect Double
-> Rect Double
-> Rect Double
-> Chart Double
tickGlyph_ Place
pl (GlyphStyle
g, Double
b) TickStyle
ts Rect Double
a Rect Double
d Rect Double
xs
  #chartDim .= addToRect a (styleBox c)
  [Chart Double] -> StateT (ChartDims Double) m [Chart Double]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Chart Double] -> StateT (ChartDims Double) m [Chart Double])
-> [Chart Double] -> StateT (ChartDims Double) m [Chart Double]
forall a b. (a -> b) -> a -> b
$ Chart Double
c Chart Double -> [Chart Double] -> [Chart Double]
forall a. a -> [a] -> [a]
: [Chart Double]
cs

tickText_ ::
  Place ->
  (TextStyle, Double) ->
  TickStyle ->
  Rect Double ->
  Rect Double ->
  Rect Double ->
  [Chart Double]
tickText_ :: Place
-> (TextStyle, Double)
-> TickStyle
-> Rect Double
-> Rect Double
-> Rect Double
-> [Chart Double]
tickText_ Place
pl (TextStyle
txts, Double
b) TickStyle
ts Rect Double
ca Rect Double
da Rect Double
xs =
  (Text -> Point Double -> Chart Double)
-> [Text] -> [Point Double] -> [Chart Double]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith
    ( \Text
txt Point Double
sp ->
        Annotation -> [XY Double] -> Chart Double
forall a. Annotation -> [XY a] -> Chart a
Chart
          ( TextStyle -> [Text] -> Annotation
TextA
              (Place -> TextStyle -> TextStyle
placeTextAnchor Place
pl TextStyle
txts)
              [Text
txt]
          )
          [Point Double -> XY Double
forall a. Point a -> XY a
PointXY Point Double
sp]
    )
    (TickComponents -> [Text]
labels (TickComponents -> [Text]) -> TickComponents -> [Text]
forall a b. (a -> b) -> a -> b
$ TickStyle -> Place -> Rect Double -> Rect Double -> TickComponents
ticksPlaced TickStyle
ts Place
pl Rect Double
da Rect Double
xs)
    ( (Place -> Double -> Rect Double -> Point Double
placePos Place
pl Double
b Rect Double
ca Point Double -> Point Double -> Point Double
forall a. Additive a => a -> a -> a
+ Place -> TextStyle -> Double -> Point Double
textPos Place
pl TextStyle
txts Double
b Point Double -> Point Double -> Point Double
forall a. Additive a => a -> a -> a
+) (Point Double -> Point Double)
-> (Double -> Point Double) -> Double -> Point Double
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Place -> Double -> Point Double
placeOrigin Place
pl
        (Double -> Point Double) -> [Double] -> [Point Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TickComponents -> [Double]
positions (TickStyle -> Place -> Rect Double -> Rect Double -> TickComponents
ticksPlaced TickStyle
ts Place
pl Rect Double
da Rect Double
xs)
    )

-- | aka tick labels
tickText ::
  (Monad m) =>
  Place ->
  (TextStyle, Double) ->
  TickStyle ->
  HudT m Double
tickText :: Place -> (TextStyle, Double) -> TickStyle -> HudT m Double
tickText Place
pl (TextStyle
txts, Double
b) TickStyle
ts = ([Chart Double] -> StateT (ChartDims Double) m [Chart Double])
-> HudT m Double
forall (m :: * -> *) a.
([Chart a] -> StateT (ChartDims a) m [Chart a]) -> HudT m a
Hud (([Chart Double] -> StateT (ChartDims Double) m [Chart Double])
 -> HudT m Double)
-> ([Chart Double] -> StateT (ChartDims Double) m [Chart Double])
-> HudT m Double
forall a b. (a -> b) -> a -> b
$ \[Chart Double]
cs -> do
  Rect Double
ca <- Getting (Rect Double) (ChartDims Double) (Rect Double)
-> StateT (ChartDims Double) m (Rect Double)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (Rect Double) (ChartDims Double) (Rect Double)
forall a. IsLabel "chartDim" a => a
forall (x :: Symbol) a. IsLabel x a => a
#chartDim
  Rect Double
da <- Getting (Rect Double) (ChartDims Double) (Rect Double)
-> StateT (ChartDims Double) m (Rect Double)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (Rect Double) (ChartDims Double) (Rect Double)
forall a. IsLabel "canvasDim" a => a
forall (x :: Symbol) a. IsLabel x a => a
#canvasDim
  Rect Double
xs <- Getting (Rect Double) (ChartDims Double) (Rect Double)
-> StateT (ChartDims Double) m (Rect Double)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (Rect Double) (ChartDims Double) (Rect Double)
forall a. IsLabel "dataDim" a => a
forall (x :: Symbol) a. IsLabel x a => a
#dataDim
  let c :: [Chart Double]
c = Place
-> (TextStyle, Double)
-> TickStyle
-> Rect Double
-> Rect Double
-> Rect Double
-> [Chart Double]
tickText_ Place
pl (TextStyle
txts, Double
b) TickStyle
ts Rect Double
ca Rect Double
da Rect Double
xs
  #chartDim .= addChartBoxes c ca
  [Chart Double] -> StateT (ChartDims Double) m [Chart Double]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Chart Double] -> StateT (ChartDims Double) m [Chart Double])
-> [Chart Double] -> StateT (ChartDims Double) m [Chart Double]
forall a b. (a -> b) -> a -> b
$ [Chart Double]
c [Chart Double] -> [Chart Double] -> [Chart Double]
forall a. Semigroup a => a -> a -> a
<> [Chart Double]
cs

-- | aka grid lines
tickLine ::
  (Monad m) =>
  Place ->
  (LineStyle, Double) ->
  TickStyle ->
  HudT m Double
tickLine :: Place -> (LineStyle, Double) -> TickStyle -> HudT m Double
tickLine Place
pl (LineStyle
ls, Double
b) TickStyle
ts = ([Chart Double] -> StateT (ChartDims Double) m [Chart Double])
-> HudT m Double
forall (m :: * -> *) a.
([Chart a] -> StateT (ChartDims a) m [Chart a]) -> HudT m a
Hud (([Chart Double] -> StateT (ChartDims Double) m [Chart Double])
 -> HudT m Double)
-> ([Chart Double] -> StateT (ChartDims Double) m [Chart Double])
-> HudT m Double
forall a b. (a -> b) -> a -> b
$ \[Chart Double]
cs -> do
  Rect Double
da <- Getting (Rect Double) (ChartDims Double) (Rect Double)
-> StateT (ChartDims Double) m (Rect Double)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (Rect Double) (ChartDims Double) (Rect Double)
forall a. IsLabel "canvasDim" a => a
forall (x :: Symbol) a. IsLabel x a => a
#canvasDim
  Rect Double
xs <- Getting (Rect Double) (ChartDims Double) (Rect Double)
-> StateT (ChartDims Double) m (Rect Double)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (Rect Double) (ChartDims Double) (Rect Double)
forall a. IsLabel "dataDim" a => a
forall (x :: Symbol) a. IsLabel x a => a
#dataDim
  let c :: [Chart Double]
c =
        Annotation -> [XY Double] -> Chart Double
forall a. Annotation -> [XY a] -> Chart a
Chart (LineStyle -> Annotation
LineA LineStyle
ls) ([XY Double] -> Chart Double)
-> (Double -> [XY Double]) -> Double -> Chart Double
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (\Double
x -> Place -> Rect Double -> Double -> Double -> [XY Double]
placeGridLines Place
pl Rect Double
da Double
x Double
b)
          (Double -> Chart Double) -> [Double] -> [Chart Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TickComponents -> [Double]
positions (TickStyle -> Place -> Rect Double -> Rect Double -> TickComponents
ticksPlaced TickStyle
ts Place
pl Rect Double
da Rect Double
xs)
  #chartDim %= addChartBoxes c
  [Chart Double] -> StateT (ChartDims Double) m [Chart Double]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Chart Double] -> StateT (ChartDims Double) m [Chart Double])
-> [Chart Double] -> StateT (ChartDims Double) m [Chart Double]
forall a b. (a -> b) -> a -> b
$ [Chart Double]
c [Chart Double] -> [Chart Double] -> [Chart Double]
forall a. Semigroup a => a -> a -> a
<> [Chart Double]
cs

-- | Create tick glyphs (marks), lines (grid) and text (labels)
tick ::
  (Monad m) =>
  Place ->
  Tick ->
  HudT m Double
tick :: Place -> Tick -> HudT m Double
tick Place
pl Tick
t =
  HudT m Double
-> ((GlyphStyle, Double) -> HudT m Double)
-> Maybe (GlyphStyle, Double)
-> HudT m Double
forall b a. b -> (a -> b) -> Maybe a -> b
maybe HudT m Double
forall a. Monoid a => a
mempty (\(GlyphStyle, Double)
x -> Place -> (GlyphStyle, Double) -> TickStyle -> HudT m Double
forall (m :: * -> *).
Monad m =>
Place -> (GlyphStyle, Double) -> TickStyle -> HudT m Double
tickGlyph Place
pl (GlyphStyle, Double)
x (Tick
t Tick
-> ((TickStyle -> Const TickStyle TickStyle)
    -> Tick -> Const TickStyle Tick)
-> TickStyle
forall s a. s -> Getting a s a -> a
^. (TickStyle -> Const TickStyle TickStyle)
-> Tick -> Const TickStyle Tick
forall a. IsLabel "tstyle" a => a
forall (x :: Symbol) a. IsLabel x a => a
#tstyle)) (Tick
t Tick
-> Getting
     (Maybe (GlyphStyle, Double)) Tick (Maybe (GlyphStyle, Double))
-> Maybe (GlyphStyle, Double)
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (GlyphStyle, Double)) Tick (Maybe (GlyphStyle, Double))
forall a. IsLabel "gtick" a => a
forall (x :: Symbol) a. IsLabel x a => a
#gtick)
    HudT m Double -> HudT m Double -> HudT m Double
forall a. Semigroup a => a -> a -> a
<> HudT m Double
-> ((TextStyle, Double) -> HudT m Double)
-> Maybe (TextStyle, Double)
-> HudT m Double
forall b a. b -> (a -> b) -> Maybe a -> b
maybe HudT m Double
forall a. Monoid a => a
mempty (\(TextStyle, Double)
x -> Place -> (TextStyle, Double) -> TickStyle -> HudT m Double
forall (m :: * -> *).
Monad m =>
Place -> (TextStyle, Double) -> TickStyle -> HudT m Double
tickText Place
pl (TextStyle, Double)
x (Tick
t Tick
-> ((TickStyle -> Const TickStyle TickStyle)
    -> Tick -> Const TickStyle Tick)
-> TickStyle
forall s a. s -> Getting a s a -> a
^. (TickStyle -> Const TickStyle TickStyle)
-> Tick -> Const TickStyle Tick
forall a. IsLabel "tstyle" a => a
forall (x :: Symbol) a. IsLabel x a => a
#tstyle)) (Tick
t Tick
-> Getting
     (Maybe (TextStyle, Double)) Tick (Maybe (TextStyle, Double))
-> Maybe (TextStyle, Double)
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (TextStyle, Double)) Tick (Maybe (TextStyle, Double))
forall a. IsLabel "ttick" a => a
forall (x :: Symbol) a. IsLabel x a => a
#ttick)
    HudT m Double -> HudT m Double -> HudT m Double
forall a. Semigroup a => a -> a -> a
<> HudT m Double
-> ((LineStyle, Double) -> HudT m Double)
-> Maybe (LineStyle, Double)
-> HudT m Double
forall b a. b -> (a -> b) -> Maybe a -> b
maybe HudT m Double
forall a. Monoid a => a
mempty (\(LineStyle, Double)
x -> Place -> (LineStyle, Double) -> TickStyle -> HudT m Double
forall (m :: * -> *).
Monad m =>
Place -> (LineStyle, Double) -> TickStyle -> HudT m Double
tickLine Place
pl (LineStyle, Double)
x (Tick
t Tick
-> ((TickStyle -> Const TickStyle TickStyle)
    -> Tick -> Const TickStyle Tick)
-> TickStyle
forall s a. s -> Getting a s a -> a
^. (TickStyle -> Const TickStyle TickStyle)
-> Tick -> Const TickStyle Tick
forall a. IsLabel "tstyle" a => a
forall (x :: Symbol) a. IsLabel x a => a
#tstyle)) (Tick
t Tick
-> Getting
     (Maybe (LineStyle, Double)) Tick (Maybe (LineStyle, Double))
-> Maybe (LineStyle, Double)
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (LineStyle, Double)) Tick (Maybe (LineStyle, Double))
forall a. IsLabel "ltick" a => a
forall (x :: Symbol) a. IsLabel x a => a
#ltick)
    HudT m Double -> HudT m Double -> HudT m Double
forall a. Semigroup a => a -> a -> a
<> Place -> Tick -> HudT m Double
forall (m :: * -> *). Monad m => Place -> Tick -> HudT m Double
extendData Place
pl Tick
t

-- | compute an extension to the Range if a tick went over the data bounding box
computeTickExtension :: TickStyle -> Range Double -> Maybe (Range Double)
computeTickExtension :: TickStyle -> Range Double -> Maybe (Range Double)
computeTickExtension TickStyle
s Range Double
r =
  case TickStyle
s of
    TickStyle
TickNone -> Maybe (Range Double)
forall a. Maybe a
Nothing
    TickRound FormatN
_ Int
n TickExtend
e -> Maybe (Range Double)
-> Maybe (Range Double) -> Bool -> Maybe (Range Double)
forall a. a -> a -> Bool -> a
bool Maybe (Range Double)
forall a. Maybe a
Nothing (Range Double -> Maybe (Range Double)
forall a. a -> Maybe a
Just ([Element (Range Double)] -> Range Double
forall s (f :: * -> *).
(Space s, Traversable f) =>
f (Element s) -> s
space1 [Double]
[Element (Range Double)]
ticks0 Range Double -> Range Double -> Range Double
forall a. Semigroup a => a -> a -> a
<> Range Double
r)) (TickExtend
e TickExtend -> TickExtend -> Bool
forall a. Eq a => a -> a -> Bool
== TickExtend
TickExtend)
      where
        ticks0 :: [Double]
ticks0 = Pos -> Bool -> Range Double -> Integer -> [Double]
gridSensible Pos
OuterPos (TickExtend
e TickExtend -> TickExtend -> Bool
forall a. Eq a => a -> a -> Bool
== TickExtend
NoTickExtend) Range Double
r (Int -> Integer
forall a b. FromIntegral a b => b -> a
fromIntegral Int
n :: Integer)
    TickExact FormatN
_ Int
_ -> Maybe (Range Double)
forall a. Maybe a
Nothing
    TickLabels [Text]
_ -> Maybe (Range Double)
forall a. Maybe a
Nothing
    TickPlaced [(Double, Text)]
xs -> Range Double -> Maybe (Range Double)
forall a. a -> Maybe a
Just (Range Double -> Maybe (Range Double))
-> Range Double -> Maybe (Range Double)
forall a b. (a -> b) -> a -> b
$ Range Double
r Range Double -> Range Double -> Range Double
forall a. Semigroup a => a -> a -> a
<> [Element (Range Double)] -> Range Double
forall s (f :: * -> *).
(Space s, Traversable f) =>
f (Element s) -> s
space1 ((Double, Text) -> Double
forall a b. (a, b) -> a
fst ((Double, Text) -> Double) -> [(Double, Text)] -> [Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Double, Text)]
xs)

-- | Create a style extension for the data, if ticks extend beyond the existing range
tickExtended ::
  Place ->
  Tick ->
  Rect Double ->
  Rect Double
tickExtended :: Place -> Tick -> Rect Double -> Rect Double
tickExtended Place
pl Tick
t Rect Double
xs =
  Rect Double
-> (Range Double -> Rect Double)
-> Maybe (Range Double)
-> Rect Double
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
    Rect Double
xs
    (Rect Double -> Range Double -> Rect Double
rangeext Rect Double
xs)
    (TickStyle -> Range Double -> Maybe (Range Double)
computeTickExtension (Tick
t Tick
-> ((TickStyle -> Const TickStyle TickStyle)
    -> Tick -> Const TickStyle Tick)
-> TickStyle
forall s a. s -> Getting a s a -> a
^. (TickStyle -> Const TickStyle TickStyle)
-> Tick -> Const TickStyle Tick
forall a. IsLabel "tstyle" a => a
forall (x :: Symbol) a. IsLabel x a => a
#tstyle) (Rect Double -> Range Double
ranged Rect Double
xs))
  where
    ranged :: Rect Double -> Range Double
ranged Rect Double
xs' = case Place
pl of
      Place
PlaceTop -> Rect Double -> Range Double
forall a. Rect a -> Range a
rangex Rect Double
xs'
      Place
PlaceBottom -> Rect Double -> Range Double
forall a. Rect a -> Range a
rangex Rect Double
xs'
      Place
PlaceLeft -> Rect Double -> Range Double
forall a. Rect a -> Range a
rangey Rect Double
xs'
      Place
PlaceRight -> Rect Double -> Range Double
forall a. Rect a -> Range a
rangey Rect Double
xs'
      PlaceAbsolute Point Double
_ -> Rect Double -> Range Double
forall a. Rect a -> Range a
rangex Rect Double
xs'
    rangex :: Rect a -> Range a
rangex (Rect a
x a
z a
_ a
_) = a -> a -> Range a
forall a. a -> a -> Range a
Range a
x a
z
    rangey :: Rect a -> Range a
rangey (Rect a
_ a
_ a
y a
w) = a -> a -> Range a
forall a. a -> a -> Range a
Range a
y a
w
    rangeext :: Rect Double -> Range Double -> Rect Double
rangeext (Rect Double
x Double
z Double
y Double
w) (Range Double
a0 Double
a1) = case Place
pl of
      Place
PlaceTop -> Double -> Double -> Double -> Double -> Rect Double
forall a. a -> a -> a -> a -> Rect a
Rect Double
a0 Double
a1 Double
y Double
w
      Place
PlaceBottom -> Double -> Double -> Double -> Double -> Rect Double
forall a. a -> a -> a -> a -> Rect a
Rect Double
a0 Double
a1 Double
y Double
w
      Place
PlaceLeft -> Double -> Double -> Double -> Double -> Rect Double
forall a. a -> a -> a -> a -> Rect a
Rect Double
x Double
z Double
a0 Double
a1
      Place
PlaceRight -> Double -> Double -> Double -> Double -> Rect Double
forall a. a -> a -> a -> a -> Rect a
Rect Double
x Double
z Double
a0 Double
a1
      PlaceAbsolute Point Double
_ -> Double -> Double -> Double -> Double -> Rect Double
forall a. a -> a -> a -> a -> Rect a
Rect Double
a0 Double
a1 Double
y Double
w

extendData :: (Monad m) => Place -> Tick -> HudT m Double
extendData :: Place -> Tick -> HudT m Double
extendData Place
pl Tick
t = ([Chart Double] -> StateT (ChartDims Double) m [Chart Double])
-> HudT m Double
forall (m :: * -> *) a.
([Chart a] -> StateT (ChartDims a) m [Chart a]) -> HudT m a
Hud (([Chart Double] -> StateT (ChartDims Double) m [Chart Double])
 -> HudT m Double)
-> ([Chart Double] -> StateT (ChartDims Double) m [Chart Double])
-> HudT m Double
forall a b. (a -> b) -> a -> b
$ \[Chart Double]
cs -> do
  #dataDim %= tickExtended pl t
  pure cs

-- | adjust Tick for sane font sizes etc
adjustTick ::
  Adjustments ->
  Rect Double ->
  Rect Double ->
  Place ->
  Tick ->
  Tick
adjustTick :: Adjustments -> Rect Double -> Rect Double -> Place -> Tick -> Tick
adjustTick (Adjustments Double
mrx Double
ma Double
mry Bool
ad) Rect Double
vb Rect Double
cs Place
pl Tick
t
  | Place
pl Place -> [Place] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Place
PlaceBottom, Place
PlaceTop] =
    if Bool
ad
      then
        ( case Double
adjustSizeX Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
1 of
            Bool
True ->
              ( case Place
pl of
                  Place
PlaceBottom -> (Maybe (TextStyle, Double) -> Identity (Maybe (TextStyle, Double)))
-> Tick -> Identity Tick
forall a. IsLabel "ttick" a => a
forall (x :: Symbol) a. IsLabel x a => a
#ttick ((Maybe (TextStyle, Double)
  -> Identity (Maybe (TextStyle, Double)))
 -> Tick -> Identity Tick)
-> ((Anchor -> Identity Anchor)
    -> Maybe (TextStyle, Double)
    -> Identity (Maybe (TextStyle, Double)))
-> (Anchor -> Identity Anchor)
-> Tick
-> Identity Tick
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ((TextStyle, Double) -> Identity (TextStyle, Double))
-> Maybe (TextStyle, Double)
-> Identity (Maybe (TextStyle, Double))
forall a b. Prism (Maybe a) (Maybe b) a b
_Just (((TextStyle, Double) -> Identity (TextStyle, Double))
 -> Maybe (TextStyle, Double)
 -> Identity (Maybe (TextStyle, Double)))
-> ((Anchor -> Identity Anchor)
    -> (TextStyle, Double) -> Identity (TextStyle, Double))
-> (Anchor -> Identity Anchor)
-> Maybe (TextStyle, Double)
-> Identity (Maybe (TextStyle, Double))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (TextStyle -> Identity TextStyle)
-> (TextStyle, Double) -> Identity (TextStyle, Double)
forall s t a b. Field1 s t a b => Lens s t a b
_1 ((TextStyle -> Identity TextStyle)
 -> (TextStyle, Double) -> Identity (TextStyle, Double))
-> ((Anchor -> Identity Anchor) -> TextStyle -> Identity TextStyle)
-> (Anchor -> Identity Anchor)
-> (TextStyle, Double)
-> Identity (TextStyle, Double)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Anchor -> Identity Anchor) -> TextStyle -> Identity TextStyle
forall a. IsLabel "anchor" a => a
forall (x :: Symbol) a. IsLabel x a => a
#anchor ((Anchor -> Identity Anchor) -> Tick -> Identity Tick)
-> Anchor -> Tick -> Tick
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Anchor
AnchorEnd
                  Place
PlaceTop -> (Maybe (TextStyle, Double) -> Identity (Maybe (TextStyle, Double)))
-> Tick -> Identity Tick
forall a. IsLabel "ttick" a => a
forall (x :: Symbol) a. IsLabel x a => a
#ttick ((Maybe (TextStyle, Double)
  -> Identity (Maybe (TextStyle, Double)))
 -> Tick -> Identity Tick)
-> ((Anchor -> Identity Anchor)
    -> Maybe (TextStyle, Double)
    -> Identity (Maybe (TextStyle, Double)))
-> (Anchor -> Identity Anchor)
-> Tick
-> Identity Tick
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ((TextStyle, Double) -> Identity (TextStyle, Double))
-> Maybe (TextStyle, Double)
-> Identity (Maybe (TextStyle, Double))
forall a b. Prism (Maybe a) (Maybe b) a b
_Just (((TextStyle, Double) -> Identity (TextStyle, Double))
 -> Maybe (TextStyle, Double)
 -> Identity (Maybe (TextStyle, Double)))
-> ((Anchor -> Identity Anchor)
    -> (TextStyle, Double) -> Identity (TextStyle, Double))
-> (Anchor -> Identity Anchor)
-> Maybe (TextStyle, Double)
-> Identity (Maybe (TextStyle, Double))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (TextStyle -> Identity TextStyle)
-> (TextStyle, Double) -> Identity (TextStyle, Double)
forall s t a b. Field1 s t a b => Lens s t a b
_1 ((TextStyle -> Identity TextStyle)
 -> (TextStyle, Double) -> Identity (TextStyle, Double))
-> ((Anchor -> Identity Anchor) -> TextStyle -> Identity TextStyle)
-> (Anchor -> Identity Anchor)
-> (TextStyle, Double)
-> Identity (TextStyle, Double)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Anchor -> Identity Anchor) -> TextStyle -> Identity TextStyle
forall a. IsLabel "anchor" a => a
forall (x :: Symbol) a. IsLabel x a => a
#anchor ((Anchor -> Identity Anchor) -> Tick -> Identity Tick)
-> Anchor -> Tick -> Tick
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Anchor
AnchorStart
                  Place
_ -> (Maybe (TextStyle, Double) -> Identity (Maybe (TextStyle, Double)))
-> Tick -> Identity Tick
forall a. IsLabel "ttick" a => a
forall (x :: Symbol) a. IsLabel x a => a
#ttick ((Maybe (TextStyle, Double)
  -> Identity (Maybe (TextStyle, Double)))
 -> Tick -> Identity Tick)
-> ((Anchor -> Identity Anchor)
    -> Maybe (TextStyle, Double)
    -> Identity (Maybe (TextStyle, Double)))
-> (Anchor -> Identity Anchor)
-> Tick
-> Identity Tick
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ((TextStyle, Double) -> Identity (TextStyle, Double))
-> Maybe (TextStyle, Double)
-> Identity (Maybe (TextStyle, Double))
forall a b. Prism (Maybe a) (Maybe b) a b
_Just (((TextStyle, Double) -> Identity (TextStyle, Double))
 -> Maybe (TextStyle, Double)
 -> Identity (Maybe (TextStyle, Double)))
-> ((Anchor -> Identity Anchor)
    -> (TextStyle, Double) -> Identity (TextStyle, Double))
-> (Anchor -> Identity Anchor)
-> Maybe (TextStyle, Double)
-> Identity (Maybe (TextStyle, Double))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (TextStyle -> Identity TextStyle)
-> (TextStyle, Double) -> Identity (TextStyle, Double)
forall s t a b. Field1 s t a b => Lens s t a b
_1 ((TextStyle -> Identity TextStyle)
 -> (TextStyle, Double) -> Identity (TextStyle, Double))
-> ((Anchor -> Identity Anchor) -> TextStyle -> Identity TextStyle)
-> (Anchor -> Identity Anchor)
-> (TextStyle, Double)
-> Identity (TextStyle, Double)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Anchor -> Identity Anchor) -> TextStyle -> Identity TextStyle
forall a. IsLabel "anchor" a => a
forall (x :: Symbol) a. IsLabel x a => a
#anchor ((Anchor -> Identity Anchor) -> Tick -> Identity Tick)
-> Anchor -> Tick -> Tick
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Anchor
AnchorEnd
              )
                (Tick -> Tick) -> (Tick -> Tick) -> Tick -> Tick
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ((Maybe (TextStyle, Double) -> Identity (Maybe (TextStyle, Double)))
-> Tick -> Identity Tick
forall a. IsLabel "ttick" a => a
forall (x :: Symbol) a. IsLabel x a => a
#ttick ((Maybe (TextStyle, Double)
  -> Identity (Maybe (TextStyle, Double)))
 -> Tick -> Identity Tick)
-> ((Double -> Identity Double)
    -> Maybe (TextStyle, Double)
    -> Identity (Maybe (TextStyle, Double)))
-> (Double -> Identity Double)
-> Tick
-> Identity Tick
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ((TextStyle, Double) -> Identity (TextStyle, Double))
-> Maybe (TextStyle, Double)
-> Identity (Maybe (TextStyle, Double))
forall a b. Prism (Maybe a) (Maybe b) a b
_Just (((TextStyle, Double) -> Identity (TextStyle, Double))
 -> Maybe (TextStyle, Double)
 -> Identity (Maybe (TextStyle, Double)))
-> ((Double -> Identity Double)
    -> (TextStyle, Double) -> Identity (TextStyle, Double))
-> (Double -> Identity Double)
-> Maybe (TextStyle, Double)
-> Identity (Maybe (TextStyle, Double))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (TextStyle -> Identity TextStyle)
-> (TextStyle, Double) -> Identity (TextStyle, Double)
forall s t a b. Field1 s t a b => Lens s t a b
_1 ((TextStyle -> Identity TextStyle)
 -> (TextStyle, Double) -> Identity (TextStyle, Double))
-> ((Double -> Identity Double) -> TextStyle -> Identity TextStyle)
-> (Double -> Identity Double)
-> (TextStyle, Double)
-> Identity (TextStyle, Double)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Double -> Identity Double) -> TextStyle -> Identity TextStyle
forall a. IsLabel "size" a => a
forall (x :: Symbol) a. IsLabel x a => a
#size ((Double -> Identity Double) -> Tick -> Identity Tick)
-> (Double -> Double) -> Tick -> Tick
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ Double
adjustSizeA))
                (Tick -> Tick) -> Tick -> Tick
forall a b. (a -> b) -> a -> b
$ ((Maybe (TextStyle, Double) -> Identity (Maybe (TextStyle, Double)))
-> Tick -> Identity Tick
forall a. IsLabel "ttick" a => a
forall (x :: Symbol) a. IsLabel x a => a
#ttick ((Maybe (TextStyle, Double)
  -> Identity (Maybe (TextStyle, Double)))
 -> Tick -> Identity Tick)
-> ((Maybe Double -> Identity (Maybe Double))
    -> Maybe (TextStyle, Double)
    -> Identity (Maybe (TextStyle, Double)))
-> (Maybe Double -> Identity (Maybe Double))
-> Tick
-> Identity Tick
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ((TextStyle, Double) -> Identity (TextStyle, Double))
-> Maybe (TextStyle, Double)
-> Identity (Maybe (TextStyle, Double))
forall a b. Prism (Maybe a) (Maybe b) a b
_Just (((TextStyle, Double) -> Identity (TextStyle, Double))
 -> Maybe (TextStyle, Double)
 -> Identity (Maybe (TextStyle, Double)))
-> ((Maybe Double -> Identity (Maybe Double))
    -> (TextStyle, Double) -> Identity (TextStyle, Double))
-> (Maybe Double -> Identity (Maybe Double))
-> Maybe (TextStyle, Double)
-> Identity (Maybe (TextStyle, Double))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (TextStyle -> Identity TextStyle)
-> (TextStyle, Double) -> Identity (TextStyle, Double)
forall s t a b. Field1 s t a b => Lens s t a b
_1 ((TextStyle -> Identity TextStyle)
 -> (TextStyle, Double) -> Identity (TextStyle, Double))
-> ((Maybe Double -> Identity (Maybe Double))
    -> TextStyle -> Identity TextStyle)
-> (Maybe Double -> Identity (Maybe Double))
-> (TextStyle, Double)
-> Identity (TextStyle, Double)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Maybe Double -> Identity (Maybe Double))
-> TextStyle -> Identity TextStyle
forall a. IsLabel "rotation" a => a
forall (x :: Symbol) a. IsLabel x a => a
#rotation ((Maybe Double -> Identity (Maybe Double))
 -> Tick -> Identity Tick)
-> Double -> Tick -> Tick
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Double
forall a. TrigField a => a
pi Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ Double
4) Tick
t
            Bool
False -> ((Maybe (TextStyle, Double) -> Identity (Maybe (TextStyle, Double)))
-> Tick -> Identity Tick
forall a. IsLabel "ttick" a => a
forall (x :: Symbol) a. IsLabel x a => a
#ttick ((Maybe (TextStyle, Double)
  -> Identity (Maybe (TextStyle, Double)))
 -> Tick -> Identity Tick)
-> ((Double -> Identity Double)
    -> Maybe (TextStyle, Double)
    -> Identity (Maybe (TextStyle, Double)))
-> (Double -> Identity Double)
-> Tick
-> Identity Tick
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ((TextStyle, Double) -> Identity (TextStyle, Double))
-> Maybe (TextStyle, Double)
-> Identity (Maybe (TextStyle, Double))
forall a b. Prism (Maybe a) (Maybe b) a b
_Just (((TextStyle, Double) -> Identity (TextStyle, Double))
 -> Maybe (TextStyle, Double)
 -> Identity (Maybe (TextStyle, Double)))
-> ((Double -> Identity Double)
    -> (TextStyle, Double) -> Identity (TextStyle, Double))
-> (Double -> Identity Double)
-> Maybe (TextStyle, Double)
-> Identity (Maybe (TextStyle, Double))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (TextStyle -> Identity TextStyle)
-> (TextStyle, Double) -> Identity (TextStyle, Double)
forall s t a b. Field1 s t a b => Lens s t a b
_1 ((TextStyle -> Identity TextStyle)
 -> (TextStyle, Double) -> Identity (TextStyle, Double))
-> ((Double -> Identity Double) -> TextStyle -> Identity TextStyle)
-> (Double -> Identity Double)
-> (TextStyle, Double)
-> Identity (TextStyle, Double)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Double -> Identity Double) -> TextStyle -> Identity TextStyle
forall a. IsLabel "size" a => a
forall (x :: Symbol) a. IsLabel x a => a
#size ((Double -> Identity Double) -> Tick -> Identity Tick)
-> (Double -> Double) -> Tick -> Tick
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ Double
adjustSizeA)) Tick
t
        )
      else Tick
t Tick -> (Tick -> Tick) -> Tick
forall a b. a -> (a -> b) -> b
& (Maybe (TextStyle, Double) -> Identity (Maybe (TextStyle, Double)))
-> Tick -> Identity Tick
forall a. IsLabel "ttick" a => a
forall (x :: Symbol) a. IsLabel x a => a
#ttick ((Maybe (TextStyle, Double)
  -> Identity (Maybe (TextStyle, Double)))
 -> Tick -> Identity Tick)
-> ((Double -> Identity Double)
    -> Maybe (TextStyle, Double)
    -> Identity (Maybe (TextStyle, Double)))
-> (Double -> Identity Double)
-> Tick
-> Identity Tick
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ((TextStyle, Double) -> Identity (TextStyle, Double))
-> Maybe (TextStyle, Double)
-> Identity (Maybe (TextStyle, Double))
forall a b. Prism (Maybe a) (Maybe b) a b
_Just (((TextStyle, Double) -> Identity (TextStyle, Double))
 -> Maybe (TextStyle, Double)
 -> Identity (Maybe (TextStyle, Double)))
-> ((Double -> Identity Double)
    -> (TextStyle, Double) -> Identity (TextStyle, Double))
-> (Double -> Identity Double)
-> Maybe (TextStyle, Double)
-> Identity (Maybe (TextStyle, Double))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (TextStyle -> Identity TextStyle)
-> (TextStyle, Double) -> Identity (TextStyle, Double)
forall s t a b. Field1 s t a b => Lens s t a b
_1 ((TextStyle -> Identity TextStyle)
 -> (TextStyle, Double) -> Identity (TextStyle, Double))
-> ((Double -> Identity Double) -> TextStyle -> Identity TextStyle)
-> (Double -> Identity Double)
-> (TextStyle, Double)
-> Identity (TextStyle, Double)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Double -> Identity Double) -> TextStyle -> Identity TextStyle
forall a. IsLabel "size" a => a
forall (x :: Symbol) a. IsLabel x a => a
#size ((Double -> Identity Double) -> Tick -> Identity Tick)
-> (Double -> Double) -> Tick -> Tick
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ Double
adjustSizeX)
  | Bool
otherwise -- pl `elem` [PlaceLeft, PlaceRight]
    =
    ((Maybe (TextStyle, Double) -> Identity (Maybe (TextStyle, Double)))
-> Tick -> Identity Tick
forall a. IsLabel "ttick" a => a
forall (x :: Symbol) a. IsLabel x a => a
#ttick ((Maybe (TextStyle, Double)
  -> Identity (Maybe (TextStyle, Double)))
 -> Tick -> Identity Tick)
-> ((Double -> Identity Double)
    -> Maybe (TextStyle, Double)
    -> Identity (Maybe (TextStyle, Double)))
-> (Double -> Identity Double)
-> Tick
-> Identity Tick
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ((TextStyle, Double) -> Identity (TextStyle, Double))
-> Maybe (TextStyle, Double)
-> Identity (Maybe (TextStyle, Double))
forall a b. Prism (Maybe a) (Maybe b) a b
_Just (((TextStyle, Double) -> Identity (TextStyle, Double))
 -> Maybe (TextStyle, Double)
 -> Identity (Maybe (TextStyle, Double)))
-> ((Double -> Identity Double)
    -> (TextStyle, Double) -> Identity (TextStyle, Double))
-> (Double -> Identity Double)
-> Maybe (TextStyle, Double)
-> Identity (Maybe (TextStyle, Double))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (TextStyle -> Identity TextStyle)
-> (TextStyle, Double) -> Identity (TextStyle, Double)
forall s t a b. Field1 s t a b => Lens s t a b
_1 ((TextStyle -> Identity TextStyle)
 -> (TextStyle, Double) -> Identity (TextStyle, Double))
-> ((Double -> Identity Double) -> TextStyle -> Identity TextStyle)
-> (Double -> Identity Double)
-> (TextStyle, Double)
-> Identity (TextStyle, Double)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Double -> Identity Double) -> TextStyle -> Identity TextStyle
forall a. IsLabel "size" a => a
forall (x :: Symbol) a. IsLabel x a => a
#size ((Double -> Identity Double) -> Tick -> Identity Tick)
-> (Double -> Double) -> Tick -> Tick
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ Double
adjustSizeY)) Tick
t
  where
    max' :: [p] -> p
max' [] = p
1
    max' [p]
xs = [p] -> p
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [p]
xs
    ra :: Rect Double -> Range Double
ra (Rect Double
x Double
z Double
y Double
w)
      | Place
pl Place -> [Place] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Place
PlaceTop, Place
PlaceBottom] = Double -> Double -> Range Double
forall a. a -> a -> Range a
Range Double
x Double
z
      | Bool
otherwise = Double -> Double -> Range Double
forall a. a -> a -> Range a
Range Double
y Double
w
    asp :: Range Double
asp = Rect Double -> Range Double
ra Rect Double
vb
    r :: Range Double
r = Rect Double -> Range Double
ra Rect Double
cs
    tickl :: [Text]
tickl = (Double, Text) -> Text
forall a b. (a, b) -> b
snd ((Double, Text) -> Text) -> [(Double, Text)] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TickStyle -> Range Double -> Range Double -> [(Double, Text)]
ticksR (Tick
t Tick
-> ((TickStyle -> Const TickStyle TickStyle)
    -> Tick -> Const TickStyle Tick)
-> TickStyle
forall s a. s -> Getting a s a -> a
^. (TickStyle -> Const TickStyle TickStyle)
-> Tick -> Const TickStyle Tick
forall a. IsLabel "tstyle" a => a
forall (x :: Symbol) a. IsLabel x a => a
#tstyle) Range Double
asp Range Double
r
    maxWidth :: Double
    maxWidth :: Double
maxWidth =
      Double
-> ((TextStyle, Double) -> Double)
-> Maybe (TextStyle, Double)
-> Double
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
        Double
1
        ( \(TextStyle, Double)
tt ->
            [Double] -> Double
forall p. (FromInteger p, Ord p) => [p] -> p
max' ([Double] -> Double) -> [Double] -> Double
forall a b. (a -> b) -> a -> b
$
              (\(Rect Double
x Double
z Double
_ Double
_) -> Double
z Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- Double
x)
                (Rect Double -> Double) -> (Text -> Rect Double) -> Text -> Double
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (\Text
x -> TextStyle -> Text -> Point Double -> Rect Double
styleBoxText ((TextStyle, Double) -> TextStyle
forall a b. (a, b) -> a
fst (TextStyle, Double)
tt) Text
x (Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
0 Double
0))
                (Text -> Double) -> [Text] -> [Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
tickl
        )
        (Tick
t Tick
-> Getting
     (Maybe (TextStyle, Double)) Tick (Maybe (TextStyle, Double))
-> Maybe (TextStyle, Double)
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (TextStyle, Double)) Tick (Maybe (TextStyle, Double))
forall a. IsLabel "ttick" a => a
forall (x :: Symbol) a. IsLabel x a => a
#ttick)
    maxHeight :: Double
maxHeight =
      Double
-> ((TextStyle, Double) -> Double)
-> Maybe (TextStyle, Double)
-> Double
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
        Double
1
        ( \(TextStyle, Double)
tt ->
            [Double] -> Double
forall p. (FromInteger p, Ord p) => [p] -> p
max' ([Double] -> Double) -> [Double] -> Double
forall a b. (a -> b) -> a -> b
$
              (\(Rect Double
_ Double
_ Double
y Double
w) -> Double
w Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- Double
y)
                (Rect Double -> Double) -> (Text -> Rect Double) -> Text -> Double
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (\Text
x -> TextStyle -> Text -> Point Double -> Rect Double
styleBoxText ((TextStyle, Double) -> TextStyle
forall a b. (a, b) -> a
fst (TextStyle, Double)
tt) Text
x (Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
0 Double
0))
                (Text -> Double) -> [Text] -> [Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
tickl
        )
        (Tick
t Tick
-> Getting
     (Maybe (TextStyle, Double)) Tick (Maybe (TextStyle, Double))
-> Maybe (TextStyle, Double)
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (TextStyle, Double)) Tick (Maybe (TextStyle, Double))
forall a. IsLabel "ttick" a => a
forall (x :: Symbol) a. IsLabel x a => a
#ttick)
    adjustSizeX :: Double
    adjustSizeX :: Double
adjustSizeX = [Double] -> Double
forall p. (FromInteger p, Ord p) => [p] -> p
max' [(Double
maxWidth Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ (Range Double -> Element (Range Double)
forall s. Space s => s -> Element s
upper Range Double
asp Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- Range Double -> Element (Range Double)
forall s. Space s => s -> Element s
lower Range Double
asp)) Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ Double
mrx, Double
1]
    adjustSizeY :: Double
adjustSizeY = [Double] -> Double
forall p. (FromInteger p, Ord p) => [p] -> p
max' [(Double
maxHeight Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ (Range Double -> Element (Range Double)
forall s. Space s => s -> Element s
upper Range Double
asp Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- Range Double -> Element (Range Double)
forall s. Space s => s -> Element s
lower Range Double
asp)) Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ Double
mry, Double
1]
    adjustSizeA :: Double
adjustSizeA = [Double] -> Double
forall p. (FromInteger p, Ord p) => [p] -> p
max' [(Double
maxHeight Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ (Range Double -> Element (Range Double)
forall s. Space s => s -> Element s
upper Range Double
asp Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- Range Double -> Element (Range Double)
forall s. Space s => s -> Element s
lower Range Double
asp)) Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ Double
ma, Double
1]

makeTick :: (Monad m) => AxisOptions -> HudT m Double
makeTick :: AxisOptions -> HudT m Double
makeTick AxisOptions
c = ([Chart Double] -> StateT (ChartDims Double) m [Chart Double])
-> HudT m Double
forall (m :: * -> *) a.
([Chart a] -> StateT (ChartDims a) m [Chart a]) -> HudT m a
Hud (([Chart Double] -> StateT (ChartDims Double) m [Chart Double])
 -> HudT m Double)
-> ([Chart Double] -> StateT (ChartDims Double) m [Chart Double])
-> HudT m Double
forall a b. (a -> b) -> a -> b
$ \[Chart Double]
cs -> do
  Rect Double
vb <- Getting (Rect Double) (ChartDims Double) (Rect Double)
-> StateT (ChartDims Double) m (Rect Double)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (Rect Double) (ChartDims Double) (Rect Double)
forall a. IsLabel "chartDim" a => a
forall (x :: Symbol) a. IsLabel x a => a
#chartDim
  Rect Double
xs <- Getting (Rect Double) (ChartDims Double) (Rect Double)
-> StateT (ChartDims Double) m (Rect Double)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (Rect Double) (ChartDims Double) (Rect Double)
forall a. IsLabel "dataDim" a => a
forall (x :: Symbol) a. IsLabel x a => a
#dataDim
  let adjTick :: Tick
adjTick =
        Tick -> (Adjustments -> Tick) -> Maybe Adjustments -> Tick
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
          (AxisOptions
c AxisOptions -> Getting Tick AxisOptions Tick -> Tick
forall s a. s -> Getting a s a -> a
^. Getting Tick AxisOptions Tick
forall a. IsLabel "axisTick" a => a
forall (x :: Symbol) a. IsLabel x a => a
#axisTick)
          (\Adjustments
x -> Adjustments -> Rect Double -> Rect Double -> Place -> Tick -> Tick
adjustTick Adjustments
x Rect Double
vb Rect Double
xs (AxisOptions
c AxisOptions -> Getting Place AxisOptions Place -> Place
forall s a. s -> Getting a s a -> a
^. Getting Place AxisOptions Place
forall a. IsLabel "place" a => a
forall (x :: Symbol) a. IsLabel x a => a
#place) (AxisOptions
c AxisOptions -> Getting Tick AxisOptions Tick -> Tick
forall s a. s -> Getting a s a -> a
^. Getting Tick AxisOptions Tick
forall a. IsLabel "axisTick" a => a
forall (x :: Symbol) a. IsLabel x a => a
#axisTick))
          (AxisOptions
c AxisOptions
-> Getting (Maybe Adjustments) AxisOptions (Maybe Adjustments)
-> Maybe Adjustments
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Adjustments) AxisOptions (Maybe Adjustments)
forall a. IsLabel "adjust" a => a
forall (x :: Symbol) a. IsLabel x a => a
#adjust)
  HudT m Double
-> [Chart Double] -> StateT (ChartDims Double) m [Chart Double]
forall (m :: * -> *) a.
HudT m a -> [Chart a] -> StateT (ChartDims a) m [Chart a]
unhud (Place -> Tick -> HudT m Double
forall (m :: * -> *). Monad m => Place -> Tick -> HudT m Double
tick (AxisOptions
c AxisOptions -> Getting Place AxisOptions Place -> Place
forall s a. s -> Getting a s a -> a
^. Getting Place AxisOptions Place
forall a. IsLabel "place" a => a
forall (x :: Symbol) a. IsLabel x a => a
#place) Tick
adjTick) [Chart Double]
cs

-- | Convert a UTCTime list into sensible ticks, placed exactly
makeTickDates :: PosDiscontinuous -> Maybe Text -> Int -> [UTCTime] -> [(Int, Text)]
makeTickDates :: PosDiscontinuous -> Maybe Text -> Int -> [UTCTime] -> [(Int, Text)]
makeTickDates PosDiscontinuous
pc Maybe Text
fmt Int
n [UTCTime]
dates =
  ((Int, Text) -> (Int, Text) -> Bool)
-> [(Int, Text)] -> [(Int, Text)]
forall a. (a -> a -> Bool) -> [a] -> [a]
lastOnes (\(Int
_, Text
x0) (Int
_, Text
x1) -> Text
x0 Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
x1) ([(Int, Text)] -> [(Int, Text)])
-> (([(Int, Text)], [UTCTime]) -> [(Int, Text)])
-> ([(Int, Text)], [UTCTime])
-> [(Int, Text)]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ([(Int, Text)], [UTCTime]) -> [(Int, Text)]
forall a b. (a, b) -> a
fst (([(Int, Text)], [UTCTime]) -> [(Int, Text)])
-> ([(Int, Text)], [UTCTime]) -> [(Int, Text)]
forall a b. (a -> b) -> a -> b
$ PosDiscontinuous
-> Maybe Text -> Int -> [UTCTime] -> ([(Int, Text)], [UTCTime])
placedTimeLabelDiscontinuous PosDiscontinuous
pc Maybe Text
fmt Int
n [UTCTime]
dates
  where
    lastOnes :: (a -> a -> Bool) -> [a] -> [a]
    lastOnes :: (a -> a -> Bool) -> [a] -> [a]
lastOnes a -> a -> Bool
_ [] = []
    lastOnes a -> a -> Bool
_ [a
x] = [a
x]
    lastOnes a -> a -> Bool
f (a
x : [a]
xs) = (\(a
x0, [a]
x1) -> [a] -> [a]
forall a. [a] -> [a]
reverse ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ a
x0 a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
x1) ((a, [a]) -> [a]) -> (a, [a]) -> [a]
forall a b. (a -> b) -> a -> b
$ ((a, [a]) -> a -> (a, [a])) -> (a, [a]) -> [a] -> (a, [a])
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (a, [a]) -> a -> (a, [a])
step (a
x, []) [a]
xs
      where
        step :: (a, [a]) -> a -> (a, [a])
step (a
a0, [a]
rs) a
a1 = if a -> a -> Bool
f a
a0 a
a1 then (a
a1, [a]
rs) else (a
a1, a
a0 a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
rs)

-- | Convert a UTCTime list into sensible ticks, placed on the (0,1) space
makeTickDatesContinuous :: PosDiscontinuous -> Maybe Text -> Int -> [UTCTime] -> [(Double, Text)]
makeTickDatesContinuous :: PosDiscontinuous
-> Maybe Text -> Int -> [UTCTime] -> [(Double, Text)]
makeTickDatesContinuous PosDiscontinuous
pc Maybe Text
fmt Int
n [UTCTime]
dates =
  PosDiscontinuous
-> Maybe Text -> Int -> Range UTCTime -> [(Double, Text)]
placedTimeLabelContinuous PosDiscontinuous
pc Maybe Text
fmt Int
n ([Element (Range UTCTime)] -> Range UTCTime
forall s (f :: * -> *).
(Space s, Traversable f) =>
f (Element s) -> s
space1 [UTCTime]
[Element (Range UTCTime)]
dates)

-- | Make a legend hud element taking into account the chart.
legendHud :: LegendOptions -> [Chart Double] -> Hud Double
legendHud :: LegendOptions -> [Chart Double] -> Hud Double
legendHud LegendOptions
l [Chart Double]
lcs = ([Chart Double] -> State (ChartDims Double) [Chart Double])
-> Hud Double
forall (m :: * -> *) a.
([Chart a] -> StateT (ChartDims a) m [Chart a]) -> HudT m a
Hud (([Chart Double] -> State (ChartDims Double) [Chart Double])
 -> Hud Double)
-> ([Chart Double] -> State (ChartDims Double) [Chart Double])
-> Hud Double
forall a b. (a -> b) -> a -> b
$ \[Chart Double]
cs -> do
  Rect Double
ca <- Getting (Rect Double) (ChartDims Double) (Rect Double)
-> StateT (ChartDims Double) Identity (Rect Double)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (Rect Double) (ChartDims Double) (Rect Double)
forall a. IsLabel "chartDim" a => a
forall (x :: Symbol) a. IsLabel x a => a
#chartDim
  let cs' :: [Chart Double]
cs' = [Chart Double]
cs [Chart Double] -> [Chart Double] -> [Chart Double]
forall a. Semigroup a => a -> a -> a
<> Rect Double -> [Chart Double] -> [Chart Double]
movedleg Rect Double
ca [Chart Double]
scaledleg
  #chartDim .= fromMaybe one (styleBoxes cs')
  [Chart Double] -> State (ChartDims Double) [Chart Double]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Chart Double]
cs'
  where
    scaledleg :: [Chart Double]
scaledleg =
      ((Annotation -> Identity Annotation)
-> Chart Double -> Identity (Chart Double)
forall a. IsLabel "annotation" a => a
forall (x :: Symbol) a. IsLabel x a => a
#annotation ((Annotation -> Identity Annotation)
 -> Chart Double -> Identity (Chart Double))
-> (Annotation -> Annotation) -> Chart Double -> Chart Double
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Double -> Annotation -> Annotation
scaleAnn (LegendOptions
l LegendOptions -> Getting Double LegendOptions Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double LegendOptions Double
forall a. IsLabel "lscale" a => a
forall (x :: Symbol) a. IsLabel x a => a
#lscale))
        (Chart Double -> Chart Double)
-> (Chart Double -> Chart Double) -> Chart Double -> Chart Double
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (([XY Double] -> Identity [XY Double])
-> Chart Double -> Identity (Chart Double)
forall a. IsLabel "xys" a => a
forall (x :: Symbol) a. IsLabel x a => a
#xys (([XY Double] -> Identity [XY Double])
 -> Chart Double -> Identity (Chart Double))
-> ([XY Double] -> [XY Double]) -> Chart Double -> Chart Double
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (XY Double -> XY Double) -> [XY Double] -> [XY Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Double -> Double) -> XY Double -> XY Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* LegendOptions
l LegendOptions -> Getting Double LegendOptions Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double LegendOptions Double
forall a. IsLabel "lscale" a => a
forall (x :: Symbol) a. IsLabel x a => a
#lscale)))
        (Chart Double -> Chart Double) -> [Chart Double] -> [Chart Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Chart Double]
lcs
    movedleg :: Rect Double -> [Chart Double] -> [Chart Double]
movedleg Rect Double
ca' [Chart Double]
leg =
      ([Chart Double] -> [Chart Double])
-> (Rect Double -> [Chart Double] -> [Chart Double])
-> Maybe (Rect Double)
-> [Chart Double]
-> [Chart Double]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Chart Double] -> [Chart Double]
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id (XY Double -> [Chart Double] -> [Chart Double]
forall a. Additive a => XY a -> [Chart a] -> [Chart a]
moveChart (XY Double -> [Chart Double] -> [Chart Double])
-> (Rect Double -> XY Double)
-> Rect Double
-> [Chart Double]
-> [Chart Double]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Point Double -> XY Double
forall a. Point a -> XY a
PointXY (Point Double -> XY Double)
-> (Rect Double -> Point Double) -> Rect Double -> XY Double
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Place -> Rect Double -> Rect Double -> Point Double
placel (LegendOptions
l LegendOptions -> Getting Place LegendOptions Place -> Place
forall s a. s -> Getting a s a -> a
^. Getting Place LegendOptions Place
forall a. IsLabel "lplace" a => a
forall (x :: Symbol) a. IsLabel x a => a
#lplace) Rect Double
ca') ([Chart Double] -> Maybe (Rect Double)
styleBoxes [Chart Double]
leg) [Chart Double]
leg
    placel :: Place -> Rect Double -> Rect Double -> Point Double
placel Place
pl (Rect Double
x Double
z Double
y Double
w) (Rect Double
x' Double
z' Double
y' Double
w') =
      case Place
pl of
        Place
PlaceTop -> Double -> Double -> Point Double
forall a. a -> a -> Point a
Point ((Double
x Double -> Double -> Double
forall a. Additive a => a -> a -> a
+ Double
z) Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ Double
2.0) (Double
w Double -> Double -> Double
forall a. Additive a => a -> a -> a
+ (Double
w' Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- Double
y') Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ Double
2.0)
        Place
PlaceBottom -> Double -> Double -> Point Double
forall a. a -> a -> Point a
Point ((Double
x Double -> Double -> Double
forall a. Additive a => a -> a -> a
+ Double
z) Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ Double
2.0) (Double
y Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- (Double
w' Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- Double
y' Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ Double
2.0))
        Place
PlaceLeft -> Double -> Double -> Point Double
forall a. a -> a -> Point a
Point (Double
x Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- (Double
z' Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- Double
x') Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ Double
2.0) ((Double
y Double -> Double -> Double
forall a. Additive a => a -> a -> a
+ Double
w) Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ Double
2.0)
        Place
PlaceRight -> Double -> Double -> Point Double
forall a. a -> a -> Point a
Point (Double
z Double -> Double -> Double
forall a. Additive a => a -> a -> a
+ (Double
z' Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- Double
x') Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ Double
2.0) ((Double
y Double -> Double -> Double
forall a. Additive a => a -> a -> a
+ Double
w) Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ Double
2.0)
        PlaceAbsolute Point Double
p -> Point Double
p

legendEntry ::
  LegendOptions ->
  Annotation ->
  Text ->
  (Chart Double, Chart Double)
legendEntry :: LegendOptions -> Annotation -> Text -> (Chart Double, Chart Double)
legendEntry LegendOptions
l Annotation
a Text
t =
  ( Annotation -> [XY Double] -> Chart Double
forall a. Annotation -> [XY a] -> Chart a
Chart Annotation
ann [XY Double]
sps,
    Annotation -> [XY Double] -> Chart Double
forall a. Annotation -> [XY a] -> Chart a
Chart (TextStyle -> [Text] -> Annotation
TextA (LegendOptions
l LegendOptions
-> Getting TextStyle LegendOptions TextStyle -> TextStyle
forall s a. s -> Getting a s a -> a
^. Getting TextStyle LegendOptions TextStyle
forall a. IsLabel "ltext" a => a
forall (x :: Symbol) a. IsLabel x a => a
#ltext TextStyle -> (TextStyle -> TextStyle) -> TextStyle
forall a b. a -> (a -> b) -> b
& (Anchor -> Identity Anchor) -> TextStyle -> Identity TextStyle
forall a. IsLabel "anchor" a => a
forall (x :: Symbol) a. IsLabel x a => a
#anchor ((Anchor -> Identity Anchor) -> TextStyle -> Identity TextStyle)
-> Anchor -> TextStyle -> TextStyle
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Anchor
AnchorStart) [Text
t]) [XY Double
forall a. Additive a => a
zero]
  )
  where
    (Annotation
ann, [XY Double]
sps) = case Annotation
a of
      RectA RectStyle
rs ->
        ( RectStyle -> Annotation
RectA RectStyle
rs,
          [Double -> Double -> Double -> Double -> XY Double
forall a. a -> a -> a -> a -> XY a
R Double
0 (LegendOptions
l LegendOptions -> Getting Double LegendOptions Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double LegendOptions Double
forall a. IsLabel "lsize" a => a
forall (x :: Symbol) a. IsLabel x a => a
#lsize) Double
0 (LegendOptions
l LegendOptions -> Getting Double LegendOptions Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double LegendOptions Double
forall a. IsLabel "lsize" a => a
forall (x :: Symbol) a. IsLabel x a => a
#lsize)]
        )
      TextA TextStyle
ts [Text]
txts ->
        ( TextStyle -> [Text] -> Annotation
TextA (TextStyle
ts TextStyle -> (TextStyle -> TextStyle) -> TextStyle
forall a b. a -> (a -> b) -> b
& (Double -> Identity Double) -> TextStyle -> Identity TextStyle
forall a. IsLabel "size" a => a
forall (x :: Symbol) a. IsLabel x a => a
#size ((Double -> Identity Double) -> TextStyle -> Identity TextStyle)
-> Double -> TextStyle -> TextStyle
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (LegendOptions
l LegendOptions -> Getting Double LegendOptions Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double LegendOptions Double
forall a. IsLabel "lsize" a => a
forall (x :: Symbol) a. IsLabel x a => a
#lsize)) (Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
take Int
1 [Text]
txts),
          [XY Double
forall a. Additive a => a
zero]
        )
      GlyphA GlyphStyle
gs ->
        ( GlyphStyle -> Annotation
GlyphA (GlyphStyle
gs GlyphStyle -> (GlyphStyle -> GlyphStyle) -> GlyphStyle
forall a b. a -> (a -> b) -> b
& (Double -> Identity Double) -> GlyphStyle -> Identity GlyphStyle
forall a. IsLabel "size" a => a
forall (x :: Symbol) a. IsLabel x a => a
#size ((Double -> Identity Double) -> GlyphStyle -> Identity GlyphStyle)
-> Double -> GlyphStyle -> GlyphStyle
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (LegendOptions
l LegendOptions -> Getting Double LegendOptions Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double LegendOptions Double
forall a. IsLabel "lsize" a => a
forall (x :: Symbol) a. IsLabel x a => a
#lsize)),
          [Double -> Double -> XY Double
forall a. a -> a -> XY a
P (Double
0.5 Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* LegendOptions
l LegendOptions -> Getting Double LegendOptions Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double LegendOptions Double
forall a. IsLabel "lsize" a => a
forall (x :: Symbol) a. IsLabel x a => a
#lsize) (Double
0.33 Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* LegendOptions
l LegendOptions -> Getting Double LegendOptions Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double LegendOptions Double
forall a. IsLabel "lsize" a => a
forall (x :: Symbol) a. IsLabel x a => a
#lsize)]
        )
      LineA LineStyle
ls ->
        ( LineStyle -> Annotation
LineA (LineStyle
ls LineStyle -> (LineStyle -> LineStyle) -> LineStyle
forall a b. a -> (a -> b) -> b
& (Double -> Identity Double) -> LineStyle -> Identity LineStyle
forall a. IsLabel "width" a => a
forall (x :: Symbol) a. IsLabel x a => a
#width ((Double -> Identity Double) -> LineStyle -> Identity LineStyle)
-> (Double -> Double) -> LineStyle -> LineStyle
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ (LegendOptions
l LegendOptions -> Getting Double LegendOptions Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double LegendOptions Double
forall a. IsLabel "lscale" a => a
forall (x :: Symbol) a. IsLabel x a => a
#lscale))),
          [Double -> Double -> XY Double
forall a. a -> a -> XY a
P Double
0 (Double
1 Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* LegendOptions
l LegendOptions -> Getting Double LegendOptions Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double LegendOptions Double
forall a. IsLabel "lsize" a => a
forall (x :: Symbol) a. IsLabel x a => a
#lsize), Double -> Double -> XY Double
forall a. a -> a -> XY a
P (Double
2 Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* LegendOptions
l LegendOptions -> Getting Double LegendOptions Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double LegendOptions Double
forall a. IsLabel "lsize" a => a
forall (x :: Symbol) a. IsLabel x a => a
#lsize) (Double
1 Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* LegendOptions
l LegendOptions -> Getting Double LegendOptions Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double LegendOptions Double
forall a. IsLabel "lsize" a => a
forall (x :: Symbol) a. IsLabel x a => a
#lsize)]
        )
      PathA PathStyle
ps [PathInfo Double]
_ ->
        ( let cs :: [(PathInfo Double, Point Double)]
cs =
                CubicPosition Double -> [(PathInfo Double, Point Double)]
singletonCubic
                  ( Point Double
-> Point Double
-> Point Double
-> Point Double
-> CubicPosition Double
forall a.
Point a -> Point a -> Point a -> Point a -> CubicPosition a
CubicPosition
                      (Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
0 Double
0)
                      (Double -> Double -> Point Double
forall a. a -> a -> Point a
Point (Double
0.33 Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* LegendOptions
l LegendOptions -> Getting Double LegendOptions Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double LegendOptions Double
forall a. IsLabel "lsize" a => a
forall (x :: Symbol) a. IsLabel x a => a
#lsize) (Double
0.33 Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* LegendOptions
l LegendOptions -> Getting Double LegendOptions Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double LegendOptions Double
forall a. IsLabel "lsize" a => a
forall (x :: Symbol) a. IsLabel x a => a
#lsize))
                      (Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
0 (Double
0.33 Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* LegendOptions
l LegendOptions -> Getting Double LegendOptions Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double LegendOptions Double
forall a. IsLabel "lsize" a => a
forall (x :: Symbol) a. IsLabel x a => a
#lsize))
                      (Double -> Double -> Point Double
forall a. a -> a -> Point a
Point (Double
0.33 Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* LegendOptions
l LegendOptions -> Getting Double LegendOptions Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double LegendOptions Double
forall a. IsLabel "lsize" a => a
forall (x :: Symbol) a. IsLabel x a => a
#lsize) Double
0)
                  )
           in (PathStyle -> [PathInfo Double] -> Annotation
PathA (PathStyle
ps PathStyle -> (PathStyle -> PathStyle) -> PathStyle
forall a b. a -> (a -> b) -> b
& (Double -> Identity Double) -> PathStyle -> Identity PathStyle
forall a. IsLabel "borderSize" a => a
forall (x :: Symbol) a. IsLabel x a => a
#borderSize ((Double -> Identity Double) -> PathStyle -> Identity PathStyle)
-> Double -> PathStyle -> PathStyle
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (LegendOptions
l LegendOptions -> Getting Double LegendOptions Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double LegendOptions Double
forall a. IsLabel "lsize" a => a
forall (x :: Symbol) a. IsLabel x a => a
#lsize)) ((PathInfo Double, Point Double) -> PathInfo Double
forall a b. (a, b) -> a
fst ((PathInfo Double, Point Double) -> PathInfo Double)
-> [(PathInfo Double, Point Double)] -> [PathInfo Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(PathInfo Double, Point Double)]
cs), Point Double -> XY Double
forall a. Point a -> XY a
PointXY (Point Double -> XY Double)
-> ((PathInfo Double, Point Double) -> Point Double)
-> (PathInfo Double, Point Double)
-> XY Double
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (PathInfo Double, Point Double) -> Point Double
forall a b. (a, b) -> b
snd ((PathInfo Double, Point Double) -> XY Double)
-> [(PathInfo Double, Point Double)] -> [XY Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(PathInfo Double, Point Double)]
cs)
        )
      Annotation
BlankA ->
        ( Annotation
BlankA,
          [XY Double
forall a. Additive a => a
zero]
        )

legendChart :: [(Annotation, Text)] -> LegendOptions -> [Chart Double]
legendChart :: [(Annotation, Text)] -> LegendOptions -> [Chart Double]
legendChart [(Annotation, Text)]
lrs LegendOptions
l =
  Double -> [Chart Double] -> [Chart Double]
padChart (LegendOptions
l LegendOptions -> Getting Double LegendOptions Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double LegendOptions Double
forall a. IsLabel "outerPad" a => a
forall (x :: Symbol) a. IsLabel x a => a
#outerPad)
    ([Chart Double] -> [Chart Double])
-> ([[Chart Double]] -> [Chart Double])
-> [[Chart Double]]
-> [Chart Double]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ([Chart Double] -> [Chart Double])
-> (RectStyle -> [Chart Double] -> [Chart Double])
-> Maybe RectStyle
-> [Chart Double]
-> [Chart Double]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Chart Double] -> [Chart Double]
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id (\RectStyle
x -> RectStyle -> Double -> [Chart Double] -> [Chart Double]
frameChart RectStyle
x (LegendOptions
l LegendOptions -> Getting Double LegendOptions Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double LegendOptions Double
forall a. IsLabel "innerPad" a => a
forall (x :: Symbol) a. IsLabel x a => a
#innerPad)) (LegendOptions
l LegendOptions
-> Getting (Maybe RectStyle) LegendOptions (Maybe RectStyle)
-> Maybe RectStyle
forall s a. s -> Getting a s a -> a
^. Getting (Maybe RectStyle) LegendOptions (Maybe RectStyle)
forall a. IsLabel "legendFrame" a => a
forall (x :: Symbol) a. IsLabel x a => a
#legendFrame)
    ([Chart Double] -> [Chart Double])
-> ([[Chart Double]] -> [Chart Double])
-> [[Chart Double]]
-> [Chart Double]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Double -> [[Chart Double]] -> [Chart Double]
vert (LegendOptions
l LegendOptions -> Getting Double LegendOptions Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double LegendOptions Double
forall a. IsLabel "hgap" a => a
forall (x :: Symbol) a. IsLabel x a => a
#hgap)
    ([[Chart Double]] -> [Chart Double])
-> [[Chart Double]] -> [Chart Double]
forall a b. (a -> b) -> a -> b
$ (\(Chart Double
a, Chart Double
t) -> Double -> [[Chart Double]] -> [Chart Double]
hori ((LegendOptions
l LegendOptions -> Getting Double LegendOptions Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double LegendOptions Double
forall a. IsLabel "vgap" a => a
forall (x :: Symbol) a. IsLabel x a => a
#vgap) Double -> Double -> Double
forall a. Additive a => a -> a -> a
+ Double
twidth Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- Chart Double -> Double
gapwidth Chart Double
t) [[Chart Double
t], [Chart Double
a]])
      ((Chart Double, Chart Double) -> [Chart Double])
-> [(Chart Double, Chart Double)] -> [[Chart Double]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Chart Double, Chart Double)]
es
  where
    es :: [(Chart Double, Chart Double)]
es = [(Chart Double, Chart Double)] -> [(Chart Double, Chart Double)]
forall a. [a] -> [a]
reverse ([(Chart Double, Chart Double)] -> [(Chart Double, Chart Double)])
-> [(Chart Double, Chart Double)] -> [(Chart Double, Chart Double)]
forall a b. (a -> b) -> a -> b
$ (Annotation -> Text -> (Chart Double, Chart Double))
-> (Annotation, Text) -> (Chart Double, Chart Double)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (LegendOptions -> Annotation -> Text -> (Chart Double, Chart Double)
legendEntry LegendOptions
l) ((Annotation, Text) -> (Chart Double, Chart Double))
-> [(Annotation, Text)] -> [(Chart Double, Chart Double)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Annotation, Text)]
lrs
    twidth :: Double
twidth = Double -> (Rect Double -> Double) -> Maybe (Rect Double) -> Double
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Double
0 (\(Rect Double
_ Double
z Double
_ Double
_) -> Double
z) (Maybe (Rect Double) -> Double)
-> ([Rect Double] -> Maybe (Rect Double))
-> [Rect Double]
-> Double
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [Rect Double] -> Maybe (Rect Double)
forall a. Ord a => [Rect a] -> Maybe (Rect a)
foldRect ([Rect Double] -> Double) -> [Rect Double] -> Double
forall a b. (a -> b) -> a -> b
$ [Maybe (Rect Double)] -> [Rect Double]
forall a. [Maybe a] -> [a]
catMaybes (Chart Double -> Maybe (Rect Double)
styleBox (Chart Double -> Maybe (Rect Double))
-> ((Chart Double, Chart Double) -> Chart Double)
-> (Chart Double, Chart Double)
-> Maybe (Rect Double)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Chart Double, Chart Double) -> Chart Double
forall a b. (a, b) -> b
snd ((Chart Double, Chart Double) -> Maybe (Rect Double))
-> [(Chart Double, Chart Double)] -> [Maybe (Rect Double)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Chart Double, Chart Double)]
es)
    gapwidth :: Chart Double -> Double
gapwidth Chart Double
t = Double -> (Rect Double -> Double) -> Maybe (Rect Double) -> Double
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Double
0 (\(Rect Double
_ Double
z Double
_ Double
_) -> Double
z) (Chart Double -> Maybe (Rect Double)
styleBox Chart Double
t)

-- | Project the xys of a chart to a new XY Space.
--
-- > projectXYs (dataBox cs) cs == cs if cs is non-empty
projectXYs :: Rect Double -> [Chart Double] -> [Chart Double]
projectXYs :: Rect Double -> [Chart Double] -> [Chart Double]
projectXYs Rect Double
_ [] = []
projectXYs Rect Double
new [Chart Double]
cs = Rect Double -> Rect Double -> [Chart Double] -> [Chart Double]
projectXYsWith Rect Double
new Rect Double
old [Chart Double]
cs
  where
    old :: Rect Double
old = Rect Double -> Maybe (Rect Double) -> Rect Double
forall a. a -> Maybe a -> a
fromMaybe Rect Double
forall a. Multiplicative a => a
one ([Chart Double] -> Maybe (Rect Double)
dataBoxes [Chart Double]
cs)

-- | Project chart xys to a new XY Space from an old XY Space
--
-- The projections needed are:
--
-- - project the 'xys'
--
-- - project the control points of bezier curves
--
-- - project aspect changes only to radii of ellipticals.
--
-- > projectXYsWith x x == id
projectXYsWith :: Rect Double -> Rect Double -> [Chart Double] -> [Chart Double]
projectXYsWith :: Rect Double -> Rect Double -> [Chart Double] -> [Chart Double]
projectXYsWith Rect Double
new Rect Double
old [Chart Double]
cs = [Chart Double]
cs'
  where
    xss :: [[XY Double]]
xss = (XY Double -> XY Double) -> [XY Double] -> [XY Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Rect Double -> Rect Double -> XY Double -> XY Double
projectOn Rect Double
new Rect Double
old) ([XY Double] -> [XY Double])
-> (Chart Double -> [XY Double]) -> Chart Double -> [XY Double]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Chart Double -> [XY Double]
forall a. Chart a -> [XY a]
xys (Chart Double -> [XY Double]) -> [Chart Double] -> [[XY Double]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Chart Double]
cs
    ss :: [Annotation]
ss = Chart Double -> Annotation
projectAnn (Chart Double -> Annotation) -> [Chart Double] -> [Annotation]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Chart Double]
cs
    cs' :: [Chart Double]
cs' = (Annotation -> [XY Double] -> Chart Double)
-> [Annotation] -> [[XY Double]] -> [Chart Double]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Annotation -> [XY Double] -> Chart Double
forall a. Annotation -> [XY a] -> Chart a
Chart [Annotation]
ss [[XY Double]]
xss
    projectAnn :: Chart Double -> Annotation
projectAnn (Chart (PathA PathStyle
ps [PathInfo Double]
ips) [XY Double]
xys) =
      PathStyle -> [PathInfo Double] -> Annotation
PathA PathStyle
ps ([PathInfo Double] -> [XY Double] -> [PathInfo Double]
projectControls [PathInfo Double]
ips [XY Double]
xys)
    projectAnn Chart Double
x = Chart Double -> Annotation
forall a. Chart a -> Annotation
annotation Chart Double
x

    projectControls :: [PathInfo Double] -> [XY Double] -> [PathInfo Double]
projectControls [PathInfo Double]
pis [XY Double]
xys =
      ([PathInfo Double] -> [PathInfo Double]
forall a. [a] -> [a]
reverse ([PathInfo Double] -> [PathInfo Double])
-> ((XY Double, [PathInfo Double]) -> [PathInfo Double])
-> (XY Double, [PathInfo Double])
-> [PathInfo Double]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (XY Double, [PathInfo Double]) -> [PathInfo Double]
forall a b. (a, b) -> b
snd) (((XY Double, [PathInfo Double])
 -> (PathInfo Double, XY Double) -> (XY Double, [PathInfo Double]))
-> (XY Double, [PathInfo Double])
-> [(PathInfo Double, XY Double)]
-> (XY Double, [PathInfo Double])
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\(XY Double
prevp, [PathInfo Double]
l) (PathInfo Double
i, XY Double
xy) -> (XY Double
xy, XY Double -> XY Double -> PathInfo Double -> PathInfo Double
projectControl XY Double
prevp XY Double
xy PathInfo Double
i PathInfo Double -> [PathInfo Double] -> [PathInfo Double]
forall a. a -> [a] -> [a]
: [PathInfo Double]
l)) (XY Double
forall a. Additive a => a
zero, []) ([PathInfo Double] -> [XY Double] -> [(PathInfo Double, XY Double)]
forall a b. [a] -> [b] -> [(a, b)]
zip [PathInfo Double]
pis [XY Double]
xys))

    projectControl :: XY Double -> XY Double -> PathInfo Double -> PathInfo Double
projectControl XY Double
_ XY Double
_ (CubicI Point Double
c1 Point Double
c2) =
      Point Double -> Point Double -> PathInfo Double
forall a. Point a -> Point a -> PathInfo a
CubicI (Rect Double -> Rect Double -> Point Double -> Point Double
projectOnP Rect Double
new Rect Double
old Point Double
c1) (Rect Double -> Rect Double -> Point Double -> Point Double
projectOnP Rect Double
new Rect Double
old Point Double
c2)
    projectControl XY Double
_ XY Double
_ (QuadI Point Double
c) =
      Point Double -> PathInfo Double
forall a. Point a -> PathInfo a
QuadI (Rect Double -> Rect Double -> Point Double -> Point Double
projectOnP Rect Double
new Rect Double
old Point Double
c)
    projectControl XY Double
p1 XY Double
p2 (ArcI ArcInfo Double
ai) = ArcInfo Double -> PathInfo Double
forall a. ArcInfo a -> PathInfo a
ArcI (ArcInfo Double -> PathInfo Double)
-> ArcInfo Double -> PathInfo Double
forall a b. (a -> b) -> a -> b
$ Rect Double -> Rect Double -> ArcPosition Double -> ArcInfo Double
projectArcPosition Rect Double
new Rect Double
old (Point Double
-> Point Double -> ArcInfo Double -> ArcPosition Double
forall a. Point a -> Point a -> ArcInfo a -> ArcPosition a
ArcPosition (XY Double -> Point Double
forall a. (Ord a, Field a) => XY a -> Point a
toPoint XY Double
p1) (XY Double -> Point Double
forall a. (Ord a, Field a) => XY a -> Point a
toPoint XY Double
p2) ArcInfo Double
ai)
    projectControl XY Double
_ XY Double
_ PathInfo Double
x = PathInfo Double
x

-- | project an ArcPosition given new and old Rects
--
-- The radii of the ellipse can be represented as:
--
-- Point rx 0 & Point 0 ry
--
-- These two points are firstly rotated by p and then undergo scaling...
projectArcPosition :: Rect Double -> Rect Double -> ArcPosition Double -> ArcInfo Double
projectArcPosition :: Rect Double -> Rect Double -> ArcPosition Double -> ArcInfo Double
projectArcPosition Rect Double
new Rect Double
old (ArcPosition Point Double
_ Point Double
_ (ArcInfo (Point Double
rx Double
ry) Double
phi Bool
l Bool
cl)) = Point Double -> Double -> Bool -> Bool -> ArcInfo Double
forall a. Point a -> a -> Bool -> Bool -> ArcInfo a
ArcInfo (Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
rx'' Double
ry'') Double
phi Bool
l Bool
cl
  where
    rx' :: Point Double
rx' = Double -> Point Double -> Point Double
forall a. TrigField a => a -> Point a -> Point a
rotateP Double
phi (Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
rx Double
forall a. Additive a => a
zero)
    rx'' :: Double
rx'' = Point Double -> Double
forall a b. Norm a b => a -> b
norm (Point Double -> Double) -> Point Double -> Double
forall a b. (a -> b) -> a -> b
$ Point Double
rx' Point Double -> Point Double -> Point Double
forall a. Multiplicative a => a -> a -> a
* Rect Double -> Element (Rect Double)
forall s. (Space s, Subtractive (Element s)) => s -> Element s
NH.width Rect Double
new Point Double -> Point Double -> Point Double
forall a. Divisive a => a -> a -> a
/ Rect Double -> Element (Rect Double)
forall s. (Space s, Subtractive (Element s)) => s -> Element s
NH.width Rect Double
old
    ry' :: Point Double
ry' = Double -> Point Double -> Point Double
forall a. TrigField a => a -> Point a -> Point a
rotateP Double
phi (Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
forall a. Additive a => a
zero Double
ry)
    ry'' :: Double
ry'' = Point Double -> Double
forall a b. Norm a b => a -> b
norm (Point Double -> Double) -> Point Double -> Double
forall a b. (a -> b) -> a -> b
$ Point Double
ry' Point Double -> Point Double -> Point Double
forall a. Multiplicative a => a -> a -> a
* Rect Double -> Element (Rect Double)
forall s. (Space s, Subtractive (Element s)) => s -> Element s
NH.width Rect Double
new Point Double -> Point Double -> Point Double
forall a. Divisive a => a -> a -> a
/ Rect Double -> Element (Rect Double)
forall s. (Space s, Subtractive (Element s)) => s -> Element s
NH.width Rect Double
old

-- | pad a Rect to remove singleton dimensions
padBox :: Maybe (Rect Double) -> Rect Double
padBox :: Maybe (Rect Double) -> Rect Double
padBox = Rect Double
-> (Rect Double -> Rect Double)
-> Maybe (Rect Double)
-> Rect Double
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Rect Double
forall a. Multiplicative a => a
one Rect Double -> Rect Double
forall a. (Eq a, Subtractive a, FromRational a) => Rect a -> Rect a
singletonUnit
  where
    singletonUnit :: Rect a -> Rect a
singletonUnit (Rect a
x a
z a
y a
w)
      | a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
z Bool -> Bool -> Bool
&& a
y a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
w = a -> a -> a -> a -> Rect a
forall a. a -> a -> a -> a -> Rect a
Rect (a
x a -> a -> a
forall a. Subtractive a => a -> a -> a
- a
0.5) (a
x a -> a -> a
forall a. Additive a => a -> a -> a
+ a
0.5) (a
y a -> a -> a
forall a. Subtractive a => a -> a -> a
- a
0.5) (a
y a -> a -> a
forall a. Additive a => a -> a -> a
+ a
0.5)
      | a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
z = a -> a -> a -> a -> Rect a
forall a. a -> a -> a -> a -> Rect a
Rect (a
x a -> a -> a
forall a. Subtractive a => a -> a -> a
- a
0.5) (a
x a -> a -> a
forall a. Additive a => a -> a -> a
+ a
0.5) a
y a
w
      | a
y a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
w = a -> a -> a -> a -> Rect a
forall a. a -> a -> a -> a -> Rect a
Rect a
x a
z (a
y a -> a -> a
forall a. Subtractive a => a -> a -> a
- a
0.5) (a
y a -> a -> a
forall a. Additive a => a -> a -> a
+ a
0.5)
      | Bool
otherwise = a -> a -> a -> a -> Rect a
forall a. a -> a -> a -> a -> Rect a
Rect a
x a
z a
y a
w

-- | 'Rect' of a 'Chart', not including style
dataBox :: Chart Double -> Maybe (Rect Double)
dataBox :: Chart Double -> Maybe (Rect Double)
dataBox Chart Double
c =
  case Chart Double
c Chart Double
-> Getting Annotation (Chart Double) Annotation -> Annotation
forall s a. s -> Getting a s a -> a
^. Getting Annotation (Chart Double) Annotation
forall a. IsLabel "annotation" a => a
forall (x :: Symbol) a. IsLabel x a => a
#annotation of
    PathA PathStyle
_ [PathInfo Double]
path' -> [(PathInfo Double, Point Double)] -> Maybe (Rect Double)
pathBoxes ([(PathInfo Double, Point Double)] -> Maybe (Rect Double))
-> [(PathInfo Double, Point Double)] -> Maybe (Rect Double)
forall a b. (a -> b) -> a -> b
$ [PathInfo Double]
-> [Point Double] -> [(PathInfo Double, Point Double)]
forall a b. [a] -> [b] -> [(a, b)]
zip [PathInfo Double]
path' (XY Double -> Point Double
forall a. (Ord a, Field a) => XY a -> Point a
toPoint (XY Double -> Point Double) -> [XY Double] -> [Point Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Chart Double
c Chart Double
-> Getting [XY Double] (Chart Double) [XY Double] -> [XY Double]
forall s a. s -> Getting a s a -> a
^. Getting [XY Double] (Chart Double) [XY Double]
forall a. IsLabel "xys" a => a
forall (x :: Symbol) a. IsLabel x a => a
#xys)
    Annotation
_ -> [Rect Double] -> Maybe (Rect Double)
forall a. Ord a => [Rect a] -> Maybe (Rect a)
foldRect ([Rect Double] -> Maybe (Rect Double))
-> [Rect Double] -> Maybe (Rect Double)
forall a b. (a -> b) -> a -> b
$ (XY Double -> Rect Double) -> [XY Double] -> [Rect Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap XY Double -> Rect Double
forall a. XY a -> Rect a
toRect (Chart Double
c Chart Double
-> Getting [XY Double] (Chart Double) [XY Double] -> [XY Double]
forall s a. s -> Getting a s a -> a
^. Getting [XY Double] (Chart Double) [XY Double]
forall a. IsLabel "xys" a => a
forall (x :: Symbol) a. IsLabel x a => a
#xys)

-- | 'Rect' of charts, not including style
dataBoxes :: [Chart Double] -> Maybe (Rect Double)
dataBoxes :: [Chart Double] -> Maybe (Rect Double)
dataBoxes [Chart Double]
cs = [Rect Double] -> Maybe (Rect Double)
forall a. Ord a => [Rect a] -> Maybe (Rect a)
foldRect ([Rect Double] -> Maybe (Rect Double))
-> [Rect Double] -> Maybe (Rect Double)
forall a b. (a -> b) -> a -> b
$ [Maybe (Rect Double)] -> [Rect Double]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (Rect Double)] -> [Rect Double])
-> [Maybe (Rect Double)] -> [Rect Double]
forall a b. (a -> b) -> a -> b
$ Chart Double -> Maybe (Rect Double)
dataBox (Chart Double -> Maybe (Rect Double))
-> [Chart Double] -> [Maybe (Rect Double)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Chart Double]
cs

-- | 'Rect' of charts, not including style, with defaults for Nothing and singleton dimensions if any.
dataBoxesS :: [Chart Double] -> Rect Double
dataBoxesS :: [Chart Double] -> Rect Double
dataBoxesS [Chart Double]
cs = Maybe (Rect Double) -> Rect Double
padBox (Maybe (Rect Double) -> Rect Double)
-> Maybe (Rect Double) -> Rect Double
forall a b. (a -> b) -> a -> b
$ [Rect Double] -> Maybe (Rect Double)
forall a. Ord a => [Rect a] -> Maybe (Rect a)
foldRect ([Rect Double] -> Maybe (Rect Double))
-> [Rect Double] -> Maybe (Rect Double)
forall a b. (a -> b) -> a -> b
$ [Maybe (Rect Double)] -> [Rect Double]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (Rect Double)] -> [Rect Double])
-> [Maybe (Rect Double)] -> [Rect Double]
forall a b. (a -> b) -> a -> b
$ Chart Double -> Maybe (Rect Double)
dataBox (Chart Double -> Maybe (Rect Double))
-> [Chart Double] -> [Maybe (Rect Double)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Chart Double]
cs

-- | the extra area from text styling
styleBoxText ::
  TextStyle ->
  Text ->
  Point Double ->
  Rect Double
styleBoxText :: TextStyle -> Text -> Point Double -> Rect Double
styleBoxText TextStyle
o Text
t Point Double
p = Element (Rect Double) -> Rect Double -> Rect Double
forall s. (Additive (Element s), Space s) => Element s -> s -> s
move Point Double
Element (Rect Double)
p (Rect Double -> Rect Double) -> Rect Double -> Rect Double
forall a b. (a -> b) -> a -> b
$ Rect Double
-> (Double -> Rect Double) -> Maybe Double -> Rect Double
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Rect Double
flat (Double -> Rect Double -> Rect Double
forall a. (TrigField a, Ord a) => a -> Rect a -> Rect a
`rotationBound` Rect Double
flat) (TextStyle
o TextStyle
-> Getting (Maybe Double) TextStyle (Maybe Double) -> Maybe Double
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Double) TextStyle (Maybe Double)
forall a. IsLabel "rotation" a => a
forall (x :: Symbol) a. IsLabel x a => a
#rotation)
  where
    flat :: Rect Double
flat = Double -> Double -> Double -> Double -> Rect Double
forall a. a -> a -> a -> a -> Rect a
Rect ((- Double
x' Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ Double
2.0) Double -> Double -> Double
forall a. Additive a => a -> a -> a
+ Double
x' Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Double
a') (Double
x' Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ Double
2 Double -> Double -> Double
forall a. Additive a => a -> a -> a
+ Double
x' Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Double
a') ((- Double
y' Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ Double
2) Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- Double
n1') (Double
y' Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ Double
2 Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- Double
n1')
    s :: Double
s = TextStyle
o TextStyle
-> ((Double -> Const Double Double)
    -> TextStyle -> Const Double TextStyle)
-> Double
forall s a. s -> Getting a s a -> a
^. (Double -> Const Double Double)
-> TextStyle -> Const Double TextStyle
forall a. IsLabel "size" a => a
forall (x :: Symbol) a. IsLabel x a => a
#size
    h :: Double
h = TextStyle
o TextStyle
-> ((Double -> Const Double Double)
    -> TextStyle -> Const Double TextStyle)
-> Double
forall s a. s -> Getting a s a -> a
^. (Double -> Const Double Double)
-> TextStyle -> Const Double TextStyle
forall a. IsLabel "hsize" a => a
forall (x :: Symbol) a. IsLabel x a => a
#hsize
    v :: Double
v = TextStyle
o TextStyle
-> ((Double -> Const Double Double)
    -> TextStyle -> Const Double TextStyle)
-> Double
forall s a. s -> Getting a s a -> a
^. (Double -> Const Double Double)
-> TextStyle -> Const Double TextStyle
forall a. IsLabel "vsize" a => a
forall (x :: Symbol) a. IsLabel x a => a
#vsize
    n1 :: Double
n1 = TextStyle
o TextStyle
-> ((Double -> Const Double Double)
    -> TextStyle -> Const Double TextStyle)
-> Double
forall s a. s -> Getting a s a -> a
^. (Double -> Const Double Double)
-> TextStyle -> Const Double TextStyle
forall a. IsLabel "nudge1" a => a
forall (x :: Symbol) a. IsLabel x a => a
#nudge1
    x' :: Double
x' = Double
s Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Double
h Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Int -> Double
forall a b. FromIntegral a b => b -> a
fromIntegral ([Int] -> Int
forall a (f :: * -> *). (Additive a, Foldable f) => f a -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ Int -> (Text -> Int) -> Maybe Text -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 Text -> Int
Text.length (Maybe Text -> Int) -> (Tag Text -> Maybe Text) -> Tag Text -> Int
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Tag Text -> Maybe Text
forall str. Tag str -> Maybe str
maybeTagText (Tag Text -> Int) -> [Tag Text] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> [Tag Text]
forall str. StringLike str => str -> [Tag str]
parseTags Text
t)
    y' :: Double
y' = Double
s Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Double
v
    n1' :: Double
n1' = Double
s Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Double
n1
    a' :: Double
a' = case TextStyle
o TextStyle -> Getting Anchor TextStyle Anchor -> Anchor
forall s a. s -> Getting a s a -> a
^. Getting Anchor TextStyle Anchor
forall a. IsLabel "anchor" a => a
forall (x :: Symbol) a. IsLabel x a => a
#anchor of
      Anchor
AnchorStart -> Double
0.5
      Anchor
AnchorEnd -> Double
-0.5
      Anchor
AnchorMiddle -> Double
0.0

-- | the extra area from glyph styling
styleBoxGlyph :: GlyphStyle -> Rect Double
styleBoxGlyph :: GlyphStyle -> Rect Double
styleBoxGlyph GlyphStyle
s = Element (Rect Double) -> Rect Double -> Rect Double
forall s. (Additive (Element s), Space s) => Element s -> s -> s
move Point Double
Element (Rect Double)
p' (Rect Double -> Rect Double) -> Rect Double -> Rect Double
forall a b. (a -> b) -> a -> b
$
  Rect Double -> Rect Double
sw (Rect Double -> Rect Double) -> Rect Double -> Rect Double
forall a b. (a -> b) -> a -> b
$ case GlyphShape
sh of
    GlyphShape
CircleGlyph -> (Double
sz Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
*) (Double -> Double) -> Rect Double -> Rect Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Rect Double
forall a. Multiplicative a => a
one
    GlyphShape
SquareGlyph -> (Double
sz Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
*) (Double -> Double) -> Rect Double -> Rect Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Rect Double
forall a. Multiplicative a => a
one
    EllipseGlyph Double
a -> Element (Rect Double) -> Rect Double -> Rect Double
forall s.
(Multiplicative (Element s), Space s) =>
Element s -> s -> s
NH.scale (Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
sz (Double
a Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Double
sz)) Rect Double
forall a. Multiplicative a => a
one
    RectSharpGlyph Double
a -> Element (Rect Double) -> Rect Double -> Rect Double
forall s.
(Multiplicative (Element s), Space s) =>
Element s -> s -> s
NH.scale (Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
sz (Double
a Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Double
sz)) Rect Double
forall a. Multiplicative a => a
one
    RectRoundedGlyph Double
a Double
_ Double
_ -> Element (Rect Double) -> Rect Double -> Rect Double
forall s.
(Multiplicative (Element s), Space s) =>
Element s -> s -> s
NH.scale (Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
sz (Double
a Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Double
sz)) Rect Double
forall a. Multiplicative a => a
one
    VLineGlyph Double
_ -> Element (Rect Double) -> Rect Double -> Rect Double
forall s.
(Multiplicative (Element s), Space s) =>
Element s -> s -> s
NH.scale (Double -> Double -> Point Double
forall a. a -> a -> Point a
Point ((GlyphStyle
s GlyphStyle -> Getting Double GlyphStyle Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double GlyphStyle Double
forall a. IsLabel "borderSize" a => a
forall (x :: Symbol) a. IsLabel x a => a
#borderSize) Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Double
sz) Double
sz) Rect Double
forall a. Multiplicative a => a
one
    HLineGlyph Double
_ -> Element (Rect Double) -> Rect Double -> Rect Double
forall s.
(Multiplicative (Element s), Space s) =>
Element s -> s -> s
NH.scale (Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
sz ((GlyphStyle
s GlyphStyle -> Getting Double GlyphStyle Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double GlyphStyle Double
forall a. IsLabel "borderSize" a => a
forall (x :: Symbol) a. IsLabel x a => a
#borderSize) Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Double
sz)) Rect Double
forall a. Multiplicative a => a
one
    TriangleGlyph Point Double
a Point Double
b Point Double
c -> (Double
sz Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
*) (Double -> Double) -> Rect Double -> Rect Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (Rect Double) -> Rect Double
forall a. Semigroup a => NonEmpty a -> a
sconcat (XY Double -> Rect Double
forall a. XY a -> Rect a
toRect (XY Double -> Rect Double)
-> (Point Double -> XY Double) -> Point Double -> Rect Double
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Point Double -> XY Double
forall a. Point a -> XY a
PointXY (Point Double -> Rect Double)
-> NonEmpty (Point Double) -> NonEmpty (Rect Double)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Point Double
a Point Double -> [Point Double] -> NonEmpty (Point Double)
forall a. a -> [a] -> NonEmpty a
:| [Point Double
b, Point Double
c]) :: NonEmpty (Rect Double))
    PathGlyph Text
path' -> (Double
sz Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
*) (Double -> Double) -> Rect Double -> Rect Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Rect Double -> Maybe (Rect Double) -> Rect Double
forall a. a -> Maybe a -> a
fromMaybe Rect Double
forall a. Multiplicative a => a
one ([(PathInfo Double, Point Double)] -> Maybe (Rect Double)
pathBoxes ([(PathInfo Double, Point Double)] -> Maybe (Rect Double))
-> (Text -> [(PathInfo Double, Point Double)])
-> Text
-> Maybe (Rect Double)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [PathCommand] -> [(PathInfo Double, Point Double)]
toPathXYs ([PathCommand] -> [(PathInfo Double, Point Double)])
-> (Text -> [PathCommand])
-> Text
-> [(PathInfo Double, Point Double)]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> [PathCommand]
parsePath (Text -> Maybe (Rect Double)) -> Text -> Maybe (Rect Double)
forall a b. (a -> b) -> a -> b
$ Text
path')
  where
    sh :: GlyphShape
sh = GlyphStyle
s GlyphStyle
-> Getting GlyphShape GlyphStyle GlyphShape -> GlyphShape
forall s a. s -> Getting a s a -> a
^. Getting GlyphShape GlyphStyle GlyphShape
forall a. IsLabel "shape" a => a
forall (x :: Symbol) a. IsLabel x a => a
#shape
    sz :: Double
sz = GlyphStyle
s GlyphStyle -> Getting Double GlyphStyle Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double GlyphStyle Double
forall a. IsLabel "size" a => a
forall (x :: Symbol) a. IsLabel x a => a
#size
    sw :: Rect Double -> Rect Double
sw = Double -> Rect Double -> Rect Double
forall a. Num a => a -> Rect a -> Rect a
padRect (Double
0.5 Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* GlyphStyle
s GlyphStyle -> Getting Double GlyphStyle Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double GlyphStyle Double
forall a. IsLabel "borderSize" a => a
forall (x :: Symbol) a. IsLabel x a => a
#borderSize)
    p' :: Point Double
p' = Point Double -> Maybe (Point Double) -> Point Double
forall a. a -> Maybe a -> a
fromMaybe (Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
0.0 Double
0.0) (GlyphStyle
s GlyphStyle
-> Getting (Maybe (Point Double)) GlyphStyle (Maybe (Point Double))
-> Maybe (Point Double)
forall s a. s -> Getting a s a -> a
^. Getting (Maybe (Point Double)) GlyphStyle (Maybe (Point Double))
forall a. IsLabel "translate" a => a
forall (x :: Symbol) a. IsLabel x a => a
#translate)

-- | the geometric dimensions of a Chart inclusive of style geometry, but excluding PathA effects
styleBox :: Chart Double -> Maybe (Rect Double)
styleBox :: Chart Double -> Maybe (Rect Double)
styleBox (Chart (TextA TextStyle
s [Text]
ts) [XY Double]
xs) = [Rect Double] -> Maybe (Rect Double)
forall a. Ord a => [Rect a] -> Maybe (Rect a)
foldRect ([Rect Double] -> Maybe (Rect Double))
-> [Rect Double] -> Maybe (Rect Double)
forall a b. (a -> b) -> a -> b
$ (Text -> XY Double -> Rect Double)
-> [Text] -> [XY Double] -> [Rect Double]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Text
t XY Double
x -> TextStyle -> Text -> Point Double -> Rect Double
styleBoxText TextStyle
s Text
t (XY Double -> Point Double
forall a. (Ord a, Field a) => XY a -> Point a
toPoint XY Double
x)) [Text]
ts [XY Double]
xs
styleBox (Chart (GlyphA GlyphStyle
s) [XY Double]
xs) = [Rect Double] -> Maybe (Rect Double)
forall a. Ord a => [Rect a] -> Maybe (Rect a)
foldRect ([Rect Double] -> Maybe (Rect Double))
-> [Rect Double] -> Maybe (Rect Double)
forall a b. (a -> b) -> a -> b
$ (\XY Double
x -> Element (Rect Double) -> Rect Double -> Rect Double
forall s. (Additive (Element s), Space s) => Element s -> s -> s
move (XY Double -> Point Double
forall a. (Ord a, Field a) => XY a -> Point a
toPoint XY Double
x) (GlyphStyle -> Rect Double
styleBoxGlyph GlyphStyle
s)) (XY Double -> Rect Double) -> [XY Double] -> [Rect Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [XY Double]
xs
styleBox (Chart (RectA RectStyle
s) [XY Double]
xs) = [Rect Double] -> Maybe (Rect Double)
forall a. Ord a => [Rect a] -> Maybe (Rect a)
foldRect (Double -> Rect Double -> Rect Double
forall a. Num a => a -> Rect a -> Rect a
padRect (Double
0.5 Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* RectStyle
s RectStyle -> Getting Double RectStyle Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double RectStyle Double
forall a. IsLabel "borderSize" a => a
forall (x :: Symbol) a. IsLabel x a => a
#borderSize) (Rect Double -> Rect Double)
-> (XY Double -> Rect Double) -> XY Double -> Rect Double
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. XY Double -> Rect Double
forall a. XY a -> Rect a
toRect (XY Double -> Rect Double) -> [XY Double] -> [Rect Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [XY Double]
xs)
styleBox (Chart (LineA LineStyle
s) [XY Double]
xs) = [Rect Double] -> Maybe (Rect Double)
forall a. Ord a => [Rect a] -> Maybe (Rect a)
foldRect (Double -> Rect Double -> Rect Double
forall a. Num a => a -> Rect a -> Rect a
padRect (Double
0.5 Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* LineStyle
s LineStyle -> Getting Double LineStyle Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double LineStyle Double
forall a. IsLabel "width" a => a
forall (x :: Symbol) a. IsLabel x a => a
#width) (Rect Double -> Rect Double)
-> (XY Double -> Rect Double) -> XY Double -> Rect Double
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. XY Double -> Rect Double
forall a. XY a -> Rect a
toRect (XY Double -> Rect Double) -> [XY Double] -> [Rect Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [XY Double]
xs)
styleBox c :: Chart Double
c@(Chart (PathA PathStyle
s [PathInfo Double]
_) [XY Double]
_) = Double -> Rect Double -> Rect Double
forall a. Num a => a -> Rect a -> Rect a
padRect (Double
0.5 Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* PathStyle
s PathStyle -> Getting Double PathStyle Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double PathStyle Double
forall a. IsLabel "borderSize" a => a
forall (x :: Symbol) a. IsLabel x a => a
#borderSize) (Rect Double -> Rect Double)
-> Maybe (Rect Double) -> Maybe (Rect Double)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Chart Double -> Maybe (Rect Double)
dataBox Chart Double
c
styleBox (Chart Annotation
BlankA [XY Double]
xs) = [Rect Double] -> Maybe (Rect Double)
forall a. Ord a => [Rect a] -> Maybe (Rect a)
foldRect (XY Double -> Rect Double
forall a. XY a -> Rect a
toRect (XY Double -> Rect Double) -> [XY Double] -> [Rect Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [XY Double]
xs)

-- | the extra geometric dimensions of a [Chart]
styleBoxes :: [Chart Double] -> Maybe (Rect Double)
styleBoxes :: [Chart Double] -> Maybe (Rect Double)
styleBoxes [Chart Double]
xss = [Rect Double] -> Maybe (Rect Double)
forall a. Ord a => [Rect a] -> Maybe (Rect a)
foldRect ([Rect Double] -> Maybe (Rect Double))
-> [Rect Double] -> Maybe (Rect Double)
forall a b. (a -> b) -> a -> b
$ [Maybe (Rect Double)] -> [Rect Double]
forall a. [Maybe a] -> [a]
catMaybes (Chart Double -> Maybe (Rect Double)
styleBox (Chart Double -> Maybe (Rect Double))
-> [Chart Double] -> [Maybe (Rect Double)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Chart Double]
xss)

-- | the extra geometric dimensions of a [Chart], adjusted for Nothing or singleton dimensions.
styleBoxesS :: [Chart Double] -> Rect Double
styleBoxesS :: [Chart Double] -> Rect Double
styleBoxesS [Chart Double]
xss = Maybe (Rect Double) -> Rect Double
padBox (Maybe (Rect Double) -> Rect Double)
-> Maybe (Rect Double) -> Rect Double
forall a b. (a -> b) -> a -> b
$ [Rect Double] -> Maybe (Rect Double)
forall a. Ord a => [Rect a] -> Maybe (Rect a)
foldRect ([Rect Double] -> Maybe (Rect Double))
-> [Rect Double] -> Maybe (Rect Double)
forall a b. (a -> b) -> a -> b
$ [Maybe (Rect Double)] -> [Rect Double]
forall a. [Maybe a] -> [a]
catMaybes (Chart Double -> Maybe (Rect Double)
styleBox (Chart Double -> Maybe (Rect Double))
-> [Chart Double] -> [Maybe (Rect Double)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Chart Double]
xss)

-- | additively pad a [Chart]
--
-- >>> padChart 0.1 [Chart (RectA defaultRectStyle) [RectXY one]]
-- [Chart {annotation = RectA (RectStyle {borderSize = 1.0e-2, borderColor = Colour 0.65 0.81 0.89 1.00, color = Colour 0.12 0.47 0.71 1.00}), xys = [R -0.5 0.5 -0.5 0.5]},Chart {annotation = BlankA, xys = [R -0.605 0.605 -0.605 0.605]}]
padChart :: Double -> [Chart Double] -> [Chart Double]
padChart :: Double -> [Chart Double] -> [Chart Double]
padChart Double
p [Chart Double]
cs = [Chart Double]
cs [Chart Double] -> [Chart Double] -> [Chart Double]
forall a. Semigroup a => a -> a -> a
<> [Annotation -> [XY Double] -> Chart Double
forall a. Annotation -> [XY a] -> Chart a
Chart Annotation
BlankA (Maybe (XY Double) -> [XY Double]
forall a. Maybe a -> [a]
maybeToList (Rect Double -> XY Double
forall a. Rect a -> XY a
RectXY (Rect Double -> XY Double)
-> (Rect Double -> Rect Double) -> Rect Double -> XY Double
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Double -> Rect Double -> Rect Double
forall a. Num a => a -> Rect a -> Rect a
padRect Double
p (Rect Double -> XY Double)
-> Maybe (Rect Double) -> Maybe (XY Double)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Chart Double] -> Maybe (Rect Double)
styleBoxes [Chart Double]
cs))]

-- | overlay a frame on some charts with some additive padding between
--
-- >>> frameChart defaultRectStyle 0.1 [Chart BlankA []]
-- [Chart {annotation = RectA (RectStyle {borderSize = 1.0e-2, borderColor = Colour 0.65 0.81 0.89 1.00, color = Colour 0.12 0.47 0.71 1.00}), xys = []},Chart {annotation = BlankA, xys = []}]
frameChart :: RectStyle -> Double -> [Chart Double] -> [Chart Double]
frameChart :: RectStyle -> Double -> [Chart Double] -> [Chart Double]
frameChart RectStyle
rs Double
p [Chart Double]
cs = [Annotation -> [XY Double] -> Chart Double
forall a. Annotation -> [XY a] -> Chart a
Chart (RectStyle -> Annotation
RectA RectStyle
rs) (Maybe (XY Double) -> [XY Double]
forall a. Maybe a -> [a]
maybeToList (Rect Double -> XY Double
forall a. Rect a -> XY a
RectXY (Rect Double -> XY Double)
-> (Rect Double -> Rect Double) -> Rect Double -> XY Double
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Double -> Rect Double -> Rect Double
forall a. Num a => a -> Rect a -> Rect a
padRect Double
p (Rect Double -> XY Double)
-> Maybe (Rect Double) -> Maybe (XY Double)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Chart Double] -> Maybe (Rect Double)
styleBoxes [Chart Double]
cs))] [Chart Double] -> [Chart Double] -> [Chart Double]
forall a. Semigroup a => a -> a -> a
<> [Chart Double]
cs

-- | useful for testing bounding boxes
frameAllCharts :: [Chart Double] -> [Chart Double]
frameAllCharts :: [Chart Double] -> [Chart Double]
frameAllCharts [Chart Double]
cs = [[Chart Double]] -> [Chart Double]
forall a. Monoid a => [a] -> a
mconcat ([[Chart Double]] -> [Chart Double])
-> [[Chart Double]] -> [Chart Double]
forall a b. (a -> b) -> a -> b
$ RectStyle -> Double -> [Chart Double] -> [Chart Double]
frameChart (Double -> Colour -> RectStyle
border Double
0.004 Colour
light) Double
0.004 ([Chart Double] -> [Chart Double])
-> (Chart Double -> [Chart Double])
-> Chart Double
-> [Chart Double]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Chart Double -> [Chart Double] -> [Chart Double]
forall a. a -> [a] -> [a]
: []) (Chart Double -> [Chart Double])
-> [Chart Double] -> [[Chart Double]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Chart Double]
cs

-- | horizontally stack a list of list of charts (proceeding to the right) with a gap between
hori :: Double -> [[Chart Double]] -> [Chart Double]
hori :: Double -> [[Chart Double]] -> [Chart Double]
hori Double
_ [] = []
hori Double
gap [[Chart Double]]
cs = ([Chart Double] -> [Chart Double] -> [Chart Double])
-> [Chart Double] -> [[Chart Double]] -> [Chart Double]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' [Chart Double] -> [Chart Double] -> [Chart Double]
step [] [[Chart Double]]
cs
  where
    step :: [Chart Double] -> [Chart Double] -> [Chart Double]
step [Chart Double]
x [Chart Double]
a = [Chart Double]
x [Chart Double] -> [Chart Double] -> [Chart Double]
forall a. Semigroup a => a -> a -> a
<> ([Chart Double]
a [Chart Double]
-> ([Chart Double] -> [Chart Double]) -> [Chart Double]
forall a b. a -> (a -> b) -> b
& (Chart Double -> Chart Double) -> [Chart Double] -> [Chart Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([XY Double] -> Identity [XY Double])
-> Chart Double -> Identity (Chart Double)
forall a. IsLabel "xys" a => a
forall (x :: Symbol) a. IsLabel x a => a
#xys (([XY Double] -> Identity [XY Double])
 -> Chart Double -> Identity (Chart Double))
-> ([XY Double] -> [XY Double]) -> Chart Double -> Chart Double
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (XY Double -> XY Double) -> [XY Double] -> [XY Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\XY Double
s -> Double -> Double -> XY Double
forall a. a -> a -> XY a
P ([Chart Double] -> Double
widthx [Chart Double]
x) ([Chart Double] -> Double
aligny [Chart Double]
x Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- [Chart Double] -> Double
aligny [Chart Double]
a) XY Double -> XY Double -> XY Double
forall a. Additive a => a -> a -> a
+ XY Double
s)))
    widthx :: [Chart Double] -> Double
widthx [Chart Double]
xs = Double -> (Rect Double -> Double) -> Maybe (Rect Double) -> Double
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Double
0 (\(Rect Double
x' Double
z' Double
_ Double
_) -> Double
z' Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- Double
x' Double -> Double -> Double
forall a. Additive a => a -> a -> a
+ Double
gap) ([Chart Double] -> Maybe (Rect Double)
styleBoxes [Chart Double]
xs)
    aligny :: [Chart Double] -> Double
aligny [Chart Double]
xs = Double -> (Rect Double -> Double) -> Maybe (Rect Double) -> Double
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Double
0 (\(Rect Double
_ Double
_ Double
y' Double
w') -> (Double
y' Double -> Double -> Double
forall a. Additive a => a -> a -> a
+ Double
w') Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ Double
2) ([Chart Double] -> Maybe (Rect Double)
styleBoxes [Chart Double]
xs)

-- | vertically stack a list of charts (proceeding upwards), aligning them to the left
vert :: Double -> [[Chart Double]] -> [Chart Double]
vert :: Double -> [[Chart Double]] -> [Chart Double]
vert Double
_ [] = []
vert Double
gap [[Chart Double]]
cs = ([Chart Double] -> [Chart Double] -> [Chart Double])
-> [Chart Double] -> [[Chart Double]] -> [Chart Double]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' [Chart Double] -> [Chart Double] -> [Chart Double]
step [] [[Chart Double]]
cs
  where
    step :: [Chart Double] -> [Chart Double] -> [Chart Double]
step [Chart Double]
x [Chart Double]
a = [Chart Double]
x [Chart Double] -> [Chart Double] -> [Chart Double]
forall a. Semigroup a => a -> a -> a
<> ([Chart Double]
a [Chart Double]
-> ([Chart Double] -> [Chart Double]) -> [Chart Double]
forall a b. a -> (a -> b) -> b
& (Chart Double -> Chart Double) -> [Chart Double] -> [Chart Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([XY Double] -> Identity [XY Double])
-> Chart Double -> Identity (Chart Double)
forall a. IsLabel "xys" a => a
forall (x :: Symbol) a. IsLabel x a => a
#xys (([XY Double] -> Identity [XY Double])
 -> Chart Double -> Identity (Chart Double))
-> ([XY Double] -> [XY Double]) -> Chart Double -> Chart Double
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (XY Double -> XY Double) -> [XY Double] -> [XY Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\XY Double
s -> Double -> Double -> XY Double
forall a. a -> a -> XY a
P ([Chart Double] -> Double
alignx [Chart Double]
x Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- [Chart Double] -> Double
alignx [Chart Double]
a) ([Chart Double] -> Double
widthy [Chart Double]
x) XY Double -> XY Double -> XY Double
forall a. Additive a => a -> a -> a
+ XY Double
s)))
    widthy :: [Chart Double] -> Double
widthy [Chart Double]
xs = Double -> (Rect Double -> Double) -> Maybe (Rect Double) -> Double
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Double
0 (\(Rect Double
_ Double
_ Double
y' Double
w') -> Double
w' Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- Double
y' Double -> Double -> Double
forall a. Additive a => a -> a -> a
+ Double
gap) ([Chart Double] -> Maybe (Rect Double)
styleBoxes [Chart Double]
xs)
    alignx :: [Chart Double] -> Double
alignx [Chart Double]
xs = Double -> (Rect Double -> Double) -> Maybe (Rect Double) -> Double
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Double
0 (\(Rect Double
x' Double
_ Double
_ Double
_) -> Double
x') ([Chart Double] -> Maybe (Rect Double)
styleBoxes [Chart Double]
xs)

-- | stack a list of charts horizontally, then vertically
stack :: Int -> Double -> [[Chart Double]] -> [Chart Double]
stack :: Int -> Double -> [[Chart Double]] -> [Chart Double]
stack Int
_ Double
_ [] = []
stack Int
n Double
gap [[Chart Double]]
cs = Double -> [[Chart Double]] -> [Chart Double]
vert Double
gap (Double -> [[Chart Double]] -> [Chart Double]
hori Double
gap ([[Chart Double]] -> [Chart Double])
-> [[[Chart Double]]] -> [[Chart Double]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Chart Double]] -> [[[Chart Double]]] -> [[[Chart Double]]]
group' [[Chart Double]]
cs [])
  where
    group' :: [[Chart Double]] -> [[[Chart Double]]] -> [[[Chart Double]]]
group' [] [[[Chart Double]]]
acc = [[[Chart Double]]] -> [[[Chart Double]]]
forall a. [a] -> [a]
reverse [[[Chart Double]]]
acc
    group' [[Chart Double]]
x [[[Chart Double]]]
acc = [[Chart Double]] -> [[[Chart Double]]] -> [[[Chart Double]]]
group' (Int -> [[Chart Double]] -> [[Chart Double]]
forall a. Int -> [a] -> [a]
drop Int
n [[Chart Double]]
x) (Int -> [[Chart Double]] -> [[Chart Double]]
forall a. Int -> [a] -> [a]
take Int
n [[Chart Double]]
x [[Chart Double]] -> [[[Chart Double]]] -> [[[Chart Double]]]
forall a. a -> [a] -> [a]
: [[[Chart Double]]]
acc)

addChartBox :: Chart Double -> Rect Double -> Rect Double
addChartBox :: Chart Double -> Rect Double -> Rect Double
addChartBox Chart Double
c Rect Double
r = NonEmpty (Rect Double) -> Rect Double
forall a. Semigroup a => NonEmpty a -> a
sconcat (Rect Double
r Rect Double -> [Rect Double] -> NonEmpty (Rect Double)
forall a. a -> [a] -> NonEmpty a
:| Maybe (Rect Double) -> [Rect Double]
forall a. Maybe a -> [a]
maybeToList (Chart Double -> Maybe (Rect Double)
styleBox Chart Double
c))

addChartBoxes :: [Chart Double] -> Rect Double -> Rect Double
addChartBoxes :: [Chart Double] -> Rect Double -> Rect Double
addChartBoxes [Chart Double]
c Rect Double
r = NonEmpty (Rect Double) -> Rect Double
forall a. Semigroup a => NonEmpty a -> a
sconcat (Rect Double
r Rect Double -> [Rect Double] -> NonEmpty (Rect Double)
forall a. a -> [a] -> NonEmpty a
:| Maybe (Rect Double) -> [Rect Double]
forall a. Maybe a -> [a]
maybeToList ([Chart Double] -> Maybe (Rect Double)
styleBoxes [Chart Double]
c))