{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}

-- | Integration of reanimate and chart-svg
module Chart.Reanimate
  ( ReanimateConfig (..),
    defaultReanimateConfig,
    animChartSvg,
    ChartReanimate (..),
    chartReanimate,
    toTreeA,
    tree,
    treeFromFile,
  )
where

import Chart as C hiding (Line, renderChartsWith, transform)
import Codec.Picture.Types
import Control.Lens hiding (transform)
import qualified Data.Attoparsec.Text as A
import Data.Maybe
import Data.Text (Text, unpack)
import GHC.Generics
import Graphics.SvgTree as Svg hiding (Text)
import qualified Graphics.SvgTree.PathParser as Svg
import Linear.V2
import NumHask.Prelude (one)
import Reanimate as Re

-- | global reanimate configuration.
--
-- >>> defaultReanimateConfig
-- ReanimateConfig {duration = 5.0, background = Just "black", globalFontFamily = Just ["Arial","Helvetica","sans-serif"], globalFontStyle = Just FontStyleNormal, globalAlignment = AlignxMinYMin}
data ReanimateConfig = ReanimateConfig
  { ReanimateConfig -> Double
duration :: Double,
    ReanimateConfig -> Maybe Text
background :: Maybe Text,
    ReanimateConfig -> Maybe [Text]
globalFontFamily :: Maybe [Text],
    ReanimateConfig -> Maybe FontStyle
globalFontStyle :: Maybe Svg.FontStyle,
    ReanimateConfig -> Alignment
globalAlignment :: Svg.Alignment
  }
  deriving (ReanimateConfig -> ReanimateConfig -> Bool
(ReanimateConfig -> ReanimateConfig -> Bool)
-> (ReanimateConfig -> ReanimateConfig -> Bool)
-> Eq ReanimateConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReanimateConfig -> ReanimateConfig -> Bool
$c/= :: ReanimateConfig -> ReanimateConfig -> Bool
== :: ReanimateConfig -> ReanimateConfig -> Bool
$c== :: ReanimateConfig -> ReanimateConfig -> Bool
Eq, Int -> ReanimateConfig -> ShowS
[ReanimateConfig] -> ShowS
ReanimateConfig -> String
(Int -> ReanimateConfig -> ShowS)
-> (ReanimateConfig -> String)
-> ([ReanimateConfig] -> ShowS)
-> Show ReanimateConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReanimateConfig] -> ShowS
$cshowList :: [ReanimateConfig] -> ShowS
show :: ReanimateConfig -> String
$cshow :: ReanimateConfig -> String
showsPrec :: Int -> ReanimateConfig -> ShowS
$cshowsPrec :: Int -> ReanimateConfig -> ShowS
Show, (forall x. ReanimateConfig -> Rep ReanimateConfig x)
-> (forall x. Rep ReanimateConfig x -> ReanimateConfig)
-> Generic ReanimateConfig
forall x. Rep ReanimateConfig x -> ReanimateConfig
forall x. ReanimateConfig -> Rep ReanimateConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ReanimateConfig x -> ReanimateConfig
$cfrom :: forall x. ReanimateConfig -> Rep ReanimateConfig x
Generic)

-- |
defaultReanimateConfig :: ReanimateConfig
defaultReanimateConfig :: ReanimateConfig
defaultReanimateConfig = Double
-> Maybe Text
-> Maybe [Text]
-> Maybe FontStyle
-> Alignment
-> ReanimateConfig
ReanimateConfig Double
5 (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"black") ([Text] -> Maybe [Text]
forall a. a -> Maybe a
Just [Text
"Arial", Text
"Helvetica", Text
"sans-serif"]) (FontStyle -> Maybe FontStyle
forall a. a -> Maybe a
Just FontStyle
FontStyleNormal) Alignment
AlignxMinYMin

-- | Animate a ChartSvg animation.
animChartSvg :: ReanimateConfig -> (Double -> ChartSvg) -> Animation
animChartSvg :: ReanimateConfig -> (Double -> ChartSvg) -> Animation
animChartSvg ReanimateConfig
cfg Double -> ChartSvg
cs =
  Double -> (Double -> SVG) -> Animation
mkAnimation (Getting Double ReanimateConfig Double -> ReanimateConfig -> Double
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view IsLabel "duration" (Getting Double ReanimateConfig Double)
Getting Double ReanimateConfig Double
#duration ReanimateConfig
cfg) ((Double -> SVG) -> Animation) -> (Double -> SVG) -> Animation
forall a b. (a -> b) -> a -> b
$ ReanimateConfig -> (Double -> ChartSvg) -> Double -> SVG
toTreeA ReanimateConfig
cfg Double -> ChartSvg
cs

globalAtts :: ReanimateConfig -> Svg.DrawAttributes
globalAtts :: ReanimateConfig -> DrawAttributes
globalAtts ReanimateConfig
cfg =
  DrawAttributes
forall a. Monoid a => a
mempty
    DrawAttributes
-> (DrawAttributes -> DrawAttributes) -> DrawAttributes
forall a b. a -> (a -> b) -> b
& (DrawAttributes -> DrawAttributes)
-> ([Text] -> DrawAttributes -> DrawAttributes)
-> Maybe [Text]
-> DrawAttributes
-> DrawAttributes
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
      DrawAttributes -> DrawAttributes
forall a. a -> a
id
      (\[Text]
x -> (Maybe [String] -> Identity (Maybe [String]))
-> DrawAttributes -> Identity DrawAttributes
forall c. HasDrawAttributes c => Lens' c (Maybe [String])
fontFamily ((Maybe [String] -> Identity (Maybe [String]))
 -> DrawAttributes -> Identity DrawAttributes)
-> Maybe [String] -> DrawAttributes -> DrawAttributes
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [String] -> Maybe [String]
forall a. a -> Maybe a
Just ((Text -> String) -> [Text] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> String
unpack [Text]
x))
      (Getting (Maybe [Text]) ReanimateConfig (Maybe [Text])
-> ReanimateConfig -> Maybe [Text]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view IsLabel
  "globalFontFamily"
  (Getting (Maybe [Text]) ReanimateConfig (Maybe [Text]))
Getting (Maybe [Text]) ReanimateConfig (Maybe [Text])
#globalFontFamily ReanimateConfig
cfg)
      (DrawAttributes -> DrawAttributes)
-> (DrawAttributes -> DrawAttributes)
-> DrawAttributes
-> DrawAttributes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DrawAttributes -> DrawAttributes)
-> (FontStyle -> DrawAttributes -> DrawAttributes)
-> Maybe FontStyle
-> DrawAttributes
-> DrawAttributes
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
        DrawAttributes -> DrawAttributes
forall a. a -> a
id
        (\FontStyle
x -> (Maybe FontStyle -> Identity (Maybe FontStyle))
-> DrawAttributes -> Identity DrawAttributes
forall c. HasDrawAttributes c => Lens' c (Maybe FontStyle)
fontStyle ((Maybe FontStyle -> Identity (Maybe FontStyle))
 -> DrawAttributes -> Identity DrawAttributes)
-> Maybe FontStyle -> DrawAttributes -> DrawAttributes
forall s t a b. ASetter s t a b -> b -> s -> t
.~ FontStyle -> Maybe FontStyle
forall a. a -> Maybe a
Just FontStyle
x)
        (Getting (Maybe FontStyle) ReanimateConfig (Maybe FontStyle)
-> ReanimateConfig -> Maybe FontStyle
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view IsLabel
  "globalFontStyle"
  (Getting (Maybe FontStyle) ReanimateConfig (Maybe FontStyle))
Getting (Maybe FontStyle) ReanimateConfig (Maybe FontStyle)
#globalFontStyle ReanimateConfig
cfg)

-- | The output of the raw translation of ChartSvg to a reanimate svg tree.
data ChartReanimate = ChartReanimate
  { ChartReanimate -> [SVG]
trees :: [Tree],
    ChartReanimate -> Rect Double
box :: Rect Double,
    ChartReanimate -> Point Double
size :: C.Point Double
  }
  deriving (ChartReanimate -> ChartReanimate -> Bool
(ChartReanimate -> ChartReanimate -> Bool)
-> (ChartReanimate -> ChartReanimate -> Bool) -> Eq ChartReanimate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChartReanimate -> ChartReanimate -> Bool
$c/= :: ChartReanimate -> ChartReanimate -> Bool
== :: ChartReanimate -> ChartReanimate -> Bool
$c== :: ChartReanimate -> ChartReanimate -> Bool
Eq, Int -> ChartReanimate -> ShowS
[ChartReanimate] -> ShowS
ChartReanimate -> String
(Int -> ChartReanimate -> ShowS)
-> (ChartReanimate -> String)
-> ([ChartReanimate] -> ShowS)
-> Show ChartReanimate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChartReanimate] -> ShowS
$cshowList :: [ChartReanimate] -> ShowS
show :: ChartReanimate -> String
$cshow :: ChartReanimate -> String
showsPrec :: Int -> ChartReanimate -> ShowS
$cshowsPrec :: Int -> ChartReanimate -> ShowS
Show, (forall x. ChartReanimate -> Rep ChartReanimate x)
-> (forall x. Rep ChartReanimate x -> ChartReanimate)
-> Generic ChartReanimate
forall x. Rep ChartReanimate x -> ChartReanimate
forall x. ChartReanimate -> Rep ChartReanimate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ChartReanimate x -> ChartReanimate
$cfrom :: forall x. ChartReanimate -> Rep ChartReanimate x
Generic)

-- | Render a 'ChartSvg' to 'Tree's, the fitted chart viewbox, and the suggested SVG dimensions
chartReanimate :: ChartSvg -> ChartReanimate
chartReanimate :: ChartSvg -> ChartReanimate
chartReanimate ChartSvg
cs = [SVG] -> Rect Double -> Point Double -> ChartReanimate
ChartReanimate [SVG]
ts Rect Double
rect' Point Double
size'
  where
    ([Chart Double]
cl'', Rect Double
rect', Point Double
size') = SvgOptions
-> [Chart Double] -> ([Chart Double], Rect Double, Point Double)
renderToCRS SvgOptions
so [Chart Double]
cl'
    so :: SvgOptions
so = Getting SvgOptions ChartSvg SvgOptions -> ChartSvg -> SvgOptions
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view IsLabel "svgOptions" (Getting SvgOptions ChartSvg SvgOptions)
Getting SvgOptions ChartSvg SvgOptions
#svgOptions ChartSvg
cs
    cl' :: [Chart Double]
cl' = ChartSvg -> [Chart Double]
renderToCharts ChartSvg
cs
    ts :: [SVG]
ts = Chart Double -> SVG
tree (Chart Double -> SVG) -> [Chart Double] -> [SVG]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Chart Double]
cl''

-- | convert a ChartSvg animation to a Tree animation.
toTreeA :: ReanimateConfig -> (Double -> ChartSvg) -> Double -> Tree
toTreeA :: ReanimateConfig -> (Double -> ChartSvg) -> Double -> SVG
toTreeA ReanimateConfig
cfg Double -> ChartSvg
cs Double
x =
  CssOptions -> SVG -> SVG
reCss (Double -> ChartSvg
cs Double
x ChartSvg -> (ChartSvg -> CssOptions) -> CssOptions
forall a b. a -> (a -> b) -> b
& Getting CssOptions ChartSvg CssOptions -> ChartSvg -> CssOptions
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (IsLabel
  "svgOptions"
  ((SvgOptions -> Const CssOptions SvgOptions)
   -> ChartSvg -> Const CssOptions ChartSvg)
(SvgOptions -> Const CssOptions SvgOptions)
-> ChartSvg -> Const CssOptions ChartSvg
#svgOptions ((SvgOptions -> Const CssOptions SvgOptions)
 -> ChartSvg -> Const CssOptions ChartSvg)
-> ((CssOptions -> Const CssOptions CssOptions)
    -> SvgOptions -> Const CssOptions SvgOptions)
-> Getting CssOptions ChartSvg CssOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IsLabel
  "cssOptions"
  ((CssOptions -> Const CssOptions CssOptions)
   -> SvgOptions -> Const CssOptions SvgOptions)
(CssOptions -> Const CssOptions CssOptions)
-> SvgOptions -> Const CssOptions SvgOptions
#cssOptions)) (SVG -> SVG) -> SVG -> SVG
forall a b. (a -> b) -> a -> b
$
    [SVG] -> SVG
mkGroup ([SVG] -> SVG) -> [SVG] -> SVG
forall a b. (a -> b) -> a -> b
$
      (String -> SVG
mkBackground (String -> SVG) -> (Text -> String) -> Text -> SVG
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
unpack (Text -> SVG) -> [Text] -> [SVG]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text -> [Text]
forall a. Maybe a -> [a]
maybeToList (Getting (Maybe Text) ReanimateConfig (Maybe Text)
-> ReanimateConfig -> Maybe Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view IsLabel
  "background" (Getting (Maybe Text) ReanimateConfig (Maybe Text))
Getting (Maybe Text) ReanimateConfig (Maybe Text)
#background ReanimateConfig
cfg))
        [SVG] -> [SVG] -> [SVG]
forall a. Semigroup a => a -> a -> a
<> [ ( \ChartReanimate
cr ->
                 let (Rect Double
x Double
z Double
y Double
w) =
                       Getting (Rect Double) ChartReanimate (Rect Double)
-> ChartReanimate -> Rect Double
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view IsLabel "box" (Getting (Rect Double) ChartReanimate (Rect Double))
Getting (Rect Double) ChartReanimate (Rect Double)
#box ChartReanimate
cr
                  in (Double, Double, Double, Double)
-> PreserveAspectRatio -> SVG -> SVG
withViewBox'
                       (Double
x, Double
y, Double
z Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
x, Double
w Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
y)
                       (Bool -> Alignment -> Maybe MeetSlice -> PreserveAspectRatio
PreserveAspectRatio Bool
False (Getting Alignment ReanimateConfig Alignment
-> ReanimateConfig -> Alignment
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view IsLabel
  "globalAlignment" (Getting Alignment ReanimateConfig Alignment)
Getting Alignment ReanimateConfig Alignment
#globalAlignment ReanimateConfig
cfg) Maybe MeetSlice
forall a. Maybe a
Nothing)
                       (SVG -> SVG) -> SVG -> SVG
forall a b. (a -> b) -> a -> b
$ SVG -> SVG
flipYAxis (SVG -> SVG) -> SVG -> SVG
forall a b. (a -> b) -> a -> b
$
                         DrawAttributes -> [SVG] -> SVG
groupTrees (ReanimateConfig -> DrawAttributes
globalAtts ReanimateConfig
cfg) ([SVG] -> SVG) -> [SVG] -> SVG
forall a b. (a -> b) -> a -> b
$ Getting [SVG] ChartReanimate [SVG] -> ChartReanimate -> [SVG]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view IsLabel "trees" (Getting [SVG] ChartReanimate [SVG])
Getting [SVG] ChartReanimate [SVG]
#trees ChartReanimate
cr
             )
               (ChartReanimate -> SVG) -> ChartReanimate -> SVG
forall a b. (a -> b) -> a -> b
$ ChartSvg -> ChartReanimate
chartReanimate
                 (Double -> ChartSvg
cs Double
x)
           ]

reCss :: CssOptions -> (Tree -> Tree)
reCss :: CssOptions -> SVG -> SVG
reCss CssOptions
NoCssOptions = SVG -> SVG
forall a. a -> a
id
reCss CssOptions
UseCssCrisp = [CssRule] -> SVG -> SVG
Svg.cssApply (Text -> [CssRule]
Svg.cssRulesOfText Text
"* { shape-rendering: crispEdges; }")
reCss CssOptions
UseGeometricPrecision = [CssRule] -> SVG -> SVG
Svg.cssApply (Text -> [CssRule]
Svg.cssRulesOfText Text
"* { shape-rendering: geometricPrecision; }")

withViewBox' :: (Double, Double, Double, Double) -> Svg.PreserveAspectRatio -> Tree -> Tree
withViewBox' :: (Double, Double, Double, Double)
-> PreserveAspectRatio -> SVG -> SVG
withViewBox' (Double, Double, Double, Double)
vbox PreserveAspectRatio
par SVG
child =
  Double -> Double -> SVG -> SVG
Re.translate (-Double
forall a. Fractional a => a
screenWidth Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2) (-Double
forall a. Fractional a => a
screenHeight Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2) (SVG -> SVG) -> SVG -> SVG
forall a b. (a -> b) -> a -> b
$
    Document -> SVG
svgTree
      Document :: Maybe (Double, Double, Double, Double)
-> Maybe Number
-> Maybe Number
-> [SVG]
-> String
-> String
-> PreserveAspectRatio
-> Document
Document
        { _documentViewBox :: Maybe (Double, Double, Double, Double)
_documentViewBox = (Double, Double, Double, Double)
-> Maybe (Double, Double, Double, Double)
forall a. a -> Maybe a
Just (Double, Double, Double, Double)
vbox,
          _documentWidth :: Maybe Number
_documentWidth = Number -> Maybe Number
forall a. a -> Maybe a
Just (Double -> Number
Num Double
forall a. Fractional a => a
screenWidth),
          _documentHeight :: Maybe Number
_documentHeight = Number -> Maybe Number
forall a. a -> Maybe a
Just (Double -> Number
Num Double
forall a. Fractional a => a
screenHeight),
          _documentElements :: [SVG]
_documentElements = [SVG
child],
          _documentDescription :: String
_documentDescription = String
"",
          _documentLocation :: String
_documentLocation = String
"",
          _documentAspectRatio :: PreserveAspectRatio
_documentAspectRatio = PreserveAspectRatio
par
        }

-- | Rectange svg
treeRect :: Rect Double -> Tree
treeRect :: Rect Double -> SVG
treeRect Rect Double
a =
  Rectangle -> SVG
RectangleTree (Rectangle -> SVG) -> Rectangle -> SVG
forall a b. (a -> b) -> a -> b
$ Rect Double -> Rectangle -> Rectangle
rectSvg Rect Double
a Rectangle
forall a. WithDefaultSvg a => a
defaultSvg

-- | Text svg
treeText :: TextStyle -> Text -> C.Point Double -> Tree
treeText :: TextStyle -> Text -> Point Double -> SVG
treeText TextStyle
s Text
t Point Double
p =
  Maybe TextPath -> Text -> SVG
TextTree Maybe TextPath
forall a. Maybe a
Nothing (Point -> Text -> Text
textAt (Point Double -> Point
pointSvg Point Double
p) Text
t)
    SVG -> (SVG -> SVG) -> SVG
forall a b. a -> (a -> b) -> b
& (SVG -> SVG)
-> (Double -> SVG -> SVG) -> Maybe Double -> SVG -> SVG
forall b a. b -> (a -> b) -> Maybe a -> b
maybe SVG -> SVG
forall a. a -> a
id (\Double
x -> (DrawAttributes -> Identity DrawAttributes) -> SVG -> Identity SVG
forall c. HasDrawAttributes c => Lens' c DrawAttributes
drawAttributes ((DrawAttributes -> Identity DrawAttributes)
 -> SVG -> Identity SVG)
-> (DrawAttributes -> DrawAttributes) -> SVG -> SVG
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Double -> Point Double -> DrawAttributes -> DrawAttributes
forall s. HasDrawAttributes s => Double -> Point Double -> s -> s
rotatePDA 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)

-- | GlyphShape to svg Tree
treeShape :: GlyphShape -> Double -> C.Point Double -> Tree
treeShape :: GlyphShape -> Double -> Point Double -> SVG
treeShape GlyphShape
CircleGlyph Double
s Point Double
p =
  Circle -> SVG
CircleTree (Circle -> SVG) -> Circle -> SVG
forall a b. (a -> b) -> a -> b
$ DrawAttributes -> Point -> Number -> Circle
Circle DrawAttributes
forall a. Monoid a => a
mempty (Point Double -> Point
pointSvg Point Double
p) (Double -> Number
Num (Double
s Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2))
treeShape GlyphShape
SquareGlyph Double
s Point Double
p = Rect Double -> SVG
treeRect (Element (Rect Double) -> Rect Double -> Rect Double
forall s. (Additive (Element s), Space s) => Element s -> s -> s
move Point Double
Element (Rect Double)
p ((Double
s Double -> Double -> Double
forall a. Num a => a -> a -> a
*) (Double -> Double) -> Rect Double -> Rect Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Rect Double
forall a. Multiplicative a => a
one))
treeShape (RectSharpGlyph Double
x') Double
s Point Double
p =
  Rect Double -> SVG
treeRect (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
C.scale (Double -> Double -> Point Double
forall a. a -> a -> Point a
C.Point Double
s (Double
x' Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
s)) Rect Double
forall a. Multiplicative a => a
one))
treeShape (RectRoundedGlyph Double
x'' Double
rx Double
ry) Double
s Point Double
p =
  Rectangle -> SVG
RectangleTree
    (Rectangle -> SVG) -> (Rectangle -> Rectangle) -> Rectangle -> SVG
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rect Double -> Rectangle -> Rectangle
rectSvg (Point Double -> Rect Double -> Rect Double
forall a. Additive a => Point a -> Rect a -> Rect a
addPoint Point Double
p (Rect Double -> Rect Double) -> Rect Double -> Rect Double
forall a b. (a -> b) -> a -> b
$ Element (Rect Double) -> Rect Double -> Rect Double
forall s.
(Multiplicative (Element s), Space s) =>
Element s -> s -> s
C.scale (Double -> Double -> Point Double
forall a. a -> a -> Point a
C.Point Double
s (Double
x'' Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
s)) Rect Double
forall a. Multiplicative a => a
one)
    (Rectangle -> Rectangle)
-> (Rectangle -> Rectangle) -> Rectangle -> Rectangle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((Maybe Number, Maybe Number)
 -> Identity (Maybe Number, Maybe Number))
-> Rectangle -> Identity Rectangle
Lens' Rectangle (Maybe Number, Maybe Number)
rectCornerRadius (((Maybe Number, Maybe Number)
  -> Identity (Maybe Number, Maybe Number))
 -> Rectangle -> Identity Rectangle)
-> (Maybe Number, Maybe Number) -> Rectangle -> Rectangle
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Number -> Maybe Number
forall a. a -> Maybe a
Just (Number -> Maybe Number) -> Number -> Maybe Number
forall a b. (a -> b) -> a -> b
$ Double -> Number
Num Double
rx, Number -> Maybe Number
forall a. a -> Maybe a
Just (Number -> Maybe Number) -> Number -> Maybe Number
forall a b. (a -> b) -> a -> b
$ Double -> Number
Num Double
ry))
    (Rectangle -> SVG) -> Rectangle -> SVG
forall a b. (a -> b) -> a -> b
$ Rectangle
forall a. WithDefaultSvg a => a
defaultSvg
treeShape (TriangleGlyph (C.Point Double
xa Double
ya) (C.Point Double
xb Double
yb) (C.Point Double
xc Double
yc)) Double
s Point Double
p =
  Polygon -> SVG
PolygonTree
    (Polygon -> SVG) -> (Polygon -> Polygon) -> Polygon -> SVG
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([RPoint] -> Identity [RPoint]) -> Polygon -> Identity Polygon
Lens' Polygon [RPoint]
polygonPoints (([RPoint] -> Identity [RPoint]) -> Polygon -> Identity Polygon)
-> [RPoint] -> Polygon -> Polygon
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [RPoint]
rps)
    (Polygon -> SVG) -> Polygon -> SVG
forall a b. (a -> b) -> a -> b
$ ((DrawAttributes -> Identity DrawAttributes)
-> Polygon -> Identity Polygon
forall c. HasDrawAttributes c => Lens' c DrawAttributes
drawAttributes ((DrawAttributes -> Identity DrawAttributes)
 -> Polygon -> Identity Polygon)
-> (DrawAttributes -> DrawAttributes) -> Polygon -> Polygon
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Point Double -> DrawAttributes -> DrawAttributes
forall s. HasDrawAttributes s => Point Double -> s -> s
translateDA Point Double
p) Polygon
forall a. WithDefaultSvg a => a
defaultSvg
  where
    rps :: [RPoint]
rps =
      [ Double -> Double -> RPoint
forall a. a -> a -> V2 a
V2 (Double
s Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
xa) (-Double
s Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
ya),
        Double -> Double -> RPoint
forall a. a -> a -> V2 a
V2 (Double
s Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
xb) (-Double
s Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
yb),
        Double -> Double -> RPoint
forall a. a -> a -> V2 a
V2 (Double
s Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
xc) (-Double
s Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
yc)
      ]
treeShape (EllipseGlyph Double
x') Double
s Point Double
p =
  Ellipse -> SVG
EllipseTree (Ellipse -> SVG) -> Ellipse -> SVG
forall a b. (a -> b) -> a -> b
$
    DrawAttributes -> Point -> Number -> Number -> Ellipse
Ellipse
      DrawAttributes
forall a. Monoid a => a
mempty
      (Point Double -> Point
pointSvg Point Double
p)
      (Double -> Number
Num (Double -> Number) -> Double -> Number
forall a b. (a -> b) -> a -> b
$ Double
s Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2)
      (Double -> Number
Num (Double -> Number) -> Double -> Number
forall a b. (a -> b) -> a -> b
$ (Double
x' Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
s) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2)
treeShape (VLineGlyph Double
x') Double
s (C.Point Double
x Double
y) =
  Line -> SVG
LineTree (Line -> SVG) -> Line -> SVG
forall a b. (a -> b) -> a -> b
$
    DrawAttributes -> Point -> Point -> Line
Line
      (DrawAttributes
forall a. Monoid a => a
mempty DrawAttributes
-> (DrawAttributes -> DrawAttributes) -> DrawAttributes
forall a b. a -> (a -> b) -> b
& (Maybe Number -> Identity (Maybe Number))
-> DrawAttributes -> Identity DrawAttributes
forall c. HasDrawAttributes c => Lens' c (Maybe Number)
strokeWidth ((Maybe Number -> Identity (Maybe Number))
 -> DrawAttributes -> Identity DrawAttributes)
-> Maybe Number -> DrawAttributes -> DrawAttributes
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Number -> Maybe Number
forall a. a -> Maybe a
Just (Double -> Number
Num Double
x'))
      (Point Double -> Point
pointSvg (Double -> Double -> Point Double
forall a. a -> a -> Point a
C.Point Double
x (Double
y Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
s Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2)))
      (Point Double -> Point
pointSvg (Double -> Double -> Point Double
forall a. a -> a -> Point a
C.Point Double
x (Double
y Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
s Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2)))
treeShape (HLineGlyph Double
x') Double
s (C.Point Double
x Double
y) =
  Line -> SVG
LineTree (Line -> SVG) -> Line -> SVG
forall a b. (a -> b) -> a -> b
$
    DrawAttributes -> Point -> Point -> Line
Line
      (DrawAttributes
forall a. Monoid a => a
mempty DrawAttributes
-> (DrawAttributes -> DrawAttributes) -> DrawAttributes
forall a b. a -> (a -> b) -> b
& (Maybe Number -> Identity (Maybe Number))
-> DrawAttributes -> Identity DrawAttributes
forall c. HasDrawAttributes c => Lens' c (Maybe Number)
strokeWidth ((Maybe Number -> Identity (Maybe Number))
 -> DrawAttributes -> Identity DrawAttributes)
-> Maybe Number -> DrawAttributes -> DrawAttributes
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Number -> Maybe Number
forall a. a -> Maybe a
Just (Double -> Number
Num Double
x'))
      (Point Double -> Point
pointSvg (Double -> Double -> Point Double
forall a. a -> a -> Point a
C.Point (Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
s Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2) Double
y))
      (Point Double -> Point
pointSvg (Double -> Double -> Point Double
forall a. a -> a -> Point a
C.Point (Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
s Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2) Double
y))
treeShape (PathGlyph Text
path) Double
s Point Double
p =
  Path -> SVG
Svg.PathTree
    ( DrawAttributes -> [PathCommand] -> Path
Svg.Path
        ( DrawAttributes
forall a. WithDefaultSvg a => a
Svg.defaultSvg
            DrawAttributes
-> (DrawAttributes -> DrawAttributes) -> DrawAttributes
forall a b. a -> (a -> b) -> b
& ((DrawAttributes -> Identity DrawAttributes)
-> DrawAttributes -> Identity DrawAttributes
forall c. HasDrawAttributes c => Lens' c DrawAttributes
Svg.drawAttributes ((DrawAttributes -> Identity DrawAttributes)
 -> DrawAttributes -> Identity DrawAttributes)
-> (DrawAttributes -> DrawAttributes)
-> DrawAttributes
-> DrawAttributes
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Point Double -> DrawAttributes -> DrawAttributes
forall s. HasDrawAttributes s => Point Double -> s -> s
scaleDA (Double -> Double -> Point Double
forall a. a -> a -> Point a
C.Point Double
s Double
s) (DrawAttributes -> DrawAttributes)
-> (DrawAttributes -> DrawAttributes)
-> DrawAttributes
-> DrawAttributes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point Double -> DrawAttributes -> DrawAttributes
forall s. HasDrawAttributes s => Point Double -> s -> s
translateDA Point Double
p)
        )
        ((String -> [PathCommand])
-> ([PathCommand] -> [PathCommand])
-> Either String [PathCommand]
-> [PathCommand]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> [PathCommand]
forall a. Monoid a => a
mempty [PathCommand] -> [PathCommand]
forall a. a -> a
id (Either String [PathCommand] -> [PathCommand])
-> Either String [PathCommand] -> [PathCommand]
forall a b. (a -> b) -> a -> b
$ Parser [PathCommand] -> Text -> Either String [PathCommand]
forall a. Parser a -> Text -> Either String a
A.parseOnly Parser [PathCommand]
Svg.pathParser Text
path)
    )

-- | GlyphStyle to svg Tree
treeGlyph :: GlyphStyle -> C.Point Double -> Tree
treeGlyph :: GlyphStyle -> Point Double -> SVG
treeGlyph GlyphStyle
s Point Double
p =
  GlyphShape -> Double -> Point Double -> SVG
treeShape (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
    SVG -> (SVG -> SVG) -> SVG
forall a b. a -> (a -> b) -> b
& (SVG -> SVG)
-> (Double -> SVG -> SVG) -> Maybe Double -> SVG -> SVG
forall b a. b -> (a -> b) -> Maybe a -> b
maybe SVG -> SVG
forall a. a -> a
id (\Double
x -> (DrawAttributes -> Identity DrawAttributes) -> SVG -> Identity SVG
forall c. HasDrawAttributes c => Lens' c DrawAttributes
drawAttributes ((DrawAttributes -> Identity DrawAttributes)
 -> SVG -> Identity SVG)
-> (DrawAttributes -> DrawAttributes) -> SVG -> SVG
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Double -> Point Double -> DrawAttributes -> DrawAttributes
forall s. HasDrawAttributes s => Double -> Point Double -> s -> s
rotatePDA Double
x 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)

-- | line svg
treeLine :: [C.Point Double] -> Tree
treeLine :: [Point Double] -> SVG
treeLine [Point Double]
xs =
  PolyLine -> SVG
PolyLineTree
    (PolyLine -> SVG) -> (PolyLine -> PolyLine) -> PolyLine -> SVG
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([RPoint] -> Identity [RPoint]) -> PolyLine -> Identity PolyLine
Lens' PolyLine [RPoint]
polyLinePoints (([RPoint] -> Identity [RPoint]) -> PolyLine -> Identity PolyLine)
-> [RPoint] -> PolyLine -> PolyLine
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ((\(C.Point Double
x Double
y) -> Double -> Double -> RPoint
forall a. a -> a -> V2 a
V2 Double
x (-Double
y)) (Point Double -> RPoint) -> [Point Double] -> [RPoint]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Point Double]
xs))
    (PolyLine -> SVG) -> PolyLine -> SVG
forall a b. (a -> b) -> a -> b
$ PolyLine
forall a. WithDefaultSvg a => a
defaultSvg

-- | GlyphStyle to svg Tree
treePath :: [PathInfo Double] -> [C.Point Double] -> Tree
treePath :: [PathInfo Double] -> [Point Double] -> SVG
treePath [PathInfo Double]
s [Point Double]
p =
  Path -> SVG
PathTree (Path -> SVG) -> Path -> SVG
forall a b. (a -> b) -> a -> b
$
    DrawAttributes -> [PathCommand] -> Path
Path
      DrawAttributes
forall a. Monoid a => a
mempty
      ( (PathInfo Double -> Point Double -> PathCommand)
-> [PathInfo Double] -> [Point Double] -> [PathCommand]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith
          (((PathInfo Double, Point Double) -> PathCommand)
-> PathInfo Double -> Point Double -> PathCommand
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (PathInfo Double, Point Double) -> PathCommand
toPathCommand)
          [PathInfo Double]
s
          ((Point Double -> Point Double) -> [Point Double] -> [Point Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(C.Point Double
x Double
y) -> Double -> Double -> Point Double
forall a. a -> a -> Point a
C.Point Double
x (-Double
y)) [Point Double]
p)
      )

-- | convert a 'Chart' to a 'Tree'
tree :: Chart Double -> Tree
tree :: Chart Double -> SVG
tree (Chart (TextA TextStyle
s [Text]
ts) [XY Double]
xs) =
  DrawAttributes -> [SVG] -> SVG
groupTrees (TextStyle -> DrawAttributes
daText TextStyle
s) ((Text -> Point Double -> SVG) -> [Text] -> [Point Double] -> [SVG]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (TextStyle -> Text -> Point Double -> SVG
treeText TextStyle
s) [Text]
ts (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))
tree (Chart (GlyphA GlyphStyle
s) [XY Double]
xs) =
  DrawAttributes -> [SVG] -> SVG
groupTrees (GlyphStyle -> DrawAttributes
daGlyph GlyphStyle
s) (GlyphStyle -> Point Double -> SVG
treeGlyph GlyphStyle
s (Point Double -> SVG)
-> (XY Double -> Point Double) -> XY Double -> SVG
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XY Double -> Point Double
forall a. (Ord a, Field a) => XY a -> Point a
toPoint (XY Double -> SVG) -> [XY Double] -> [SVG]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [XY Double]
xs)
tree (Chart (LineA LineStyle
s) [XY Double]
xs) =
  DrawAttributes -> [SVG] -> SVG
groupTrees (LineStyle -> DrawAttributes
daLine LineStyle
s) [[Point Double] -> SVG
treeLine (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)]
tree (Chart (RectA RectStyle
s) [XY Double]
xs) =
  DrawAttributes -> [SVG] -> SVG
groupTrees (RectStyle -> DrawAttributes
daRect RectStyle
s) (Rect Double -> SVG
treeRect (Rect Double -> SVG) -> [Rect Double] -> [SVG]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XY Double -> Rect Double
forall a. XY a -> Rect a
toRect (XY Double -> Rect Double) -> [XY Double] -> [Rect Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [XY Double]
xs))
tree (Chart (PathA PathStyle
s [PathInfo Double]
pis) [XY Double]
xs) =
  DrawAttributes -> [SVG] -> SVG
groupTrees (PathStyle -> DrawAttributes
daPath PathStyle
s) [[PathInfo Double] -> [Point Double] -> SVG
treePath [PathInfo Double]
pis (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)]
tree (Chart Annotation
BlankA [XY Double]
_) =
  DrawAttributes -> [SVG] -> SVG
groupTrees DrawAttributes
forall a. Monoid a => a
mempty []

-- | add drawing attributes as a group svg wrapping a [Tree]
groupTrees :: DrawAttributes -> [Tree] -> Tree
groupTrees :: DrawAttributes -> [SVG] -> SVG
groupTrees DrawAttributes
da' [SVG]
tree' =
  Group -> SVG
GroupTree ((DrawAttributes -> Identity DrawAttributes)
-> Group -> Identity Group
forall c. HasDrawAttributes c => Lens' c DrawAttributes
drawAttributes ((DrawAttributes -> Identity DrawAttributes)
 -> Group -> Identity Group)
-> (DrawAttributes -> DrawAttributes) -> Group -> Group
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (DrawAttributes -> DrawAttributes -> DrawAttributes
forall a. Semigroup a => a -> a -> a
<> DrawAttributes
da') (Group -> Group) -> Group -> Group
forall a b. (a -> b) -> a -> b
$ ([SVG] -> Identity [SVG]) -> Group -> Identity Group
Lens' Group [SVG]
groupChildren (([SVG] -> Identity [SVG]) -> Group -> Identity Group)
-> [SVG] -> Group -> Group
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [SVG]
tree' (Group -> Group) -> Group -> Group
forall a b. (a -> b) -> a -> b
$ Group
forall a. WithDefaultSvg a => a
defaultSvg)

-- * DrawAttribute computations

daRect :: RectStyle -> DrawAttributes
daRect :: RectStyle -> DrawAttributes
daRect RectStyle
o =
  DrawAttributes
forall a. Monoid a => a
mempty
    DrawAttributes
-> (DrawAttributes -> DrawAttributes) -> DrawAttributes
forall a b. a -> (a -> b) -> b
& ((Maybe Number -> Identity (Maybe Number))
-> DrawAttributes -> Identity DrawAttributes
forall c. HasDrawAttributes c => Lens' c (Maybe Number)
strokeWidth ((Maybe Number -> Identity (Maybe Number))
 -> DrawAttributes -> Identity DrawAttributes)
-> Maybe Number -> DrawAttributes -> DrawAttributes
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Number -> Maybe Number
forall a. a -> Maybe a
Just (Double -> Number
Num (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)))
    DrawAttributes
-> (DrawAttributes -> DrawAttributes) -> DrawAttributes
forall a b. a -> (a -> b) -> b
& ((Maybe Texture -> Identity (Maybe Texture))
-> DrawAttributes -> Identity DrawAttributes
forall c. HasDrawAttributes c => Lens' c (Maybe Texture)
strokeColor ((Maybe Texture -> Identity (Maybe Texture))
 -> DrawAttributes -> Identity DrawAttributes)
-> Maybe Texture -> DrawAttributes -> DrawAttributes
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Texture -> Maybe Texture
forall a. a -> Maybe a
Just (PixelRGBA8 -> Texture
ColorRef (Colour -> PixelRGBA8
toPixelRGBA8 (Colour -> PixelRGBA8) -> Colour -> PixelRGBA8
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)))
    DrawAttributes
-> (DrawAttributes -> DrawAttributes) -> DrawAttributes
forall a b. a -> (a -> b) -> b
& ((Maybe Float -> Identity (Maybe Float))
-> DrawAttributes -> Identity DrawAttributes
forall c. HasDrawAttributes c => Lens' c (Maybe Float)
strokeOpacity ((Maybe Float -> Identity (Maybe Float))
 -> DrawAttributes -> Identity DrawAttributes)
-> Float -> DrawAttributes -> DrawAttributes
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Double -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac (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))
    DrawAttributes
-> (DrawAttributes -> DrawAttributes) -> DrawAttributes
forall a b. a -> (a -> b) -> b
& ((Maybe Texture -> Identity (Maybe Texture))
-> DrawAttributes -> Identity DrawAttributes
forall c. HasDrawAttributes c => Lens' c (Maybe Texture)
fillColor ((Maybe Texture -> Identity (Maybe Texture))
 -> DrawAttributes -> Identity DrawAttributes)
-> Maybe Texture -> DrawAttributes -> DrawAttributes
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Texture -> Maybe Texture
forall a. a -> Maybe a
Just (PixelRGBA8 -> Texture
ColorRef (Colour -> PixelRGBA8
toPixelRGBA8 (Colour -> PixelRGBA8) -> Colour -> PixelRGBA8
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)))
    DrawAttributes
-> (DrawAttributes -> DrawAttributes) -> DrawAttributes
forall a b. a -> (a -> b) -> b
& ((Maybe Float -> Identity (Maybe Float))
-> DrawAttributes -> Identity DrawAttributes
forall c. HasDrawAttributes c => Lens' c (Maybe Float)
fillOpacity ((Maybe Float -> Identity (Maybe Float))
 -> DrawAttributes -> Identity DrawAttributes)
-> Float -> DrawAttributes -> DrawAttributes
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Double -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac (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))

daText :: () => TextStyle -> DrawAttributes
daText :: TextStyle -> DrawAttributes
daText TextStyle
o =
  DrawAttributes
forall a. Monoid a => a
mempty
    DrawAttributes
-> (DrawAttributes -> DrawAttributes) -> DrawAttributes
forall a b. a -> (a -> b) -> b
& ((Maybe Number -> Identity (Maybe Number))
-> DrawAttributes -> Identity DrawAttributes
forall c. HasDrawAttributes c => Lens' c (Maybe Number)
fontSize ((Maybe Number -> Identity (Maybe Number))
 -> DrawAttributes -> Identity DrawAttributes)
-> Maybe Number -> DrawAttributes -> DrawAttributes
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Number -> Maybe Number
forall a. a -> Maybe a
Just (Double -> Number
Num (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)))
    DrawAttributes
-> (DrawAttributes -> DrawAttributes) -> DrawAttributes
forall a b. a -> (a -> b) -> b
& ((Maybe Number -> Identity (Maybe Number))
-> DrawAttributes -> Identity DrawAttributes
forall c. HasDrawAttributes c => Lens' c (Maybe Number)
strokeWidth ((Maybe Number -> Identity (Maybe Number))
 -> DrawAttributes -> Identity DrawAttributes)
-> Maybe Number -> DrawAttributes -> DrawAttributes
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Number -> Maybe Number
forall a. a -> Maybe a
Just (Double -> Number
Num Double
0))
    DrawAttributes
-> (DrawAttributes -> DrawAttributes) -> DrawAttributes
forall a b. a -> (a -> b) -> b
& ((Maybe Texture -> Identity (Maybe Texture))
-> DrawAttributes -> Identity DrawAttributes
forall c. HasDrawAttributes c => Lens' c (Maybe Texture)
strokeColor ((Maybe Texture -> Identity (Maybe Texture))
 -> DrawAttributes -> Identity DrawAttributes)
-> Maybe Texture -> DrawAttributes -> DrawAttributes
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Texture -> Maybe Texture
forall a. a -> Maybe a
Just Texture
FillNone)
    DrawAttributes
-> (DrawAttributes -> DrawAttributes) -> DrawAttributes
forall a b. a -> (a -> b) -> b
& ((Maybe Texture -> Identity (Maybe Texture))
-> DrawAttributes -> Identity DrawAttributes
forall c. HasDrawAttributes c => Lens' c (Maybe Texture)
fillColor ((Maybe Texture -> Identity (Maybe Texture))
 -> DrawAttributes -> Identity DrawAttributes)
-> Maybe Texture -> DrawAttributes -> DrawAttributes
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Texture -> Maybe Texture
forall a. a -> Maybe a
Just (PixelRGBA8 -> Texture
ColorRef (Colour -> PixelRGBA8
toPixelRGBA8 (Colour -> PixelRGBA8) -> Colour -> PixelRGBA8
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)))
    DrawAttributes
-> (DrawAttributes -> DrawAttributes) -> DrawAttributes
forall a b. a -> (a -> b) -> b
& ((Maybe Float -> Identity (Maybe Float))
-> DrawAttributes -> Identity DrawAttributes
forall c. HasDrawAttributes c => Lens' c (Maybe Float)
fillOpacity ((Maybe Float -> Identity (Maybe Float))
 -> DrawAttributes -> Identity DrawAttributes)
-> Float -> DrawAttributes -> DrawAttributes
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Double -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac (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))
    DrawAttributes
-> (DrawAttributes -> DrawAttributes) -> DrawAttributes
forall a b. a -> (a -> b) -> b
& ((Maybe TextAnchor -> Identity (Maybe TextAnchor))
-> DrawAttributes -> Identity DrawAttributes
forall c. HasDrawAttributes c => Lens' c (Maybe TextAnchor)
textAnchor ((Maybe TextAnchor -> Identity (Maybe TextAnchor))
 -> DrawAttributes -> Identity DrawAttributes)
-> Maybe TextAnchor -> DrawAttributes -> DrawAttributes
forall s t a b. ASetter s t a b -> b -> s -> t
.~ TextAnchor -> Maybe TextAnchor
forall a. a -> Maybe a
Just (Anchor -> TextAnchor
toTextAnchor (Anchor -> TextAnchor) -> Anchor -> TextAnchor
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))
  where
    toTextAnchor :: Anchor -> Svg.TextAnchor
    toTextAnchor :: Anchor -> TextAnchor
toTextAnchor Anchor
AnchorMiddle = TextAnchor
TextAnchorMiddle
    toTextAnchor Anchor
AnchorStart = TextAnchor
TextAnchorStart
    toTextAnchor Anchor
AnchorEnd = TextAnchor
TextAnchorEnd

daGlyph :: GlyphStyle -> DrawAttributes
daGlyph :: GlyphStyle -> DrawAttributes
daGlyph GlyphStyle
o =
  DrawAttributes
forall a. Monoid a => a
mempty
    DrawAttributes
-> (DrawAttributes -> DrawAttributes) -> DrawAttributes
forall a b. a -> (a -> b) -> b
& ((Maybe Number -> Identity (Maybe Number))
-> DrawAttributes -> Identity DrawAttributes
forall c. HasDrawAttributes c => Lens' c (Maybe Number)
strokeWidth ((Maybe Number -> Identity (Maybe Number))
 -> DrawAttributes -> Identity DrawAttributes)
-> Maybe Number -> DrawAttributes -> DrawAttributes
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Number -> Maybe Number
forall a. a -> Maybe a
Just (Double -> Number
Num (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)))
    DrawAttributes
-> (DrawAttributes -> DrawAttributes) -> DrawAttributes
forall a b. a -> (a -> b) -> b
& ( (Maybe Texture -> Identity (Maybe Texture))
-> DrawAttributes -> Identity DrawAttributes
forall c. HasDrawAttributes c => Lens' c (Maybe Texture)
strokeColor
          ((Maybe Texture -> Identity (Maybe Texture))
 -> DrawAttributes -> Identity DrawAttributes)
-> Maybe Texture -> DrawAttributes -> DrawAttributes
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Texture -> Maybe Texture
forall a. a -> Maybe a
Just (PixelRGBA8 -> Texture
ColorRef (Colour -> PixelRGBA8
toPixelRGBA8 (Colour -> PixelRGBA8) -> Colour -> PixelRGBA8
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))
      )
    DrawAttributes
-> (DrawAttributes -> DrawAttributes) -> DrawAttributes
forall a b. a -> (a -> b) -> b
& ((Maybe Float -> Identity (Maybe Float))
-> DrawAttributes -> Identity DrawAttributes
forall c. HasDrawAttributes c => Lens' c (Maybe Float)
strokeOpacity ((Maybe Float -> Identity (Maybe Float))
 -> DrawAttributes -> Identity DrawAttributes)
-> Float -> DrawAttributes -> DrawAttributes
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Double -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac (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))
    DrawAttributes
-> (DrawAttributes -> DrawAttributes) -> DrawAttributes
forall a b. a -> (a -> b) -> b
& ((Maybe Texture -> Identity (Maybe Texture))
-> DrawAttributes -> Identity DrawAttributes
forall c. HasDrawAttributes c => Lens' c (Maybe Texture)
fillColor ((Maybe Texture -> Identity (Maybe Texture))
 -> DrawAttributes -> Identity DrawAttributes)
-> Maybe Texture -> DrawAttributes -> DrawAttributes
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Texture -> Maybe Texture
forall a. a -> Maybe a
Just (PixelRGBA8 -> Texture
ColorRef (Colour -> PixelRGBA8
toPixelRGBA8 (Colour -> PixelRGBA8) -> Colour -> PixelRGBA8
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)))
    DrawAttributes
-> (DrawAttributes -> DrawAttributes) -> DrawAttributes
forall a b. a -> (a -> b) -> b
& ((Maybe Float -> Identity (Maybe Float))
-> DrawAttributes -> Identity DrawAttributes
forall c. HasDrawAttributes c => Lens' c (Maybe Float)
fillOpacity ((Maybe Float -> Identity (Maybe Float))
 -> DrawAttributes -> Identity DrawAttributes)
-> Float -> DrawAttributes -> DrawAttributes
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Double -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac (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))
    DrawAttributes
-> (DrawAttributes -> DrawAttributes) -> DrawAttributes
forall a b. a -> (a -> b) -> b
& (DrawAttributes -> DrawAttributes)
-> (Point Double -> DrawAttributes -> DrawAttributes)
-> Maybe (Point Double)
-> DrawAttributes
-> DrawAttributes
forall b a. b -> (a -> b) -> Maybe a -> b
maybe DrawAttributes -> DrawAttributes
forall a. a -> a
id (\(C.Point Double
x Double
y) -> (Maybe [Transformation] -> Identity (Maybe [Transformation]))
-> DrawAttributes -> Identity DrawAttributes
forall c. HasDrawAttributes c => Lens' c (Maybe [Transformation])
transform ((Maybe [Transformation] -> Identity (Maybe [Transformation]))
 -> DrawAttributes -> Identity DrawAttributes)
-> [Transformation] -> DrawAttributes -> DrawAttributes
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ [Double -> Double -> Transformation
Translate Double
x (-Double
y)]) (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)

daLine :: LineStyle -> DrawAttributes
daLine :: LineStyle -> DrawAttributes
daLine LineStyle
o =
  DrawAttributes
forall a. Monoid a => a
mempty
    DrawAttributes
-> (DrawAttributes -> DrawAttributes) -> DrawAttributes
forall a b. a -> (a -> b) -> b
& ((Maybe Number -> Identity (Maybe Number))
-> DrawAttributes -> Identity DrawAttributes
forall c. HasDrawAttributes c => Lens' c (Maybe Number)
strokeWidth ((Maybe Number -> Identity (Maybe Number))
 -> DrawAttributes -> Identity DrawAttributes)
-> Maybe Number -> DrawAttributes -> DrawAttributes
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Number -> Maybe Number
forall a. a -> Maybe a
Just (Double -> Number
Num (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)))
    DrawAttributes
-> (DrawAttributes -> DrawAttributes) -> DrawAttributes
forall a b. a -> (a -> b) -> b
& ((Maybe Texture -> Identity (Maybe Texture))
-> DrawAttributes -> Identity DrawAttributes
forall c. HasDrawAttributes c => Lens' c (Maybe Texture)
strokeColor ((Maybe Texture -> Identity (Maybe Texture))
 -> DrawAttributes -> Identity DrawAttributes)
-> Maybe Texture -> DrawAttributes -> DrawAttributes
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Texture -> Maybe Texture
forall a. a -> Maybe a
Just (PixelRGBA8 -> Texture
ColorRef (Colour -> PixelRGBA8
toPixelRGBA8 (Colour -> PixelRGBA8) -> Colour -> PixelRGBA8
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)))
    DrawAttributes
-> (DrawAttributes -> DrawAttributes) -> DrawAttributes
forall a b. a -> (a -> b) -> b
& ((Maybe Float -> Identity (Maybe Float))
-> DrawAttributes -> Identity DrawAttributes
forall c. HasDrawAttributes c => Lens' c (Maybe Float)
strokeOpacity ((Maybe Float -> Identity (Maybe Float))
 -> DrawAttributes -> Identity DrawAttributes)
-> Float -> DrawAttributes -> DrawAttributes
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Double -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac (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))
    DrawAttributes
-> (DrawAttributes -> DrawAttributes) -> DrawAttributes
forall a b. a -> (a -> b) -> b
& ((Maybe Texture -> Identity (Maybe Texture))
-> DrawAttributes -> Identity DrawAttributes
forall c. HasDrawAttributes c => Lens' c (Maybe Texture)
fillColor ((Maybe Texture -> Identity (Maybe Texture))
 -> DrawAttributes -> Identity DrawAttributes)
-> Maybe Texture -> DrawAttributes -> DrawAttributes
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Texture -> Maybe Texture
forall a. a -> Maybe a
Just Texture
FillNone)
    DrawAttributes
-> (DrawAttributes -> DrawAttributes) -> DrawAttributes
forall a b. a -> (a -> b) -> b
& (DrawAttributes -> DrawAttributes)
-> (LineCap -> DrawAttributes -> DrawAttributes)
-> Maybe LineCap
-> DrawAttributes
-> DrawAttributes
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
      DrawAttributes -> DrawAttributes
forall a. a -> a
id
      (\LineCap
x -> (Maybe Cap -> Identity (Maybe Cap))
-> DrawAttributes -> Identity DrawAttributes
forall c. HasDrawAttributes c => Lens' c (Maybe Cap)
strokeLineCap ((Maybe Cap -> Identity (Maybe Cap))
 -> DrawAttributes -> Identity DrawAttributes)
-> Maybe Cap -> DrawAttributes -> DrawAttributes
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Cap -> Maybe Cap
forall a. a -> Maybe a
Just (LineCap -> Cap
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)
    DrawAttributes
-> (DrawAttributes -> DrawAttributes) -> DrawAttributes
forall a b. a -> (a -> b) -> b
& (DrawAttributes -> DrawAttributes)
-> (LineJoin -> DrawAttributes -> DrawAttributes)
-> Maybe LineJoin
-> DrawAttributes
-> DrawAttributes
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
      DrawAttributes -> DrawAttributes
forall a. a -> a
id
      (\LineJoin
x -> (Maybe LineJoin -> Identity (Maybe LineJoin))
-> DrawAttributes -> Identity DrawAttributes
forall c. HasDrawAttributes c => Lens' c (Maybe LineJoin)
strokeLineJoin ((Maybe LineJoin -> Identity (Maybe LineJoin))
 -> DrawAttributes -> Identity DrawAttributes)
-> Maybe LineJoin -> DrawAttributes -> DrawAttributes
forall s t a b. ASetter s t a b -> b -> s -> t
.~ LineJoin -> Maybe LineJoin
forall a. a -> Maybe a
Just (LineJoin -> LineJoin
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)
    DrawAttributes
-> (DrawAttributes -> DrawAttributes) -> DrawAttributes
forall a b. a -> (a -> b) -> b
& (DrawAttributes -> DrawAttributes)
-> (Double -> DrawAttributes -> DrawAttributes)
-> Maybe Double
-> DrawAttributes
-> DrawAttributes
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
      DrawAttributes -> DrawAttributes
forall a. a -> a
id
      (\Double
x -> (Maybe Number -> Identity (Maybe Number))
-> DrawAttributes -> Identity DrawAttributes
forall c. HasDrawAttributes c => Lens' c (Maybe Number)
strokeOffset ((Maybe Number -> Identity (Maybe Number))
 -> DrawAttributes -> Identity DrawAttributes)
-> Maybe Number -> DrawAttributes -> DrawAttributes
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Number -> Maybe Number
forall a. a -> Maybe a
Just (Double -> Number
Num 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)
    DrawAttributes
-> (DrawAttributes -> DrawAttributes) -> DrawAttributes
forall a b. a -> (a -> b) -> b
& (DrawAttributes -> DrawAttributes)
-> ([Double] -> DrawAttributes -> DrawAttributes)
-> Maybe [Double]
-> DrawAttributes
-> DrawAttributes
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
      DrawAttributes -> DrawAttributes
forall a. a -> a
id
      (\[Double]
xs -> (Maybe [Number] -> Identity (Maybe [Number]))
-> DrawAttributes -> Identity DrawAttributes
forall c. HasDrawAttributes c => Lens' c (Maybe [Number])
strokeDashArray ((Maybe [Number] -> Identity (Maybe [Number]))
 -> DrawAttributes -> Identity DrawAttributes)
-> Maybe [Number] -> DrawAttributes -> DrawAttributes
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Number] -> Maybe [Number]
forall a. a -> Maybe a
Just (Double -> Number
Num (Double -> Number) -> [Double] -> [Number]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Double]
xs))
      (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)

fromLineCap' :: LineCap -> Svg.Cap
fromLineCap' :: LineCap -> Cap
fromLineCap' LineCap
LineCapButt = Cap
CapButt
fromLineCap' LineCap
LineCapRound = Cap
CapRound
fromLineCap' LineCap
LineCapSquare = Cap
CapSquare

fromLineJoin' :: C.LineJoin -> Svg.LineJoin
fromLineJoin' :: LineJoin -> LineJoin
fromLineJoin' LineJoin
LineJoinMiter = LineJoin
JoinMiter
fromLineJoin' LineJoin
LineJoinBevel = LineJoin
JoinBevel
fromLineJoin' LineJoin
LineJoinRound = LineJoin
JoinRound

daPath :: PathStyle -> DrawAttributes
daPath :: PathStyle -> DrawAttributes
daPath PathStyle
o =
  DrawAttributes
forall a. Monoid a => a
mempty
    DrawAttributes
-> (DrawAttributes -> DrawAttributes) -> DrawAttributes
forall a b. a -> (a -> b) -> b
& ((Maybe Number -> Identity (Maybe Number))
-> DrawAttributes -> Identity DrawAttributes
forall c. HasDrawAttributes c => Lens' c (Maybe Number)
strokeWidth ((Maybe Number -> Identity (Maybe Number))
 -> DrawAttributes -> Identity DrawAttributes)
-> Maybe Number -> DrawAttributes -> DrawAttributes
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Number -> Maybe Number
forall a. a -> Maybe a
Just (Double -> Number
Num (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)))
    DrawAttributes
-> (DrawAttributes -> DrawAttributes) -> DrawAttributes
forall a b. a -> (a -> b) -> b
& ( (Maybe Texture -> Identity (Maybe Texture))
-> DrawAttributes -> Identity DrawAttributes
forall c. HasDrawAttributes c => Lens' c (Maybe Texture)
strokeColor
          ((Maybe Texture -> Identity (Maybe Texture))
 -> DrawAttributes -> Identity DrawAttributes)
-> Maybe Texture -> DrawAttributes -> DrawAttributes
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Texture -> Maybe Texture
forall a. a -> Maybe a
Just (PixelRGBA8 -> Texture
ColorRef (Colour -> PixelRGBA8
toPixelRGBA8 (Colour -> PixelRGBA8) -> Colour -> PixelRGBA8
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))
      )
    DrawAttributes
-> (DrawAttributes -> DrawAttributes) -> DrawAttributes
forall a b. a -> (a -> b) -> b
& ((Maybe Float -> Identity (Maybe Float))
-> DrawAttributes -> Identity DrawAttributes
forall c. HasDrawAttributes c => Lens' c (Maybe Float)
strokeOpacity ((Maybe Float -> Identity (Maybe Float))
 -> DrawAttributes -> Identity DrawAttributes)
-> Float -> DrawAttributes -> DrawAttributes
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Double -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac (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))
    DrawAttributes
-> (DrawAttributes -> DrawAttributes) -> DrawAttributes
forall a b. a -> (a -> b) -> b
& ((Maybe Texture -> Identity (Maybe Texture))
-> DrawAttributes -> Identity DrawAttributes
forall c. HasDrawAttributes c => Lens' c (Maybe Texture)
fillColor ((Maybe Texture -> Identity (Maybe Texture))
 -> DrawAttributes -> Identity DrawAttributes)
-> Maybe Texture -> DrawAttributes -> DrawAttributes
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Texture -> Maybe Texture
forall a. a -> Maybe a
Just (PixelRGBA8 -> Texture
ColorRef (Colour -> PixelRGBA8
toPixelRGBA8 (Colour -> PixelRGBA8) -> Colour -> PixelRGBA8
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)))
    DrawAttributes
-> (DrawAttributes -> DrawAttributes) -> DrawAttributes
forall a b. a -> (a -> b) -> b
& ((Maybe Float -> Identity (Maybe Float))
-> DrawAttributes -> Identity DrawAttributes
forall c. HasDrawAttributes c => Lens' c (Maybe Float)
fillOpacity ((Maybe Float -> Identity (Maybe Float))
 -> DrawAttributes -> Identity DrawAttributes)
-> Float -> DrawAttributes -> DrawAttributes
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Double -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac (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))

-- * svg primitives

-- | Convert to reanimate color primitive.
toPixelRGBA8 :: Colour -> PixelRGBA8
toPixelRGBA8 :: Colour -> PixelRGBA8
toPixelRGBA8 (Colour Double
r Double
g Double
b Double
o) =
  Pixel8 -> Pixel8 -> Pixel8 -> Pixel8 -> PixelRGBA8
PixelRGBA8
    (Int -> Pixel8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double -> Int) -> Double -> Int
forall a b. (a -> b) -> a -> b
$ Double
r Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
256 :: Int))
    (Int -> Pixel8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double -> Int) -> Double -> Int
forall a b. (a -> b) -> a -> b
$ Double
g Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
256 :: Int))
    (Int -> Pixel8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double -> Int) -> Double -> Int
forall a b. (a -> b) -> a -> b
$ Double
b Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
256 :: Int))
    (Int -> Pixel8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double -> Int) -> Double -> Int
forall a b. (a -> b) -> a -> b
$ Double
o Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
256 :: Int))

-- | convert a point to the svg co-ordinate system
-- The svg coordinate system has the y-axis going from top to bottom.
pointSvg :: C.Point Double -> (Svg.Number, Svg.Number)
pointSvg :: Point Double -> Point
pointSvg (C.Point Double
x Double
y) = (Double -> Number
Num Double
x, Double -> Number
Num (-Double
y))

-- | A DrawAttributes to rotate around a point by x degrees.
rotatePDA :: (HasDrawAttributes s) => Double -> C.Point Double -> s -> s
rotatePDA :: Double -> Point Double -> s -> s
rotatePDA Double
a (C.Point Double
x Double
y) s
s = s
s s -> (s -> s) -> s
forall a b. a -> (a -> b) -> b
& (Maybe [Transformation] -> Identity (Maybe [Transformation]))
-> s -> Identity s
forall c. HasDrawAttributes c => Lens' c (Maybe [Transformation])
transform ((Maybe [Transformation] -> Identity (Maybe [Transformation]))
 -> s -> Identity s)
-> (Maybe [Transformation] -> Maybe [Transformation]) -> s -> s
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ([Transformation] -> Maybe [Transformation]
forall a. a -> Maybe a
Just ([Transformation] -> Maybe [Transformation])
-> (Maybe [Transformation] -> [Transformation])
-> Maybe [Transformation]
-> Maybe [Transformation]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Transformation]
-> ([Transformation] -> [Transformation])
-> Maybe [Transformation]
-> [Transformation]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Transformation]
r ([Transformation] -> [Transformation] -> [Transformation]
forall a. Semigroup a => a -> a -> a
<> [Transformation]
r))
  where
    r :: [Transformation]
r = [Double -> Maybe (Double, Double) -> Transformation
Rotate (-Double
a Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
180 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
forall a. Floating a => a
pi) ((Double, Double) -> Maybe (Double, Double)
forall a. a -> Maybe a
Just (Double
x, -Double
y))]

-- | A DrawAttributes to translate by a Point.
translateDA :: (HasDrawAttributes s) => C.Point Double -> s -> s
translateDA :: Point Double -> s -> s
translateDA (C.Point Double
x' Double
y') =
  (Maybe [Transformation] -> Identity (Maybe [Transformation]))
-> s -> Identity s
forall c. HasDrawAttributes c => Lens' c (Maybe [Transformation])
transform
    ((Maybe [Transformation] -> Identity (Maybe [Transformation]))
 -> s -> Identity s)
-> (Maybe [Transformation] -> Maybe [Transformation]) -> s -> s
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (\Maybe [Transformation]
x -> [Transformation] -> Maybe [Transformation]
forall a. a -> Maybe a
Just ([Transformation] -> Maybe [Transformation])
-> [Transformation] -> Maybe [Transformation]
forall a b. (a -> b) -> a -> b
$ [Transformation]
-> ([Transformation] -> [Transformation])
-> Maybe [Transformation]
-> [Transformation]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Double -> Double -> Transformation
Translate Double
x' (-Double
y')] ([Transformation] -> [Transformation] -> [Transformation]
forall a. Semigroup a => a -> a -> a
<> [Double -> Double -> Transformation
Translate Double
x' (-Double
y')]) Maybe [Transformation]
x)

-- | A DrawAttributes to translate by a Point.
scaleDA :: (HasDrawAttributes s) => C.Point Double -> s -> s
scaleDA :: Point Double -> s -> s
scaleDA (C.Point Double
x' Double
y') =
  (Maybe [Transformation] -> Identity (Maybe [Transformation]))
-> s -> Identity s
forall c. HasDrawAttributes c => Lens' c (Maybe [Transformation])
transform
    ((Maybe [Transformation] -> Identity (Maybe [Transformation]))
 -> s -> Identity s)
-> (Maybe [Transformation] -> Maybe [Transformation]) -> s -> s
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (\Maybe [Transformation]
x -> [Transformation] -> Maybe [Transformation]
forall a. a -> Maybe a
Just ([Transformation] -> Maybe [Transformation])
-> [Transformation] -> Maybe [Transformation]
forall a b. (a -> b) -> a -> b
$ [Transformation]
-> ([Transformation] -> [Transformation])
-> Maybe [Transformation]
-> [Transformation]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Double -> Maybe Double -> Transformation
Scale Double
x' (Double -> Maybe Double
forall a. a -> Maybe a
Just Double
y')] ([Transformation] -> [Transformation] -> [Transformation]
forall a. Semigroup a => a -> a -> a
<> [Double -> Maybe Double -> Transformation
Scale Double
x' (Double -> Maybe Double
forall a. a -> Maybe a
Just Double
y')]) Maybe [Transformation]
x)

-- | convert a Rect to the svg co-ordinate system
rectSvg :: Rect Double -> Svg.Rectangle -> Svg.Rectangle
rectSvg :: Rect Double -> Rectangle -> Rectangle
rectSvg (Rect Double
x Double
z Double
y Double
w) =
  ((Point -> Identity Point) -> Rectangle -> Identity Rectangle
Lens' Rectangle Point
rectUpperLeftCorner ((Point -> Identity Point) -> Rectangle -> Identity Rectangle)
-> Point -> Rectangle -> Rectangle
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Double -> Number
Num Double
x, Double -> Number
Num (-Double
w)))
    (Rectangle -> Rectangle)
-> (Rectangle -> Rectangle) -> Rectangle -> Rectangle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Maybe Number -> Identity (Maybe Number))
-> Rectangle -> Identity Rectangle
Lens' Rectangle (Maybe Number)
rectWidth ((Maybe Number -> Identity (Maybe Number))
 -> Rectangle -> Identity Rectangle)
-> Maybe Number -> Rectangle -> Rectangle
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Number -> Maybe Number
forall a. a -> Maybe a
Just (Double -> Number
Num (Double
z Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
x)))
    (Rectangle -> Rectangle)
-> (Rectangle -> Rectangle) -> Rectangle -> Rectangle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Maybe Number -> Identity (Maybe Number))
-> Rectangle -> Identity Rectangle
Lens' Rectangle (Maybe Number)
rectHeight ((Maybe Number -> Identity (Maybe Number))
 -> Rectangle -> Identity Rectangle)
-> Maybe Number -> Rectangle -> Rectangle
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Number -> Maybe Number
forall a. a -> Maybe a
Just (Double -> Number
Num (Double
w Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
y)))

-- | import a Tree from a file
treeFromFile :: FilePath -> IO Tree
treeFromFile :: String -> IO SVG
treeFromFile String
fp = do
  Maybe Document
t <- String -> IO (Maybe Document)
Svg.loadSvgFile String
fp
  SVG -> IO SVG
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SVG -> IO SVG) -> SVG -> IO SVG
forall a b. (a -> b) -> a -> b
$ SVG -> (Document -> SVG) -> Maybe Document -> SVG
forall b a. b -> (a -> b) -> Maybe a -> b
maybe SVG
Svg.None Document -> SVG
Re.unbox Maybe Document
t