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

-- | Conversion from a chart to SVG.
--
module Chart.Svg
  ( -- * ChartSvg
    ChartSvg (..),
    toChartTree,
    writeChartSvg,
    chartSvg,
    initialCanvas,

    -- * SVG Options
    SvgOptions (..),
    defaultSvgOptions,

    -- * SVG Style primitives
    CssOptions (..),
    defaultCssOptions,
    CssShapeRendering (..),
    CssPreferColorScheme (..),
    cssShapeRendering,
    cssPreferColorScheme,
  )
where

import Chart.Data
import Chart.Hud
import Chart.Primitive
import Chart.Style
import Data.Colour
import Data.Maybe
import Data.Path
import Data.Path.Parser
import Data.Text (Text, pack, unpack)
import qualified Data.Text as Text
import qualified Data.Text.Lazy as Lazy
import Data.Tree
import GHC.Generics
import Lucid
import Lucid.Base
import NeatInterpolation
import Optics.Core
import Prelude

-- $setup
--
-- >>> :set -XOverloadedLabels
-- >>> :set -XOverloadedStrings
-- >>> import Chart
-- >>> import Optics.Core

-- helpers
--
draw :: Chart -> Html ()
draw :: Chart -> Html ()
draw (RectChart RectStyle
_ [Rect Double]
a) = [Html ()] -> Html ()
forall a. Monoid a => [a] -> a
mconcat ([Html ()] -> Html ()) -> [Html ()] -> Html ()
forall a b. (a -> b) -> a -> b
$ Rect Double -> Html ()
svgRect_ (Rect Double -> Html ()) -> [Rect Double] -> [Html ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Rect Double]
a
draw (TextChart TextStyle
s [(Text, Point Double)]
a) = [Html ()] -> Html ()
forall a. Monoid a => [a] -> a
mconcat ([Html ()] -> Html ()) -> [Html ()] -> Html ()
forall a b. (a -> b) -> a -> b
$ (Text -> Point Double -> Html ())
-> (Text, Point Double) -> Html ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (TextStyle -> Text -> Point Double -> Html ()
svgText_ TextStyle
s) ((Text, Point Double) -> Html ())
-> [(Text, Point Double)] -> [Html ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, Point Double)]
a
draw (LineChart LineStyle
_ [[Point Double]]
as) = [[Point Double]] -> Html ()
svgLine_ [[Point Double]]
as
draw (GlyphChart GlyphStyle
s [Point Double]
a) = [Html ()] -> Html ()
forall a. Monoid a => [a] -> a
mconcat ([Html ()] -> Html ()) -> [Html ()] -> Html ()
forall a b. (a -> b) -> a -> b
$ GlyphStyle -> Point Double -> Html ()
svgGlyph_ GlyphStyle
s (Point Double -> Html ()) -> [Point Double] -> [Html ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Point Double]
a
draw (PathChart PathStyle
_ [PathData Double]
a) = [PathData Double] -> Html ()
svgPath_ [PathData Double]
a
draw (BlankChart [Rect Double]
_) = Html ()
forall a. Monoid a => a
mempty

atts :: Chart -> [Attribute]
atts :: Chart -> [Attribute]
atts (RectChart RectStyle
s [Rect Double]
_) = RectStyle -> [Attribute]
attsRect RectStyle
s
atts (TextChart TextStyle
s [(Text, Point Double)]
_) = TextStyle -> [Attribute]
attsText TextStyle
s
atts (LineChart LineStyle
s [[Point Double]]
_) = LineStyle -> [Attribute]
attsLine LineStyle
s
atts (GlyphChart GlyphStyle
s [Point Double]
_) = GlyphStyle -> [Attribute]
attsGlyph GlyphStyle
s
atts (PathChart PathStyle
s [PathData Double]
_) = PathStyle -> [Attribute]
attsPath PathStyle
s
atts (BlankChart [Rect Double]
_) = [Attribute]
forall a. Monoid a => a
mempty

svgChartTree :: ChartTree -> Lucid.Html ()
svgChartTree :: ChartTree -> Html ()
svgChartTree ChartTree
cs
  | Maybe Text -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Text
label Bool -> Bool -> Bool
&& [Chart] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Chart]
cs' = [Html ()] -> Html ()
forall a. Monoid a => [a] -> a
mconcat ([Html ()] -> Html ()) -> [Html ()] -> Html ()
forall a b. (a -> b) -> a -> b
$ ChartTree -> Html ()
svgChartTree (ChartTree -> Html ())
-> (Tree (Maybe Text, [Chart]) -> ChartTree)
-> Tree (Maybe Text, [Chart])
-> Html ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree (Maybe Text, [Chart]) -> ChartTree
ChartTree (Tree (Maybe Text, [Chart]) -> Html ())
-> [Tree (Maybe Text, [Chart])] -> [Html ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Tree (Maybe Text, [Chart])]
xs
  | Bool
otherwise = Text -> [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => Text -> arg -> result
term Text
"g" ((Text -> [Attribute]) -> Maybe Text -> [Attribute]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\Text
x -> [Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"class" Text
x]) Maybe Text
label) Html ()
content'
  where
    (ChartTree (Node (Maybe Text
label, [Chart]
cs') [Tree (Maybe Text, [Chart])]
xs)) = (Chart -> Bool) -> ChartTree -> ChartTree
filterChartTree (Bool -> Bool
not (Bool -> Bool) -> (Chart -> Bool) -> Chart -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Chart -> Bool
isEmptyChart) ChartTree
cs
    content' :: Html ()
content' = ([Html ()] -> Html ()
forall a. Monoid a => [a] -> a
mconcat ([Html ()] -> Html ()) -> [Html ()] -> Html ()
forall a b. (a -> b) -> a -> b
$ Chart -> Html ()
svg (Chart -> Html ()) -> [Chart] -> [Html ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Chart]
cs') Html () -> Html () -> Html ()
forall a. Semigroup a => a -> a -> a
<> ([Html ()] -> Html ()
forall a. Monoid a => [a] -> a
mconcat ([Html ()] -> Html ()) -> [Html ()] -> Html ()
forall a b. (a -> b) -> a -> b
$ ChartTree -> Html ()
svgChartTree (ChartTree -> Html ())
-> (Tree (Maybe Text, [Chart]) -> ChartTree)
-> Tree (Maybe Text, [Chart])
-> Html ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree (Maybe Text, [Chart]) -> ChartTree
ChartTree (Tree (Maybe Text, [Chart]) -> Html ())
-> [Tree (Maybe Text, [Chart])] -> [Html ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Tree (Maybe Text, [Chart])]
xs)

-- ** ChartSvg

-- | Specification of a chart ready to be rendered to SVG includes:
--
-- - svg options
--
-- - hud options
--
-- - any extra hud elements beyond the usual options
--
-- - an underlying chart tree.
--
-- See Data.Examples for usage.
data ChartSvg = ChartSvg
  { ChartSvg -> SvgOptions
svgOptions :: SvgOptions,
    ChartSvg -> HudOptions
hudOptions :: HudOptions,
    ChartSvg -> [Hud]
extraHuds :: [Hud],
    ChartSvg -> ChartTree
charts :: ChartTree
  }
  deriving ((forall x. ChartSvg -> Rep ChartSvg x)
-> (forall x. Rep ChartSvg x -> ChartSvg) -> Generic ChartSvg
forall x. Rep ChartSvg x -> ChartSvg
forall x. ChartSvg -> Rep ChartSvg x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ChartSvg x -> ChartSvg
$cfrom :: forall x. ChartSvg -> Rep ChartSvg x
Generic)

instance Semigroup ChartSvg where
  <> :: ChartSvg -> ChartSvg -> ChartSvg
(<>) (ChartSvg SvgOptions
_ HudOptions
o [Hud]
h ChartTree
c) (ChartSvg SvgOptions
s' HudOptions
o' [Hud]
h' ChartTree
c') =
    SvgOptions -> HudOptions -> [Hud] -> ChartTree -> ChartSvg
ChartSvg SvgOptions
s' (HudOptions
o HudOptions -> HudOptions -> HudOptions
forall a. Semigroup a => a -> a -> a
<> HudOptions
o') ([Hud]
h [Hud] -> [Hud] -> [Hud]
forall a. Semigroup a => a -> a -> a
<> [Hud]
h') (ChartTree
c ChartTree -> ChartTree -> ChartTree
forall a. Semigroup a => a -> a -> a
<> ChartTree
c')

instance Monoid ChartSvg where
  mempty :: ChartSvg
mempty = SvgOptions -> HudOptions -> [Hud] -> ChartTree -> ChartSvg
ChartSvg SvgOptions
defaultSvgOptions HudOptions
forall a. Monoid a => a
mempty [Hud]
forall a. Monoid a => a
mempty ChartTree
forall a. Monoid a => a
mempty

-- * rendering

-- | @svg@ element + svg 2 attributes
svg2Tag :: Term [Attribute] (s -> t) => s -> t
svg2Tag :: s -> t
svg2Tag s
m =
  [Attribute] -> s -> t
forall arg result. Term arg result => arg -> result
svg_
    [ Text -> Text -> Attribute
makeAttribute Text
"xmlns" Text
"http://www.w3.org/2000/svg",
      Text -> Text -> Attribute
makeAttribute Text
"xmlns:xlink" Text
"http://www.w3.org/1999/xlink"
    ]
    s
m

renderToText :: Html () -> Text
renderToText :: Html () -> Text
renderToText = Text -> Text
Lazy.toStrict (Text -> Text) -> (Html () -> Text) -> Html () -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Html () -> Text
forall a. Html a -> Text
renderText

renderToSvg :: SvgOptions -> ChartTree -> Html ()
renderToSvg :: SvgOptions -> ChartTree -> Html ()
renderToSvg SvgOptions
so ChartTree
cs =
  Html () -> [Attribute] -> Html ()
forall a. With a => a -> [Attribute] -> a
with
    (Html () -> Html ()
forall s t. Term [Attribute] (s -> t) => s -> t
svg2Tag (CssOptions -> Html ()
cssText (Optic' A_Lens NoIx SvgOptions CssOptions
-> SvgOptions -> CssOptions
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view IsLabel "cssOptions" (Optic' A_Lens NoIx SvgOptions CssOptions)
Optic' A_Lens NoIx SvgOptions CssOptions
#cssOptions SvgOptions
so) Html () -> Html () -> Html ()
forall a. Semigroup a => a -> a -> a
<> ChartTree -> Html ()
svgChartTree ChartTree
cs))
    [ Text -> Attribute
width_ (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Double -> String
forall a. Show a => a -> String
show Double
w''),
      Text -> Attribute
height_ (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Double -> String
forall a. Show a => a -> String
show Double
h''),
      Text -> Text -> Attribute
makeAttribute Text
"viewBox" (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Double -> String
forall a. Show a => a -> String
show Double
x String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Double -> String
forall a. Show a => a -> String
show (-Double
w) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Double -> String
forall a. Show a => a -> String
show (Double
z Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
x) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Double -> String
forall a. Show a => a -> String
show (Double
w Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
y))
    ]
  where
    r :: Rect Double
r@(Rect Double
x Double
z Double
y Double
w) = Maybe (Rect Double) -> Rect Double
singletonGuard (Optic' A_Lens NoIx ChartTree (Maybe (Rect Double))
-> ChartTree -> Maybe (Rect Double)
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx ChartTree (Maybe (Rect Double))
styleBox' ChartTree
cs)
    Point Double
w' Double
h' = Rect Double -> Element (Rect Double)
forall s. (Space s, Subtractive (Element s)) => s -> Element s
width Rect Double
r
    Point Double
w'' Double
h'' = Double -> Double -> Point Double
forall a. a -> a -> Point a
Point ((SvgOptions
so SvgOptions -> Optic' A_Lens NoIx SvgOptions Double -> Double
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "svgHeight" (Optic' A_Lens NoIx SvgOptions Double)
Optic' A_Lens NoIx SvgOptions Double
#svgHeight) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
h' Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
w') (SvgOptions
so SvgOptions -> Optic' A_Lens NoIx SvgOptions Double -> Double
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "svgHeight" (Optic' A_Lens NoIx SvgOptions Double)
Optic' A_Lens NoIx SvgOptions Double
#svgHeight)

-- | Low-level conversion of a Chart to svg
svg :: Chart -> Lucid.Html ()
svg :: Chart -> Html ()
svg (BlankChart [Rect Double]
_) = Html ()
forall a. Monoid a => a
mempty
svg Chart
c = Text -> [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => Text -> arg -> result
term Text
"g" (Chart -> [Attribute]
atts Chart
c) (Chart -> Html ()
draw Chart
c)

cssText :: CssOptions -> Html ()
cssText :: CssOptions -> Html ()
cssText CssOptions
csso =
  [Attribute] -> Text -> Html ()
forall arg result. TermRaw arg result => arg -> result
style_ [] (Text -> Html ()) -> Text -> Html ()
forall a b. (a -> b) -> a -> b
$
    CssShapeRendering -> Text
cssShapeRendering (CssOptions
csso CssOptions
-> Optic' A_Lens NoIx CssOptions CssShapeRendering
-> CssShapeRendering
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel
  "shapeRendering" (Optic' A_Lens NoIx CssOptions CssShapeRendering)
Optic' A_Lens NoIx CssOptions CssShapeRendering
#shapeRendering)
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Colour, Colour) -> CssPreferColorScheme -> Text
cssPreferColorScheme (Colour
light, Colour
dark) (CssOptions
csso CssOptions
-> Optic' A_Lens NoIx CssOptions CssPreferColorScheme
-> CssPreferColorScheme
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel
  "preferColorScheme"
  (Optic' A_Lens NoIx CssOptions CssPreferColorScheme)
Optic' A_Lens NoIx CssOptions CssPreferColorScheme
#preferColorScheme)
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> CssOptions
csso CssOptions -> Optic' A_Lens NoIx CssOptions Text -> Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "cssExtra" (Optic' A_Lens NoIx CssOptions Text)
Optic' A_Lens NoIx CssOptions Text
#cssExtra

-- | CSS shape rendering text snippet
cssShapeRendering :: CssShapeRendering -> Text
cssShapeRendering :: CssShapeRendering -> Text
cssShapeRendering CssShapeRendering
UseGeometricPrecision = Text
"svg { shape-rendering: geometricPrecision; }"
cssShapeRendering CssShapeRendering
UseCssCrisp = Text
"svg { shape-rendering: crispEdges; }"
cssShapeRendering CssShapeRendering
NoShapeRendering = Text
forall a. Monoid a => a
mempty

-- | CSS prefer-color-scheme text snippet
cssPreferColorScheme :: (Colour, Colour) -> CssPreferColorScheme -> Text
cssPreferColorScheme :: (Colour, Colour) -> CssPreferColorScheme -> Text
cssPreferColorScheme (Colour
cl, Colour
cd) CssPreferColorScheme
PreferHud =
  [trimming|
svg {
  color-scheme: light dark;
}
{
  .canvas g, .title g, .axisbar g, .ticktext g, .tickglyph g, .ticklines g, .legendContent g text {
    fill: $hexDark;
  }
  .ticklines g, .tickglyph g, .legendBorder g {
    stroke: $hexDark;
  }
  .legendBorder g {
    fill: $hexLight;
  }
}
@media (prefers-color-scheme:dark) {
  .canvas g, .title g, .axisbar g, .ticktext g, .tickglyph g, .ticklines g, .legendContent g text {
    fill: $hexLight;
  }
  .ticklines g, .tickglyph g, .legendBorder g {
    stroke: $hexLight;
  }
  .legendBorder g {
    fill: $hexDark;
  }
}
|]
  where
    hexLight :: Text
hexLight = Colour -> Text
hex Colour
cl
    hexDark :: Text
hexDark = Colour -> Text
hex Colour
cd
cssPreferColorScheme (Colour
bglight, Colour
_) CssPreferColorScheme
PreferLight =
  [trimming|
    svg {
      color-scheme: light dark;
    }
    @media (prefers-color-scheme:dark) {
      svg {
        background-color: $c;
      }
    }
  |]
  where
    c :: Text
c = Colour -> Text
hex Colour
bglight
cssPreferColorScheme (Colour
_, Colour
bgdark) CssPreferColorScheme
PreferDark =
  [trimming|
    svg {
      color-scheme: light dark;
    }
    @media (prefers-color-scheme:light) {
      svg {
        background-color: $c;
      }
    }
  |]
  where
    c :: Text
c = Colour -> Text
hex Colour
bgdark
cssPreferColorScheme (Colour, Colour)
_ CssPreferColorScheme
PreferNormal = Text
forall a. Monoid a => a
mempty

-- | consume the huds transforming a 'ChartSvg' to a 'ChartTree'
toChartTree :: ChartSvg -> ChartTree
toChartTree :: ChartSvg -> ChartTree
toChartTree ChartSvg
cs =
  Rect Double -> Rect Double -> [Hud] -> ChartTree -> ChartTree
runHudWith
    (ChartAspect -> ChartTree -> Rect Double
initialCanvas (Optic' A_Lens NoIx ChartSvg ChartAspect -> ChartSvg -> ChartAspect
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view (IsLabel
  "hudOptions"
  (Optic A_Lens NoIx ChartSvg ChartSvg HudOptions HudOptions)
Optic A_Lens NoIx ChartSvg ChartSvg HudOptions HudOptions
#hudOptions Optic A_Lens NoIx ChartSvg ChartSvg HudOptions HudOptions
-> Optic A_Lens NoIx HudOptions HudOptions ChartAspect ChartAspect
-> Optic' A_Lens NoIx ChartSvg ChartAspect
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% IsLabel
  "chartAspect"
  (Optic A_Lens NoIx HudOptions HudOptions ChartAspect ChartAspect)
Optic A_Lens NoIx HudOptions HudOptions ChartAspect ChartAspect
#chartAspect) ChartSvg
cs) (Optic' A_Lens NoIx ChartSvg ChartTree -> ChartSvg -> ChartTree
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view IsLabel "charts" (Optic' A_Lens NoIx ChartSvg ChartTree)
Optic' A_Lens NoIx ChartSvg ChartTree
#charts ChartSvg
cs))
    Rect Double
db'
    [Hud]
hs'
    (Optic' A_Lens NoIx ChartSvg ChartTree -> ChartSvg -> ChartTree
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view IsLabel "charts" (Optic' A_Lens NoIx ChartSvg ChartTree)
Optic' A_Lens NoIx ChartSvg ChartTree
#charts ChartSvg
cs ChartTree -> ChartTree -> ChartTree
forall a. Semigroup a => a -> a -> a
<> Rect Double -> ChartTree
blank Rect Double
db')
  where
    ([Hud]
hs, Rect Double
db') = HudOptions -> Rect Double -> ([Hud], Rect Double)
toHuds (Optic A_Lens NoIx ChartSvg ChartSvg HudOptions HudOptions
-> ChartSvg -> HudOptions
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view IsLabel
  "hudOptions"
  (Optic A_Lens NoIx ChartSvg ChartSvg HudOptions HudOptions)
Optic A_Lens NoIx ChartSvg ChartSvg HudOptions HudOptions
#hudOptions ChartSvg
cs) (Maybe (Rect Double) -> Rect Double
singletonGuard (Maybe (Rect Double) -> Rect Double)
-> Maybe (Rect Double) -> Rect Double
forall a b. (a -> b) -> a -> b
$ Optic' A_Lens NoIx ChartSvg (Maybe (Rect Double))
-> ChartSvg -> Maybe (Rect Double)
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view (IsLabel "charts" (Optic' A_Lens NoIx ChartSvg ChartTree)
Optic' A_Lens NoIx ChartSvg ChartTree
#charts Optic' A_Lens NoIx ChartSvg ChartTree
-> Optic' A_Lens NoIx ChartTree (Maybe (Rect Double))
-> Optic' A_Lens NoIx ChartSvg (Maybe (Rect Double))
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 ChartTree (Maybe (Rect Double))
box') ChartSvg
cs)
    hs' :: [Hud]
hs' =
      [Hud]
hs
        [Hud] -> [Hud] -> [Hud]
forall a. Semigroup a => a -> a -> a
<> Optic' A_Lens NoIx ChartSvg [Hud] -> ChartSvg -> [Hud]
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view IsLabel "extraHuds" (Optic' A_Lens NoIx ChartSvg [Hud])
Optic' A_Lens NoIx ChartSvg [Hud]
#extraHuds ChartSvg
cs

-- | The initial canvas before applying Huds
--
-- >>> initialCanvas (FixedAspect 1.5) (unnamed [RectChart defaultRectStyle [one]])
-- Rect -0.75 0.75 -0.5 0.5
initialCanvas :: ChartAspect -> ChartTree -> CanvasBox
initialCanvas :: ChartAspect -> ChartTree -> Rect Double
initialCanvas (FixedAspect Double
a) ChartTree
_ = Double -> Rect Double
aspect Double
a
initialCanvas (CanvasAspect Double
a) ChartTree
_ = Double -> Rect Double
aspect Double
a
initialCanvas ChartAspect
ChartAspect ChartTree
cs = Maybe (Rect Double) -> Rect Double
singletonGuard (Maybe (Rect Double) -> Rect Double)
-> Maybe (Rect Double) -> Rect Double
forall a b. (a -> b) -> a -> b
$ Optic' A_Lens NoIx ChartTree (Maybe (Rect Double))
-> ChartTree -> Maybe (Rect Double)
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx ChartTree (Maybe (Rect Double))
box' ChartTree
cs

-- | Render a chart using the supplied svg and hud config.
--
-- >>> chartSvg mempty
-- "<svg xmlns=\"http://www.w3.org/2000/svg\" width=\"450.0\" xmlns:xlink=\"http://www.w3.org/1999/xlink\" viewBox=\"-0.75 -0.5 1.5 1.0\" height=\"300.0\"><style>svg {\n  color-scheme: light dark;\n}\n{\n  .canvas g, .title g, .axisbar g, .ticktext g, .tickglyph g, .ticklines g, .legendContent g text {\n    fill: #0d0d0d;\n  }\n  .ticklines g, .tickglyph g, .legendBorder g {\n    stroke: #0d0d0d;\n  }\n  .legendBorder g {\n    fill: #f0f0f0;\n  }\n}\n@media (prefers-color-scheme:dark) {\n  .canvas g, .title g, .axisbar g, .ticktext g, .tickglyph g, .ticklines g, .legendContent g text {\n    fill: #f0f0f0;\n  }\n  .ticklines g, .tickglyph g, .legendBorder g {\n    stroke: #f0f0f0;\n  }\n  .legendBorder g {\n    fill: #0d0d0d;\n  }\n}</style><g class=\"chart\"></g><g class=\"hud\"></g></svg>"
chartSvg :: ChartSvg -> Text
chartSvg :: ChartSvg -> Text
chartSvg ChartSvg
cs = Html () -> Text
renderToText (SvgOptions -> ChartTree -> Html ()
renderToSvg (Optic' A_Lens NoIx ChartSvg SvgOptions -> ChartSvg -> SvgOptions
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view IsLabel "svgOptions" (Optic' A_Lens NoIx ChartSvg SvgOptions)
Optic' A_Lens NoIx ChartSvg SvgOptions
#svgOptions ChartSvg
cs) (ChartSvg -> ChartTree
toChartTree ChartSvg
cs))

-- | Write to a file.
writeChartSvg :: FilePath -> ChartSvg -> IO ()
writeChartSvg :: String -> ChartSvg -> IO ()
writeChartSvg String
fp ChartSvg
cs =
  String -> String -> IO ()
writeFile String
fp (Text -> String
unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ ChartSvg -> Text
chartSvg ChartSvg
cs)

-- | Make Lucid Html given term and attributes
terms :: Text -> [Lucid.Attribute] -> Lucid.Html ()
terms :: Text -> [Attribute] -> Html ()
terms Text
t = Html () -> [Attribute] -> Html ()
forall a. With a => a -> [Attribute] -> a
with (Html () -> [Attribute] -> Html ())
-> Html () -> [Attribute] -> Html ()
forall a b. (a -> b) -> a -> b
$ Text -> Html ()
forall (m :: * -> *). Applicative m => Text -> HtmlT m ()
makeXmlElementNoEnd Text
t

-- | Rectangle svg
svgRect_ :: Rect Double -> Lucid.Html ()
svgRect_ :: Rect Double -> Html ()
svgRect_ (Rect Double
x Double
z Double
y Double
w) =
  Text -> [Attribute] -> Html ()
terms
    Text
"rect"
    [ Text -> Attribute
width_ (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Double -> String
forall a. Show a => a -> String
show (Double -> String) -> Double -> String
forall a b. (a -> b) -> a -> b
$ Double
z Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
x),
      Text -> Attribute
height_ (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Double -> String
forall a. Show a => a -> String
show (Double -> String) -> Double -> String
forall a b. (a -> b) -> a -> b
$ Double
w Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
y),
      Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"x" (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Double -> String
forall a. Show a => a -> String
show Double
x),
      Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"y" (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Double -> String
forall a. Show a => a -> String
show (Double -> String) -> Double -> String
forall a b. (a -> b) -> a -> b
$ -Double
w)
    ]

-- | Text svg
svgText_ :: TextStyle -> Text -> Point Double -> Lucid.Html ()
svgText_ :: TextStyle -> Text -> Point Double -> Html ()
svgText_ TextStyle
s Text
t p :: Point Double
p@(Point Double
x Double
y) =
  Text -> [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => Text -> arg -> result
term
    Text
"text"
    ( [ Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"x" (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Double -> String
forall a. Show a => a -> String
show Double
x),
        Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"y" (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Double -> String
forall a. Show a => a -> String
show (Double -> String) -> Double -> String
forall a b. (a -> b) -> a -> b
$ -Double
y)
      ]
        [Attribute] -> [Attribute] -> [Attribute]
forall a. Semigroup a => a -> a -> a
<> (Double -> [Attribute]) -> Maybe Double -> [Attribute]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\Double
x' -> [Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"transform" (Double -> Point Double -> Text
toRotateText Double
x' Point Double
p)]) (TextStyle
s TextStyle
-> Optic' A_Lens NoIx TextStyle (Maybe Double) -> Maybe Double
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "rotation" (Optic' A_Lens NoIx TextStyle (Maybe Double))
Optic' A_Lens NoIx TextStyle (Maybe Double)
#rotation)
    )
    (Text -> Html ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtmlRaw Text
t)
    Html () -> Html () -> Html ()
forall a. Semigroup a => a -> a -> a
<> case Optic' A_Lens NoIx TextStyle (Maybe RectStyle)
-> TextStyle -> Maybe RectStyle
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view IsLabel "frame" (Optic' A_Lens NoIx TextStyle (Maybe RectStyle))
Optic' A_Lens NoIx TextStyle (Maybe RectStyle)
#frame TextStyle
s of
      Maybe RectStyle
Nothing -> Html ()
forall a. Monoid a => a
mempty
      Just RectStyle
f -> Chart -> Html ()
svg (RectStyle -> [Rect Double] -> Chart
RectChart (RectStyle
f RectStyle -> (RectStyle -> RectStyle) -> RectStyle
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx RectStyle RectStyle Double 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
over IsLabel
  "borderSize" (Optic A_Lens NoIx RectStyle RectStyle Double Double)
Optic A_Lens NoIx RectStyle RectStyle Double Double
#borderSize (Double -> Double -> Double
forall a. Num a => a -> a -> a
* Optic' A_Lens NoIx TextStyle Double -> TextStyle -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view IsLabel "size" (Optic' A_Lens NoIx TextStyle Double)
Optic' A_Lens NoIx TextStyle Double
#size TextStyle
s)) [TextStyle -> Text -> Point Double -> Rect Double
styleBoxText TextStyle
s Text
t Point Double
p])

-- | line svg
svgLine_ :: [[Point Double]] -> Lucid.Html ()
svgLine_ :: [[Point Double]] -> Html ()
svgLine_ [[Point Double]]
xss =
  [Html ()] -> Html ()
forall a. Monoid a => [a] -> a
mconcat ([Html ()] -> Html ()) -> [Html ()] -> Html ()
forall a b. (a -> b) -> a -> b
$
    (\[Point Double]
xs -> Text -> [Attribute] -> Html ()
terms Text
"polyline" [Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"points" ([Point Double] -> Text
forall a. (Show a, Num a) => [Point a] -> Text
toPointsText [Point Double]
xs)]) ([Point Double] -> Html ()) -> [[Point Double]] -> [Html ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Point Double]]
xss
  where
    toPointsText :: [Point a] -> Text
toPointsText [Point a]
xs' = Text -> [Text] -> Text
Text.intercalate Text
"\n" ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (\(Point a
x a
y) -> String -> Text
pack (a -> String
forall a. Show a => a -> String
show a
x String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"," String -> String -> String
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show (-a
y))) (Point a -> Text) -> [Point a] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Point a]
xs'

-- | GlyphShape to svg Tree
svgShape_ :: GlyphShape -> Double -> Point Double -> Lucid.Html ()
svgShape_ :: GlyphShape -> Double -> Point Double -> Html ()
svgShape_ GlyphShape
CircleGlyph Double
s (Point Double
x Double
y) =
  Text -> [Attribute] -> Html ()
terms
    Text
"circle"
    [ Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"cx" (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Double -> String
forall a. Show a => a -> String
show Double
x),
      Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"cy" (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Double -> String
forall a. Show a => a -> String
show (Double -> String) -> Double -> String
forall a b. (a -> b) -> a -> b
$ -Double
y),
      Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"r" (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Double -> String
forall a. Show a => a -> String
show (Double -> String) -> Double -> String
forall a b. (a -> b) -> a -> b
$ Double
0.5 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
s)
    ]
svgShape_ GlyphShape
SquareGlyph Double
s Point Double
p =
  Rect Double -> Html ()
svgRect_ (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 ((Double
s Double -> Double -> Double
forall a. Num 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))
svgShape_ (RectSharpGlyph Double
x') Double
s Point Double
p =
  Rect Double -> Html ()
svgRect_ (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 (Element (Rect Double) -> Rect Double -> Rect Double
forall s.
(Multiplicative (Element s), Space s) =>
Element s -> s -> s
scale (Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
s (Double
x' Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
s)) Rect Double
forall a. Multiplicative a => a
one))
svgShape_ (RectRoundedGlyph Double
x' Double
rx Double
ry) Double
s Point Double
p =
  Text -> [Attribute] -> Html ()
terms
    Text
"rect"
    [ Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"width" (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Double -> String
forall a. Show a => a -> String
show (Double -> String) -> Double -> String
forall a b. (a -> b) -> a -> b
$ Double
z Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
x),
      Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"height" (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Double -> String
forall a. Show a => a -> String
show (Double -> String) -> Double -> String
forall a b. (a -> b) -> a -> b
$ Double
w Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
y),
      Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"x" (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Double -> String
forall a. Show a => a -> String
show Double
x),
      Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"y" (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Double -> String
forall a. Show a => a -> String
show (Double -> String) -> Double -> String
forall a b. (a -> b) -> a -> b
$ -Double
w),
      Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"rx" (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Double -> String
forall a. Show a => a -> String
show Double
rx),
      Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"ry" (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Double -> String
forall a. Show a => a -> String
show Double
ry)
    ]
  where
    (Rect Double
x Double
z Double
y Double
w) = 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 (Element (Rect Double) -> Rect Double -> Rect Double
forall s.
(Multiplicative (Element s), Space s) =>
Element s -> s -> s
scale (Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
s (Double
x' Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
s)) Rect Double
forall a. Multiplicative a => a
one)
svgShape_ (TriangleGlyph (Point Double
xa Double
ya) (Point Double
xb Double
yb) (Point Double
xc Double
yc)) Double
s Point Double
p =
  Text -> [Attribute] -> Html ()
terms
    Text
"polygon"
    [ Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"transform" (Point Double -> Text
toTranslateText Point Double
p),
      Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"points" (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Double -> String
forall a. Show a => a -> String
show (Double
s Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
xa) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"," String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Double -> String
forall a. Show a => a -> String
show (-(Double
s Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
ya)) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Double -> String
forall a. Show a => a -> String
show (Double
s Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
xb) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"," String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Double -> String
forall a. Show a => a -> String
show (-(Double
s Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
yb)) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Double -> String
forall a. Show a => a -> String
show (Double
s Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
xc) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"," String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Double -> String
forall a. Show a => a -> String
show (-(Double
s Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
yc)))
    ]
svgShape_ (EllipseGlyph Double
x') Double
s (Point Double
x Double
y) =
  Text -> [Attribute] -> Html ()
terms
    Text
"ellipse"
    [ Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"cx" ((String -> Text
pack (String -> Text) -> (Double -> String) -> Double -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> String
forall a. Show a => a -> String
show) Double
x),
      Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"cy" ((String -> Text
pack (String -> Text) -> (Double -> String) -> Double -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> String
forall a. Show a => a -> String
show) (Double -> Text) -> Double -> Text
forall a b. (a -> b) -> a -> b
$ -Double
y),
      Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"rx" ((String -> Text
pack (String -> Text) -> (Double -> String) -> Double -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> String
forall a. Show a => a -> String
show) (Double -> Text) -> Double -> Text
forall a b. (a -> b) -> a -> b
$ Double
0.5 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
s),
      Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"ry" ((String -> Text
pack (String -> Text) -> (Double -> String) -> Double -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> String
forall a. Show a => a -> String
show) (Double -> Text) -> Double -> Text
forall a b. (a -> b) -> a -> b
$ Double
0.5 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
s Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
x')
    ]
svgShape_ GlyphShape
VLineGlyph Double
s (Point Double
x Double
y) =
  Text -> [Attribute] -> Html ()
terms Text
"polyline" [Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"points" (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Double -> String
forall a. Show a => a -> String
show Double
x String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"," String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Double -> String
forall a. Show a => a -> String
show (-(Double
y Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
s Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2)) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\n" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Double -> String
forall a. Show a => a -> String
show Double
x String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"," String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Double -> String
forall a. Show a => a -> String
show (-(Double
y Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
s Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2)))]
svgShape_ GlyphShape
HLineGlyph Double
s (Point Double
x Double
y) =
  Text -> [Attribute] -> Html ()
terms Text
"polyline" [Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"points" (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Double -> String
forall a. Show a => a -> String
show (Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
s Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"," String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Double -> String
forall a. Show a => a -> String
show (-Double
y) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\n" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Double -> String
forall a. Show a => a -> String
show (Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
s Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"," String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Double -> String
forall a. Show a => a -> String
show (-Double
y))]
svgShape_ (PathGlyph Text
path ScaleBorder
_) Double
s Point Double
p =
  Text -> [Attribute] -> Html ()
terms Text
"path" [Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"d" Text
path, Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"transform" (Point Double -> Text
toTranslateText Point Double
p Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Double -> Text
toScaleText Double
s)]

-- | GlyphStyle to svg Tree
svgGlyph_ :: GlyphStyle -> Point Double -> Lucid.Html ()
svgGlyph_ :: GlyphStyle -> Point Double -> Html ()
svgGlyph_ GlyphStyle
s Point Double
p =
  GlyphShape -> Double -> Point Double -> Html ()
svgShape_ (GlyphStyle
s GlyphStyle
-> Optic' A_Lens NoIx GlyphStyle GlyphShape -> GlyphShape
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "shape" (Optic' A_Lens NoIx GlyphStyle GlyphShape)
Optic' A_Lens NoIx GlyphStyle GlyphShape
#shape) (GlyphStyle
s GlyphStyle -> Optic' A_Lens NoIx GlyphStyle 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 GlyphStyle Double)
Optic' A_Lens NoIx GlyphStyle Double
#size) Point Double
p
    Html () -> (Html () -> Html ()) -> Html ()
forall a b. a -> (a -> b) -> b
& (Html () -> Html ())
-> (Double -> Html () -> Html ())
-> Maybe Double
-> Html ()
-> Html ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Html () -> Html ()
forall a. a -> a
id (\Double
r -> Text -> [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => Text -> arg -> result
term Text
"g" [Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"transform" (Double -> Point Double -> Text
toRotateText Double
r Point Double
p)]) (GlyphStyle
s GlyphStyle
-> Optic' A_Lens NoIx GlyphStyle (Maybe Double) -> Maybe Double
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "rotation" (Optic' A_Lens NoIx GlyphStyle (Maybe Double))
Optic' A_Lens NoIx GlyphStyle (Maybe Double)
#rotation)

-- | Path svg
svgPath_ :: [PathData Double] -> Lucid.Html ()
svgPath_ :: [PathData Double] -> Html ()
svgPath_ [PathData Double]
ps =
  Text -> [Attribute] -> Html ()
terms Text
"path" [Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"d" ([PathData Double] -> Text
pathDataToSvg [PathData Double]
ps)]

-- | RectStyle to Attributes
attsRect :: RectStyle -> [Lucid.Attribute]
attsRect :: RectStyle -> [Attribute]
attsRect RectStyle
o =
  [ Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"stroke-width" (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Double -> String
forall a. Show a => a -> String
show (Double -> String) -> Double -> String
forall a b. (a -> b) -> a -> b
$ RectStyle
o RectStyle
-> Optic A_Lens NoIx RectStyle RectStyle Double Double -> Double
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel
  "borderSize" (Optic A_Lens NoIx RectStyle RectStyle Double Double)
Optic A_Lens NoIx RectStyle RectStyle Double Double
#borderSize),
    Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"stroke" (Colour -> Text
showRGB (Colour -> Text) -> Colour -> Text
forall a b. (a -> b) -> a -> b
$ RectStyle
o RectStyle -> Optic' A_Lens NoIx RectStyle Colour -> Colour
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "borderColor" (Optic' A_Lens NoIx RectStyle Colour)
Optic' A_Lens NoIx RectStyle Colour
#borderColor),
    Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"stroke-opacity" (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Double -> String
forall a. Show a => a -> String
show (Double -> String) -> Double -> String
forall a b. (a -> b) -> a -> b
$ Colour -> Double
opac (Colour -> Double) -> Colour -> Double
forall a b. (a -> b) -> a -> b
$ RectStyle
o RectStyle -> Optic' A_Lens NoIx RectStyle Colour -> Colour
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "borderColor" (Optic' A_Lens NoIx RectStyle Colour)
Optic' A_Lens NoIx RectStyle Colour
#borderColor),
    Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"fill" (Colour -> Text
showRGB (Colour -> Text) -> Colour -> Text
forall a b. (a -> b) -> a -> b
$ RectStyle
o RectStyle -> Optic' A_Lens NoIx RectStyle Colour -> Colour
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "color" (Optic' A_Lens NoIx RectStyle Colour)
Optic' A_Lens NoIx RectStyle Colour
#color),
    Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"fill-opacity" (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Double -> String
forall a. Show a => a -> String
show (Double -> String) -> Double -> String
forall a b. (a -> b) -> a -> b
$ Colour -> Double
opac (Colour -> Double) -> Colour -> Double
forall a b. (a -> b) -> a -> b
$ RectStyle
o RectStyle -> Optic' A_Lens NoIx RectStyle Colour -> Colour
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "color" (Optic' A_Lens NoIx RectStyle Colour)
Optic' A_Lens NoIx RectStyle Colour
#color)
  ]

-- | TextStyle to Attributes
attsText :: TextStyle -> [Lucid.Attribute]
attsText :: TextStyle -> [Attribute]
attsText TextStyle
o =
  [ Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"stroke-width" Text
"0.0",
    Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"stroke" Text
"none",
    Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"fill" (Colour -> Text
showRGB (Colour -> Text) -> Colour -> Text
forall a b. (a -> b) -> a -> b
$ TextStyle
o TextStyle -> Optic' A_Lens NoIx TextStyle Colour -> Colour
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "color" (Optic' A_Lens NoIx TextStyle Colour)
Optic' A_Lens NoIx TextStyle Colour
#color),
    Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"fill-opacity" (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Double -> String
forall a. Show a => a -> String
show (Double -> String) -> Double -> String
forall a b. (a -> b) -> a -> b
$ Colour -> Double
opac (Colour -> Double) -> Colour -> Double
forall a b. (a -> b) -> a -> b
$ TextStyle
o TextStyle -> Optic' A_Lens NoIx TextStyle Colour -> Colour
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "color" (Optic' A_Lens NoIx TextStyle Colour)
Optic' A_Lens NoIx TextStyle Colour
#color),
    Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"font-size" (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Double -> String
forall a. Show a => a -> String
show (Double -> String) -> Double -> String
forall a b. (a -> b) -> a -> b
$ TextStyle
o TextStyle -> Optic' A_Lens NoIx TextStyle 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 TextStyle Double)
Optic' A_Lens NoIx TextStyle Double
#size),
    Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"text-anchor" (Anchor -> Text
toTextAnchor (Anchor -> Text) -> Anchor -> Text
forall a b. (a -> b) -> a -> b
$ TextStyle
o TextStyle -> Optic' A_Lens NoIx TextStyle Anchor -> Anchor
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "anchor" (Optic' A_Lens NoIx TextStyle Anchor)
Optic' A_Lens NoIx TextStyle Anchor
#anchor)
  ]
  where
    toTextAnchor :: Anchor -> Text
    toTextAnchor :: Anchor -> Text
toTextAnchor Anchor
AnchorMiddle = Text
"middle"
    toTextAnchor Anchor
AnchorStart = Text
"start"
    toTextAnchor Anchor
AnchorEnd = Text
"end"

-- | GlyphStyle to Attributes
attsGlyph :: GlyphStyle -> [Lucid.Attribute]
attsGlyph :: GlyphStyle -> [Attribute]
attsGlyph GlyphStyle
o =
  [ Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"stroke-width" (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Double -> String
forall a. Show a => a -> String
show Double
sw),
    Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"stroke" (Colour -> Text
showRGB (Colour -> Text) -> Colour -> Text
forall a b. (a -> b) -> a -> b
$ GlyphStyle
o GlyphStyle -> Optic' A_Lens NoIx GlyphStyle Colour -> Colour
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "borderColor" (Optic' A_Lens NoIx GlyphStyle Colour)
Optic' A_Lens NoIx GlyphStyle Colour
#borderColor),
    Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"stroke-opacity" (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Double -> String
forall a. Show a => a -> String
show (Double -> String) -> Double -> String
forall a b. (a -> b) -> a -> b
$ Colour -> Double
opac (Colour -> Double) -> Colour -> Double
forall a b. (a -> b) -> a -> b
$ GlyphStyle
o GlyphStyle -> Optic' A_Lens NoIx GlyphStyle Colour -> Colour
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "borderColor" (Optic' A_Lens NoIx GlyphStyle Colour)
Optic' A_Lens NoIx GlyphStyle Colour
#borderColor),
    Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"fill" (Colour -> Text
showRGB (Colour -> Text) -> Colour -> Text
forall a b. (a -> b) -> a -> b
$ GlyphStyle
o GlyphStyle -> Optic' A_Lens NoIx GlyphStyle Colour -> Colour
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "color" (Optic' A_Lens NoIx GlyphStyle Colour)
Optic' A_Lens NoIx GlyphStyle Colour
#color),
    Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"fill-opacity" (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Double -> String
forall a. Show a => a -> String
show (Double -> String) -> Double -> String
forall a b. (a -> b) -> a -> b
$ Colour -> Double
opac (Colour -> Double) -> Colour -> Double
forall a b. (a -> b) -> a -> b
$ GlyphStyle
o GlyphStyle -> Optic' A_Lens NoIx GlyphStyle Colour -> Colour
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "color" (Optic' A_Lens NoIx GlyphStyle Colour)
Optic' A_Lens NoIx GlyphStyle Colour
#color)
  ]
    [Attribute] -> [Attribute] -> [Attribute]
forall a. Semigroup a => a -> a -> a
<> (Point Double -> [Attribute])
-> Maybe (Point Double) -> [Attribute]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((Attribute -> [Attribute] -> [Attribute]
forall a. a -> [a] -> [a]
: []) (Attribute -> [Attribute])
-> (Point Double -> Attribute) -> Point Double -> [Attribute]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"transform" (Text -> Attribute)
-> (Point Double -> Text) -> Point Double -> Attribute
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point Double -> Text
toTranslateText) (GlyphStyle
o GlyphStyle
-> Optic' A_Lens NoIx GlyphStyle (Maybe (Point Double))
-> Maybe (Point Double)
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel
  "translate" (Optic' A_Lens NoIx GlyphStyle (Maybe (Point Double)))
Optic' A_Lens NoIx GlyphStyle (Maybe (Point Double))
#translate)
  where
    sw :: Double
sw = case GlyphStyle
o GlyphStyle
-> Optic' A_Lens NoIx GlyphStyle GlyphShape -> GlyphShape
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "shape" (Optic' A_Lens NoIx GlyphStyle GlyphShape)
Optic' A_Lens NoIx GlyphStyle GlyphShape
#shape of
      PathGlyph Text
_ ScaleBorder
NoScaleBorder -> GlyphStyle
o GlyphStyle -> Optic' A_Lens NoIx GlyphStyle Double -> Double
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "borderSize" (Optic' A_Lens NoIx GlyphStyle Double)
Optic' A_Lens NoIx GlyphStyle Double
#borderSize
      PathGlyph Text
_ ScaleBorder
ScaleBorder -> Double -> Double -> Double
forall a. Ord a => a -> a -> a
min Double
0.2 (GlyphStyle
o GlyphStyle -> Optic' A_Lens NoIx GlyphStyle Double -> Double
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "borderSize" (Optic' A_Lens NoIx GlyphStyle Double)
Optic' A_Lens NoIx GlyphStyle Double
#borderSize Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ GlyphStyle
o GlyphStyle -> Optic' A_Lens NoIx GlyphStyle 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 GlyphStyle Double)
Optic' A_Lens NoIx GlyphStyle Double
#size)
      GlyphShape
_ -> GlyphStyle
o GlyphStyle -> Optic' A_Lens NoIx GlyphStyle Double -> Double
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "borderSize" (Optic' A_Lens NoIx GlyphStyle Double)
Optic' A_Lens NoIx GlyphStyle Double
#borderSize

-- | LineStyle to Attributes
attsLine :: LineStyle -> [Lucid.Attribute]
attsLine :: LineStyle -> [Attribute]
attsLine LineStyle
o =
  [ Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"stroke-width" (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Double -> String
forall a. Show a => a -> String
show (Double -> String) -> Double -> String
forall a b. (a -> b) -> a -> b
$ LineStyle
o 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),
    Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"stroke" (Colour -> Text
showRGB (Colour -> Text) -> Colour -> Text
forall a b. (a -> b) -> a -> b
$ LineStyle
o LineStyle -> Optic' A_Lens NoIx LineStyle Colour -> Colour
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "color" (Optic' A_Lens NoIx LineStyle Colour)
Optic' A_Lens NoIx LineStyle Colour
#color),
    Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"stroke-opacity" (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Double -> String
forall a. Show a => a -> String
show (Double -> String) -> Double -> String
forall a b. (a -> b) -> a -> b
$ Colour -> Double
opac (Colour -> Double) -> Colour -> Double
forall a b. (a -> b) -> a -> b
$ LineStyle
o LineStyle -> Optic' A_Lens NoIx LineStyle Colour -> Colour
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "color" (Optic' A_Lens NoIx LineStyle Colour)
Optic' A_Lens NoIx LineStyle Colour
#color),
    Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"fill" Text
"none"
  ]
    [Attribute] -> [Attribute] -> [Attribute]
forall a. Semigroup a => a -> a -> a
<> (LineCap -> [Attribute]) -> Maybe LineCap -> [Attribute]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\LineCap
x -> [Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"stroke-linecap" (LineCap -> Text
forall s. IsString s => LineCap -> s
fromLineCap LineCap
x)]) (LineStyle
o LineStyle
-> Optic' A_Lens NoIx LineStyle (Maybe LineCap) -> Maybe LineCap
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "linecap" (Optic' A_Lens NoIx LineStyle (Maybe LineCap))
Optic' A_Lens NoIx LineStyle (Maybe LineCap)
#linecap)
    [Attribute] -> [Attribute] -> [Attribute]
forall a. Semigroup a => a -> a -> a
<> (LineJoin -> [Attribute]) -> Maybe LineJoin -> [Attribute]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\LineJoin
x -> [Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"stroke-linejoin" (LineJoin -> Text
forall s. IsString s => LineJoin -> s
fromLineJoin LineJoin
x)]) (LineStyle
o LineStyle
-> Optic' A_Lens NoIx LineStyle (Maybe LineJoin) -> Maybe LineJoin
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "linejoin" (Optic' A_Lens NoIx LineStyle (Maybe LineJoin))
Optic' A_Lens NoIx LineStyle (Maybe LineJoin)
#linejoin)
    [Attribute] -> [Attribute] -> [Attribute]
forall a. Semigroup a => a -> a -> a
<> ([Double] -> [Attribute]) -> Maybe [Double] -> [Attribute]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\[Double]
x -> [Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"stroke-dasharray" ([Double] -> Text
fromDashArray [Double]
x)]) (LineStyle
o LineStyle
-> Optic' A_Lens NoIx LineStyle (Maybe [Double]) -> Maybe [Double]
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "dasharray" (Optic' A_Lens NoIx LineStyle (Maybe [Double]))
Optic' A_Lens NoIx LineStyle (Maybe [Double])
#dasharray)
    [Attribute] -> [Attribute] -> [Attribute]
forall a. Semigroup a => a -> a -> a
<> (Double -> [Attribute]) -> Maybe Double -> [Attribute]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\Double
x -> [Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"stroke-dashoffset" (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Double -> String
forall a. Show a => a -> String
show Double
x)]) (LineStyle
o LineStyle
-> Optic' A_Lens NoIx LineStyle (Maybe Double) -> Maybe Double
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "dashoffset" (Optic' A_Lens NoIx LineStyle (Maybe Double))
Optic' A_Lens NoIx LineStyle (Maybe Double)
#dashoffset)

-- | PathStyle to Attributes
attsPath :: PathStyle -> [Lucid.Attribute]
attsPath :: PathStyle -> [Attribute]
attsPath PathStyle
o =
  [ Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"stroke-width" (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Double -> String
forall a. Show a => a -> String
show (Double -> String) -> Double -> String
forall a b. (a -> b) -> a -> b
$ PathStyle
o PathStyle -> Optic' A_Lens NoIx PathStyle Double -> Double
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "borderSize" (Optic' A_Lens NoIx PathStyle Double)
Optic' A_Lens NoIx PathStyle Double
#borderSize),
    Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"stroke" (Colour -> Text
showRGB (Colour -> Text) -> Colour -> Text
forall a b. (a -> b) -> a -> b
$ PathStyle
o PathStyle -> Optic' A_Lens NoIx PathStyle Colour -> Colour
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "borderColor" (Optic' A_Lens NoIx PathStyle Colour)
Optic' A_Lens NoIx PathStyle Colour
#borderColor),
    Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"stroke-opacity" (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Double -> String
forall a. Show a => a -> String
show (Double -> String) -> Double -> String
forall a b. (a -> b) -> a -> b
$ Colour -> Double
opac (Colour -> Double) -> Colour -> Double
forall a b. (a -> b) -> a -> b
$ PathStyle
o PathStyle -> Optic' A_Lens NoIx PathStyle Colour -> Colour
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "borderColor" (Optic' A_Lens NoIx PathStyle Colour)
Optic' A_Lens NoIx PathStyle Colour
#borderColor),
    Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"fill" (Colour -> Text
showRGB (Colour -> Text) -> Colour -> Text
forall a b. (a -> b) -> a -> b
$ PathStyle
o PathStyle -> Optic' A_Lens NoIx PathStyle Colour -> Colour
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "color" (Optic' A_Lens NoIx PathStyle Colour)
Optic' A_Lens NoIx PathStyle Colour
#color),
    Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"fill-opacity" (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Double -> String
forall a. Show a => a -> String
show (Double -> String) -> Double -> String
forall a b. (a -> b) -> a -> b
$ Colour -> Double
opac (Colour -> Double) -> Colour -> Double
forall a b. (a -> b) -> a -> b
$ PathStyle
o PathStyle -> Optic' A_Lens NoIx PathStyle Colour -> Colour
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "color" (Optic' A_Lens NoIx PathStyle Colour)
Optic' A_Lens NoIx PathStyle Colour
#color)
  ]

-- | includes a flip of the y dimension.
toTranslateText :: Point Double -> Text
toTranslateText :: Point Double -> Text
toTranslateText (Point Double
x Double
y) =
  String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$
    String
"translate(" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Double -> String
forall a. Show a => a -> String
show Double
x String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
", " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Double -> String
forall a. Show a => a -> String
show (-Double
y) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
")"

-- | includes reference changes:
--
-- - from radians to degrees
--
-- - from counter-clockwise is a positive rotation to clockwise is positive
--
-- - flip y dimension
toRotateText :: Double -> Point Double -> Text
toRotateText :: Double -> Point Double -> Text
toRotateText Double
r (Point Double
x Double
y) =
  String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$
    String
"rotate(" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Double -> String
forall a. Show a => a -> String
show (-Double
r Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
180 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
forall a. Floating a => a
pi) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
", " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Double -> String
forall a. Show a => a -> String
show Double
x String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
", " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Double -> String
forall a. Show a => a -> String
show (-Double
y) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
")"

toScaleText :: Double -> Text
toScaleText :: Double -> Text
toScaleText Double
x =
  String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$
    String
"scale(" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Double -> String
forall a. Show a => a -> String
show Double
x String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
")"

-- | SVG tag options.
--
-- >>> defaultSvgOptions
-- SvgOptions {svgHeight = 300.0, cssOptions = CssOptions {shapeRendering = NoShapeRendering, preferColorScheme = PreferHud, cssExtra = ""}}
data SvgOptions = SvgOptions
  { SvgOptions -> Double
svgHeight :: Double,
    SvgOptions -> CssOptions
cssOptions :: CssOptions
  }
  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 -> String -> String
[SvgOptions] -> String -> String
SvgOptions -> String
(Int -> SvgOptions -> String -> String)
-> (SvgOptions -> String)
-> ([SvgOptions] -> String -> String)
-> Show SvgOptions
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [SvgOptions] -> String -> String
$cshowList :: [SvgOptions] -> String -> String
show :: SvgOptions -> String
$cshow :: SvgOptions -> String
showsPrec :: Int -> SvgOptions -> String -> String
$cshowsPrec :: Int -> SvgOptions -> String -> String
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 -> CssOptions -> SvgOptions
SvgOptions Double
300 CssOptions
defaultCssOptions

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

-- | CSS prefer-color-scheme options
data CssPreferColorScheme
  = -- | includes css that switches approriate hud elements between light and dark.
    PreferHud
  | PreferDark
  | PreferLight
  | PreferNormal
  deriving (Int -> CssPreferColorScheme -> String -> String
[CssPreferColorScheme] -> String -> String
CssPreferColorScheme -> String
(Int -> CssPreferColorScheme -> String -> String)
-> (CssPreferColorScheme -> String)
-> ([CssPreferColorScheme] -> String -> String)
-> Show CssPreferColorScheme
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [CssPreferColorScheme] -> String -> String
$cshowList :: [CssPreferColorScheme] -> String -> String
show :: CssPreferColorScheme -> String
$cshow :: CssPreferColorScheme -> String
showsPrec :: Int -> CssPreferColorScheme -> String -> String
$cshowsPrec :: Int -> CssPreferColorScheme -> String -> String
Show, CssPreferColorScheme -> CssPreferColorScheme -> Bool
(CssPreferColorScheme -> CssPreferColorScheme -> Bool)
-> (CssPreferColorScheme -> CssPreferColorScheme -> Bool)
-> Eq CssPreferColorScheme
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CssPreferColorScheme -> CssPreferColorScheme -> Bool
$c/= :: CssPreferColorScheme -> CssPreferColorScheme -> Bool
== :: CssPreferColorScheme -> CssPreferColorScheme -> Bool
$c== :: CssPreferColorScheme -> CssPreferColorScheme -> Bool
Eq, (forall x. CssPreferColorScheme -> Rep CssPreferColorScheme x)
-> (forall x. Rep CssPreferColorScheme x -> CssPreferColorScheme)
-> Generic CssPreferColorScheme
forall x. Rep CssPreferColorScheme x -> CssPreferColorScheme
forall x. CssPreferColorScheme -> Rep CssPreferColorScheme x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CssPreferColorScheme x -> CssPreferColorScheme
$cfrom :: forall x. CssPreferColorScheme -> Rep CssPreferColorScheme x
Generic)

-- | css options
--
-- >>> defaultCssOptions
-- CssOptions {shapeRendering = NoShapeRendering, preferColorScheme = PreferHud, cssExtra = ""}
data CssOptions = CssOptions {CssOptions -> CssShapeRendering
shapeRendering :: CssShapeRendering, CssOptions -> CssPreferColorScheme
preferColorScheme :: CssPreferColorScheme, CssOptions -> Text
cssExtra :: Text} deriving (Int -> CssOptions -> String -> String
[CssOptions] -> String -> String
CssOptions -> String
(Int -> CssOptions -> String -> String)
-> (CssOptions -> String)
-> ([CssOptions] -> String -> String)
-> Show CssOptions
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [CssOptions] -> String -> String
$cshowList :: [CssOptions] -> String -> String
show :: CssOptions -> String
$cshow :: CssOptions -> String
showsPrec :: Int -> CssOptions -> String -> String
$cshowsPrec :: Int -> CssOptions -> String -> String
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)

-- | No special shape rendering and default hud responds to user color scheme preferences.
defaultCssOptions :: CssOptions
defaultCssOptions :: CssOptions
defaultCssOptions = CssShapeRendering -> CssPreferColorScheme -> Text -> CssOptions
CssOptions CssShapeRendering
NoShapeRendering CssPreferColorScheme
PreferHud Text
forall a. Monoid a => a
mempty