{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -Wall #-}

-- | Base 'Chart' and 'ChartTree' types and support
module Chart.Primitive
  ( -- * Charts

    Chart (..),
    ChartTree (..),
    tree',
    chart',
    charts',
    named,
    unnamed,
    rename,
    blank,
    group,
    filterChartTree,
    Orientation (..),
    ChartAspect (..),

    -- * Boxes

    -- $boxes
    box,
    sbox,
    projectWith,
    maybeProjectWith,
    moveChart,
    scaleChart,
    scaleStyle,
    colourChart,
    projectChartTree,
    boxes,
    box',
    styleBoxes,
    styleBox',

    -- * Combinators
    vert,
    hori,
    stack,
    frameChart,
    isEmptyChart,
    padChart,
    rectangularize,
    glyphize,
    overText,
  )
where

import Chart.Data
import Chart.Style
import Data.Bifunctor
import Data.Bool
import Data.Colour
import Data.Foldable
import Data.Maybe
import Data.Path
import Data.Text (Text)
import Data.Tree
import GHC.Generics
import qualified NumHask.Prelude as NH
import Optics.Core
import Prelude

-- $setup
--
-- >>> :set -XOverloadedLabels
-- >>> :set -XOverloadedStrings
-- >>> import Chart
-- >>> import Optics.Core
-- >>> let r = RectChart defaultRectStyle [one]

-- | There are 6 Chart primitives, unified as the Chart type.
--
-- - 'RectChart': a rectangle in the XY-domain. For example, a @Rect 0 1 0 1@ is the set of points on the XY Plane bounded by (0,0), (0,1), (1,0) & (1,1). Much of the library is built on Rect Double's but the base types are polymorphic.
-- - 'LineChart': a list of points which represent connected straight lines. [Point 0 0, Point 1 1, Point 2 2, Point 3 3] is an example; three lines connected up to form a line from (0,0) to (3,3).
-- - 'GlyphChart': a 'GlyphShape' which is a predefined shaped centered at a 'Point' in XY space.
-- - 'TextChart': text centered at a 'Point' in XY space.
-- - 'PathChart': specification of curvilinear paths using the SVG standards.
-- - 'BlankChart': a rectangular space that has no visual representation.
--
-- What is a Chart is usually a combination of these primitives into a tree or list of charts.
--
-- Each Chart primitive is a product of a style (the syntactic representation of the data) and a list of data.
--
-- A simple example is:
--
-- >>> let r = RectChart defaultRectStyle [one]
-- >>> r
-- RectChart (RectStyle {borderSize = 1.0e-2, borderColor = Colour 0.02 0.29 0.48 1.00, color = Colour 0.02 0.73 0.80 0.10}) [Rect -0.5 0.5 -0.5 0.5]
--
-- Using the defaults, this chart is rendered as:
--
-- > writeChartSvg "other/unit.hs" $ mempty & #hudOptions .~ defaultHudOptions & #charts .~ unnamed [r]
--
-- ![unit example](other/unit.svg)
data Chart where
  RectChart :: RectStyle -> [Rect Double] -> Chart
  LineChart :: LineStyle -> [[Point Double]] -> Chart
  GlyphChart :: GlyphStyle -> [Point Double] -> Chart
  TextChart :: TextStyle -> [(Text, Point Double)] -> Chart
  PathChart :: PathStyle -> [PathData Double] -> Chart
  BlankChart :: [Rect Double] -> Chart
  deriving (Chart -> Chart -> Bool
(Chart -> Chart -> Bool) -> (Chart -> Chart -> Bool) -> Eq Chart
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Chart -> Chart -> Bool
$c/= :: Chart -> Chart -> Bool
== :: Chart -> Chart -> Bool
$c== :: Chart -> Chart -> Bool
Eq, Int -> Chart -> ShowS
[Chart] -> ShowS
Chart -> String
(Int -> Chart -> ShowS)
-> (Chart -> String) -> ([Chart] -> ShowS) -> Show Chart
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Chart] -> ShowS
$cshowList :: [Chart] -> ShowS
show :: Chart -> String
$cshow :: Chart -> String
showsPrec :: Int -> Chart -> ShowS
$cshowsPrec :: Int -> Chart -> ShowS
Show)

-- | A group of charts represented by a 'Tree' of chart lists with labelled branches. The labelling is particularly useful downstream, when groupings become grouped SVG elements with classes or ids.
newtype ChartTree = ChartTree {ChartTree -> Tree (Maybe Text, [Chart])
tree :: Tree (Maybe Text, [Chart])} deriving (ChartTree -> ChartTree -> Bool
(ChartTree -> ChartTree -> Bool)
-> (ChartTree -> ChartTree -> Bool) -> Eq ChartTree
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChartTree -> ChartTree -> Bool
$c/= :: ChartTree -> ChartTree -> Bool
== :: ChartTree -> ChartTree -> Bool
$c== :: ChartTree -> ChartTree -> Bool
Eq, Int -> ChartTree -> ShowS
[ChartTree] -> ShowS
ChartTree -> String
(Int -> ChartTree -> ShowS)
-> (ChartTree -> String)
-> ([ChartTree] -> ShowS)
-> Show ChartTree
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChartTree] -> ShowS
$cshowList :: [ChartTree] -> ShowS
show :: ChartTree -> String
$cshow :: ChartTree -> String
showsPrec :: Int -> ChartTree -> ShowS
$cshowsPrec :: Int -> ChartTree -> ShowS
Show, (forall x. ChartTree -> Rep ChartTree x)
-> (forall x. Rep ChartTree x -> ChartTree) -> Generic ChartTree
forall x. Rep ChartTree x -> ChartTree
forall x. ChartTree -> Rep ChartTree x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ChartTree x -> ChartTree
$cfrom :: forall x. ChartTree -> Rep ChartTree x
Generic)

-- | Apply a filter to ChartTree
filterChartTree :: (Chart -> Bool) -> ChartTree -> ChartTree
filterChartTree :: (Chart -> Bool) -> ChartTree -> ChartTree
filterChartTree Chart -> Bool
p (ChartTree (Node (Maybe Text
a, [Chart]
cs) Forest (Maybe Text, [Chart])
xs)) =
  Tree (Maybe Text, [Chart]) -> ChartTree
ChartTree ((Maybe Text, [Chart])
-> Forest (Maybe Text, [Chart]) -> Tree (Maybe Text, [Chart])
forall a. a -> Forest a -> Tree a
Node (Maybe Text
a, [Maybe Chart] -> [Chart]
forall a. [Maybe a] -> [a]
catMaybes (Chart -> Maybe Chart
rem' (Chart -> Maybe Chart) -> [Chart] -> [Maybe Chart]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Chart]
cs)) (ChartTree -> Tree (Maybe Text, [Chart])
tree (ChartTree -> Tree (Maybe Text, [Chart]))
-> (Tree (Maybe Text, [Chart]) -> ChartTree)
-> Tree (Maybe Text, [Chart])
-> Tree (Maybe Text, [Chart])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Chart -> Bool) -> ChartTree -> ChartTree
filterChartTree Chart -> Bool
p (ChartTree -> ChartTree)
-> (Tree (Maybe Text, [Chart]) -> ChartTree)
-> Tree (Maybe Text, [Chart])
-> ChartTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree (Maybe Text, [Chart]) -> ChartTree
ChartTree (Tree (Maybe Text, [Chart]) -> Tree (Maybe Text, [Chart]))
-> Forest (Maybe Text, [Chart]) -> Forest (Maybe Text, [Chart])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Forest (Maybe Text, [Chart])
xs))
  where
    rem' :: Chart -> Maybe Chart
rem' Chart
x = Maybe Chart -> Maybe Chart -> Bool -> Maybe Chart
forall a. a -> a -> Bool -> a
bool Maybe Chart
forall a. Maybe a
Nothing (Chart -> Maybe Chart
forall a. a -> Maybe a
Just Chart
x) (Chart -> Bool
p Chart
x)

-- | Lens between ChartTree and the underlying Tree representation
tree' :: Iso' ChartTree (Tree (Maybe Text, [Chart]))
tree' :: Iso' ChartTree (Tree (Maybe Text, [Chart]))
tree' = (ChartTree -> Tree (Maybe Text, [Chart]))
-> (Tree (Maybe Text, [Chart]) -> ChartTree)
-> Iso' ChartTree (Tree (Maybe Text, [Chart]))
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso ChartTree -> Tree (Maybe Text, [Chart])
tree Tree (Maybe Text, [Chart]) -> ChartTree
ChartTree

-- | A traversal of each chart list in a tree.
charts' :: Traversal' ChartTree [Chart]
charts' :: Traversal' ChartTree [Chart]
charts' = Iso' ChartTree (Tree (Maybe Text, [Chart]))
tree' Iso' ChartTree (Tree (Maybe Text, [Chart]))
-> Optic
     A_Traversal
     NoIx
     (Tree (Maybe Text, [Chart]))
     (Tree (Maybe Text, [Chart]))
     (Maybe Text, [Chart])
     (Maybe Text, [Chart])
-> Optic
     A_Traversal
     NoIx
     ChartTree
     ChartTree
     (Maybe Text, [Chart])
     (Maybe Text, [Chart])
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Traversal
  NoIx
  (Tree (Maybe Text, [Chart]))
  (Tree (Maybe Text, [Chart]))
  (Maybe Text, [Chart])
  (Maybe Text, [Chart])
forall (t :: * -> *) a b.
Traversable t =>
Traversal (t a) (t b) a b
traversed Optic
  A_Traversal
  NoIx
  ChartTree
  ChartTree
  (Maybe Text, [Chart])
  (Maybe Text, [Chart])
-> Optic
     A_Lens
     NoIx
     (Maybe Text, [Chart])
     (Maybe Text, [Chart])
     [Chart]
     [Chart]
-> Traversal' ChartTree [Chart]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  NoIx
  (Maybe Text, [Chart])
  (Maybe Text, [Chart])
  [Chart]
  [Chart]
forall s t a b. Field2 s t a b => Lens s t a b
_2

-- | A traversal of each chart in a tree.
chart' :: Traversal' ChartTree Chart
chart' :: Traversal' ChartTree Chart
chart' = Iso' ChartTree (Tree (Maybe Text, [Chart]))
tree' Iso' ChartTree (Tree (Maybe Text, [Chart]))
-> Optic
     A_Traversal
     NoIx
     (Tree (Maybe Text, [Chart]))
     (Tree (Maybe Text, [Chart]))
     (Maybe Text, [Chart])
     (Maybe Text, [Chart])
-> Optic
     A_Traversal
     NoIx
     ChartTree
     ChartTree
     (Maybe Text, [Chart])
     (Maybe Text, [Chart])
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Traversal
  NoIx
  (Tree (Maybe Text, [Chart]))
  (Tree (Maybe Text, [Chart]))
  (Maybe Text, [Chart])
  (Maybe Text, [Chart])
forall (t :: * -> *) a b.
Traversable t =>
Traversal (t a) (t b) a b
traversed Optic
  A_Traversal
  NoIx
  ChartTree
  ChartTree
  (Maybe Text, [Chart])
  (Maybe Text, [Chart])
-> Optic
     A_Lens
     NoIx
     (Maybe Text, [Chart])
     (Maybe Text, [Chart])
     [Chart]
     [Chart]
-> Traversal' ChartTree [Chart]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  NoIx
  (Maybe Text, [Chart])
  (Maybe Text, [Chart])
  [Chart]
  [Chart]
forall s t a b. Field2 s t a b => Lens s t a b
_2 Traversal' ChartTree [Chart]
-> Optic A_Traversal NoIx [Chart] [Chart] Chart Chart
-> Traversal' ChartTree Chart
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Traversal NoIx [Chart] [Chart] Chart Chart
forall (t :: * -> *) a b.
Traversable t =>
Traversal (t a) (t b) a b
traversed

-- | Convert a chart list to a tree, adding a specific text label.
named :: Text -> [Chart] -> ChartTree
named :: Text -> [Chart] -> ChartTree
named Text
l [Chart]
cs = Tree (Maybe Text, [Chart]) -> ChartTree
ChartTree (Tree (Maybe Text, [Chart]) -> ChartTree)
-> Tree (Maybe Text, [Chart]) -> ChartTree
forall a b. (a -> b) -> a -> b
$ (Maybe Text, [Chart])
-> Forest (Maybe Text, [Chart]) -> Tree (Maybe Text, [Chart])
forall a. a -> Forest a -> Tree a
Node (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
l, [Chart]
cs) []

-- | Convert a chart list to a tree, with no text label.
unnamed :: [Chart] -> ChartTree
unnamed :: [Chart] -> ChartTree
unnamed [Chart]
cs = Tree (Maybe Text, [Chart]) -> ChartTree
ChartTree (Tree (Maybe Text, [Chart]) -> ChartTree)
-> Tree (Maybe Text, [Chart]) -> ChartTree
forall a b. (a -> b) -> a -> b
$ (Maybe Text, [Chart])
-> Forest (Maybe Text, [Chart]) -> Tree (Maybe Text, [Chart])
forall a. a -> Forest a -> Tree a
Node (Maybe Text
forall a. Maybe a
Nothing, [Chart]
cs) []

-- | Rename a top-level label in a tree.
rename :: Maybe Text -> ChartTree -> ChartTree
rename :: Maybe Text -> ChartTree -> ChartTree
rename Maybe Text
l (ChartTree (Node (Maybe Text
_, [Chart]
cs) Forest (Maybe Text, [Chart])
xs)) = Tree (Maybe Text, [Chart]) -> ChartTree
ChartTree ((Maybe Text, [Chart])
-> Forest (Maybe Text, [Chart]) -> Tree (Maybe Text, [Chart])
forall a. a -> Forest a -> Tree a
Node (Maybe Text
l, [Chart]
cs) Forest (Maybe Text, [Chart])
xs)

-- | A tree with no charts and no label.
blank :: Rect Double -> ChartTree
blank :: Rect Double -> ChartTree
blank Rect Double
r = [Chart] -> ChartTree
unnamed [[Rect Double] -> Chart
BlankChart [Rect Double
r]]

-- | Group a list of trees into a new tree.
group :: Maybe Text -> [ChartTree] -> ChartTree
group :: Maybe Text -> [ChartTree] -> ChartTree
group Maybe Text
name [ChartTree]
cs = Tree (Maybe Text, [Chart]) -> ChartTree
ChartTree (Tree (Maybe Text, [Chart]) -> ChartTree)
-> Tree (Maybe Text, [Chart]) -> ChartTree
forall a b. (a -> b) -> a -> b
$ (Maybe Text, [Chart])
-> Forest (Maybe Text, [Chart]) -> Tree (Maybe Text, [Chart])
forall a. a -> Forest a -> Tree a
Node (Maybe Text
name, []) (ChartTree -> Tree (Maybe Text, [Chart])
tree (ChartTree -> Tree (Maybe Text, [Chart]))
-> [ChartTree] -> Forest (Maybe Text, [Chart])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ChartTree]
cs)

instance Semigroup ChartTree where
  <> :: ChartTree -> ChartTree -> ChartTree
(<>) (ChartTree x :: Tree (Maybe Text, [Chart])
x@(Node (Maybe Text
n, [Chart]
cs) Forest (Maybe Text, [Chart])
xs)) (ChartTree x' :: Tree (Maybe Text, [Chart])
x'@(Node (Maybe Text
n', [Chart]
cs') Forest (Maybe Text, [Chart])
xs')) =
    case (Maybe Text
n, Maybe Text
n') of
      (Maybe Text
Nothing, Maybe Text
Nothing) -> Tree (Maybe Text, [Chart]) -> ChartTree
ChartTree (Tree (Maybe Text, [Chart]) -> ChartTree)
-> Tree (Maybe Text, [Chart]) -> ChartTree
forall a b. (a -> b) -> a -> b
$ (Maybe Text, [Chart])
-> Forest (Maybe Text, [Chart]) -> Tree (Maybe Text, [Chart])
forall a. a -> Forest a -> Tree a
Node (Maybe Text
forall a. Maybe a
Nothing, [Chart]
cs [Chart] -> [Chart] -> [Chart]
forall a. Semigroup a => a -> a -> a
<> [Chart]
cs') (Forest (Maybe Text, [Chart])
xs Forest (Maybe Text, [Chart])
-> Forest (Maybe Text, [Chart]) -> Forest (Maybe Text, [Chart])
forall a. Semigroup a => a -> a -> a
<> Forest (Maybe Text, [Chart])
xs')
      (Maybe Text, Maybe Text)
_ -> Tree (Maybe Text, [Chart]) -> ChartTree
ChartTree (Tree (Maybe Text, [Chart]) -> ChartTree)
-> Tree (Maybe Text, [Chart]) -> ChartTree
forall a b. (a -> b) -> a -> b
$ (Maybe Text, [Chart])
-> Forest (Maybe Text, [Chart]) -> Tree (Maybe Text, [Chart])
forall a. a -> Forest a -> Tree a
Node (Maybe Text
forall a. Maybe a
Nothing, []) [Tree (Maybe Text, [Chart])
x, Tree (Maybe Text, [Chart])
x']

instance Monoid ChartTree where
  mempty :: ChartTree
mempty = Tree (Maybe Text, [Chart]) -> ChartTree
ChartTree (Tree (Maybe Text, [Chart]) -> ChartTree)
-> Tree (Maybe Text, [Chart]) -> ChartTree
forall a b. (a -> b) -> a -> b
$ (Maybe Text, [Chart])
-> Forest (Maybe Text, [Chart]) -> Tree (Maybe Text, [Chart])
forall a. a -> Forest a -> Tree a
Node (Maybe Text
forall a. Maybe a
Nothing, []) []

-- $boxes
--
-- Library functionality (rescaling, combining charts, working out axes and generally putting charts together) is driven by a box model. A box is a rectangular space that bounds chart elements.

-- | The 'Rect' which encloses the data elements of the chart. /Bounding box/ is a synonym.
--
-- >>> box r
-- Just Rect -0.5 0.5 -0.5 0.5
box :: Chart -> Maybe (Rect Double)
box :: Chart -> Maybe (Rect Double)
box (RectChart RectStyle
_ [Rect Double]
a) = [Rect Double] -> Maybe (Rect Double)
forall a. Ord a => [Rect a] -> Maybe (Rect a)
foldRect [Rect Double]
a
box (TextChart TextStyle
_ [(Text, Point Double)]
a) = [Element (Rect Double)] -> Maybe (Rect Double)
forall s (f :: * -> *).
(Space s, Traversable f) =>
f (Element s) -> Maybe s
space1 ([Element (Rect Double)] -> Maybe (Rect Double))
-> [Element (Rect Double)] -> Maybe (Rect Double)
forall a b. (a -> b) -> a -> b
$ (Text, Point Double) -> Point Double
forall a b. (a, b) -> b
snd ((Text, Point Double) -> Point Double)
-> [(Text, Point Double)] -> [Point Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, Point Double)]
a
box (LineChart LineStyle
_ [[Point Double]]
a) = [Element (Rect Double)] -> Maybe (Rect Double)
forall s (f :: * -> *).
(Space s, Traversable f) =>
f (Element s) -> Maybe s
space1 ([Element (Rect Double)] -> Maybe (Rect Double))
-> [Element (Rect Double)] -> Maybe (Rect Double)
forall a b. (a -> b) -> a -> b
$ [[Point Double]] -> [Point Double]
forall a. Monoid a => [a] -> a
mconcat [[Point Double]]
a
box (GlyphChart GlyphStyle
_ [Point Double]
a) = [Element (Rect Double)] -> Maybe (Rect Double)
forall s (f :: * -> *).
(Space s, Traversable f) =>
f (Element s) -> Maybe s
space1 [Point Double]
[Element (Rect Double)]
a
box (PathChart PathStyle
_ [PathData Double]
a) = [PathData Double] -> Maybe (Rect Double)
pathBoxes [PathData Double]
a
box (BlankChart [Rect Double]
a) = [Rect Double] -> Maybe (Rect Double)
forall a. Ord a => [Rect a] -> Maybe (Rect a)
foldRect [Rect Double]
a

-- | The bounding box for a chart including both data and style elements.
--
-- >>> sbox r
-- Just Rect -0.505 0.505 -0.505 0.505
--
-- In the above example, the border of the rectangle adds an extra 0.1 to the height and width of the bounding box enclosing the chart.
sbox :: Chart -> Maybe (Rect Double)
sbox :: Chart -> Maybe (Rect Double)
sbox (RectChart RectStyle
s [Rect Double]
a) = [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
$ Double -> Rect Double -> Rect Double
forall a. Subtractive a => a -> Rect a -> Rect a
padRect (Double
0.5 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Optic' A_Lens NoIx RectStyle Double -> RectStyle -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view IsLabel "borderSize" (Optic' A_Lens NoIx RectStyle Double)
Optic' A_Lens NoIx RectStyle Double
#borderSize RectStyle
s) (Rect Double -> Rect Double) -> [Rect Double] -> [Rect Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Rect Double]
a
sbox (TextChart TextStyle
s [(Text, Point Double)]
a) = [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 -> Point Double -> Rect Double)
-> (Text, Point Double) -> Rect Double
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (TextStyle -> Text -> Point Double -> Rect Double
styleBoxText TextStyle
s) ((Text, Point Double) -> Rect Double)
-> [(Text, Point Double)] -> [Rect Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, Point Double)]
a
sbox (LineChart LineStyle
s [[Point Double]]
a) = Double -> Rect Double -> Rect Double
forall a. Subtractive a => a -> Rect a -> Rect a
padRect (Double
0.5 Double -> Double -> Double
forall a. Num a => a -> a -> a
* LineStyle
s LineStyle -> Optic' A_Lens NoIx LineStyle Double -> Double
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "size" (Optic' A_Lens NoIx LineStyle Double)
Optic' A_Lens NoIx LineStyle Double
#size) (Rect Double -> Rect Double)
-> Maybe (Rect Double) -> Maybe (Rect Double)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Element (Rect Double)] -> Maybe (Rect Double)
forall s (f :: * -> *).
(Space s, Traversable f) =>
f (Element s) -> Maybe s
space1 ([Element (Rect Double)] -> Maybe (Rect Double))
-> [Element (Rect Double)] -> Maybe (Rect Double)
forall a b. (a -> b) -> a -> b
$ [[Point Double]] -> [Point Double]
forall a. Monoid a => [a] -> a
mconcat [[Point Double]]
a)
sbox (GlyphChart GlyphStyle
s [Point Double]
a) = [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
$ (\Point Double
p -> Point Double -> Rect Double -> Rect Double
forall a. Additive a => Point a -> Rect a -> Rect a
addPoint Point Double
p (GlyphStyle -> Rect Double
styleBoxGlyph GlyphStyle
s)) (Point Double -> Rect Double) -> [Point Double] -> [Rect Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Point Double]
a
sbox (PathChart PathStyle
s [PathData Double]
a) = Double -> Rect Double -> Rect Double
forall a. Subtractive a => a -> Rect a -> Rect a
padRect (Double
0.5 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Optic' A_Lens NoIx PathStyle Double -> PathStyle -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view IsLabel "borderSize" (Optic' A_Lens NoIx PathStyle Double)
Optic' A_Lens NoIx PathStyle Double
#borderSize PathStyle
s) (Rect Double -> Rect Double)
-> Maybe (Rect Double) -> Maybe (Rect Double)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PathData Double] -> Maybe (Rect Double)
pathBoxes [PathData Double]
a
sbox (BlankChart [Rect Double]
a) = [Rect Double] -> Maybe (Rect Double)
forall a. Ord a => [Rect a] -> Maybe (Rect a)
foldRect [Rect Double]
a

-- | projects a Chart to a new space from an old rectangular space, preserving linear metric structure.
--
-- >>> projectWith (fmap (2*) one) one r
-- RectChart (RectStyle {borderSize = 1.0e-2, borderColor = Colour 0.02 0.29 0.48 1.00, color = Colour 0.02 0.73 0.80 0.10}) [Rect -1.0 1.0 -1.0 1.0]
projectWith :: Rect Double -> Rect Double -> Chart -> Chart
projectWith :: Rect Double -> Rect Double -> Chart -> Chart
projectWith Rect Double
new Rect Double
old (RectChart RectStyle
s [Rect Double]
a) = RectStyle -> [Rect Double] -> Chart
RectChart RectStyle
s (Rect Double -> Rect Double -> Rect Double -> Rect Double
projectOnR Rect Double
new Rect Double
old (Rect Double -> Rect Double) -> [Rect Double] -> [Rect Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Rect Double]
a)
projectWith Rect Double
new Rect Double
old (TextChart TextStyle
s [(Text, Point Double)]
a) = TextStyle -> [(Text, Point Double)] -> Chart
TextChart (TextStyle -> TextStyle
projectX TextStyle
s) ((Point Double -> Point Double)
-> (Text, Point Double) -> (Text, Point Double)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (Rect Double -> Rect Double -> Point Double -> Point Double
projectOnP Rect Double
new Rect Double
old) ((Text, Point Double) -> (Text, Point Double))
-> [(Text, Point Double)] -> [(Text, Point Double)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, Point Double)]
a)
  where
    projectX :: TextStyle -> TextStyle
    projectX :: TextStyle -> TextStyle
projectX TextStyle
s' = case Optic' A_Lens NoIx TextStyle ScaleX -> TextStyle -> ScaleX
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view IsLabel "scalex" (Optic' A_Lens NoIx TextStyle ScaleX)
Optic' A_Lens NoIx TextStyle ScaleX
#scalex TextStyle
s' of
      ScaleX
NoScaleX -> TextStyle
s' TextStyle -> (TextStyle -> TextStyle) -> TextStyle
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx TextStyle TextStyle Double Double
-> (Double -> Double) -> TextStyle -> TextStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over IsLabel
  "hsize" (Optic A_Lens NoIx TextStyle TextStyle Double Double)
Optic A_Lens NoIx TextStyle TextStyle Double Double
#hsize (Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Range Double -> Element (Range Double)
forall s. (Space s, Subtractive (Element s)) => s -> Element s
width Range Double
ox Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Range Double -> Element (Range Double)
forall s. (Space s, Subtractive (Element s)) => s -> Element s
width Range Double
nx)) TextStyle -> (TextStyle -> TextStyle) -> TextStyle
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx TextStyle TextStyle Double Double
-> (Double -> Double) -> TextStyle -> TextStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over IsLabel
  "vsize" (Optic A_Lens NoIx TextStyle TextStyle Double Double)
Optic A_Lens NoIx TextStyle TextStyle Double Double
#vsize (Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Range Double -> Element (Range Double)
forall s. (Space s, Subtractive (Element s)) => s -> Element s
width Range Double
ox Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Range Double -> Element (Range Double)
forall s. (Space s, Subtractive (Element s)) => s -> Element s
width Range Double
nx))
      ScaleX
ScaleX -> TextStyle
s' TextStyle -> (TextStyle -> TextStyle) -> TextStyle
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx TextStyle TextStyle Double Double
-> (Double -> Double) -> TextStyle -> TextStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over IsLabel
  "size" (Optic A_Lens NoIx TextStyle TextStyle Double Double)
Optic A_Lens NoIx TextStyle TextStyle Double Double
#size (Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Range Double -> Element (Range Double)
forall s. (Space s, Subtractive (Element s)) => s -> Element s
width Range Double
nx Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Range Double -> Element (Range Double)
forall s. (Space s, Subtractive (Element s)) => s -> Element s
width Range Double
ox))
    (Ranges Range Double
nx Range Double
_) = Rect Double
new
    (Ranges Range Double
ox Range Double
_) = Rect Double
old
projectWith Rect Double
new Rect Double
old (LineChart LineStyle
s [[Point Double]]
a) = LineStyle -> [[Point Double]] -> Chart
LineChart LineStyle
s ((Point Double -> Point Double) -> [Point Double] -> [Point Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Rect Double -> Rect Double -> Point Double -> Point Double
projectOnP Rect Double
new Rect Double
old) ([Point Double] -> [Point Double])
-> [[Point Double]] -> [[Point Double]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Point Double]]
a)
projectWith Rect Double
new Rect Double
old (GlyphChart GlyphStyle
s [Point Double]
a) = GlyphStyle -> [Point Double] -> Chart
GlyphChart GlyphStyle
s (Rect Double -> Rect Double -> Point Double -> Point Double
projectOnP Rect Double
new Rect Double
old (Point Double -> Point Double) -> [Point Double] -> [Point Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Point Double]
a)
projectWith Rect Double
new Rect Double
old (BlankChart [Rect Double]
a) = [Rect Double] -> Chart
BlankChart (Rect Double -> Rect Double -> Rect Double -> Rect Double
projectOnR Rect Double
new Rect Double
old (Rect Double -> Rect Double) -> [Rect Double] -> [Rect Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Rect Double]
a)
projectWith Rect Double
new Rect Double
old (PathChart PathStyle
s [PathData Double]
a) = PathStyle -> [PathData Double] -> Chart
PathChart PathStyle
s (Rect Double
-> Rect Double -> [PathData Double] -> [PathData Double]
projectPaths Rect Double
new Rect Double
old [PathData Double]
a)

-- | Maybe project a Chart to a new rectangular space from an old rectangular space, if both Rects exist.
maybeProjectWith :: Maybe (Rect Double) -> Maybe (Rect Double) -> Chart -> Chart
maybeProjectWith :: Maybe (Rect Double) -> Maybe (Rect Double) -> Chart -> Chart
maybeProjectWith Maybe (Rect Double)
new Maybe (Rect Double)
old = (Chart -> Chart) -> Maybe (Chart -> Chart) -> Chart -> Chart
forall a. a -> Maybe a -> a
fromMaybe Chart -> Chart
forall a. a -> a
id (Rect Double -> Rect Double -> Chart -> Chart
projectWith (Rect Double -> Rect Double -> Chart -> Chart)
-> Maybe (Rect Double) -> Maybe (Rect Double -> Chart -> Chart)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Rect Double)
new Maybe (Rect Double -> Chart -> Chart)
-> Maybe (Rect Double) -> Maybe (Chart -> Chart)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe (Rect Double)
old)

-- | Move a chart.
moveChart :: Point Double -> Chart -> Chart
moveChart :: Point Double -> Chart -> Chart
moveChart Point Double
p (RectChart RectStyle
s [Rect Double]
a) = RectStyle -> [Rect Double] -> Chart
RectChart RectStyle
s (Point Double -> Rect Double -> Rect Double
forall a. Additive a => Point a -> Rect a -> Rect a
addPoint Point Double
p (Rect Double -> Rect Double) -> [Rect Double] -> [Rect Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Rect Double]
a)
moveChart Point Double
p (TextChart TextStyle
s [(Text, Point Double)]
a) = TextStyle -> [(Text, Point Double)] -> Chart
TextChart TextStyle
s ((Point Double -> Point Double)
-> (Text, Point Double) -> (Text, Point Double)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (Point Double -> Point Double -> Point Double
addp Point Double
p) ((Text, Point Double) -> (Text, Point Double))
-> [(Text, Point Double)] -> [(Text, Point Double)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, Point Double)]
a)
moveChart Point Double
p (LineChart LineStyle
s [[Point Double]]
a) = LineStyle -> [[Point Double]] -> Chart
LineChart LineStyle
s ((Point Double -> Point Double) -> [Point Double] -> [Point Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Point Double -> Point Double -> Point Double
addp Point Double
p) ([Point Double] -> [Point Double])
-> [[Point Double]] -> [[Point Double]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Point Double]]
a)
moveChart Point Double
p (GlyphChart GlyphStyle
s [Point Double]
a) = GlyphStyle -> [Point Double] -> Chart
GlyphChart GlyphStyle
s (Point Double -> Point Double -> Point Double
addp Point Double
p (Point Double -> Point Double) -> [Point Double] -> [Point Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Point Double]
a)
moveChart Point Double
p (PathChart PathStyle
s [PathData Double]
a) = PathStyle -> [PathData Double] -> Chart
PathChart PathStyle
s (Point Double -> PathData Double -> PathData Double
forall a. Additive a => Point a -> PathData a -> PathData a
movePath Point Double
p (PathData Double -> PathData Double)
-> [PathData Double] -> [PathData Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PathData Double]
a)
moveChart Point Double
p (BlankChart [Rect Double]
a) = [Rect Double] -> Chart
BlankChart (Point Double -> Rect Double -> Rect Double
forall a. Additive a => Point a -> Rect a -> Rect a
addPoint Point Double
p (Rect Double -> Rect Double) -> [Rect Double] -> [Rect Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Rect Double]
a)

-- | Scale a chart (effecting both the chart data and the style).
scaleChart :: Double -> Chart -> Chart
scaleChart :: Double -> Chart -> Chart
scaleChart Double
p (RectChart RectStyle
s [Rect Double]
a) =
  RectStyle -> [Rect Double] -> Chart
RectChart (RectStyle
s RectStyle -> (RectStyle -> RectStyle) -> RectStyle
forall a b. a -> (a -> b) -> b
& IsLabel "borderSize" (Optic' A_Lens NoIx RectStyle Double)
Optic' A_Lens NoIx RectStyle Double
#borderSize Optic' A_Lens NoIx RectStyle Double
-> (Double -> Double) -> RectStyle -> RectStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ (Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
p)) ((Rect Double -> Rect Double) -> [Rect Double] -> [Rect Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Double -> Double) -> Rect Double -> Rect Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
p)) [Rect Double]
a)
scaleChart Double
p (LineChart LineStyle
s [[Point Double]]
a) =
  LineStyle -> [[Point Double]] -> Chart
LineChart (LineStyle
s LineStyle -> (LineStyle -> LineStyle) -> LineStyle
forall a b. a -> (a -> b) -> b
& IsLabel "size" (Optic' A_Lens NoIx LineStyle Double)
Optic' A_Lens NoIx LineStyle Double
#size Optic' A_Lens NoIx LineStyle Double
-> (Double -> Double) -> LineStyle -> LineStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ (Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
p)) (([Point Double] -> [Point Double])
-> [[Point Double]] -> [[Point Double]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Point Double -> Point Double) -> [Point Double] -> [Point Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Double -> Double) -> Point Double -> Point Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
p))) [[Point Double]]
a)
scaleChart Double
p (TextChart TextStyle
s [(Text, Point Double)]
a) =
  TextStyle -> [(Text, Point Double)] -> Chart
TextChart (TextStyle
s TextStyle -> (TextStyle -> TextStyle) -> TextStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "size" (Optic A_Lens NoIx TextStyle TextStyle Double Double)
Optic A_Lens NoIx TextStyle TextStyle Double Double
#size Optic A_Lens NoIx TextStyle TextStyle Double Double
-> (Double -> Double) -> TextStyle -> TextStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ (Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
p)) (((Text, Point Double) -> (Text, Point Double))
-> [(Text, Point Double)] -> [(Text, Point Double)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Point Double -> Point Double)
-> (Text, Point Double) -> (Text, Point Double)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ((Double -> Double) -> Point Double -> Point Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
p))) [(Text, Point Double)]
a)
scaleChart Double
p (GlyphChart GlyphStyle
s [Point Double]
a) =
  GlyphStyle -> [Point Double] -> Chart
GlyphChart (GlyphStyle
s GlyphStyle -> (GlyphStyle -> GlyphStyle) -> GlyphStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "size" (Optic A_Lens NoIx GlyphStyle GlyphStyle Double Double)
Optic A_Lens NoIx GlyphStyle GlyphStyle Double Double
#size Optic A_Lens NoIx GlyphStyle GlyphStyle Double Double
-> (Double -> Double) -> GlyphStyle -> GlyphStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ (Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
p)) ((Point Double -> Point Double) -> [Point Double] -> [Point Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Double -> Double) -> Point Double -> Point Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
p)) [Point Double]
a)
scaleChart Double
p (PathChart PathStyle
s [PathData Double]
a) =
  PathStyle -> [PathData Double] -> Chart
PathChart (PathStyle
s PathStyle -> (PathStyle -> PathStyle) -> PathStyle
forall a b. a -> (a -> b) -> b
& IsLabel "borderSize" (Optic' A_Lens NoIx PathStyle Double)
Optic' A_Lens NoIx PathStyle Double
#borderSize Optic' A_Lens NoIx PathStyle Double
-> (Double -> Double) -> PathStyle -> PathStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ (Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
p)) (Double -> PathData Double -> PathData Double
forall a. Multiplicative a => a -> PathData a -> PathData a
scalePath Double
p (PathData Double -> PathData Double)
-> [PathData Double] -> [PathData Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PathData Double]
a)
scaleChart Double
p (BlankChart [Rect Double]
a) =
  [Rect Double] -> Chart
BlankChart ((Rect Double -> Rect Double) -> [Rect Double] -> [Rect Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Double -> Double) -> Rect Double -> Rect Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
p)) [Rect Double]
a)

-- | Scale just the chart style.
scaleStyle :: Double -> Chart -> Chart
scaleStyle :: Double -> Chart -> Chart
scaleStyle Double
x (LineChart LineStyle
a [[Point Double]]
d) = LineStyle -> [[Point Double]] -> Chart
LineChart (LineStyle
a LineStyle -> (LineStyle -> LineStyle) -> LineStyle
forall a b. a -> (a -> b) -> b
& IsLabel "size" (Optic' A_Lens NoIx LineStyle Double)
Optic' A_Lens NoIx LineStyle Double
#size Optic' A_Lens NoIx LineStyle Double
-> (Double -> Double) -> LineStyle -> LineStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ (Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
x)) [[Point Double]]
d
scaleStyle Double
x (RectChart RectStyle
a [Rect Double]
d) = RectStyle -> [Rect Double] -> Chart
RectChart (RectStyle
a RectStyle -> (RectStyle -> RectStyle) -> RectStyle
forall a b. a -> (a -> b) -> b
& IsLabel "borderSize" (Optic' A_Lens NoIx RectStyle Double)
Optic' A_Lens NoIx RectStyle Double
#borderSize Optic' A_Lens NoIx RectStyle Double
-> (Double -> Double) -> RectStyle -> RectStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ (Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
x)) [Rect Double]
d
scaleStyle Double
x (TextChart TextStyle
a [(Text, Point Double)]
d) = TextStyle -> [(Text, Point Double)] -> Chart
TextChart (TextStyle
a TextStyle -> (TextStyle -> TextStyle) -> TextStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "size" (Optic A_Lens NoIx TextStyle TextStyle Double Double)
Optic A_Lens NoIx TextStyle TextStyle Double Double
#size Optic A_Lens NoIx TextStyle TextStyle Double Double
-> (Double -> Double) -> TextStyle -> TextStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ (Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
x)) [(Text, Point Double)]
d
scaleStyle Double
x (GlyphChart GlyphStyle
a [Point Double]
d) = GlyphStyle -> [Point Double] -> Chart
GlyphChart (GlyphStyle
a GlyphStyle -> (GlyphStyle -> GlyphStyle) -> GlyphStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "size" (Optic A_Lens NoIx GlyphStyle GlyphStyle Double Double)
Optic A_Lens NoIx GlyphStyle GlyphStyle Double Double
#size Optic A_Lens NoIx GlyphStyle GlyphStyle Double Double
-> (Double -> Double) -> GlyphStyle -> GlyphStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ (Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
x)) [Point Double]
d
scaleStyle Double
x (PathChart PathStyle
a [PathData Double]
d) = PathStyle -> [PathData Double] -> Chart
PathChart (PathStyle
a PathStyle -> (PathStyle -> PathStyle) -> PathStyle
forall a b. a -> (a -> b) -> b
& IsLabel "borderSize" (Optic' A_Lens NoIx PathStyle Double)
Optic' A_Lens NoIx PathStyle Double
#borderSize Optic' A_Lens NoIx PathStyle Double
-> (Double -> Double) -> PathStyle -> PathStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ (Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
x)) [PathData Double]
d
scaleStyle Double
_ (BlankChart [Rect Double]
d) = [Rect Double] -> Chart
BlankChart [Rect Double]
d

-- | Modify chart colors, applying to both border and main colors.
colourChart :: (Colour -> Colour) -> Chart -> Chart
colourChart :: (Colour -> Colour) -> Chart -> Chart
colourChart Colour -> Colour
f (RectChart RectStyle
s [Rect Double]
d) = RectStyle -> [Rect Double] -> Chart
RectChart RectStyle
s' [Rect Double]
d
  where
    s' :: RectStyle
s' = RectStyle
s RectStyle -> (RectStyle -> RectStyle) -> RectStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "color" (Optic A_Lens NoIx RectStyle RectStyle Colour Colour)
Optic A_Lens NoIx RectStyle RectStyle Colour Colour
#color Optic A_Lens NoIx RectStyle RectStyle Colour Colour
-> (Colour -> Colour) -> RectStyle -> RectStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ Colour -> Colour
f RectStyle -> (RectStyle -> RectStyle) -> RectStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "borderColor" (Optic A_Lens NoIx RectStyle RectStyle Colour Colour)
Optic A_Lens NoIx RectStyle RectStyle Colour Colour
#borderColor Optic A_Lens NoIx RectStyle RectStyle Colour Colour
-> (Colour -> Colour) -> RectStyle -> RectStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ Colour -> Colour
f
colourChart Colour -> Colour
f (TextChart TextStyle
s [(Text, Point Double)]
d) = TextStyle -> [(Text, Point Double)] -> Chart
TextChart TextStyle
s' [(Text, Point Double)]
d
  where
    s' :: TextStyle
s' = TextStyle
s TextStyle -> (TextStyle -> TextStyle) -> TextStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "color" (Optic A_Lens NoIx TextStyle TextStyle Colour Colour)
Optic A_Lens NoIx TextStyle TextStyle Colour Colour
#color Optic A_Lens NoIx TextStyle TextStyle Colour Colour
-> (Colour -> Colour) -> TextStyle -> TextStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ Colour -> Colour
f
colourChart Colour -> Colour
f (LineChart LineStyle
s [[Point Double]]
d) = LineStyle -> [[Point Double]] -> Chart
LineChart LineStyle
s' [[Point Double]]
d
  where
    s' :: LineStyle
s' = LineStyle
s LineStyle -> (LineStyle -> LineStyle) -> LineStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "color" (Optic A_Lens NoIx LineStyle LineStyle Colour Colour)
Optic A_Lens NoIx LineStyle LineStyle Colour Colour
#color Optic A_Lens NoIx LineStyle LineStyle Colour Colour
-> (Colour -> Colour) -> LineStyle -> LineStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ Colour -> Colour
f
colourChart Colour -> Colour
f (GlyphChart GlyphStyle
s [Point Double]
d) = GlyphStyle -> [Point Double] -> Chart
GlyphChart GlyphStyle
s' [Point Double]
d
  where
    s' :: GlyphStyle
s' = GlyphStyle
s GlyphStyle -> (GlyphStyle -> GlyphStyle) -> GlyphStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "color" (Optic A_Lens NoIx GlyphStyle GlyphStyle Colour Colour)
Optic A_Lens NoIx GlyphStyle GlyphStyle Colour Colour
#color Optic A_Lens NoIx GlyphStyle GlyphStyle Colour Colour
-> (Colour -> Colour) -> GlyphStyle -> GlyphStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ Colour -> Colour
f GlyphStyle -> (GlyphStyle -> GlyphStyle) -> GlyphStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "borderColor"
  (Optic A_Lens NoIx GlyphStyle GlyphStyle Colour Colour)
Optic A_Lens NoIx GlyphStyle GlyphStyle Colour Colour
#borderColor Optic A_Lens NoIx GlyphStyle GlyphStyle Colour Colour
-> (Colour -> Colour) -> GlyphStyle -> GlyphStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ Colour -> Colour
f
colourChart Colour -> Colour
f (PathChart PathStyle
s [PathData Double]
d) = PathStyle -> [PathData Double] -> Chart
PathChart PathStyle
s' [PathData Double]
d
  where
    s' :: PathStyle
s' = PathStyle
s PathStyle -> (PathStyle -> PathStyle) -> PathStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "color" (Optic A_Lens NoIx PathStyle PathStyle Colour Colour)
Optic A_Lens NoIx PathStyle PathStyle Colour Colour
#color Optic A_Lens NoIx PathStyle PathStyle Colour Colour
-> (Colour -> Colour) -> PathStyle -> PathStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ Colour -> Colour
f PathStyle -> (PathStyle -> PathStyle) -> PathStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "borderColor" (Optic A_Lens NoIx PathStyle PathStyle Colour Colour)
Optic A_Lens NoIx PathStyle PathStyle Colour Colour
#borderColor Optic A_Lens NoIx PathStyle PathStyle Colour Colour
-> (Colour -> Colour) -> PathStyle -> PathStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ Colour -> Colour
f
colourChart Colour -> Colour
_ (BlankChart [Rect Double]
d) = [Rect Double] -> Chart
BlankChart [Rect Double]
d

-- | Project a chart tree to a new bounding box, guarding against singleton bounds.
projectChartTree :: Rect Double -> [Chart] -> [Chart]
projectChartTree :: Rect Double -> [Chart] -> [Chart]
projectChartTree Rect Double
new [Chart]
cs = case [Chart] -> Maybe (Rect Double)
styleBoxes [Chart]
cs of
  Maybe (Rect Double)
Nothing -> [Chart]
cs
  Just Rect Double
b -> Rect Double -> Rect Double -> Chart -> Chart
projectWith Rect Double
new Rect Double
b (Chart -> Chart) -> [Chart] -> [Chart]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Chart]
cs

-- | Compute the bounding box of a list of charts.
boxes :: [Chart] -> Maybe (Rect Double)
boxes :: [Chart] -> Maybe (Rect Double)
boxes [Chart]
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
$ [[Rect Double]] -> [Rect Double]
forall a. Monoid a => [a] -> a
mconcat ([[Rect Double]] -> [Rect Double])
-> [[Rect Double]] -> [Rect Double]
forall a b. (a -> b) -> a -> b
$ Maybe (Rect Double) -> [Rect Double]
forall a. Maybe a -> [a]
maybeToList (Maybe (Rect Double) -> [Rect Double])
-> (Chart -> Maybe (Rect Double)) -> Chart -> [Rect Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Chart -> Maybe (Rect Double)
box (Chart -> [Rect Double]) -> [Chart] -> [[Rect Double]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Chart]
cs

box_ :: ChartTree -> Maybe (Rect Double)
box_ :: ChartTree -> Maybe (Rect Double)
box_ = [Chart] -> Maybe (Rect Double)
boxes ([Chart] -> Maybe (Rect Double))
-> (ChartTree -> [Chart]) -> ChartTree -> Maybe (Rect Double)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Traversal' ChartTree [Chart] -> ChartTree -> [Chart]
forall k a (is :: IxList) s.
(Is k A_Fold, Monoid a) =>
Optic' k is s a -> s -> a
foldOf Traversal' ChartTree [Chart]
charts'

rebox_ :: ChartTree -> Maybe (Rect Double) -> ChartTree
rebox_ :: ChartTree -> Maybe (Rect Double) -> ChartTree
rebox_ ChartTree
cs Maybe (Rect Double)
r =
  ChartTree
cs
    ChartTree -> (ChartTree -> ChartTree) -> ChartTree
forall a b. a -> (a -> b) -> b
& Traversal' ChartTree Chart
-> (Chart -> Chart) -> ChartTree -> ChartTree
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over Traversal' ChartTree Chart
chart' ((Chart -> Chart) -> Maybe (Chart -> Chart) -> Chart -> Chart
forall a. a -> Maybe a -> a
fromMaybe Chart -> Chart
forall a. a -> a
id (Maybe (Chart -> Chart) -> Chart -> Chart)
-> Maybe (Chart -> Chart) -> Chart -> Chart
forall a b. (a -> b) -> a -> b
$ Rect Double -> Rect Double -> Chart -> Chart
projectWith (Rect Double -> Rect Double -> Chart -> Chart)
-> Maybe (Rect Double) -> Maybe (Rect Double -> Chart -> Chart)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Rect Double)
r Maybe (Rect Double -> Chart -> Chart)
-> Maybe (Rect Double) -> Maybe (Chart -> Chart)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ChartTree -> Maybe (Rect Double)
box_ ChartTree
cs)

-- | Lens between a ChartTree and its bounding box.
box' :: Lens' ChartTree (Maybe (Rect Double))
box' :: Lens' ChartTree (Maybe (Rect Double))
box' =
  (ChartTree -> Maybe (Rect Double))
-> (ChartTree -> Maybe (Rect Double) -> ChartTree)
-> Lens' ChartTree (Maybe (Rect Double))
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens ChartTree -> Maybe (Rect Double)
box_ ChartTree -> Maybe (Rect Double) -> ChartTree
rebox_

-- | Compute the bounding box of the data and style elements contained in a list of charts.
styleBoxes :: [Chart] -> Maybe (Rect Double)
styleBoxes :: [Chart] -> Maybe (Rect Double)
styleBoxes [Chart]
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
$ [[Rect Double]] -> [Rect Double]
forall a. Monoid a => [a] -> a
mconcat ([[Rect Double]] -> [Rect Double])
-> [[Rect Double]] -> [Rect Double]
forall a b. (a -> b) -> a -> b
$ Maybe (Rect Double) -> [Rect Double]
forall a. Maybe a -> [a]
maybeToList (Maybe (Rect Double) -> [Rect Double])
-> (Chart -> Maybe (Rect Double)) -> Chart -> [Rect Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Chart -> Maybe (Rect Double)
sbox (Chart -> [Rect Double]) -> [Chart] -> [[Rect Double]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Chart]
cs

styleBox_ :: ChartTree -> Maybe (Rect Double)
styleBox_ :: ChartTree -> Maybe (Rect Double)
styleBox_ = [Chart] -> Maybe (Rect Double)
styleBoxes ([Chart] -> Maybe (Rect Double))
-> (ChartTree -> [Chart]) -> ChartTree -> Maybe (Rect Double)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Traversal' ChartTree [Chart] -> ChartTree -> [Chart]
forall k a (is :: IxList) s.
(Is k A_Fold, Monoid a) =>
Optic' k is s a -> s -> a
foldOf Traversal' ChartTree [Chart]
charts'

styleRebox_ :: ChartTree -> Maybe (Rect Double) -> ChartTree
styleRebox_ :: ChartTree -> Maybe (Rect Double) -> ChartTree
styleRebox_ ChartTree
cs Maybe (Rect Double)
r =
  ChartTree
cs
    ChartTree -> (ChartTree -> ChartTree) -> ChartTree
forall a b. a -> (a -> b) -> b
& Traversal' ChartTree Chart
-> (Chart -> Chart) -> ChartTree -> ChartTree
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over Traversal' ChartTree Chart
chart' ((Chart -> Chart) -> Maybe (Chart -> Chart) -> Chart -> Chart
forall a. a -> Maybe a -> a
fromMaybe Chart -> Chart
forall a. a -> a
id (Maybe (Chart -> Chart) -> Chart -> Chart)
-> Maybe (Chart -> Chart) -> Chart -> Chart
forall a b. (a -> b) -> a -> b
$ Rect Double -> Rect Double -> Chart -> Chart
projectWith (Rect Double -> Rect Double -> Chart -> Chart)
-> Maybe (Rect Double) -> Maybe (Rect Double -> Chart -> Chart)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Rect Double)
r' Maybe (Rect Double -> Chart -> Chart)
-> Maybe (Rect Double) -> Maybe (Chart -> Chart)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ChartTree -> Maybe (Rect Double)
box_ ChartTree
cs)
  where
    r' :: Maybe (Rect Double)
r' = Rect Double -> Rect Double -> Rect Double
forall a. Subtractive a => a -> a -> a
(NH.-) (Rect Double -> Rect Double -> Rect Double)
-> Maybe (Rect Double) -> Maybe (Rect Double -> Rect Double)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Rect Double)
r Maybe (Rect Double -> Rect Double)
-> Maybe (Rect Double) -> Maybe (Rect Double)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Rect Double -> Rect Double -> Rect Double
forall a. Subtractive a => a -> a -> a
(NH.-) (Rect Double -> Rect Double -> Rect Double)
-> Maybe (Rect Double) -> Maybe (Rect Double -> Rect Double)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ChartTree -> Maybe (Rect Double)
styleBox_ ChartTree
cs Maybe (Rect Double -> Rect Double)
-> Maybe (Rect Double) -> Maybe (Rect Double)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ChartTree -> Maybe (Rect Double)
box_ ChartTree
cs)

-- | Lens between a style bounding box and a ChartTree tree.
--
-- Note that a round trip may be only approximately isomorphic ie
--
-- > forall c r. \c -> view styleBox' . set styleBox r c ~= r
--
-- - SVG is, in general, an additive model eg a border adds a constant amount no matter the scale or aspect. Text charts, in particular, can have small data boxes but large style additions to the box.
--
-- - rescaling of style here is, in juxtaposition, a multiplicative model.
--
-- In practice, this can lead to weird corner cases and unrequited distortion.
--
-- The example below starts with the unit chart, and a simple axis bar, with a dynamic overhang, so that the axis bar represents the x-axis extremity.
--
-- >>> t1 = unnamed [RectChart defaultRectStyle [one]]
-- >>> x1 h = toChartTree $ mempty & set #charts t1 & set (#hudOptions % #chartAspect) (ChartAspect) & set (#hudOptions % #axes) [(1,defaultAxisOptions & over #bar (fmap (set #overhang h)) & set (#ticks % #ttick) Nothing & set (#ticks % #gtick) Nothing & set (#ticks % #ltick) Nothing)]
--
-- With a significant overhang, the axis bar dominates the extrema:
--
-- >>> view styleBox' $ set styleBox' (Just one) (x1 0.1)
-- Just Rect -0.5 0.5 -0.5 0.5
--
-- With no overhang, the style additions caused by the chart dominates:
--
-- >>> view styleBox' $ set styleBox' (Just one) (x1 0)
-- Just Rect -0.5 0.5 -0.5 0.5
--
-- In between:
--
-- >>> view styleBox' $ set styleBox' (Just one) (x1 0.002)
-- Just Rect -0.5000199203187251 0.5000199203187251 -0.5 0.5
--
--
-- If having an exact box is important, try running set styleBox' multiple times eg
--
-- >>> view styleBox' $ foldr ($) (x1 0.002) (replicate 10 (set styleBox' (Just one)))
-- Just Rect -0.5 0.5000000000000001 -0.5 0.4999999999999999
styleBox' :: Lens' ChartTree (Maybe (Rect Double))
styleBox' :: Lens' ChartTree (Maybe (Rect Double))
styleBox' =
  (ChartTree -> Maybe (Rect Double))
-> (ChartTree -> Maybe (Rect Double) -> ChartTree)
-> Lens' ChartTree (Maybe (Rect Double))
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens ChartTree -> Maybe (Rect Double)
styleBox_ ChartTree -> Maybe (Rect Double) -> ChartTree
styleRebox_

-- | Create a frame over some charts with (additive) padding.
--
-- >>> frameChart defaultRectStyle 0.1 [BlankChart []]
-- RectChart (RectStyle {borderSize = 1.0e-2, borderColor = Colour 0.02 0.29 0.48 1.00, color = Colour 0.02 0.73 0.80 0.10}) []
frameChart :: RectStyle -> Double -> [Chart] -> Chart
frameChart :: RectStyle -> Double -> [Chart] -> Chart
frameChart RectStyle
rs Double
p [Chart]
cs = RectStyle -> [Rect Double] -> Chart
RectChart RectStyle
rs (Maybe (Rect Double) -> [Rect Double]
forall a. Maybe a -> [a]
maybeToList (Double -> Rect Double -> Rect Double
forall a. Subtractive a => a -> Rect a -> Rect a
padRect Double
p (Rect Double -> Rect Double)
-> Maybe (Rect Double) -> Maybe (Rect Double)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Chart] -> Maybe (Rect Double)
styleBoxes [Chart]
cs))

-- | Additive padding, framing or buffering for a chart list.
padChart :: Double -> [Chart] -> Chart
padChart :: Double -> [Chart] -> Chart
padChart Double
p [Chart]
cs = [Rect Double] -> Chart
BlankChart (Maybe (Rect Double) -> [Rect Double]
forall a. Maybe a -> [a]
maybeToList (Double -> Rect Double -> Rect Double
forall a. Subtractive a => a -> Rect a -> Rect a
padRect Double
p (Rect Double -> Rect Double)
-> Maybe (Rect Double) -> Maybe (Rect Double)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Chart] -> Maybe (Rect Double)
styleBoxes [Chart]
cs))

-- | Whether a chart is empty of data to be represented.
isEmptyChart :: Chart -> Bool
isEmptyChart :: Chart -> Bool
isEmptyChart (RectChart RectStyle
_ []) = Bool
True
isEmptyChart (LineChart LineStyle
_ []) = Bool
True
isEmptyChart (GlyphChart GlyphStyle
_ []) = Bool
True
isEmptyChart (TextChart TextStyle
_ []) = Bool
True
isEmptyChart (PathChart PathStyle
_ []) = Bool
True
isEmptyChart (BlankChart [Rect Double]
_) = Bool
True
isEmptyChart Chart
_ = Bool
False

-- | Horizontally stack a list of trees (proceeding to the right) with a gap between
hori :: Double -> [ChartTree] -> ChartTree
hori :: Double -> [ChartTree] -> ChartTree
hori Double
_ [] = ChartTree
forall a. Monoid a => a
mempty
hori Double
gap [ChartTree]
cs = (ChartTree -> ChartTree -> ChartTree)
-> ChartTree -> [ChartTree] -> ChartTree
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ChartTree -> ChartTree -> ChartTree
step ChartTree
forall a. Monoid a => a
mempty [ChartTree]
cs
  where
    step :: ChartTree -> ChartTree -> ChartTree
step ChartTree
x ChartTree
c = ChartTree
x ChartTree -> ChartTree -> ChartTree
forall a. Semigroup a => a -> a -> a
<> Traversal' ChartTree Chart
-> (Chart -> Chart) -> ChartTree -> ChartTree
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over Traversal' ChartTree Chart
chart' (Point Double -> Chart -> Chart
moveChart (Double -> Double -> Point Double
forall a. a -> a -> Point a
Point (ChartTree -> Double
widthx ChartTree
x) (ChartTree -> Double
aligny ChartTree
x Double -> Double -> Double
forall a. Num a => a -> a -> a
- ChartTree -> Double
aligny ChartTree
c))) ChartTree
c
    widthx :: ChartTree -> Double
widthx ChartTree
x = case Traversal' ChartTree [Chart] -> ChartTree -> [Chart]
forall k a (is :: IxList) s.
(Is k A_Fold, Monoid a) =>
Optic' k is s a -> s -> a
foldOf Traversal' ChartTree [Chart]
charts' ChartTree
x of
      [] -> Double
forall a. Additive a => a
zero
      [Chart]
xs -> Double -> (Rect Double -> Double) -> Maybe (Rect Double) -> Double
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Double
forall a. Additive a => a
zero (\(Rect Double
x' Double
z' Double
_ Double
_) -> Double
z' Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
x' Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
gap) ([Chart] -> Maybe (Rect Double)
styleBoxes [Chart]
xs)
    aligny :: ChartTree -> Double
aligny ChartTree
x = case Traversal' ChartTree [Chart] -> ChartTree -> [Chart]
forall k a (is :: IxList) s.
(Is k A_Fold, Monoid a) =>
Optic' k is s a -> s -> a
foldOf Traversal' ChartTree [Chart]
charts' ChartTree
x of
      [] -> Double
forall a. Additive a => a
zero
      [Chart]
xs -> Double -> (Rect Double -> Double) -> Maybe (Rect Double) -> Double
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Double
forall a. Additive a => a
zero (\(Rect Double
_ Double
_ Double
y' Double
w') -> (Double
y' Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
w') Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2) ([Chart] -> Maybe (Rect Double)
styleBoxes [Chart]
xs)

-- | Vertically stack a list of trees (proceeding upwards), aligning them to the left
vert :: Double -> [ChartTree] -> ChartTree
vert :: Double -> [ChartTree] -> ChartTree
vert Double
_ [] = ChartTree
forall a. Monoid a => a
mempty
vert Double
gap [ChartTree]
cs = (ChartTree -> ChartTree -> ChartTree)
-> ChartTree -> [ChartTree] -> ChartTree
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ChartTree -> ChartTree -> ChartTree
step ChartTree
forall a. Monoid a => a
mempty [ChartTree]
cs
  where
    step :: ChartTree -> ChartTree -> ChartTree
step ChartTree
x ChartTree
c = ChartTree
x ChartTree -> ChartTree -> ChartTree
forall a. Semigroup a => a -> a -> a
<> Traversal' ChartTree Chart
-> (Chart -> Chart) -> ChartTree -> ChartTree
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over Traversal' ChartTree Chart
chart' (Point Double -> Chart -> Chart
moveChart (Double -> Double -> Point Double
forall a. a -> a -> Point a
Point (ChartTree -> Double
alignx ChartTree
x Double -> Double -> Double
forall a. Num a => a -> a -> a
- ChartTree -> Double
alignx ChartTree
c) (ChartTree -> Double
widthy ChartTree
x))) ChartTree
c
    widthy :: ChartTree -> Double
widthy ChartTree
x = case Traversal' ChartTree [Chart] -> ChartTree -> [Chart]
forall k a (is :: IxList) s.
(Is k A_Fold, Monoid a) =>
Optic' k is s a -> s -> a
foldOf Traversal' ChartTree [Chart]
charts' ChartTree
x of
      [] -> Double
forall a. Additive a => a
zero
      [Chart]
xs -> Double -> (Rect Double -> Double) -> Maybe (Rect Double) -> Double
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Double
forall a. Additive a => a
zero (\(Rect Double
_ Double
_ Double
y' Double
w') -> Double
w' Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
y' Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
gap) ([Chart] -> Maybe (Rect Double)
styleBoxes [Chart]
xs)
    alignx :: ChartTree -> Double
alignx ChartTree
x = case Traversal' ChartTree [Chart] -> ChartTree -> [Chart]
forall k a (is :: IxList) s.
(Is k A_Fold, Monoid a) =>
Optic' k is s a -> s -> a
foldOf Traversal' ChartTree [Chart]
charts' ChartTree
x of
      [] -> Double
forall a. Additive a => a
zero
      [Chart]
xs -> Double -> (Rect Double -> Double) -> Maybe (Rect Double) -> Double
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Double
forall a. Additive a => a
zero (\(Rect Double
x' Double
_ Double
_ Double
_) -> Double
x') ([Chart] -> Maybe (Rect Double)
styleBoxes [Chart]
xs)

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

-- | Make a new chart tree out of the bounding boxes of a chart tree.
rectangularize :: RectStyle -> ChartTree -> ChartTree
rectangularize :: RectStyle -> ChartTree -> ChartTree
rectangularize RectStyle
r ChartTree
c = Maybe Text -> [ChartTree] -> ChartTree
group (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"rectangularize") [Traversal' ChartTree Chart
-> (Chart -> Chart) -> ChartTree -> ChartTree
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over Traversal' ChartTree Chart
chart' (RectStyle -> Chart -> Chart
rectangularize_ RectStyle
r) ChartTree
c]

rectangularize_ :: RectStyle -> Chart -> Chart
rectangularize_ :: RectStyle -> Chart -> Chart
rectangularize_ RectStyle
rs (TextChart TextStyle
s [(Text, Point Double)]
xs) = TextStyle -> [(Text, Point Double)] -> Chart
TextChart (TextStyle
s TextStyle -> (TextStyle -> TextStyle) -> TextStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "frame"
  (Optic
     A_Lens
     NoIx
     TextStyle
     TextStyle
     (Maybe RectStyle)
     (Maybe RectStyle))
Optic
  A_Lens NoIx TextStyle TextStyle (Maybe RectStyle) (Maybe RectStyle)
#frame Optic
  A_Lens NoIx TextStyle TextStyle (Maybe RectStyle) (Maybe RectStyle)
-> Maybe RectStyle -> TextStyle -> TextStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ RectStyle -> Maybe RectStyle
forall a. a -> Maybe a
Just RectStyle
rs) [(Text, Point Double)]
xs
rectangularize_ RectStyle
rs Chart
c = RectStyle -> [Rect Double] -> Chart
RectChart RectStyle
rs (Maybe (Rect Double) -> [Rect Double]
forall a. Maybe a -> [a]
maybeToList (Maybe (Rect Double) -> [Rect Double])
-> Maybe (Rect Double) -> [Rect Double]
forall a b. (a -> b) -> a -> b
$ Chart -> Maybe (Rect Double)
sbox Chart
c)

-- | Make a new chart tree out of the data points of a chart tree, using the supplied glyphs.
glyphize :: GlyphStyle -> ChartTree -> ChartTree
glyphize :: GlyphStyle -> ChartTree -> ChartTree
glyphize GlyphStyle
g ChartTree
c =
  Maybe Text -> [ChartTree] -> ChartTree
group (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"glyphize") [Traversal' ChartTree Chart
-> (Chart -> Chart) -> ChartTree -> ChartTree
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over Traversal' ChartTree Chart
chart' (GlyphStyle -> Chart -> Chart
glyphize_ GlyphStyle
g) ChartTree
c]

glyphize_ :: GlyphStyle -> Chart -> Chart
glyphize_ :: GlyphStyle -> Chart -> Chart
glyphize_ GlyphStyle
g (TextChart TextStyle
_ [(Text, Point Double)]
xs) = GlyphStyle -> [Point Double] -> Chart
GlyphChart GlyphStyle
g ((Text, Point Double) -> Point Double
forall a b. (a, b) -> b
snd ((Text, Point Double) -> Point Double)
-> [(Text, Point Double)] -> [Point Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, Point Double)]
xs)
glyphize_ GlyphStyle
g (PathChart PathStyle
_ [PathData Double]
xs) = GlyphStyle -> [Point Double] -> Chart
GlyphChart GlyphStyle
g (PathData Double -> Point Double
forall a. PathData a -> Point a
pointPath (PathData Double -> Point Double)
-> [PathData Double] -> [Point Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PathData Double]
xs)
glyphize_ GlyphStyle
g (LineChart LineStyle
_ [[Point Double]]
xs) = GlyphStyle -> [Point Double] -> Chart
GlyphChart GlyphStyle
g ([[Point Double]] -> [Point Double]
forall a. Monoid a => [a] -> a
mconcat [[Point Double]]
xs)
glyphize_ GlyphStyle
g (BlankChart [Rect Double]
xs) = GlyphStyle -> [Point Double] -> Chart
GlyphChart GlyphStyle
g (Rect Double -> Point Double
forall s. (Space s, Field (Element s)) => s -> Element s
mid (Rect Double -> Point Double) -> [Rect Double] -> [Point Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Rect Double]
xs)
glyphize_ GlyphStyle
g (RectChart RectStyle
_ [Rect Double]
xs) = GlyphStyle -> [Point Double] -> Chart
GlyphChart GlyphStyle
g (Rect Double -> Point Double
forall s. (Space s, Field (Element s)) => s -> Element s
mid (Rect Double -> Point Double) -> [Rect Double] -> [Point Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Rect Double]
xs)
glyphize_ GlyphStyle
g (GlyphChart GlyphStyle
_ [Point Double]
xs) = GlyphStyle -> [Point Double] -> Chart
GlyphChart GlyphStyle
g [Point Double]
xs

-- | Modify the text in a text chart.
overText :: (TextStyle -> TextStyle) -> Chart -> Chart
overText :: (TextStyle -> TextStyle) -> Chart -> Chart
overText TextStyle -> TextStyle
f (TextChart TextStyle
s [(Text, Point Double)]
xs) = TextStyle -> [(Text, Point Double)] -> Chart
TextChart (TextStyle -> TextStyle
f TextStyle
s) [(Text, Point Double)]
xs
overText TextStyle -> TextStyle
_ Chart
x = Chart
x

-- | 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)

-- | The basis for the x-y ratio of a 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
  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)