{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -Wall #-}

-- | Rendering charts to SVG.
--
-- Note that type signatures are tightened to Double as sane SVG rendering suggests.
module Chart.Render
  ( ChartSvg (..),
    chartSvg,
    chartSvgDefault,
    chartSvgHud,
    renderChartsWith,
    renderHudChart,
    writeChartSvg,
    writeChartSvgDefault,
    writeChartSvgHud,
    svg2Tag,
    cssCrisp,
    geometricPrecision,
    svg,
    terms,
    makeAttribute,

    -- * Augmentation
    ChartExtra (..),
    toChartExtra,
    renderChartExtrasWith,

    -- * low-level conversions
    attsRect,
    attsText,
    attsGlyph,
    attsLine,
    attsPath,
  )
where

import Chart.Types
import Data.Colour
import Data.Path
import Control.Lens hiding (transform)
import Data.Generics.Labels ()
import qualified Data.Text.Lazy as Lazy
import Lucid
import qualified Lucid.Base as Lucid
import Lucid.Base
import NumHask.Prelude
import NumHask.Space as NH hiding (Element)
import qualified Data.Text as Text

-- | Specification of a chart for rendering to SVG
data ChartSvg
  = ChartSvg
      { ChartSvg -> SvgOptions
svgOptions :: SvgOptions,
        ChartSvg -> HudOptions
hudOptions :: HudOptions,
        ChartSvg -> [Hud Double]
hudList :: [Hud Double],
        ChartSvg -> [Chart Double]
chartList :: [Chart Double]
      }
  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 Double]
h [Chart Double]
c) (ChartSvg SvgOptions
s' HudOptions
o' [Hud Double]
h' [Chart Double]
c') =
    SvgOptions
-> HudOptions -> [Hud Double] -> [Chart Double] -> ChartSvg
ChartSvg SvgOptions
s' (HudOptions
o HudOptions -> HudOptions -> HudOptions
forall a. Semigroup a => a -> a -> a
<> HudOptions
o') ([Hud Double]
h [Hud Double] -> [Hud Double] -> [Hud Double]
forall a. Semigroup a => a -> a -> a
<> [Hud Double]
h') ([Chart Double]
c [Chart Double] -> [Chart Double] -> [Chart Double]
forall a. Semigroup a => a -> a -> a
<> [Chart Double]
c')

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

-- | Specification of a chart for rendering to SVG
data ChartSvgExtra
  = ChartSvgExtra
      { ChartSvgExtra -> SvgOptions
svgOptionsExtra :: SvgOptions,
        ChartSvgExtra -> HudOptions
hudOptionsExtra :: HudOptions,
        ChartSvgExtra -> [Hud Double]
hudListExtra :: [Hud Double],
        ChartSvgExtra -> [ChartExtra Double]
chartExtraList :: [ChartExtra Double]
      }
  deriving ((forall x. ChartSvgExtra -> Rep ChartSvgExtra x)
-> (forall x. Rep ChartSvgExtra x -> ChartSvgExtra)
-> Generic ChartSvgExtra
forall x. Rep ChartSvgExtra x -> ChartSvgExtra
forall x. ChartSvgExtra -> Rep ChartSvgExtra x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ChartSvgExtra x -> ChartSvgExtra
$cfrom :: forall x. ChartSvgExtra -> Rep ChartSvgExtra x
Generic)

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

instance Monoid ChartSvgExtra where
  mempty :: ChartSvgExtra
mempty = SvgOptions
-> HudOptions
-> [Hud Double]
-> [ChartExtra Double]
-> ChartSvgExtra
ChartSvgExtra SvgOptions
defaultSvgOptions HudOptions
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
Lucid.makeAttribute Text
"xmlns" Text
"http://www.w3.org/2000/svg",
      Text -> Text -> Attribute
Lucid.makeAttribute Text
"xmlns:xlink" Text
"http://www.w3.org/1999/xlink"
    ]
    s
m

renderToSvg :: CssOptions -> Point Double -> Rect Double -> [Chart Double] -> Html ()
renderToSvg :: CssOptions
-> Point Double -> Rect Double -> [Chart Double] -> Html ()
renderToSvg CssOptions
csso (Point Double
w' Double
h') (Rect Double
x Double
z Double
y Double
w) [Chart Double]
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 CssOptions
csso Html () -> Html () -> Html ()
forall a. Semigroup a => a -> a -> a
<>
            [Html ()] -> Html ()
forall a. Monoid a => [a] -> a
mconcat (Chart Double -> Html ()
svg (Chart Double -> Html ()) -> [Chart Double] -> [Html ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Chart Double]
cs)
        )
    )
    [ Text -> Attribute
width_ (Double -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show Double
w'),
      Text -> Attribute
height_ (Double -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show Double
h'),
      Text -> Text -> Attribute
makeAttribute Text
"viewBox" (Double -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show Double
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Double -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show (- Double
w) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Double -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show (Double
z Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- Double
x) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Double -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show (Double
w Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- Double
y))
    ]

renderToSvgExtra :: CssOptions -> Point Double -> Rect Double -> [ChartExtra Double] -> Html ()
renderToSvgExtra :: CssOptions
-> Point Double -> Rect Double -> [ChartExtra Double] -> Html ()
renderToSvgExtra CssOptions
csso (Point Double
w' Double
h') (Rect Double
x Double
z Double
y Double
w) [ChartExtra Double]
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 CssOptions
csso Html () -> Html () -> Html ()
forall a. Semigroup a => a -> a -> a
<>
            [Html ()] -> Html ()
forall a. Monoid a => [a] -> a
mconcat (ChartExtra Double -> Html ()
svgExtra (ChartExtra Double -> Html ()) -> [ChartExtra Double] -> [Html ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ChartExtra Double]
cs)
        )
    )
    [ Text -> Attribute
width_ (Double -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show Double
w'),
      Text -> Attribute
height_ (Double -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show Double
h'),
      Text -> Text -> Attribute
makeAttribute Text
"viewBox" (Double -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show Double
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Double -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show (- Double
w) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Double -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show (Double
z Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- Double
x) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Double -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show (Double
w Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- Double
y))
    ]

cssText :: CssOptions -> Html ()
cssText :: CssOptions -> Html ()
cssText CssOptions
UseCssCrisp = Html ()
cssCrisp
cssText CssOptions
UseGeometricPrecision = Html ()
geometricPrecision
cssText CssOptions
NoCssOptions = Html ()
forall a. Monoid a => a
mempty

-- | crisp edges css
cssCrisp :: Html ()
cssCrisp :: Html ()
cssCrisp = [Attribute] -> Text -> Html ()
forall arg result. TermRaw arg result => arg -> result
style_ [Text -> Attribute
type_ Text
"text/css"] (Text
"* { shape-rendering: crispEdges; }" :: Text)

-- | crisp edges css
geometricPrecision :: Html ()
geometricPrecision :: Html ()
geometricPrecision = [Attribute] -> Text -> Html ()
forall arg result. TermRaw arg result => arg -> result
style_ [Text -> Attribute
type_ Text
"text/css"] (Text
"* { shape-rendering: geometricPrecision; }" :: Text)

-- | render Charts with the supplied options.
renderChartsWith :: SvgOptions -> [Chart Double] -> Text
renderChartsWith :: SvgOptions -> [Chart Double] -> Text
renderChartsWith SvgOptions
so [Chart Double]
cs =
  Text -> Text
Lazy.toStrict (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Html () -> Text
forall a. Html a -> Text
renderText (CssOptions
-> Point Double -> Rect Double -> [Chart Double] -> Html ()
renderToSvg (SvgOptions
so SvgOptions
-> Getting CssOptions SvgOptions CssOptions -> CssOptions
forall s a. s -> Getting a s a -> a
^. IsLabel "cssOptions" (Getting CssOptions SvgOptions CssOptions)
Getting CssOptions SvgOptions CssOptions
#cssOptions) Point Double
size' Rect Double
rect' [Chart Double]
cs')
  where
    rect' :: Rect Double
rect' = [Chart Double] -> Rect Double
styleBoxesS [Chart Double]
cs' Rect Double -> (Rect Double -> Rect Double) -> Rect Double
forall a b. a -> (a -> b) -> b
& (Rect Double -> Rect Double)
-> (Double -> Rect Double -> Rect Double)
-> Maybe Double
-> Rect Double
-> Rect Double
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Rect Double -> Rect Double
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id Double -> Rect Double -> Rect Double
forall a. Num a => a -> Rect a -> Rect a
padRect (SvgOptions
so SvgOptions
-> Getting (Maybe Double) SvgOptions (Maybe Double) -> Maybe Double
forall s a. s -> Getting a s a -> a
^. IsLabel
  "outerPad" (Getting (Maybe Double) SvgOptions (Maybe Double))
Getting (Maybe Double) SvgOptions (Maybe Double)
#outerPad)
    cs' :: [Chart Double]
cs' =
      [Chart Double]
cs [Chart Double]
-> ([Chart Double] -> [Chart Double]) -> [Chart Double]
forall a b. a -> (a -> b) -> b
&
      Rect Double -> [Hud Double] -> [Chart Double] -> [Chart Double]
runHud Rect Double
penult [ChartAspect -> Hud Double
forall (m :: * -> *). Monad m => ChartAspect -> HudT m Double
chartAspectHud (SvgOptions
so SvgOptions
-> Getting ChartAspect SvgOptions ChartAspect -> ChartAspect
forall s a. s -> Getting a s a -> a
^. IsLabel "chartAspect" (Getting ChartAspect SvgOptions ChartAspect)
Getting ChartAspect SvgOptions ChartAspect
#chartAspect)] [Chart Double]
-> ([Chart Double] -> [Chart Double]) -> [Chart Double]
forall a b. a -> (a -> b) -> b
&
      ([Chart Double] -> [Chart Double])
-> (RectStyle -> [Chart Double] -> [Chart Double])
-> Maybe RectStyle
-> [Chart Double]
-> [Chart Double]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Chart Double] -> [Chart Double]
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id (\RectStyle
x -> RectStyle -> Double -> [Chart Double] -> [Chart Double]
frameChart RectStyle
x (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
0 (SvgOptions
so SvgOptions
-> Getting (Maybe Double) SvgOptions (Maybe Double) -> Maybe Double
forall s a. s -> Getting a s a -> a
^. IsLabel
  "innerPad" (Getting (Maybe Double) SvgOptions (Maybe Double))
Getting (Maybe Double) SvgOptions (Maybe Double)
#innerPad)))
        (SvgOptions
so SvgOptions
-> Getting (Maybe RectStyle) SvgOptions (Maybe RectStyle)
-> Maybe RectStyle
forall s a. s -> Getting a s a -> a
^. IsLabel
  "chartFrame"
  (Getting (Maybe RectStyle) SvgOptions (Maybe RectStyle))
Getting (Maybe RectStyle) SvgOptions (Maybe RectStyle)
#chartFrame)
    Point Double
w Double
h = Rect Double -> Element (Rect Double)
forall s. (Space s, Subtractive (Element s)) => s -> Element s
NH.width Rect Double
rect'
    size' :: Point Double
size' = Double -> Double -> Point Double
forall a. a -> a -> Point a
Point ((SvgOptions
so SvgOptions -> Getting Double SvgOptions Double -> Double
forall s a. s -> Getting a s a -> a
^. IsLabel "svgHeight" (Getting Double SvgOptions Double)
Getting Double SvgOptions Double
#svgHeight)Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/Double
hDouble -> Double -> Double
forall a. Multiplicative a => a -> a -> a
*Double
w) (SvgOptions
so SvgOptions -> Getting Double SvgOptions Double -> Double
forall s a. s -> Getting a s a -> a
^. IsLabel "svgHeight" (Getting Double SvgOptions Double)
Getting Double SvgOptions Double
#svgHeight)
    penult :: Rect Double
penult = case SvgOptions
so SvgOptions
-> Getting ChartAspect SvgOptions ChartAspect -> ChartAspect
forall s a. s -> Getting a s a -> a
^. IsLabel "chartAspect" (Getting ChartAspect SvgOptions ChartAspect)
Getting ChartAspect SvgOptions ChartAspect
#chartAspect of
      FixedAspect Double
_ -> [Chart Double] -> Rect Double
styleBoxesS [Chart Double]
cs
      CanvasAspect Double
_ -> [Chart Double] -> Rect Double
dataBoxesS [Chart Double]
cs
      ChartAspect
ChartAspect -> [Chart Double] -> Rect Double
styleBoxesS [Chart Double]
cs
      ChartAspect
UnadjustedAspect -> [Chart Double] -> Rect Double
dataBoxesS [Chart Double]
cs

-- | render ChartExtras with the supplied options.
renderChartExtrasWith :: SvgOptions -> [ChartExtra Double] -> Text
renderChartExtrasWith :: SvgOptions -> [ChartExtra Double] -> Text
renderChartExtrasWith SvgOptions
so [ChartExtra Double]
cs =
  Text -> Text
Lazy.toStrict (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Html () -> Text
forall a. Html a -> Text
renderText (CssOptions
-> Point Double -> Rect Double -> [ChartExtra Double] -> Html ()
renderToSvgExtra (SvgOptions
so SvgOptions
-> Getting CssOptions SvgOptions CssOptions -> CssOptions
forall s a. s -> Getting a s a -> a
^. IsLabel "cssOptions" (Getting CssOptions SvgOptions CssOptions)
Getting CssOptions SvgOptions CssOptions
#cssOptions) Point Double
size' Rect Double
rect' [ChartExtra Double]
cs')
  where
    cs' :: [ChartExtra Double]
cs' = (ChartExtra Double -> Chart Double -> ChartExtra Double)
-> [ChartExtra Double] -> [Chart Double] -> [ChartExtra Double]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\(ChartExtra Chart Double
_ Maybe Text
l [Attribute]
a Html ()
h') Chart Double
c' -> Chart Double
-> Maybe Text -> [Attribute] -> Html () -> ChartExtra Double
forall a.
Chart a -> Maybe Text -> [Attribute] -> Html () -> ChartExtra a
ChartExtra Chart Double
c' Maybe Text
l [Attribute]
a Html ()
h') [ChartExtra Double]
cs ([Chart Double] -> [Chart Double]
csFinalize [Chart Double]
csa)
    rect' :: Rect Double
rect' = [Chart Double] -> Rect Double
styleBoxesS ([Chart Double] -> [Chart Double]
csFinalize [Chart Double]
csa) Rect Double -> (Rect Double -> Rect Double) -> Rect Double
forall a b. a -> (a -> b) -> b
& (Rect Double -> Rect Double)
-> (Double -> Rect Double -> Rect Double)
-> Maybe Double
-> Rect Double
-> Rect Double
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Rect Double -> Rect Double
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id Double -> Rect Double -> Rect Double
forall a. Num a => a -> Rect a -> Rect a
padRect (SvgOptions
so SvgOptions
-> Getting (Maybe Double) SvgOptions (Maybe Double) -> Maybe Double
forall s a. s -> Getting a s a -> a
^. IsLabel
  "outerPad" (Getting (Maybe Double) SvgOptions (Maybe Double))
Getting (Maybe Double) SvgOptions (Maybe Double)
#outerPad)
    csFinalize :: [Chart Double] -> [Chart Double]
csFinalize =
      ([Chart Double] -> [Chart Double])
-> (RectStyle -> [Chart Double] -> [Chart Double])
-> Maybe RectStyle
-> [Chart Double]
-> [Chart Double]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Chart Double] -> [Chart Double]
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id (\RectStyle
x -> RectStyle -> Double -> [Chart Double] -> [Chart Double]
frameChart RectStyle
x (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
0 (SvgOptions
so SvgOptions
-> Getting (Maybe Double) SvgOptions (Maybe Double) -> Maybe Double
forall s a. s -> Getting a s a -> a
^. IsLabel
  "innerPad" (Getting (Maybe Double) SvgOptions (Maybe Double))
Getting (Maybe Double) SvgOptions (Maybe Double)
#innerPad)))
        (SvgOptions
so SvgOptions
-> Getting (Maybe RectStyle) SvgOptions (Maybe RectStyle)
-> Maybe RectStyle
forall s a. s -> Getting a s a -> a
^. IsLabel
  "chartFrame"
  (Getting (Maybe RectStyle) SvgOptions (Maybe RectStyle))
Getting (Maybe RectStyle) SvgOptions (Maybe RectStyle)
#chartFrame) ([Chart Double] -> [Chart Double])
-> ([Chart Double] -> [Chart Double])
-> [Chart Double]
-> [Chart Double]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
      Rect Double -> [Hud Double] -> [Chart Double] -> [Chart Double]
runHud Rect Double
penult [ChartAspect -> Hud Double
forall (m :: * -> *). Monad m => ChartAspect -> HudT m Double
chartAspectHud (SvgOptions
so SvgOptions
-> Getting ChartAspect SvgOptions ChartAspect -> ChartAspect
forall s a. s -> Getting a s a -> a
^. IsLabel "chartAspect" (Getting ChartAspect SvgOptions ChartAspect)
Getting ChartAspect SvgOptions ChartAspect
#chartAspect)]
    Point Double
w Double
h = Rect Double -> Element (Rect Double)
forall s. (Space s, Subtractive (Element s)) => s -> Element s
NH.width Rect Double
rect'
    size' :: Point Double
size' = Double -> Double -> Point Double
forall a. a -> a -> Point a
Point ((SvgOptions
so SvgOptions -> Getting Double SvgOptions Double -> Double
forall s a. s -> Getting a s a -> a
^. IsLabel "svgHeight" (Getting Double SvgOptions Double)
Getting Double SvgOptions Double
#svgHeight)Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/Double
hDouble -> Double -> Double
forall a. Multiplicative a => a -> a -> a
*Double
w) (SvgOptions
so SvgOptions -> Getting Double SvgOptions Double -> Double
forall s a. s -> Getting a s a -> a
^. IsLabel "svgHeight" (Getting Double SvgOptions Double)
Getting Double SvgOptions Double
#svgHeight)
    csa :: [Chart Double]
csa = (ChartExtra Double -> Chart Double)
-> [ChartExtra Double] -> [Chart Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Getting (Chart Double) (ChartExtra Double) (Chart Double)
-> ChartExtra Double -> Chart Double
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view IsLabel
  "chartActual"
  (Getting (Chart Double) (ChartExtra Double) (Chart Double))
Getting (Chart Double) (ChartExtra Double) (Chart Double)
#chartActual) [ChartExtra Double]
cs
    penult :: Rect Double
penult = case SvgOptions
so SvgOptions
-> Getting ChartAspect SvgOptions ChartAspect -> ChartAspect
forall s a. s -> Getting a s a -> a
^. IsLabel "chartAspect" (Getting ChartAspect SvgOptions ChartAspect)
Getting ChartAspect SvgOptions ChartAspect
#chartAspect of
      FixedAspect Double
_ -> [Chart Double] -> Rect Double
styleBoxesS [Chart Double]
csa
      CanvasAspect Double
_ -> [Chart Double] -> Rect Double
dataBoxesS [Chart Double]
csa
      ChartAspect
ChartAspect -> [Chart Double] -> Rect Double
styleBoxesS [Chart Double]
csa
      ChartAspect
UnadjustedAspect -> [Chart Double] -> Rect Double
dataBoxesS [Chart Double]
csa

-- | render charts with the supplied svg options and huds
renderHudChart :: SvgOptions -> [Hud Double] -> [Chart Double] -> Text
renderHudChart :: SvgOptions -> [Hud Double] -> [Chart Double] -> Text
renderHudChart SvgOptions
so [Hud Double]
hs [Chart Double]
cs = SvgOptions -> [Chart Double] -> Text
renderChartsWith SvgOptions
so (Rect Double -> [Hud Double] -> [Chart Double] -> [Chart Double]
runHud (ChartAspect -> [Chart Double] -> Rect Double
initialCanvas (SvgOptions
so SvgOptions
-> Getting ChartAspect SvgOptions ChartAspect -> ChartAspect
forall s a. s -> Getting a s a -> a
^. IsLabel "chartAspect" (Getting ChartAspect SvgOptions ChartAspect)
Getting ChartAspect SvgOptions ChartAspect
#chartAspect) [Chart Double]
cs) [Hud Double]
hs [Chart Double]
cs)

-- | Render a chart using the supplied svg and hud config.
--
-- >>> chartSvg mempty
-- "<svg xmlns=\"http://www.w3.org/2000/svg\" height=\"300.0\" viewBox=\"-0.52 -0.52 1.04 1.04\" width=\"300.0\" xmlns:xlink=\"http://www.w3.org/1999/xlink\"></svg>"
chartSvg :: ChartSvg -> Text
chartSvg :: ChartSvg -> Text
chartSvg (ChartSvg SvgOptions
so HudOptions
ho [Hud Double]
hs [Chart Double]
cs) = SvgOptions -> [Hud Double] -> [Chart Double] -> Text
renderHudChart SvgOptions
so ([Hud Double]
hs [Hud Double] -> [Hud Double] -> [Hud Double]
forall a. Semigroup a => a -> a -> a
<> [Hud Double]
hs') ([Chart Double]
cs [Chart Double] -> [Chart Double] -> [Chart Double]
forall a. Semigroup a => a -> a -> a
<> [Chart Double]
cs')
  where
    ([Hud Double]
hs', [Chart Double]
cs') = Rect Double -> HudOptions -> ([Hud Double], [Chart Double])
makeHud (Maybe (Rect Double) -> Rect Double
padBox (Maybe (Rect Double) -> Rect Double)
-> Maybe (Rect Double) -> Rect Double
forall a b. (a -> b) -> a -> b
$ [Chart Double] -> Maybe (Rect Double)
dataBoxes [Chart Double]
cs) HudOptions
ho

-- | Render a chart using the default svg options and no hud.
--
-- >>> chartSvgDefault [] == chartSvg mempty
-- True
chartSvgDefault :: [Chart Double] -> Text
chartSvgDefault :: [Chart Double] -> Text
chartSvgDefault [Chart Double]
cs = ChartSvg -> Text
chartSvg (ChartSvg -> Text) -> ChartSvg -> Text
forall a b. (a -> b) -> a -> b
$ ChartSvg
forall a. Monoid a => a
mempty ChartSvg -> (ChartSvg -> ChartSvg) -> ChartSvg
forall a b. a -> (a -> b) -> b
& IsLabel
  "chartList"
  (ASetter ChartSvg ChartSvg [Chart Double] [Chart Double])
ASetter ChartSvg ChartSvg [Chart Double] [Chart Double]
#chartList ASetter ChartSvg ChartSvg [Chart Double] [Chart Double]
-> [Chart Double] -> ChartSvg -> ChartSvg
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Chart Double]
cs

-- | Render a chart using default svg and hud options.
--
-- >>> chartSvgHud [] == (chartSvg $ mempty & #hudOptions .~ defaultHudOptions)
-- True
chartSvgHud :: [Chart Double] -> Text
chartSvgHud :: [Chart Double] -> Text
chartSvgHud [Chart Double]
cs =
  ChartSvg -> Text
chartSvg (ChartSvg -> Text) -> ChartSvg -> Text
forall a b. (a -> b) -> a -> b
$
    ChartSvg
forall a. Monoid a => a
mempty
      ChartSvg -> (ChartSvg -> ChartSvg) -> ChartSvg
forall a b. a -> (a -> b) -> b
& IsLabel
  "hudOptions" (ASetter ChartSvg ChartSvg HudOptions HudOptions)
ASetter ChartSvg ChartSvg HudOptions HudOptions
#hudOptions ASetter ChartSvg ChartSvg HudOptions HudOptions
-> HudOptions -> ChartSvg -> ChartSvg
forall s t a b. ASetter s t a b -> b -> s -> t
.~ HudOptions
defaultHudOptions
      ChartSvg -> (ChartSvg -> ChartSvg) -> ChartSvg
forall a b. a -> (a -> b) -> b
& IsLabel
  "chartList"
  (ASetter ChartSvg ChartSvg [Chart Double] [Chart Double])
ASetter ChartSvg ChartSvg [Chart Double] [Chart Double]
#chartList ASetter ChartSvg ChartSvg [Chart Double] [Chart Double]
-> [Chart Double] -> ChartSvg -> ChartSvg
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Chart Double]
cs

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

-- | Write a chart to a file with default svg options and no hud.
writeChartSvgDefault :: FilePath -> [Chart Double] -> IO ()
writeChartSvgDefault :: String -> [Chart Double] -> IO ()
writeChartSvgDefault String
fp [Chart Double]
cs = String -> ChartSvg -> IO ()
writeChartSvg String
fp (ChartSvg
forall a. Monoid a => a
mempty ChartSvg -> (ChartSvg -> ChartSvg) -> ChartSvg
forall a b. a -> (a -> b) -> b
& IsLabel
  "chartList"
  (ASetter ChartSvg ChartSvg [Chart Double] [Chart Double])
ASetter ChartSvg ChartSvg [Chart Double] [Chart Double]
#chartList ASetter ChartSvg ChartSvg [Chart Double] [Chart Double]
-> [Chart Double] -> ChartSvg -> ChartSvg
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Chart Double]
cs)

-- | Write a chart to a file with default svg and hud options.
writeChartSvgHud :: FilePath -> [Chart Double] -> IO ()
writeChartSvgHud :: String -> [Chart Double] -> IO ()
writeChartSvgHud String
fp [Chart Double]
cs =
  String -> ChartSvg -> IO ()
writeChartSvg
    String
fp
    ( ChartSvg
forall a. Monoid a => a
mempty
        ChartSvg -> (ChartSvg -> ChartSvg) -> ChartSvg
forall a b. a -> (a -> b) -> b
& IsLabel
  "chartList"
  (ASetter ChartSvg ChartSvg [Chart Double] [Chart Double])
ASetter ChartSvg ChartSvg [Chart Double] [Chart Double]
#chartList ASetter ChartSvg ChartSvg [Chart Double] [Chart Double]
-> [Chart Double] -> ChartSvg -> ChartSvg
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Chart Double]
cs
        ChartSvg -> (ChartSvg -> ChartSvg) -> ChartSvg
forall a b. a -> (a -> b) -> b
& IsLabel
  "hudOptions" (ASetter ChartSvg ChartSvg HudOptions HudOptions)
ASetter ChartSvg ChartSvg HudOptions HudOptions
#hudOptions ASetter ChartSvg ChartSvg HudOptions HudOptions
-> HudOptions -> ChartSvg -> ChartSvg
forall s t a b. ASetter s t a b -> b -> s -> t
.~ HudOptions
defaultHudOptions
    )

-- | 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_ (Double -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show (Double -> Text) -> Double -> Text
forall a b. (a -> b) -> a -> b
$ Double
z Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- Double
x),
      Text -> Attribute
height_ (Double -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show (Double -> Text) -> Double -> Text
forall a b. (a -> b) -> a -> b
$ Double
w Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- Double
y),
      Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"x" (Double -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show Double
x),
      Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"y" (Double -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show (Double -> Text) -> Double -> Text
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" (Double -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show Double
x),
        Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"y" (Double -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show (Double -> Text) -> Double -> Text
forall a b. (a -> b) -> a -> b
$ - Double
y)
      ]
        [Attribute] -> [Attribute] -> [Attribute]
forall a. Semigroup a => a -> a -> a
<> [Attribute]
-> (Double -> [Attribute]) -> Maybe Double -> [Attribute]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\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
-> Getting (Maybe Double) TextStyle (Maybe Double) -> Maybe Double
forall s a. s -> Getting a s a -> a
^. IsLabel
  "rotation" (Getting (Maybe Double) TextStyle (Maybe Double))
Getting (Maybe Double) TextStyle (Maybe Double)
#rotation)
    )
    (Text -> Html ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtmlRaw Text
t)

-- | line svg
svgLine :: [Point Double] -> Lucid.Html ()
svgLine :: [Point Double] -> Html ()
svgLine [] = Html ()
forall a. Monoid a => a
mempty
svgLine [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)]
  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) -> a -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show a
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"," Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> a -> Text
forall a b. (Show a, ConvertText String b) => a -> b
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" (Double -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show Double
x),
      Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"cy" (Double -> Text
forall a b. (Show a, ConvertText String b) => a -> b
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
"r" (Double -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show (Double -> Text) -> Double -> Text
forall a b. (a -> b) -> a -> b
$ Double
0.5 Double -> Double -> Double
forall a. Multiplicative 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. Multiplicative a => a -> a -> a
*) (Double -> Double) -> Rect Double -> Rect Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Rect Double
forall a. Multiplicative a => a
one))
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
NH.scale (Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
s (Double
x' Double -> Double -> Double
forall a. Multiplicative 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" (Double -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show (Double -> Text) -> Double -> Text
forall a b. (a -> b) -> a -> b
$ Double
z Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- Double
x),
      Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"height" (Double -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show (Double -> Text) -> Double -> Text
forall a b. (a -> b) -> a -> b
$ Double
w Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- Double
y),
      Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"x" (Double -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show Double
x),
      Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"y" (Double -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show (Double -> Text) -> Double -> Text
forall a b. (a -> b) -> a -> b
$ - Double
w),
      Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"rx" (Double -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show Double
rx),
      Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"ry" (Double -> Text
forall a b. (Show a, ConvertText String b) => a -> b
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
NH.scale (Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
s (Double
x' Double -> Double -> Double
forall a. Multiplicative 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" (Double -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show (Double
s Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Double
xa) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"," Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Double -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show (- (Double
s Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Double
ya)) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Double -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show (Double
s Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Double
xb) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"," Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Double -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show (- (Double
s Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Double
yb)) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Double -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show (Double
s Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Double
xc) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"," Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Double -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show (- (Double
s Double -> Double -> Double
forall a. Multiplicative 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" (Double -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show Double
x),
      Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"cy" (Double -> Text
forall a b. (Show a, ConvertText String b) => a -> b
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" (Double -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show (Double -> Text) -> Double -> Text
forall a b. (a -> b) -> a -> b
$ Double
0.5 Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Double
s),
      Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"ry" (Double -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show (Double -> Text) -> Double -> Text
forall a b. (a -> b) -> a -> b
$ Double
0.5 Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Double
s Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Double
x')
    ]
svgShape (VLineGlyph Double
_) 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" (Double -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show Double
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"," Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Double -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show (- (Double
y Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- Double
s Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ Double
2)) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Double -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show Double
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"," Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Double -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show (- (Double
y Double -> Double -> Double
forall a. Additive a => a -> a -> a
+ Double
s Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ Double
2)))]
svgShape (HLineGlyph Double
_) 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" (Double -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show (Double
x Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- Double
s Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ Double
2) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"," Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Double -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show (- Double
y) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Double -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show (Double
x Double -> Double -> Double
forall a. Additive a => a -> a -> a
+ Double
s Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ Double
2) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"," Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Double -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show (- Double
y))]
svgShape (PathGlyph Text
path) 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
-> Getting GlyphShape GlyphStyle GlyphShape -> GlyphShape
forall s a. s -> Getting a s a -> a
^. IsLabel "shape" (Getting GlyphShape GlyphStyle GlyphShape)
Getting GlyphShape GlyphStyle GlyphShape
#shape) (GlyphStyle
s GlyphStyle -> Getting Double GlyphStyle Double -> Double
forall s a. s -> Getting a s a -> a
^. IsLabel "size" (Getting Double GlyphStyle Double)
Getting Double 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 k (cat :: k -> k -> *) (a :: k). Category cat => cat 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
-> Getting (Maybe Double) GlyphStyle (Maybe Double) -> Maybe Double
forall s a. s -> Getting a s a -> a
^. IsLabel
  "rotation" (Getting (Maybe Double) GlyphStyle (Maybe Double))
Getting (Maybe Double) GlyphStyle (Maybe Double)
#rotation)

-- | Path svg
svgPath :: [PathInfo Double] -> [Point Double] -> Lucid.Html ()
svgPath :: [PathInfo Double] -> [Point Double] -> Html ()
svgPath [PathInfo Double]
_ [] = Html ()
forall a. Monoid a => a
mempty
svgPath [PathInfo Double]
_ [Point Double
_] = Html ()
forall a. Monoid a => a
mempty
svgPath [PathInfo Double]
infos [Point Double]
ps =
  Text -> [Attribute] -> Html ()
terms Text
"path" [Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"d" ([(PathInfo Double, Point Double)] -> Text
toPathAbsolutes ([PathInfo Double]
-> [Point Double] -> [(PathInfo Double, Point Double)]
forall a b. [a] -> [b] -> [(a, b)]
zip [PathInfo Double]
infos [Point Double]
ps))]

svgAtts :: Annotation -> [Attribute]
svgAtts :: Annotation -> [Attribute]
svgAtts (TextA TextStyle
s [Text]
_) = TextStyle -> [Attribute]
attsText TextStyle
s
svgAtts (GlyphA GlyphStyle
s) = GlyphStyle -> [Attribute]
attsGlyph GlyphStyle
s
svgAtts (LineA LineStyle
s) = LineStyle -> [Attribute]
attsLine LineStyle
s
svgAtts (RectA RectStyle
s) = RectStyle -> [Attribute]
attsRect RectStyle
s
svgAtts (PathA PathStyle
s [PathInfo Double]
_) = PathStyle -> [Attribute]
attsPath PathStyle
s
svgAtts Annotation
BlankA = [Attribute]
forall a. Monoid a => a
mempty

svgHtml :: Chart Double -> Lucid.Html ()
svgHtml :: Chart Double -> Html ()
svgHtml (Chart (TextA TextStyle
s [Text]
ts) [XY Double]
xs) =
  [Html ()] -> Html ()
forall a. Monoid a => [a] -> a
mconcat ([Html ()] -> Html ()) -> [Html ()] -> Html ()
forall a b. (a -> b) -> a -> b
$ (Text -> XY Double -> Html ())
-> [Text] -> [XY Double] -> [Html ()]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Text
t XY Double
p -> TextStyle -> Text -> Point Double -> Html ()
svgText TextStyle
s Text
t (XY Double -> Point Double
forall a. (Ord a, Field a) => XY a -> Point a
toPoint XY Double
p)) [Text]
ts [XY Double]
xs
svgHtml (Chart (GlyphA GlyphStyle
s) [XY Double]
xs) =
  [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 ())
-> (XY Double -> Point Double) -> XY Double -> Html ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. XY Double -> Point Double
forall a. (Ord a, Field a) => XY a -> Point a
toPoint (XY Double -> Html ()) -> [XY Double] -> [Html ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [XY Double]
xs
svgHtml (Chart (LineA LineStyle
_) [XY Double]
xs) =
  [Point Double] -> Html ()
svgLine ([Point Double] -> Html ()) -> [Point Double] -> Html ()
forall a b. (a -> b) -> a -> b
$ XY Double -> Point Double
forall a. (Ord a, Field a) => XY a -> Point a
toPoint (XY Double -> Point Double) -> [XY Double] -> [Point Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [XY Double]
xs
svgHtml (Chart (RectA RectStyle
_) [XY Double]
xs) =
  [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 ())
-> (XY Double -> Rect Double) -> XY Double -> Html ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. XY Double -> Rect Double
forall a. XY a -> Rect a
toRect (XY Double -> Html ()) -> [XY Double] -> [Html ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [XY Double]
xs
svgHtml (Chart (PathA PathStyle
_ [PathInfo Double]
infos) [XY Double]
xs) =
  [PathInfo Double] -> [Point Double] -> Html ()
svgPath [PathInfo Double]
infos ([Point Double] -> Html ()) -> [Point Double] -> Html ()
forall a b. (a -> b) -> a -> b
$ XY Double -> Point Double
forall a. (Ord a, Field a) => XY a -> Point a
toPoint (XY Double -> Point Double) -> [XY Double] -> [Point Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [XY Double]
xs
svgHtml (Chart Annotation
BlankA [XY Double]
_) = Html ()
forall a. Monoid a => a
mempty

-- | Low-level conversion of a Chart to svg
svg :: Chart Double -> Lucid.Html ()
svg :: Chart Double -> Html ()
svg Chart Double
c = Text -> [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => Text -> arg -> result
term Text
"g" (Annotation -> [Attribute]
svgAtts (Annotation -> [Attribute]) -> Annotation -> [Attribute]
forall a b. (a -> b) -> a -> b
$ Chart Double
c Chart Double
-> Getting Annotation (Chart Double) Annotation -> Annotation
forall s a. s -> Getting a s a -> a
^. IsLabel "annotation" (Getting Annotation (Chart Double) Annotation)
Getting Annotation (Chart Double) Annotation
#annotation) (Chart Double -> Html ()
svgHtml Chart Double
c)

-- | render extra attributes and html
svgExtra :: ChartExtra Double -> Lucid.Html ()
svgExtra :: ChartExtra Double -> Html ()
svgExtra (ChartExtra Chart Double
c Maybe Text
l' [Attribute]
as Html ()
h) =
  case Maybe Text
l' of
    Maybe Text
Nothing -> Html ()
x
    Just Text
l ->
       Text -> [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => Text -> arg -> result
term Text
"a" [Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"xlink:href" Text
l :: Lucid.Attribute] Html ()
x
  where
    x :: Html ()
x = Text -> [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => Text -> arg -> result
term Text
"g" (Annotation -> [Attribute]
svgAtts (Chart Double
c Chart Double
-> Getting Annotation (Chart Double) Annotation -> Annotation
forall s a. s -> Getting a s a -> a
^. IsLabel "annotation" (Getting Annotation (Chart Double) Annotation)
Getting Annotation (Chart Double) Annotation
#annotation) [Attribute] -> [Attribute] -> [Attribute]
forall a. Semigroup a => a -> a -> a
<> [Attribute]
as) (Chart Double -> Html ()
svgHtml Chart Double
c Html () -> Html () -> Html ()
forall a. Semigroup a => a -> a -> a
<> Html ()
h)

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

-- | 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" (Double -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show (Double -> Text) -> Double -> Text
forall a b. (a -> b) -> a -> b
$ RectStyle
o RectStyle -> Getting Double RectStyle Double -> Double
forall s a. s -> Getting a s a -> a
^. IsLabel "borderSize" (Getting Double RectStyle Double)
Getting Double RectStyle Double
#borderSize),
    Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"stroke" (Colour -> Text
hex (Colour -> Text) -> Colour -> Text
forall a b. (a -> b) -> a -> b
$ RectStyle
o RectStyle -> Getting Colour RectStyle Colour -> Colour
forall s a. s -> Getting a s a -> a
^. IsLabel "borderColor" (Getting Colour RectStyle Colour)
Getting Colour RectStyle Colour
#borderColor),
    Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"stroke-opacity" (Double -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show (Double -> Text) -> Double -> Text
forall a b. (a -> b) -> a -> b
$ Colour -> Double
opac (Colour -> Double) -> Colour -> Double
forall a b. (a -> b) -> a -> b
$ RectStyle
o RectStyle -> Getting Colour RectStyle Colour -> Colour
forall s a. s -> Getting a s a -> a
^. IsLabel "borderColor" (Getting Colour RectStyle Colour)
Getting Colour RectStyle Colour
#borderColor),
    Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"fill" (Colour -> Text
hex (Colour -> Text) -> Colour -> Text
forall a b. (a -> b) -> a -> b
$ RectStyle
o RectStyle -> Getting Colour RectStyle Colour -> Colour
forall s a. s -> Getting a s a -> a
^. IsLabel "color" (Getting Colour RectStyle Colour)
Getting Colour RectStyle Colour
#color),
    Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"fill-opacity" (Double -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show (Double -> Text) -> Double -> Text
forall a b. (a -> b) -> a -> b
$ Colour -> Double
opac (Colour -> Double) -> Colour -> Double
forall a b. (a -> b) -> a -> b
$ RectStyle
o RectStyle -> Getting Colour RectStyle Colour -> Colour
forall s a. s -> Getting a s a -> a
^. IsLabel "color" (Getting Colour RectStyle Colour)
Getting Colour 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
toHex (Colour -> Text) -> Colour -> Text
forall a b. (a -> b) -> a -> b
$ TextStyle
o TextStyle -> Getting Colour TextStyle Colour -> Colour
forall s a. s -> Getting a s a -> a
^. IsLabel "color" (Getting Colour TextStyle Colour)
Getting Colour TextStyle Colour
#color),
    Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"fill-opacity" (Double -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show (Double -> Text) -> Double -> Text
forall a b. (a -> b) -> a -> b
$ Colour -> Double
opac (Colour -> Double) -> Colour -> Double
forall a b. (a -> b) -> a -> b
$ TextStyle
o TextStyle -> Getting Colour TextStyle Colour -> Colour
forall s a. s -> Getting a s a -> a
^. IsLabel "color" (Getting Colour TextStyle Colour)
Getting Colour TextStyle Colour
#color),
    Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"font-size" (Double -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show (Double -> Text) -> Double -> Text
forall a b. (a -> b) -> a -> b
$ TextStyle
o TextStyle -> Getting Double TextStyle Double -> Double
forall s a. s -> Getting a s a -> a
^. IsLabel "size" (Getting Double TextStyle Double)
Getting Double 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 -> Getting Anchor TextStyle Anchor -> Anchor
forall s a. s -> Getting a s a -> a
^. IsLabel "anchor" (Getting Anchor TextStyle Anchor)
Getting Anchor TextStyle Anchor
#anchor)
  ]
    [Attribute] -> [Attribute] -> [Attribute]
forall a. Semigroup a => a -> a -> a
<> [Attribute]
-> (Point Double -> [Attribute])
-> Maybe (Point Double)
-> [Attribute]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ((Attribute -> [Attribute] -> [Attribute]
forall a. a -> [a] -> [a]
: []) (Attribute -> [Attribute])
-> (Point Double -> Attribute) -> Point Double -> [Attribute]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat 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 k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Point Double -> Text
toTranslateText) (TextStyle
o TextStyle
-> Getting (Maybe (Point Double)) TextStyle (Maybe (Point Double))
-> Maybe (Point Double)
forall s a. s -> Getting a s a -> a
^. IsLabel
  "translate"
  (Getting (Maybe (Point Double)) TextStyle (Maybe (Point Double)))
Getting (Maybe (Point Double)) TextStyle (Maybe (Point Double))
#translate)
  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" (Double -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show (Double -> Text) -> Double -> Text
forall a b. (a -> b) -> a -> b
$ GlyphStyle
o GlyphStyle -> Getting Double GlyphStyle Double -> Double
forall s a. s -> Getting a s a -> a
^. IsLabel "borderSize" (Getting Double GlyphStyle Double)
Getting Double GlyphStyle Double
#borderSize),
    Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"stroke" (Colour -> Text
toHex (Colour -> Text) -> Colour -> Text
forall a b. (a -> b) -> a -> b
$ GlyphStyle
o GlyphStyle -> Getting Colour GlyphStyle Colour -> Colour
forall s a. s -> Getting a s a -> a
^. IsLabel "borderColor" (Getting Colour GlyphStyle Colour)
Getting Colour GlyphStyle Colour
#borderColor),
    Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"stroke-opacity" (Double -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show (Double -> Text) -> Double -> Text
forall a b. (a -> b) -> a -> b
$ Colour -> Double
opac (Colour -> Double) -> Colour -> Double
forall a b. (a -> b) -> a -> b
$ GlyphStyle
o GlyphStyle -> Getting Colour GlyphStyle Colour -> Colour
forall s a. s -> Getting a s a -> a
^. IsLabel "borderColor" (Getting Colour GlyphStyle Colour)
Getting Colour GlyphStyle Colour
#borderColor),
    Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"fill" (Colour -> Text
toHex (Colour -> Text) -> Colour -> Text
forall a b. (a -> b) -> a -> b
$ GlyphStyle
o GlyphStyle -> Getting Colour GlyphStyle Colour -> Colour
forall s a. s -> Getting a s a -> a
^. IsLabel "color" (Getting Colour GlyphStyle Colour)
Getting Colour GlyphStyle Colour
#color),
    Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"fill-opacity" (Double -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show (Double -> Text) -> Double -> Text
forall a b. (a -> b) -> a -> b
$ Colour -> Double
opac (Colour -> Double) -> Colour -> Double
forall a b. (a -> b) -> a -> b
$ GlyphStyle
o GlyphStyle -> Getting Colour GlyphStyle Colour -> Colour
forall s a. s -> Getting a s a -> a
^. IsLabel "color" (Getting Colour GlyphStyle Colour)
Getting Colour GlyphStyle Colour
#color)
  ]
    [Attribute] -> [Attribute] -> [Attribute]
forall a. Semigroup a => a -> a -> a
<> [Attribute]
-> (Point Double -> [Attribute])
-> Maybe (Point Double)
-> [Attribute]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ((Attribute -> [Attribute] -> [Attribute]
forall a. a -> [a] -> [a]
: []) (Attribute -> [Attribute])
-> (Point Double -> Attribute) -> Point Double -> [Attribute]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat 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 k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Point Double -> Text
toTranslateText) (GlyphStyle
o GlyphStyle
-> Getting (Maybe (Point Double)) GlyphStyle (Maybe (Point Double))
-> Maybe (Point Double)
forall s a. s -> Getting a s a -> a
^. IsLabel
  "translate"
  (Getting (Maybe (Point Double)) GlyphStyle (Maybe (Point Double)))
Getting (Maybe (Point Double)) GlyphStyle (Maybe (Point Double))
#translate)

-- | 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" (Double -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show (Double -> Text) -> Double -> Text
forall a b. (a -> b) -> a -> b
$ LineStyle
o LineStyle -> Getting Double LineStyle Double -> Double
forall s a. s -> Getting a s a -> a
^. IsLabel "width" (Getting Double LineStyle Double)
Getting Double LineStyle Double
#width),
    Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"stroke" (Colour -> Text
toHex (Colour -> Text) -> Colour -> Text
forall a b. (a -> b) -> a -> b
$ LineStyle
o LineStyle -> Getting Colour LineStyle Colour -> Colour
forall s a. s -> Getting a s a -> a
^. IsLabel "color" (Getting Colour LineStyle Colour)
Getting Colour LineStyle Colour
#color),
    Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"stroke-opacity" (Double -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show (Double -> Text) -> Double -> Text
forall a b. (a -> b) -> a -> b
$ Colour -> Double
opac (Colour -> Double) -> Colour -> Double
forall a b. (a -> b) -> a -> b
$ LineStyle
o LineStyle -> Getting Colour LineStyle Colour -> Colour
forall s a. s -> Getting a s a -> a
^. IsLabel "color" (Getting Colour LineStyle Colour)
Getting Colour 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
<>
  [Attribute]
-> (LineCap -> [Attribute]) -> Maybe LineCap -> [Attribute]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\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
-> Getting (Maybe LineCap) LineStyle (Maybe LineCap)
-> Maybe LineCap
forall s a. s -> Getting a s a -> a
^. IsLabel
  "linecap" (Getting (Maybe LineCap) LineStyle (Maybe LineCap))
Getting (Maybe LineCap) LineStyle (Maybe LineCap)
#linecap) [Attribute] -> [Attribute] -> [Attribute]
forall a. Semigroup a => a -> a -> a
<>
  [Attribute]
-> (LineJoin -> [Attribute]) -> Maybe LineJoin -> [Attribute]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\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
-> Getting (Maybe LineJoin) LineStyle (Maybe LineJoin)
-> Maybe LineJoin
forall s a. s -> Getting a s a -> a
^. IsLabel
  "linejoin" (Getting (Maybe LineJoin) LineStyle (Maybe LineJoin))
Getting (Maybe LineJoin) LineStyle (Maybe LineJoin)
#linejoin) [Attribute] -> [Attribute] -> [Attribute]
forall a. Semigroup a => a -> a -> a
<>
  [Attribute]
-> ([Double] -> [Attribute]) -> Maybe [Double] -> [Attribute]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\[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
-> Getting (Maybe [Double]) LineStyle (Maybe [Double])
-> Maybe [Double]
forall s a. s -> Getting a s a -> a
^. IsLabel
  "dasharray" (Getting (Maybe [Double]) LineStyle (Maybe [Double]))
Getting (Maybe [Double]) LineStyle (Maybe [Double])
#dasharray) [Attribute] -> [Attribute] -> [Attribute]
forall a. Semigroup a => a -> a -> a
<>
  [Attribute]
-> (Double -> [Attribute]) -> Maybe Double -> [Attribute]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Double
x -> [Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"stroke-dashoffset" (Double -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show Double
x)]) (LineStyle
o LineStyle
-> Getting (Maybe Double) LineStyle (Maybe Double) -> Maybe Double
forall s a. s -> Getting a s a -> a
^. IsLabel
  "dashoffset" (Getting (Maybe Double) LineStyle (Maybe Double))
Getting (Maybe Double) 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" (Double -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show (Double -> Text) -> Double -> Text
forall a b. (a -> b) -> a -> b
$ PathStyle
o PathStyle -> Getting Double PathStyle Double -> Double
forall s a. s -> Getting a s a -> a
^. IsLabel "borderSize" (Getting Double PathStyle Double)
Getting Double PathStyle Double
#borderSize),
    Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"stroke" (Colour -> Text
hex (Colour -> Text) -> Colour -> Text
forall a b. (a -> b) -> a -> b
$ PathStyle
o PathStyle -> Getting Colour PathStyle Colour -> Colour
forall s a. s -> Getting a s a -> a
^. IsLabel "borderColor" (Getting Colour PathStyle Colour)
Getting Colour PathStyle Colour
#borderColor),
    Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"stroke-opacity" (Double -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show (Double -> Text) -> Double -> Text
forall a b. (a -> b) -> a -> b
$ Colour -> Double
opac (Colour -> Double) -> Colour -> Double
forall a b. (a -> b) -> a -> b
$ PathStyle
o PathStyle -> Getting Colour PathStyle Colour -> Colour
forall s a. s -> Getting a s a -> a
^. IsLabel "borderColor" (Getting Colour PathStyle Colour)
Getting Colour PathStyle Colour
#borderColor),
    Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"fill" (Colour -> Text
hex (Colour -> Text) -> Colour -> Text
forall a b. (a -> b) -> a -> b
$ PathStyle
o PathStyle -> Getting Colour PathStyle Colour -> Colour
forall s a. s -> Getting a s a -> a
^. IsLabel "color" (Getting Colour PathStyle Colour)
Getting Colour PathStyle Colour
#color),
    Text -> Text -> Attribute
forall arg result. Term arg result => Text -> arg -> result
term Text
"fill-opacity" (Double -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show (Double -> Text) -> Double -> Text
forall a b. (a -> b) -> a -> b
$ Colour -> Double
opac (Colour -> Double) -> Colour -> Double
forall a b. (a -> b) -> a -> b
$ PathStyle
o PathStyle -> Getting Colour PathStyle Colour -> Colour
forall s a. s -> Getting a s a -> a
^. IsLabel "color" (Getting Colour PathStyle Colour)
Getting Colour PathStyle Colour
#color)
  ]

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

-- | 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) =
  Text
"rotate(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Double -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show (-Double
rDouble -> Double -> Double
forall a. Multiplicative a => a -> a -> a
*Double
180Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/Double
forall a. TrigField a => a
pi) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Double -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show Double
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Double -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show (- Double
y) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"

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

-- | Augmentation of a chart to include Html content.
data ChartExtra a =
  ChartExtra
  { ChartExtra a -> Chart a
chartActual :: Chart a,
    ChartExtra a -> Maybe Text
chartLink :: Maybe Text,
    ChartExtra a -> [Attribute]
chartAttributes :: [Attribute],
    ChartExtra a -> Html ()
chartContent :: Html ()
  } deriving (Int -> ChartExtra a -> ShowS
[ChartExtra a] -> ShowS
ChartExtra a -> String
(Int -> ChartExtra a -> ShowS)
-> (ChartExtra a -> String)
-> ([ChartExtra a] -> ShowS)
-> Show (ChartExtra a)
forall a. Show a => Int -> ChartExtra a -> ShowS
forall a. Show a => [ChartExtra a] -> ShowS
forall a. Show a => ChartExtra a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChartExtra a] -> ShowS
$cshowList :: forall a. Show a => [ChartExtra a] -> ShowS
show :: ChartExtra a -> String
$cshow :: forall a. Show a => ChartExtra a -> String
showsPrec :: Int -> ChartExtra a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> ChartExtra a -> ShowS
Show, (forall x. ChartExtra a -> Rep (ChartExtra a) x)
-> (forall x. Rep (ChartExtra a) x -> ChartExtra a)
-> Generic (ChartExtra a)
forall x. Rep (ChartExtra a) x -> ChartExtra a
forall x. ChartExtra a -> Rep (ChartExtra a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (ChartExtra a) x -> ChartExtra a
forall a x. ChartExtra a -> Rep (ChartExtra a) x
$cto :: forall a x. Rep (ChartExtra a) x -> ChartExtra a
$cfrom :: forall a x. ChartExtra a -> Rep (ChartExtra a) x
Generic)

-- | Convert a plain chart top a 'ChartExtra'.
toChartExtra :: Chart a -> ChartExtra a
toChartExtra :: Chart a -> ChartExtra a
toChartExtra Chart a
c = Chart a -> Maybe Text -> [Attribute] -> Html () -> ChartExtra a
forall a.
Chart a -> Maybe Text -> [Attribute] -> Html () -> ChartExtra a
ChartExtra Chart a
c Maybe Text
forall a. Maybe a
Nothing [Attribute]
forall a. Monoid a => a
mempty Html ()
forall a. Monoid a => a
mempty