{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# OPTIONS_GHC -Wall #-}
module Chart.Svg
(
ChartSvg (..),
toChartTree,
writeChartSvg,
chartSvg,
initialCanvas,
SvgOptions (..),
defaultSvgOptions,
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
draw :: Chart -> Html ()
draw :: Chart -> Html ()
draw (RectChart RectStyle
_ [Rect Double]
a) = forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ Rect Double -> Html ()
svgRect_ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Rect Double]
a
draw (TextChart TextStyle
s [(Text, Point Double)]
a) = forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (TextStyle -> Text -> Point Double -> Html ()
svgText_ TextStyle
s) 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) = forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ GlyphStyle -> Point Double -> Html ()
svgGlyph_ GlyphStyle
s 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]
_) = 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]
_) = forall a. Monoid a => a
mempty
svgChartTree :: ChartTree -> Lucid.Html ()
svgChartTree :: ChartTree -> Html ()
svgChartTree ChartTree
cs
| forall a. Maybe a -> Bool
isNothing Maybe Text
label Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Chart]
cs' = forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ ChartTree -> Html ()
svgChartTree forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree (Maybe Text, [Chart]) -> ChartTree
ChartTree forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Tree (Maybe Text, [Chart])]
xs
| Bool
otherwise = forall arg result. Term arg result => Text -> arg -> result
term Text
"g" (forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\Text
x -> [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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Chart -> Bool
isEmptyChart) ChartTree
cs
content' :: Html ()
content' = (forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ Chart -> Html ()
svg forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Chart]
cs') forall a. Semigroup a => a -> a -> a
<> (forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ ChartTree -> Html ()
svgChartTree forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree (Maybe Text, [Chart]) -> ChartTree
ChartTree forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Tree (Maybe Text, [Chart])]
xs)
data ChartSvg = ChartSvg
{ ChartSvg -> SvgOptions
svgOptions :: SvgOptions,
ChartSvg -> HudOptions
hudOptions :: HudOptions,
:: [Hud],
ChartSvg -> ChartTree
charts :: ChartTree
}
deriving (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 forall a. Semigroup a => a -> a -> a
<> HudOptions
o') ([Hud]
h forall a. Semigroup a => a -> a -> a
<> [Hud]
h') (ChartTree
c forall a. Semigroup a => a -> a -> a
<> ChartTree
c')
instance Monoid ChartSvg where
mempty :: ChartSvg
mempty = SvgOptions -> HudOptions -> [Hud] -> ChartTree -> ChartSvg
ChartSvg SvgOptions
defaultSvgOptions forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty
svg2Tag :: Term [Attribute] (s -> t) => s -> t
svg2Tag :: forall s t. Term [Attribute] (s -> t) => s -> t
svg2Tag s
m =
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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Html a -> Text
renderText
renderToSvg :: SvgOptions -> ChartTree -> Html ()
renderToSvg :: SvgOptions -> ChartTree -> Html ()
renderToSvg SvgOptions
so ChartTree
cs =
forall a. With a => a -> [Attribute] -> a
with
(forall s t. Term [Attribute] (s -> t) => s -> t
svg2Tag (CssOptions -> Html ()
cssText (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "cssOptions" a => a
#cssOptions SvgOptions
so) forall a. Semigroup a => a -> a -> a
<> ChartTree -> Html ()
svgChartTree ChartTree
cs))
[ Text -> Attribute
width_ (String -> Text
pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Double
w''),
Text -> Attribute
height_ (String -> Text
pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Double
h''),
Text -> Text -> Attribute
makeAttribute Text
"viewBox" (String -> Text
pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Double
x forall a. Semigroup a => a -> a -> a
<> String
" " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (-Double
w) forall a. Semigroup a => a -> a -> a
<> String
" " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (Double
z forall a. Num a => a -> a -> a
- Double
x) forall a. Semigroup a => a -> a -> a
<> String
" " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (Double
w 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 (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Lens' ChartTree (Maybe (Rect Double))
styleBox' ChartTree
cs)
Point Double
w' Double
h' = forall s. (Space s, Subtractive (Element s)) => s -> Element s
width Rect Double
r
Point Double
w'' Double
h'' = forall a. a -> a -> Point a
Point ((SvgOptions
so forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "svgHeight" a => a
#svgHeight) forall a. Fractional a => a -> a -> a
/ Double
h' forall a. Num a => a -> a -> a
* Double
w') (SvgOptions
so forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "svgHeight" a => a
#svgHeight)
svg :: Chart -> Lucid.Html ()
svg :: Chart -> Html ()
svg (BlankChart [Rect Double]
_) = forall a. Monoid a => a
mempty
svg Chart
c = 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 =
forall arg result. TermRaw arg result => arg -> result
style_ [] forall a b. (a -> b) -> a -> b
$
CssShapeRendering -> Text
cssShapeRendering (CssOptions
csso forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "shapeRendering" a => a
#shapeRendering)
forall a. Semigroup a => a -> a -> a
<> (Colour, Colour) -> CssPreferColorScheme -> Text
cssPreferColorScheme (Colour
light, Colour
dark) (CssOptions
csso forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "preferColorScheme" a => a
#preferColorScheme)
forall a. Semigroup a => a -> a -> a
<> CssOptions
csso forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "cssExtra" a => a
#cssExtra
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 = forall a. Monoid a => a
mempty
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 = forall a. Monoid a => a
mempty
toChartTree :: ChartSvg -> ChartTree
toChartTree :: ChartSvg -> ChartTree
toChartTree ChartSvg
cs =
Rect Double -> Rect Double -> [Hud] -> ChartTree -> ChartTree
runHudWith
(ChartAspect -> ChartTree -> Rect Double
initialCanvas (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view (forall a. IsLabel "hudOptions" a => a
#hudOptions forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a. IsLabel "chartAspect" a => a
#chartAspect) ChartSvg
cs) (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "charts" a => a
#charts ChartSvg
cs))
Rect Double
db'
[Hud]
hs'
(forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "charts" a => a
#charts ChartSvg
cs 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 (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "hudOptions" a => a
#hudOptions ChartSvg
cs) (Maybe (Rect Double) -> Rect Double
singletonGuard forall a b. (a -> b) -> a -> b
$ forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view (forall a. IsLabel "charts" a => a
#charts 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
% Lens' ChartTree (Maybe (Rect Double))
box') ChartSvg
cs)
hs' :: [Hud]
hs' =
[Hud]
hs
forall a. Semigroup a => a -> a -> a
<> forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "extraHuds" a => a
#extraHuds ChartSvg
cs
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 forall a b. (a -> b) -> a -> b
$ forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Lens' ChartTree (Maybe (Rect Double))
box' ChartTree
cs
chartSvg :: ChartSvg -> Text
chartSvg :: ChartSvg -> Text
chartSvg ChartSvg
cs = Html () -> Text
renderToText (SvgOptions -> ChartTree -> Html ()
renderToSvg (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "svgOptions" a => a
#svgOptions ChartSvg
cs) (ChartSvg -> ChartTree
toChartTree ChartSvg
cs))
writeChartSvg :: FilePath -> ChartSvg -> IO ()
writeChartSvg :: String -> ChartSvg -> IO ()
writeChartSvg String
fp ChartSvg
cs =
String -> String -> IO ()
writeFile String
fp (Text -> String
unpack forall a b. (a -> b) -> a -> b
$ ChartSvg -> Text
chartSvg ChartSvg
cs)
terms :: Text -> [Lucid.Attribute] -> Lucid.Html ()
terms :: Text -> [Attribute] -> Html ()
terms Text
t = forall a. With a => a -> [Attribute] -> a
with forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Applicative m => Text -> HtmlT m ()
makeXmlElementNoEnd Text
t
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 forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ Double
z forall a. Num a => a -> a -> a
- Double
x),
Text -> Attribute
height_ (String -> Text
pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ Double
w forall a. Num a => a -> a -> a
- Double
y),
forall arg result. Term arg result => Text -> arg -> result
term Text
"x" (String -> Text
pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Double
x),
forall arg result. Term arg result => Text -> arg -> result
term Text
"y" (String -> Text
pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ -Double
w)
]
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) =
forall arg result. Term arg result => Text -> arg -> result
term
Text
"text"
( [ forall arg result. Term arg result => Text -> arg -> result
term Text
"x" (String -> Text
pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Double
x),
forall arg result. Term arg result => Text -> arg -> result
term Text
"y" (String -> Text
pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ -Double
y)
]
forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\Double
x' -> [forall arg result. Term arg result => Text -> arg -> result
term Text
"transform" (Double -> Point Double -> Text
toRotateText Double
x' Point Double
p)]) (TextStyle
s forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "rotation" a => a
#rotation)
)
(forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtmlRaw Text
t)
forall a. Semigroup a => a -> a -> a
<> case forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "frame" a => a
#frame TextStyle
s of
Maybe RectStyle
Nothing -> forall a. Monoid a => a
mempty
Just RectStyle
f -> Chart -> Html ()
svg (RectStyle -> [Rect Double] -> Chart
RectChart (RectStyle
f forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over forall a. IsLabel "borderSize" a => a
#borderSize (forall a. Num a => a -> a -> a
* forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "size" a => a
#size TextStyle
s)) [TextStyle -> Text -> Point Double -> Rect Double
styleBoxText TextStyle
s Text
t Point Double
p])
svgLine_ :: [[Point Double]] -> Lucid.Html ()
svgLine_ :: [[Point Double]] -> Html ()
svgLine_ [[Point Double]]
xss =
forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$
(\[Point Double]
xs -> Text -> [Attribute] -> Html ()
terms Text
"polyline" [forall arg result. Term arg result => Text -> arg -> result
term Text
"points" (forall {a}. (Show a, Num a) => [Point a] -> Text
toPointsText [Point Double]
xs)]) 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" forall a b. (a -> b) -> a -> b
$ (\(Point a
x a
y) -> String -> Text
pack (forall a. Show a => a -> String
show a
x forall a. Semigroup a => a -> a -> a
<> String
"," forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (-a
y))) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Point a]
xs'
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"
[ forall arg result. Term arg result => Text -> arg -> result
term Text
"cx" (String -> Text
pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Double
x),
forall arg result. Term arg result => Text -> arg -> result
term Text
"cy" (String -> Text
pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ -Double
y),
forall arg result. Term arg result => Text -> arg -> result
term Text
"r" (String -> Text
pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ Double
0.5 forall a. Num a => a -> a -> a
* Double
s)
]
svgShape_ GlyphShape
SquareGlyph Double
s Point Double
p =
Rect Double -> Html ()
svgRect_ (forall s. (Additive (Element s), Space s) => Element s -> s -> s
move Point Double
p ((Double
s forall a. Num a => a -> a -> a
*) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Multiplicative a => a
one))
svgShape_ (RectSharpGlyph Double
x') Double
s Point Double
p =
Rect Double -> Html ()
svgRect_ (forall s. (Additive (Element s), Space s) => Element s -> s -> s
move Point Double
p (forall s.
(Multiplicative (Element s), Space s) =>
Element s -> s -> s
scale (forall a. a -> a -> Point a
Point Double
s (Double
x' forall a. Num a => a -> a -> a
* Double
s)) 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"
[ forall arg result. Term arg result => Text -> arg -> result
term Text
"width" (String -> Text
pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ Double
z forall a. Num a => a -> a -> a
- Double
x),
forall arg result. Term arg result => Text -> arg -> result
term Text
"height" (String -> Text
pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ Double
w forall a. Num a => a -> a -> a
- Double
y),
forall arg result. Term arg result => Text -> arg -> result
term Text
"x" (String -> Text
pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Double
x),
forall arg result. Term arg result => Text -> arg -> result
term Text
"y" (String -> Text
pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ -Double
w),
forall arg result. Term arg result => Text -> arg -> result
term Text
"rx" (String -> Text
pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Double
rx),
forall arg result. Term arg result => Text -> arg -> result
term Text
"ry" (String -> Text
pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Double
ry)
]
where
(Rect Double
x Double
z Double
y Double
w) = forall s. (Additive (Element s), Space s) => Element s -> s -> s
move Point Double
p (forall s.
(Multiplicative (Element s), Space s) =>
Element s -> s -> s
scale (forall a. a -> a -> Point a
Point Double
s (Double
x' forall a. Num a => a -> a -> a
* Double
s)) 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"
[ forall arg result. Term arg result => Text -> arg -> result
term Text
"transform" (Point Double -> Text
toTranslateText Point Double
p),
forall arg result. Term arg result => Text -> arg -> result
term Text
"points" (String -> Text
pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show (Double
s forall a. Num a => a -> a -> a
* Double
xa) forall a. Semigroup a => a -> a -> a
<> String
"," forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (-(Double
s forall a. Num a => a -> a -> a
* Double
ya)) forall a. Semigroup a => a -> a -> a
<> String
" " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (Double
s forall a. Num a => a -> a -> a
* Double
xb) forall a. Semigroup a => a -> a -> a
<> String
"," forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (-(Double
s forall a. Num a => a -> a -> a
* Double
yb)) forall a. Semigroup a => a -> a -> a
<> String
" " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (Double
s forall a. Num a => a -> a -> a
* Double
xc) forall a. Semigroup a => a -> a -> a
<> String
"," forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (-(Double
s 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"
[ forall arg result. Term arg result => Text -> arg -> result
term Text
"cx" ((String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) Double
x),
forall arg result. Term arg result => Text -> arg -> result
term Text
"cy" ((String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) forall a b. (a -> b) -> a -> b
$ -Double
y),
forall arg result. Term arg result => Text -> arg -> result
term Text
"rx" ((String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) forall a b. (a -> b) -> a -> b
$ Double
0.5 forall a. Num a => a -> a -> a
* Double
s),
forall arg result. Term arg result => Text -> arg -> result
term Text
"ry" ((String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) forall a b. (a -> b) -> a -> b
$ Double
0.5 forall a. Num a => a -> a -> a
* Double
s 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" [forall arg result. Term arg result => Text -> arg -> result
term Text
"points" (String -> Text
pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Double
x forall a. Semigroup a => a -> a -> a
<> String
"," forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (-(Double
y forall a. Num a => a -> a -> a
- Double
s forall a. Fractional a => a -> a -> a
/ Double
2)) forall a. Semigroup a => a -> a -> a
<> String
"\n" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Double
x forall a. Semigroup a => a -> a -> a
<> String
"," forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (-(Double
y forall a. Num a => a -> a -> a
+ Double
s 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" [forall arg result. Term arg result => Text -> arg -> result
term Text
"points" (String -> Text
pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show (Double
x forall a. Num a => a -> a -> a
- Double
s forall a. Fractional a => a -> a -> a
/ Double
2) forall a. Semigroup a => a -> a -> a
<> String
"," forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (-Double
y) forall a. Semigroup a => a -> a -> a
<> String
"\n" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (Double
x forall a. Num a => a -> a -> a
+ Double
s forall a. Fractional a => a -> a -> a
/ Double
2) forall a. Semigroup a => a -> a -> a
<> String
"," forall a. Semigroup a => a -> a -> a
<> 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" [forall arg result. Term arg result => Text -> arg -> result
term Text
"d" Text
path, forall arg result. Term arg result => Text -> arg -> result
term Text
"transform" (Point Double -> Text
toTranslateText Point Double
p forall a. Semigroup a => a -> a -> a
<> Text
" " forall a. Semigroup a => a -> a -> a
<> Double -> Text
toScaleText Double
s)]
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 forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "shape" a => a
#shape) (GlyphStyle
s forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "size" a => a
#size) Point Double
p
forall a b. a -> (a -> b) -> b
& forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (\Double
r -> forall arg result. Term arg result => Text -> arg -> result
term Text
"g" [forall arg result. Term arg result => Text -> arg -> result
term Text
"transform" (Double -> Point Double -> Text
toRotateText Double
r Point Double
p)]) (GlyphStyle
s forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "rotation" a => a
#rotation)
svgPath_ :: [PathData Double] -> Lucid.Html ()
svgPath_ :: [PathData Double] -> Html ()
svgPath_ [PathData Double]
ps =
Text -> [Attribute] -> Html ()
terms Text
"path" [forall arg result. Term arg result => Text -> arg -> result
term Text
"d" ([PathData Double] -> Text
pathDataToSvg [PathData Double]
ps)]
attsRect :: RectStyle -> [Lucid.Attribute]
attsRect :: RectStyle -> [Attribute]
attsRect RectStyle
o =
[ forall arg result. Term arg result => Text -> arg -> result
term Text
"stroke-width" (String -> Text
pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ RectStyle
o forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "borderSize" a => a
#borderSize),
forall arg result. Term arg result => Text -> arg -> result
term Text
"stroke" (Colour -> Text
showRGB forall a b. (a -> b) -> a -> b
$ RectStyle
o forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "borderColor" a => a
#borderColor),
forall arg result. Term arg result => Text -> arg -> result
term Text
"stroke-opacity" (String -> Text
pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ Colour -> Double
opac forall a b. (a -> b) -> a -> b
$ RectStyle
o forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "borderColor" a => a
#borderColor),
forall arg result. Term arg result => Text -> arg -> result
term Text
"fill" (Colour -> Text
showRGB forall a b. (a -> b) -> a -> b
$ RectStyle
o forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "color" a => a
#color),
forall arg result. Term arg result => Text -> arg -> result
term Text
"fill-opacity" (String -> Text
pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ Colour -> Double
opac forall a b. (a -> b) -> a -> b
$ RectStyle
o forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "color" a => a
#color)
]
attsText :: TextStyle -> [Lucid.Attribute]
attsText :: TextStyle -> [Attribute]
attsText TextStyle
o =
[ forall arg result. Term arg result => Text -> arg -> result
term Text
"stroke-width" Text
"0.0",
forall arg result. Term arg result => Text -> arg -> result
term Text
"stroke" Text
"none",
forall arg result. Term arg result => Text -> arg -> result
term Text
"fill" (Colour -> Text
showRGB forall a b. (a -> b) -> a -> b
$ TextStyle
o forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "color" a => a
#color),
forall arg result. Term arg result => Text -> arg -> result
term Text
"fill-opacity" (String -> Text
pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ Colour -> Double
opac forall a b. (a -> b) -> a -> b
$ TextStyle
o forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "color" a => a
#color),
forall arg result. Term arg result => Text -> arg -> result
term Text
"font-size" (String -> Text
pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ TextStyle
o forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "size" a => a
#size),
forall arg result. Term arg result => Text -> arg -> result
term Text
"text-anchor" (Anchor -> Text
toTextAnchor forall a b. (a -> b) -> a -> b
$ TextStyle
o forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "anchor" a => a
#anchor)
]
where
toTextAnchor :: Anchor -> Text
toTextAnchor :: Anchor -> Text
toTextAnchor Anchor
AnchorMiddle = Text
"middle"
toTextAnchor Anchor
AnchorStart = Text
"start"
toTextAnchor Anchor
AnchorEnd = Text
"end"
attsGlyph :: GlyphStyle -> [Lucid.Attribute]
attsGlyph :: GlyphStyle -> [Attribute]
attsGlyph GlyphStyle
o =
[ forall arg result. Term arg result => Text -> arg -> result
term Text
"stroke-width" (String -> Text
pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Double
sw),
forall arg result. Term arg result => Text -> arg -> result
term Text
"stroke" (Colour -> Text
showRGB forall a b. (a -> b) -> a -> b
$ GlyphStyle
o forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "borderColor" a => a
#borderColor),
forall arg result. Term arg result => Text -> arg -> result
term Text
"stroke-opacity" (String -> Text
pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ Colour -> Double
opac forall a b. (a -> b) -> a -> b
$ GlyphStyle
o forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "borderColor" a => a
#borderColor),
forall arg result. Term arg result => Text -> arg -> result
term Text
"fill" (Colour -> Text
showRGB forall a b. (a -> b) -> a -> b
$ GlyphStyle
o forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "color" a => a
#color),
forall arg result. Term arg result => Text -> arg -> result
term Text
"fill-opacity" (String -> Text
pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ Colour -> Double
opac forall a b. (a -> b) -> a -> b
$ GlyphStyle
o forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "color" a => a
#color)
]
forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((forall a. a -> [a] -> [a]
: []) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall arg result. Term arg result => Text -> arg -> result
term Text
"transform" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point Double -> Text
toTranslateText) (GlyphStyle
o forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "translate" a => a
#translate)
where
sw :: Double
sw = case GlyphStyle
o forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "shape" a => a
#shape of
PathGlyph Text
_ ScaleBorder
NoScaleBorder -> GlyphStyle
o forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "borderSize" a => a
#borderSize
PathGlyph Text
_ ScaleBorder
ScaleBorder -> forall a. Ord a => a -> a -> a
min Double
0.2 (GlyphStyle
o forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "borderSize" a => a
#borderSize forall a. Fractional a => a -> a -> a
/ GlyphStyle
o forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "size" a => a
#size)
GlyphShape
_ -> GlyphStyle
o forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "borderSize" a => a
#borderSize
attsLine :: LineStyle -> [Lucid.Attribute]
attsLine :: LineStyle -> [Attribute]
attsLine LineStyle
o =
[ forall arg result. Term arg result => Text -> arg -> result
term Text
"stroke-width" (String -> Text
pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ LineStyle
o forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "size" a => a
#size),
forall arg result. Term arg result => Text -> arg -> result
term Text
"stroke" (Colour -> Text
showRGB forall a b. (a -> b) -> a -> b
$ LineStyle
o forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "color" a => a
#color),
forall arg result. Term arg result => Text -> arg -> result
term Text
"stroke-opacity" (String -> Text
pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ Colour -> Double
opac forall a b. (a -> b) -> a -> b
$ LineStyle
o forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "color" a => a
#color),
forall arg result. Term arg result => Text -> arg -> result
term Text
"fill" Text
"none"
]
forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\LineCap
x -> [forall arg result. Term arg result => Text -> arg -> result
term Text
"stroke-linecap" (forall s. IsString s => LineCap -> s
fromLineCap LineCap
x)]) (LineStyle
o forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "linecap" a => a
#linecap)
forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\LineJoin
x -> [forall arg result. Term arg result => Text -> arg -> result
term Text
"stroke-linejoin" (forall s. IsString s => LineJoin -> s
fromLineJoin LineJoin
x)]) (LineStyle
o forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "linejoin" a => a
#linejoin)
forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\[Double]
x -> [forall arg result. Term arg result => Text -> arg -> result
term Text
"stroke-dasharray" ([Double] -> Text
fromDashArray [Double]
x)]) (LineStyle
o forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "dasharray" a => a
#dasharray)
forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\Double
x -> [forall arg result. Term arg result => Text -> arg -> result
term Text
"stroke-dashoffset" (String -> Text
pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Double
x)]) (LineStyle
o forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "dashoffset" a => a
#dashoffset)
attsPath :: PathStyle -> [Lucid.Attribute]
attsPath :: PathStyle -> [Attribute]
attsPath PathStyle
o =
[ forall arg result. Term arg result => Text -> arg -> result
term Text
"stroke-width" (String -> Text
pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ PathStyle
o forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "borderSize" a => a
#borderSize),
forall arg result. Term arg result => Text -> arg -> result
term Text
"stroke" (Colour -> Text
showRGB forall a b. (a -> b) -> a -> b
$ PathStyle
o forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "borderColor" a => a
#borderColor),
forall arg result. Term arg result => Text -> arg -> result
term Text
"stroke-opacity" (String -> Text
pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ Colour -> Double
opac forall a b. (a -> b) -> a -> b
$ PathStyle
o forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "borderColor" a => a
#borderColor),
forall arg result. Term arg result => Text -> arg -> result
term Text
"fill" (Colour -> Text
showRGB forall a b. (a -> b) -> a -> b
$ PathStyle
o forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "color" a => a
#color),
forall arg result. Term arg result => Text -> arg -> result
term Text
"fill-opacity" (String -> Text
pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ Colour -> Double
opac forall a b. (a -> b) -> a -> b
$ PathStyle
o forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "color" a => a
#color)
]
toTranslateText :: Point Double -> Text
toTranslateText :: Point Double -> Text
toTranslateText (Point Double
x Double
y) =
String -> Text
pack forall a b. (a -> b) -> a -> b
$
String
"translate(" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Double
x forall a. Semigroup a => a -> a -> a
<> String
", " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (-Double
y) forall a. Semigroup a => a -> a -> a
<> String
")"
toRotateText :: Double -> Point Double -> Text
toRotateText :: Double -> Point Double -> Text
toRotateText Double
r (Point Double
x Double
y) =
String -> Text
pack forall a b. (a -> b) -> a -> b
$
String
"rotate(" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (-Double
r forall a. Num a => a -> a -> a
* Double
180 forall a. Fractional a => a -> a -> a
/ forall a. Floating a => a
pi) forall a. Semigroup a => a -> a -> a
<> String
", " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Double
x forall a. Semigroup a => a -> a -> a
<> String
", " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (-Double
y) forall a. Semigroup a => a -> a -> a
<> String
")"
toScaleText :: Double -> Text
toScaleText :: Double -> Text
toScaleText Double
x =
String -> Text
pack forall a b. (a -> b) -> a -> b
$
String
"scale(" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Double
x forall a. Semigroup a => a -> a -> a
<> String
")"
data SvgOptions = SvgOptions
{ SvgOptions -> Double
svgHeight :: Double,
SvgOptions -> CssOptions
cssOptions :: CssOptions
}
deriving (SvgOptions -> SvgOptions -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SvgOptions -> SvgOptions -> Bool
$c/= :: SvgOptions -> SvgOptions -> Bool
== :: SvgOptions -> SvgOptions -> Bool
$c== :: SvgOptions -> SvgOptions -> Bool
Eq, Int -> SvgOptions -> ShowS
[SvgOptions] -> ShowS
SvgOptions -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SvgOptions] -> ShowS
$cshowList :: [SvgOptions] -> ShowS
show :: SvgOptions -> String
$cshow :: SvgOptions -> String
showsPrec :: Int -> SvgOptions -> ShowS
$cshowsPrec :: Int -> SvgOptions -> ShowS
Show, forall x. 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)
defaultSvgOptions :: SvgOptions
defaultSvgOptions :: SvgOptions
defaultSvgOptions = Double -> CssOptions -> SvgOptions
SvgOptions Double
300 CssOptions
defaultCssOptions
data CssShapeRendering = UseGeometricPrecision | UseCssCrisp | NoShapeRendering deriving (Int -> CssShapeRendering -> ShowS
[CssShapeRendering] -> ShowS
CssShapeRendering -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CssShapeRendering] -> ShowS
$cshowList :: [CssShapeRendering] -> ShowS
show :: CssShapeRendering -> String
$cshow :: CssShapeRendering -> String
showsPrec :: Int -> CssShapeRendering -> ShowS
$cshowsPrec :: Int -> CssShapeRendering -> ShowS
Show, CssShapeRendering -> CssShapeRendering -> Bool
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. 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)
data CssPreferColorScheme
=
PreferHud
| PreferDark
| PreferLight
| PreferNormal
deriving (Int -> CssPreferColorScheme -> ShowS
[CssPreferColorScheme] -> ShowS
CssPreferColorScheme -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CssPreferColorScheme] -> ShowS
$cshowList :: [CssPreferColorScheme] -> ShowS
show :: CssPreferColorScheme -> String
$cshow :: CssPreferColorScheme -> String
showsPrec :: Int -> CssPreferColorScheme -> ShowS
$cshowsPrec :: Int -> CssPreferColorScheme -> ShowS
Show, CssPreferColorScheme -> CssPreferColorScheme -> Bool
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. 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)
data CssOptions = CssOptions {CssOptions -> CssShapeRendering
shapeRendering :: CssShapeRendering, CssOptions -> CssPreferColorScheme
preferColorScheme :: CssPreferColorScheme, :: Text} deriving (Int -> CssOptions -> ShowS
[CssOptions] -> ShowS
CssOptions -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CssOptions] -> ShowS
$cshowList :: [CssOptions] -> ShowS
show :: CssOptions -> String
$cshow :: CssOptions -> String
showsPrec :: Int -> CssOptions -> ShowS
$cshowsPrec :: Int -> CssOptions -> ShowS
Show, CssOptions -> CssOptions -> Bool
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. 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)
defaultCssOptions :: CssOptions
defaultCssOptions :: CssOptions
defaultCssOptions = CssShapeRendering -> CssPreferColorScheme -> Text -> CssOptions
CssOptions CssShapeRendering
NoShapeRendering CssPreferColorScheme
PreferHud forall a. Monoid a => a
mempty