{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RebindableSyntax #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}

-- | Integration of reanimate and chart-svg
module Chart.Reanimate
  ( chartSvgTree,
    chartSvgTreeDef,
    chartSvgTrees,
    chartSvgTreesDef,
    writeChartSvgTree,
    tree,
    toPixelRGBA8,
  )
where

import Chart as C hiding (transform, Line)
import Codec.Picture.Types
import Control.Lens hiding (transform)
import qualified Data.Attoparsec.Text as A
import Graphics.SvgTree.PathParser
import Graphics.SvgTree.Types as SvgTree hiding (Point, Text)
import Linear.V2
import NumHask.Prelude hiding (fold)
import qualified Graphics.SvgTree.CssTypes as Css
import qualified Graphics.SvgTree as SvgTree
import Reanimate
import NumHask.Space.Types (width)
import Graphics.SvgTree.Printer (ppDocument)

-- | Render a 'ChartSvg' to a 'Tree'
--
-- Alters the reanimate default viewbox of 16:9, and simplifies the SVG.
chartSvgTree :: ChartSvg -> Tree
chartSvgTree :: ChartSvg -> Tree
chartSvgTree ChartSvg
cs = Tree -> Tree
simplify (Tree -> Tree) -> ([Tree] -> Tree) -> [Tree] -> Tree
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Double, Double, Double, Double) -> Tree -> Tree
withViewBox (Double, Double, Double, Double)
vb (Tree -> Tree) -> ([Tree] -> Tree) -> [Tree] -> Tree
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [Tree] -> Tree
mkGroup ([Tree] -> Tree) -> [Tree] -> Tree
forall a b. (a -> b) -> a -> b
$ [Tree]
ts
  where
    ([Tree]
ts, Rect Double
r, Point Double
_) = ChartSvg -> ([Tree], Rect Double, Point Double)
chartSvgTrees ChartSvg
cs
    (Rect Double
x Double
z Double
y Double
w) = Rect Double
r
    vb :: (Double, Double, Double, Double)
vb = (Double
x, -Double
y, Double
zDouble -> Double -> Double
forall a. Subtractive a => a -> a -> a
-Double
x, Double
wDouble -> Double -> Double
forall a. Subtractive a => a -> a -> a
-Double
y)

-- | Render a 'ChartSvg' to a 'Tree' with the default viewbox
chartSvgTreeDef :: ChartSvg -> Tree
chartSvgTreeDef :: ChartSvg -> Tree
chartSvgTreeDef = Tree -> Tree
simplify (Tree -> Tree) -> (ChartSvg -> Tree) -> ChartSvg -> Tree
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [Tree] -> Tree
mkGroup ([Tree] -> Tree) -> (ChartSvg -> [Tree]) -> ChartSvg -> Tree
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ChartSvg -> [Tree]
chartSvgTreesDef

-- | Render a 'ChartSvg' to 'Tree's, the fitted chart viewbox, and the suggested SVG dimensions
--
chartSvgTrees :: ChartSvg -> ([Tree], Rect Double, Point Double)
chartSvgTrees :: ChartSvg -> ([Tree], Rect Double, Point Double)
chartSvgTrees ChartSvg
cs = ([Tree]
ts, Rect Double
rect', Point Double
size')
  where
    so :: SvgOptions
so = Getting SvgOptions ChartSvg SvgOptions -> ChartSvg -> SvgOptions
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting SvgOptions ChartSvg SvgOptions
forall a. IsLabel "svgOptions" a => a
forall (x :: Symbol) a. IsLabel x a => a
#svgOptions ChartSvg
cs
    ho :: HudOptions
ho = Getting HudOptions ChartSvg HudOptions -> ChartSvg -> HudOptions
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting HudOptions ChartSvg HudOptions
forall a. IsLabel "hudOptions" a => a
forall (x :: Symbol) a. IsLabel x a => a
#hudOptions ChartSvg
cs
    hl :: [Hud Double]
hl = Getting [Hud Double] ChartSvg [Hud Double]
-> ChartSvg -> [Hud Double]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [Hud Double] ChartSvg [Hud Double]
forall a. IsLabel "hudList" a => a
forall (x :: Symbol) a. IsLabel x a => a
#hudList ChartSvg
cs
    cl :: [Chart Double]
cl = Getting [Chart Double] ChartSvg [Chart Double]
-> ChartSvg -> [Chart Double]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [Chart Double] ChartSvg [Chart Double]
forall a. IsLabel "chartList" a => a
forall (x :: Symbol) a. IsLabel x a => a
#chartList ChartSvg
cs
    penult :: Rect Double
penult = case Getting ChartAspect SvgOptions ChartAspect
-> SvgOptions -> ChartAspect
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ChartAspect SvgOptions ChartAspect
forall a. IsLabel "chartAspect" a => a
forall (x :: Symbol) a. IsLabel x a => a
#chartAspect SvgOptions
so of
      FixedAspect Double
_ -> [Chart Double] -> Rect Double
styleBoxesS [Chart Double]
cl
      CanvasAspect Double
_ -> [Chart Double] -> Rect Double
dataBoxesS [Chart Double]
cl
      ChartAspect
ChartAspect -> [Chart Double] -> Rect Double
styleBoxesS [Chart Double]
cl
      ChartAspect
UnadjustedAspect -> [Chart Double] -> Rect Double
dataBoxesS [Chart Double]
cl
    clAspect :: [Chart Double]
clAspect = [Chart Double]
cl [Chart Double]
-> ([Chart Double] -> [Chart Double]) -> [Chart Double]
forall a b. a -> (a -> b) -> b
&
      Rect Double -> [Hud Double] -> [Chart Double] -> [Chart Double]
runHud Rect Double
penult [ChartAspect -> Hud Double
forall (m :: * -> *). Monad m => ChartAspect -> HudT m Double
chartAspectHud (SvgOptions
so SvgOptions
-> Getting ChartAspect SvgOptions ChartAspect -> ChartAspect
forall s a. s -> Getting a s a -> a
^. Getting ChartAspect SvgOptions ChartAspect
forall a. IsLabel "chartAspect" a => a
forall (x :: Symbol) a. IsLabel x a => a
#chartAspect)] [Chart Double]
-> ([Chart Double] -> [Chart Double]) -> [Chart Double]
forall a b. a -> (a -> b) -> b
&
      ([Chart Double] -> [Chart Double])
-> (RectStyle -> [Chart Double] -> [Chart Double])
-> Maybe RectStyle
-> [Chart Double]
-> [Chart Double]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Chart Double] -> [Chart Double]
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id (\RectStyle
x -> RectStyle -> Double -> [Chart Double] -> [Chart Double]
frameChart RectStyle
x (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
0 (Getting (Maybe Double) SvgOptions (Maybe Double)
-> SvgOptions -> Maybe Double
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Maybe Double) SvgOptions (Maybe Double)
forall a. IsLabel "innerPad" a => a
forall (x :: Symbol) a. IsLabel x a => a
#innerPad SvgOptions
so)))
        (Getting (Maybe RectStyle) SvgOptions (Maybe RectStyle)
-> SvgOptions -> Maybe RectStyle
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Maybe RectStyle) SvgOptions (Maybe RectStyle)
forall a. IsLabel "chartFrame" a => a
forall (x :: Symbol) a. IsLabel x a => a
#chartFrame SvgOptions
so)
    ([Hud Double]
hlExtra, [Chart Double]
clExtra) = Rect Double -> HudOptions -> ([Hud Double], [Chart Double])
makeHud (Maybe (Rect Double) -> Rect Double
padBox (Maybe (Rect Double) -> Rect Double)
-> Maybe (Rect Double) -> Rect Double
forall a b. (a -> b) -> a -> b
$ [Chart Double] -> Maybe (Rect Double)
dataBoxes [Chart Double]
clAspect) HudOptions
ho
    clAll :: [Chart Double]
clAll = [Chart Double]
clAspect [Chart Double] -> [Chart Double] -> [Chart Double]
forall a. Semigroup a => a -> a -> a
<> [Chart Double]
clExtra
    hlAll :: [Hud Double]
hlAll = [Hud Double]
hl [Hud Double] -> [Hud Double] -> [Hud Double]
forall a. Semigroup a => a -> a -> a
<> [Hud Double]
hlExtra
    ts :: [Tree]
ts = (Chart Double -> Tree) -> [Chart Double] -> [Tree]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([CssRule] -> Tree -> Tree
SvgTree.cssApply (CssOptions -> [CssRule]
cssRules (Getting CssOptions SvgOptions CssOptions
-> SvgOptions -> CssOptions
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting CssOptions SvgOptions CssOptions
forall a. IsLabel "cssOptions" a => a
forall (x :: Symbol) a. IsLabel x a => a
#cssOptions SvgOptions
so)) (Tree -> Tree) -> (Chart Double -> Tree) -> Chart Double -> Tree
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Chart Double -> Tree
tree)
      (Rect Double -> [Hud Double] -> [Chart Double] -> [Chart Double]
runHud (ChartAspect -> [Chart Double] -> Rect Double
initialCanvas (SvgOptions
so SvgOptions
-> Getting ChartAspect SvgOptions ChartAspect -> ChartAspect
forall s a. s -> Getting a s a -> a
^. Getting ChartAspect SvgOptions ChartAspect
forall a. IsLabel "chartAspect" a => a
forall (x :: Symbol) a. IsLabel x a => a
#chartAspect) [Chart Double]
clAll) [Hud Double]
hlAll [Chart Double]
clAll)
    rect' :: Rect Double
rect' = [Chart Double] -> Rect Double
styleBoxesS [Chart Double]
clAll Rect Double -> (Rect Double -> Rect Double) -> Rect Double
forall a b. a -> (a -> b) -> b
& (Rect Double -> Rect Double)
-> (Double -> Rect Double -> Rect Double)
-> Maybe Double
-> Rect Double
-> Rect Double
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Rect Double -> Rect Double
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id Double -> Rect Double -> Rect Double
forall a. Num a => a -> Rect a -> Rect a
padRect (Getting (Maybe Double) SvgOptions (Maybe Double)
-> SvgOptions -> Maybe Double
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Maybe Double) SvgOptions (Maybe Double)
forall a. IsLabel "outerPad" a => a
forall (x :: Symbol) a. IsLabel x a => a
#outerPad SvgOptions
so)
    Point Double
w Double
h = Rect Double -> Element (Rect Double)
forall s. (Space s, Subtractive (Element s)) => s -> Element s
NumHask.Space.Types.width Rect Double
rect'
    size' :: Point Double
size' = Double -> Double -> Point Double
forall a. a -> a -> Point a
Point (Getting Double SvgOptions Double -> SvgOptions -> Double
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Double SvgOptions Double
forall a. IsLabel "svgHeight" a => a
forall (x :: Symbol) a. IsLabel x a => a
#svgHeight SvgOptions
soDouble -> Double -> Double
forall a. Divisive a => a -> a -> a
/Double
hDouble -> Double -> Double
forall a. Multiplicative a => a -> a -> a
*Double
w) (Getting Double SvgOptions Double -> SvgOptions -> Double
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Double SvgOptions Double
forall a. IsLabel "svgHeight" a => a
forall (x :: Symbol) a. IsLabel x a => a
#svgHeight SvgOptions
so)

-- | Render a 'ChartSvg' to 'Tree's at the standard reanimate viewbox
--
chartSvgTreesDef :: ChartSvg -> [Tree]
chartSvgTreesDef :: ChartSvg -> [Tree]
chartSvgTreesDef ChartSvg
cs = [Tree]
ts
  where
    so :: SvgOptions
so = Getting SvgOptions ChartSvg SvgOptions -> ChartSvg -> SvgOptions
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting SvgOptions ChartSvg SvgOptions
forall a. IsLabel "svgOptions" a => a
forall (x :: Symbol) a. IsLabel x a => a
#svgOptions ChartSvg
cs
    ho :: HudOptions
ho = Getting HudOptions ChartSvg HudOptions -> ChartSvg -> HudOptions
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting HudOptions ChartSvg HudOptions
forall a. IsLabel "hudOptions" a => a
forall (x :: Symbol) a. IsLabel x a => a
#hudOptions ChartSvg
cs
    hl :: [Hud Double]
hl = Getting [Hud Double] ChartSvg [Hud Double]
-> ChartSvg -> [Hud Double]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [Hud Double] ChartSvg [Hud Double]
forall a. IsLabel "hudList" a => a
forall (x :: Symbol) a. IsLabel x a => a
#hudList ChartSvg
cs
    cl :: [Chart Double]
cl = Getting [Chart Double] ChartSvg [Chart Double]
-> ChartSvg -> [Chart Double]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [Chart Double] ChartSvg [Chart Double]
forall a. IsLabel "chartList" a => a
forall (x :: Symbol) a. IsLabel x a => a
#chartList ChartSvg
cs
    clAspect :: [Chart Double]
clAspect = Rect Double -> [Chart Double] -> [Chart Double]
projectXYs (Double -> Double -> Double -> Double -> Rect Double
forall a. a -> a -> a -> a -> Rect a
Rect (-Double
8.0) Double
8.0 (-Double
4.5) Double
4.5) [Chart Double]
cl
    ([Hud Double]
hlExtra, [Chart Double]
clExtra) = Rect Double -> HudOptions -> ([Hud Double], [Chart Double])
makeHud (Maybe (Rect Double) -> Rect Double
padBox (Maybe (Rect Double) -> Rect Double)
-> Maybe (Rect Double) -> Rect Double
forall a b. (a -> b) -> a -> b
$ [Chart Double] -> Maybe (Rect Double)
dataBoxes [Chart Double]
clAspect) HudOptions
ho
    clAll :: [Chart Double]
clAll = [Chart Double]
clAspect [Chart Double] -> [Chart Double] -> [Chart Double]
forall a. Semigroup a => a -> a -> a
<> [Chart Double]
clExtra
    hlAll :: [Hud Double]
hlAll = [Hud Double]
hl [Hud Double] -> [Hud Double] -> [Hud Double]
forall a. Semigroup a => a -> a -> a
<> [Hud Double]
hlExtra
    ts :: [Tree]
ts = (Chart Double -> Tree) -> [Chart Double] -> [Tree]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([CssRule] -> Tree -> Tree
SvgTree.cssApply (CssOptions -> [CssRule]
cssRules (Getting CssOptions SvgOptions CssOptions
-> SvgOptions -> CssOptions
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting CssOptions SvgOptions CssOptions
forall a. IsLabel "cssOptions" a => a
forall (x :: Symbol) a. IsLabel x a => a
#cssOptions SvgOptions
so)) (Tree -> Tree) -> (Chart Double -> Tree) -> Chart Double -> Tree
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Chart Double -> Tree
tree)
      (Rect Double -> [Hud Double] -> [Chart Double] -> [Chart Double]
runHud (ChartAspect -> [Chart Double] -> Rect Double
initialCanvas (SvgOptions
so SvgOptions
-> Getting ChartAspect SvgOptions ChartAspect -> ChartAspect
forall s a. s -> Getting a s a -> a
^. Getting ChartAspect SvgOptions ChartAspect
forall a. IsLabel "chartAspect" a => a
forall (x :: Symbol) a. IsLabel x a => a
#chartAspect) [Chart Double]
clAll) [Hud Double]
hlAll [Chart Double]
clAll)

-- | render Charts to a Document using the supplied size and viewbox.
renderToDocument :: CssOptions -> Point Double -> Rect Double -> [Tree] -> Document
renderToDocument :: CssOptions -> Point Double -> Rect Double -> [Tree] -> Document
renderToDocument CssOptions
csso (Point Double
w' Double
h') Rect Double
vb [Tree]
ts =
  Maybe (Double, Double, Double, Double)
-> Maybe Number
-> Maybe Number
-> [Tree]
-> String
-> String
-> PreserveAspectRatio
-> Document
Document
    ((\(Rect Double
x Double
z Double
y Double
w) -> (Double, Double, Double, Double)
-> Maybe (Double, Double, Double, Double)
forall a. a -> Maybe a
Just (Double
x, - Double
w, Double
z Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- Double
x, Double
w Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- Double
y)) Rect Double
vb)
    (Number -> Maybe Number
forall a. a -> Maybe a
Just (Double -> Number
Num Double
w'))
    (Number -> Maybe Number
forall a. a -> Maybe a
Just (Double -> Number
Num Double
h'))
    ([CssRule] -> Tree -> Tree
SvgTree.cssApply (CssOptions -> [CssRule]
cssRules CssOptions
csso) (Tree -> Tree) -> [Tree] -> [Tree]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Tree]
ts)
    (Text -> String
unpack Text
"")
    String
""
    (Bool -> Alignment -> Maybe MeetSlice -> PreserveAspectRatio
PreserveAspectRatio Bool
False Alignment
AlignNone Maybe MeetSlice
forall a. Maybe a
Nothing)

-- | write a 'ChartSvg' to a file via conversion to a reanimate 'Tree' structure.
writeChartSvgTree :: FilePath -> ChartSvg -> IO ()
writeChartSvgTree :: String -> ChartSvg -> IO ()
writeChartSvgTree String
fp ChartSvg
cs = String -> Text -> IO ()
writeFile String
fp (Text -> IO ()) -> (Document -> Text) -> Document -> IO ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> Text
pack (String -> Text) -> (Document -> String) -> Document -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Document -> String
ppDocument (Document -> IO ()) -> Document -> IO ()
forall a b. (a -> b) -> a -> b
$ Document
doc
  where
    doc :: Document
doc = CssOptions -> Point Double -> Rect Double -> [Tree] -> Document
renderToDocument (Getting CssOptions ChartSvg CssOptions -> ChartSvg -> CssOptions
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((SvgOptions -> Const CssOptions SvgOptions)
-> ChartSvg -> Const CssOptions ChartSvg
forall a. IsLabel "svgOptions" a => a
forall (x :: Symbol) a. IsLabel x a => a
#svgOptions ((SvgOptions -> Const CssOptions SvgOptions)
 -> ChartSvg -> Const CssOptions ChartSvg)
-> Getting CssOptions SvgOptions CssOptions
-> Getting CssOptions ChartSvg CssOptions
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Getting CssOptions SvgOptions CssOptions
forall a. IsLabel "cssOptions" a => a
forall (x :: Symbol) a. IsLabel x a => a
#cssOptions) ChartSvg
cs) Point Double
size' Rect Double
rect' [Tree]
ts'
    ([Tree]
ts', Rect Double
rect', Point Double
size') = ChartSvg -> ([Tree], Rect Double, Point Double)
chartSvgTrees ChartSvg
cs

cssRules :: CssOptions -> [Css.CssRule]
cssRules :: CssOptions -> [CssRule]
cssRules CssOptions
UseCssCrisp = [CssRule
cssCrisp']
cssRules CssOptions
UseGeometricPrecision = [CssRule
cssGeometricPrecision]
cssRules CssOptions
NoCssOptions = []

-- | crisp edges css
cssGeometricPrecision :: Css.CssRule
cssGeometricPrecision :: CssRule
cssGeometricPrecision = [CssSelectorRule] -> [CssDeclaration] -> CssRule
Css.CssRule [] [Text -> [[CssElement]] -> CssDeclaration
Css.CssDeclaration Text
"shape-rendering" [[Text -> CssElement
Css.CssString Text
"geometricPrecision"]]]

cssCrisp' :: Css.CssRule
cssCrisp' :: CssRule
cssCrisp' = [CssSelectorRule] -> [CssDeclaration] -> CssRule
Css.CssRule [] [Text -> [[CssElement]] -> CssDeclaration
Css.CssDeclaration Text
"shape-rendering" [[Text -> CssElement
Css.CssString Text
"crispEdges"]]]

-- | Rectange svg
treeRect :: Rect Double -> Tree
treeRect :: Rect Double -> Tree
treeRect Rect Double
a =
  Rectangle -> Tree
RectangleTree (Rectangle -> Tree) -> Rectangle -> Tree
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 -> Point Double -> Tree
treeText :: TextStyle -> Text -> Point Double -> Tree
treeText TextStyle
s Text
t Point Double
p =
  Maybe TextPath -> Text -> Tree
TextTree Maybe TextPath
forall a. Maybe a
Nothing (Point -> Text -> Text
textAt (Point Double -> Point
pointSvg Point Double
p) Text
t)
    Tree -> (Tree -> Tree) -> Tree
forall a b. a -> (a -> b) -> b
& (Tree -> Tree)
-> (Double -> Tree -> Tree) -> Maybe Double -> Tree -> Tree
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Tree -> Tree
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id (\Double
x -> (DrawAttributes -> Identity DrawAttributes)
-> Tree -> Identity Tree
forall c. HasDrawAttributes c => Lens' c DrawAttributes
drawAttributes ((DrawAttributes -> Identity DrawAttributes)
 -> Tree -> Identity Tree)
-> (DrawAttributes -> DrawAttributes) -> Tree -> Tree
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
^. Getting (Maybe Double) TextStyle (Maybe Double)
forall a. IsLabel "rotation" a => a
forall (x :: Symbol) a. IsLabel x a => a
#rotation)

-- | GlyphShape to svg Tree
treeShape :: GlyphShape -> Double -> Point Double -> Tree
treeShape :: GlyphShape -> Double -> Point Double -> Tree
treeShape GlyphShape
CircleGlyph Double
s Point Double
p =
  Circle -> Tree
CircleTree (Circle -> Tree) -> Circle -> Tree
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. Divisive a => a -> a -> a
/ Double
2))
treeShape GlyphShape
SquareGlyph Double
s Point Double
p = Rect Double -> Tree
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. Multiplicative a => a -> a -> a
*) (Double -> Double) -> Rect Double -> Rect Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Rect Double
forall a. Multiplicative a => a
one))
treeShape (RectSharpGlyph Double
x') Double
s Point Double
p =
  Rect Double -> Tree
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
Point Double
s (Double
x' Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Double
s)) Rect Double
forall a. Multiplicative a => a
one))
treeShape (RectRoundedGlyph Double
x'' Double
rx Double
ry) Double
s Point Double
p =
  Rectangle -> Tree
RectangleTree
    (Rectangle -> Tree)
-> (Rectangle -> Rectangle) -> Rectangle -> Tree
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat 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
Point Double
s (Double
x'' Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Double
s)) Rect Double
forall a. Multiplicative a => a
one)
    (Rectangle -> Rectangle)
-> (Rectangle -> Rectangle) -> Rectangle -> Rectangle
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat 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 -> Tree) -> Rectangle -> Tree
forall a b. (a -> b) -> a -> b
$ Rectangle
forall a. WithDefaultSvg a => a
defaultSvg
treeShape (TriangleGlyph (Point Double
xa Double
ya) (Point Double
xb Double
yb) (Point Double
xc Double
yc)) Double
s Point Double
p =
  Polygon -> Tree
PolygonTree
    (Polygon -> Tree) -> (Polygon -> Polygon) -> Polygon -> Tree
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat 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 -> Tree) -> Polygon -> Tree
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. Multiplicative a => a -> a -> a
* Double
xa) (- Double
s Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Double
ya),
        Double -> Double -> RPoint
forall a. a -> a -> V2 a
V2 (Double
s Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Double
xb) (- Double
s Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Double
yb),
        Double -> Double -> RPoint
forall a. a -> a -> V2 a
V2 (Double
s Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Double
xc) (- Double
s Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Double
yc)
      ]
treeShape (EllipseGlyph Double
x') Double
s Point Double
p =
  Ellipse -> Tree
EllipseTree (Ellipse -> Tree) -> Ellipse -> Tree
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. Divisive 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. Multiplicative a => a -> a -> a
* Double
s) Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ Double
2)
treeShape (VLineGlyph Double
x') Double
s (Point Double
x Double
y) =
  Line -> Tree
LineTree (Line -> Tree) -> Line -> Tree
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
& (Last Number -> Identity (Last Number))
-> DrawAttributes -> Identity DrawAttributes
forall c. HasDrawAttributes c => Lens' c (Last Number)
strokeWidth ((Last Number -> Identity (Last Number))
 -> DrawAttributes -> Identity DrawAttributes)
-> Last Number -> DrawAttributes -> DrawAttributes
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Number -> Last Number
forall a. Maybe a -> Last a
Last (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
Point Double
x (Double
y Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- Double
s Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ Double
2)))
      (Point Double -> Point
pointSvg (Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
x (Double
y Double -> Double -> Double
forall a. Additive a => a -> a -> a
+ Double
s Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ Double
2)))
treeShape (HLineGlyph Double
x') Double
s (Point Double
x Double
y) =
  Line -> Tree
LineTree (Line -> Tree) -> Line -> Tree
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
& (Last Number -> Identity (Last Number))
-> DrawAttributes -> Identity DrawAttributes
forall c. HasDrawAttributes c => Lens' c (Last Number)
strokeWidth ((Last Number -> Identity (Last Number))
 -> DrawAttributes -> Identity DrawAttributes)
-> Last Number -> DrawAttributes -> DrawAttributes
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Number -> Last Number
forall a. Maybe a -> Last a
Last (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
Point (Double
x Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- Double
s Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ Double
2) Double
y))
      (Point Double -> Point
pointSvg (Double -> Double -> Point Double
forall a. a -> a -> Point a
Point (Double
x Double -> Double -> Double
forall a. Additive a => a -> a -> a
+ Double
s Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ Double
2) Double
y))
treeShape (PathGlyph Text
path) Double
_ Point Double
p =
  Path -> Tree
PathTree (Path -> Tree) -> Path -> Tree
forall a b. (a -> b) -> a -> b
$ DrawAttributes -> [PathCommand] -> Path
Path (((DrawAttributes -> Identity DrawAttributes)
-> DrawAttributes -> Identity DrawAttributes
forall c. HasDrawAttributes c => Lens' c DrawAttributes
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
translateDA Point Double
p) DrawAttributes
forall a. WithDefaultSvg a => a
defaultSvg) [PathCommand]
path'
  where
    path' :: [PathCommand]
path' = (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] -> [PathCommand]
forall a. a -> [a] -> [a]
: []) (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
command Text
path

-- | GlyphStyle to svg Tree
treeGlyph :: GlyphStyle -> Point Double -> Tree
treeGlyph :: GlyphStyle -> Point Double -> Tree
treeGlyph GlyphStyle
s Point Double
p =
  GlyphShape -> Double -> Point Double -> Tree
treeShape (GlyphStyle
s GlyphStyle
-> Getting GlyphShape GlyphStyle GlyphShape -> GlyphShape
forall s a. s -> Getting a s a -> a
^. Getting GlyphShape GlyphStyle GlyphShape
forall a. IsLabel "shape" a => a
forall (x :: Symbol) a. IsLabel x a => a
#shape) (GlyphStyle
s GlyphStyle -> Getting Double GlyphStyle Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double GlyphStyle Double
forall a. IsLabel "size" a => a
forall (x :: Symbol) a. IsLabel x a => a
#size) Point Double
p
    Tree -> (Tree -> Tree) -> Tree
forall a b. a -> (a -> b) -> b
& (Tree -> Tree)
-> (Double -> Tree -> Tree) -> Maybe Double -> Tree -> Tree
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Tree -> Tree
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id (\Double
x -> (DrawAttributes -> Identity DrawAttributes)
-> Tree -> Identity Tree
forall c. HasDrawAttributes c => Lens' c DrawAttributes
drawAttributes ((DrawAttributes -> Identity DrawAttributes)
 -> Tree -> Identity Tree)
-> (DrawAttributes -> DrawAttributes) -> Tree -> Tree
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
^. Getting (Maybe Double) GlyphStyle (Maybe Double)
forall a. IsLabel "rotation" a => a
forall (x :: Symbol) a. IsLabel x a => a
#rotation)

-- | line svg
treeLine :: [Point Double] -> Tree
treeLine :: [Point Double] -> Tree
treeLine [Point Double]
xs =
  PolyLine -> Tree
PolyLineTree
    (PolyLine -> Tree) -> (PolyLine -> PolyLine) -> PolyLine -> Tree
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat 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
.~ ((\(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 -> Tree) -> PolyLine -> Tree
forall a b. (a -> b) -> a -> b
$ PolyLine
forall a. WithDefaultSvg a => a
defaultSvg

-- | GlyphStyle to svg Tree
treePath :: [PathInfo Double] -> [Point Double] -> Tree
treePath :: [PathInfo Double] -> [Point Double] -> Tree
treePath [PathInfo Double]
s [Point Double]
p = Path -> Tree
PathTree (Path -> Tree) -> Path -> Tree
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]
p)

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

-- | add drawing attributes as a group svg wrapping a [Tree]
groupTrees :: DrawAttributes -> [Tree] -> Tree
groupTrees :: DrawAttributes -> [Tree] -> Tree
groupTrees DrawAttributes
da' [Tree]
tree' =
  Group -> Tree
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
$ ([Tree] -> Identity [Tree]) -> Group -> Identity Group
Lens' Group [Tree]
groupChildren (([Tree] -> Identity [Tree]) -> Group -> Identity Group)
-> [Tree] -> Group -> Group
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Tree]
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
&
  ((Last Number -> Identity (Last Number))
-> DrawAttributes -> Identity DrawAttributes
forall c. HasDrawAttributes c => Lens' c (Last Number)
strokeWidth ((Last Number -> Identity (Last Number))
 -> DrawAttributes -> Identity DrawAttributes)
-> Last Number -> DrawAttributes -> DrawAttributes
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Number -> Last Number
forall a. Maybe a -> Last a
Last (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 (RectStyle
o RectStyle -> Getting Double RectStyle Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double RectStyle Double
forall a. IsLabel "borderSize" a => a
forall (x :: Symbol) a. IsLabel x a => a
#borderSize))) DrawAttributes
-> (DrawAttributes -> DrawAttributes) -> DrawAttributes
forall a b. a -> (a -> b) -> b
&
  ((Last Texture -> Identity (Last Texture))
-> DrawAttributes -> Identity DrawAttributes
forall c. HasDrawAttributes c => Lens' c (Last Texture)
strokeColor ((Last Texture -> Identity (Last Texture))
 -> DrawAttributes -> Identity DrawAttributes)
-> Last Texture -> DrawAttributes -> DrawAttributes
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Texture -> Last Texture
forall a. Maybe a -> Last a
Last (Texture -> Maybe Texture
forall a. a -> Maybe a
Just (Texture -> Maybe Texture) -> Texture -> Maybe Texture
forall a b. (a -> b) -> a -> b
$ 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
^. Getting Colour RectStyle Colour
forall a. IsLabel "borderColor" a => a
forall (x :: Symbol) a. IsLabel x a => a
#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
^. Getting Colour RectStyle Colour
forall a. IsLabel "borderColor" a => a
forall (x :: Symbol) a. IsLabel x a => a
#borderColor)) DrawAttributes
-> (DrawAttributes -> DrawAttributes) -> DrawAttributes
forall a b. a -> (a -> b) -> b
&
  ((Last Texture -> Identity (Last Texture))
-> DrawAttributes -> Identity DrawAttributes
forall c. HasDrawAttributes c => Lens' c (Last Texture)
fillColor ((Last Texture -> Identity (Last Texture))
 -> DrawAttributes -> Identity DrawAttributes)
-> Last Texture -> DrawAttributes -> DrawAttributes
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Texture -> Last Texture
forall a. Maybe a -> Last a
Last (Texture -> Maybe Texture
forall a. a -> Maybe a
Just (Texture -> Maybe Texture) -> Texture -> Maybe Texture
forall a b. (a -> b) -> a -> b
$ 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
^. Getting Colour RectStyle Colour
forall a. IsLabel "color" a => a
forall (x :: Symbol) a. IsLabel x a => a
#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
^. Getting Colour RectStyle Colour
forall a. IsLabel "color" a => a
forall (x :: Symbol) a. IsLabel x a => a
#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
&
  ((Last Number -> Identity (Last Number))
-> DrawAttributes -> Identity DrawAttributes
forall c. HasDrawAttributes c => Lens' c (Last Number)
fontSize ((Last Number -> Identity (Last Number))
 -> DrawAttributes -> Identity DrawAttributes)
-> Last Number -> DrawAttributes -> DrawAttributes
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Number -> Last Number
forall a. Maybe a -> Last a
Last (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 (TextStyle
o TextStyle -> Getting Double TextStyle Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double TextStyle Double
forall a. IsLabel "size" a => a
forall (x :: Symbol) a. IsLabel x a => a
#size))) DrawAttributes
-> (DrawAttributes -> DrawAttributes) -> DrawAttributes
forall a b. a -> (a -> b) -> b
&
  ((Last Number -> Identity (Last Number))
-> DrawAttributes -> Identity DrawAttributes
forall c. HasDrawAttributes c => Lens' c (Last Number)
strokeWidth ((Last Number -> Identity (Last Number))
 -> DrawAttributes -> Identity DrawAttributes)
-> Last Number -> DrawAttributes -> DrawAttributes
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Number -> Last Number
forall a. Maybe a -> Last a
Last (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
0)) DrawAttributes
-> (DrawAttributes -> DrawAttributes) -> DrawAttributes
forall a b. a -> (a -> b) -> b
&
  ((Last Texture -> Identity (Last Texture))
-> DrawAttributes -> Identity DrawAttributes
forall c. HasDrawAttributes c => Lens' c (Last Texture)
strokeColor ((Last Texture -> Identity (Last Texture))
 -> DrawAttributes -> Identity DrawAttributes)
-> Last Texture -> DrawAttributes -> DrawAttributes
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Texture -> Last Texture
forall a. Maybe a -> Last a
Last (Texture -> Maybe Texture
forall a. a -> Maybe a
Just Texture
FillNone)) DrawAttributes
-> (DrawAttributes -> DrawAttributes) -> DrawAttributes
forall a b. a -> (a -> b) -> b
&
  ((Last Texture -> Identity (Last Texture))
-> DrawAttributes -> Identity DrawAttributes
forall c. HasDrawAttributes c => Lens' c (Last Texture)
fillColor ((Last Texture -> Identity (Last Texture))
 -> DrawAttributes -> Identity DrawAttributes)
-> Last Texture -> DrawAttributes -> DrawAttributes
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Texture -> Last Texture
forall a. Maybe a -> Last a
Last (Texture -> Maybe Texture
forall a. a -> Maybe a
Just (Texture -> Maybe Texture) -> Texture -> Maybe Texture
forall a b. (a -> b) -> a -> b
$ 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
^. Getting Colour TextStyle Colour
forall a. IsLabel "color" a => a
forall (x :: Symbol) a. IsLabel x a => a
#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
^. Getting Colour TextStyle Colour
forall a. IsLabel "color" a => a
forall (x :: Symbol) a. IsLabel x a => a
#color)) DrawAttributes
-> (DrawAttributes -> DrawAttributes) -> DrawAttributes
forall a b. a -> (a -> b) -> b
&
  ((Last TextAnchor -> Identity (Last TextAnchor))
-> DrawAttributes -> Identity DrawAttributes
forall c. HasDrawAttributes c => Lens' c (Last TextAnchor)
textAnchor ((Last TextAnchor -> Identity (Last TextAnchor))
 -> DrawAttributes -> Identity DrawAttributes)
-> Last TextAnchor -> DrawAttributes -> DrawAttributes
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe TextAnchor -> Last TextAnchor
forall a. Maybe a -> Last a
Last (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
^. Getting Anchor TextStyle Anchor
forall a. IsLabel "anchor" a => a
forall (x :: Symbol) a. IsLabel x a => a
#anchor))) 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 k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
      (\(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)])
      (TextStyle
o TextStyle
-> Getting (Maybe (Point Double)) TextStyle (Maybe (Point Double))
-> Maybe (Point Double)
forall s a. s -> Getting a s a -> a
^. Getting (Maybe (Point Double)) TextStyle (Maybe (Point Double))
forall a. IsLabel "translate" a => a
forall (x :: Symbol) a. IsLabel x a => a
#translate)
  where
    toTextAnchor :: Anchor -> 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
&
  ((Last Number -> Identity (Last Number))
-> DrawAttributes -> Identity DrawAttributes
forall c. HasDrawAttributes c => Lens' c (Last Number)
strokeWidth ((Last Number -> Identity (Last Number))
 -> DrawAttributes -> Identity DrawAttributes)
-> Last Number -> DrawAttributes -> DrawAttributes
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Number -> Last Number
forall a. Maybe a -> Last a
Last (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 (GlyphStyle
o GlyphStyle -> Getting Double GlyphStyle Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double GlyphStyle Double
forall a. IsLabel "borderSize" a => a
forall (x :: Symbol) a. IsLabel x a => a
#borderSize))) DrawAttributes
-> (DrawAttributes -> DrawAttributes) -> DrawAttributes
forall a b. a -> (a -> b) -> b
&
  ((Last Texture -> Identity (Last Texture))
-> DrawAttributes -> Identity DrawAttributes
forall c. HasDrawAttributes c => Lens' c (Last Texture)
strokeColor ((Last Texture -> Identity (Last Texture))
 -> DrawAttributes -> Identity DrawAttributes)
-> Last Texture -> DrawAttributes -> DrawAttributes
forall s t a b. ASetter s t a b -> b -> s -> t
.~
   Maybe Texture -> Last Texture
forall a. Maybe a -> Last a
Last (Texture -> Maybe Texture
forall a. a -> Maybe a
Just (Texture -> Maybe Texture) -> Texture -> Maybe Texture
forall a b. (a -> b) -> a -> b
$ 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
^. Getting Colour GlyphStyle Colour
forall a. IsLabel "borderColor" a => a
forall (x :: Symbol) a. IsLabel x a => a
#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
^. Getting Colour GlyphStyle Colour
forall a. IsLabel "borderColor" a => a
forall (x :: Symbol) a. IsLabel x a => a
#borderColor)) DrawAttributes
-> (DrawAttributes -> DrawAttributes) -> DrawAttributes
forall a b. a -> (a -> b) -> b
&
  ((Last Texture -> Identity (Last Texture))
-> DrawAttributes -> Identity DrawAttributes
forall c. HasDrawAttributes c => Lens' c (Last Texture)
fillColor ((Last Texture -> Identity (Last Texture))
 -> DrawAttributes -> Identity DrawAttributes)
-> Last Texture -> DrawAttributes -> DrawAttributes
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Texture -> Last Texture
forall a. Maybe a -> Last a
Last (Texture -> Maybe Texture
forall a. a -> Maybe a
Just (Texture -> Maybe Texture) -> Texture -> Maybe Texture
forall a b. (a -> b) -> a -> b
$ 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
^. Getting Colour GlyphStyle Colour
forall a. IsLabel "color" a => a
forall (x :: Symbol) a. IsLabel x a => a
#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
^. Getting Colour GlyphStyle Colour
forall a. IsLabel "color" a => a
forall (x :: Symbol) a. IsLabel x a => a
#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 k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id (\(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
^. Getting (Maybe (Point Double)) GlyphStyle (Maybe (Point Double))
forall a. IsLabel "translate" a => a
forall (x :: Symbol) a. IsLabel x a => a
#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
&
  ((Last Number -> Identity (Last Number))
-> DrawAttributes -> Identity DrawAttributes
forall c. HasDrawAttributes c => Lens' c (Last Number)
strokeWidth ((Last Number -> Identity (Last Number))
 -> DrawAttributes -> Identity DrawAttributes)
-> Last Number -> DrawAttributes -> DrawAttributes
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Number -> Last Number
forall a. Maybe a -> Last a
Last (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 (LineStyle
o LineStyle -> Getting Double LineStyle Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double LineStyle Double
forall a. IsLabel "width" a => a
forall (x :: Symbol) a. IsLabel x a => a
#width))) DrawAttributes
-> (DrawAttributes -> DrawAttributes) -> DrawAttributes
forall a b. a -> (a -> b) -> b
&
  ((Last Texture -> Identity (Last Texture))
-> DrawAttributes -> Identity DrawAttributes
forall c. HasDrawAttributes c => Lens' c (Last Texture)
strokeColor ((Last Texture -> Identity (Last Texture))
 -> DrawAttributes -> Identity DrawAttributes)
-> Last Texture -> DrawAttributes -> DrawAttributes
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Texture -> Last Texture
forall a. Maybe a -> Last a
Last (Texture -> Maybe Texture
forall a. a -> Maybe a
Just (Texture -> Maybe Texture) -> Texture -> Maybe Texture
forall a b. (a -> b) -> a -> b
$ 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
^. Getting Colour LineStyle Colour
forall a. IsLabel "color" a => a
forall (x :: Symbol) a. IsLabel x a => a
#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
^. Getting Colour LineStyle Colour
forall a. IsLabel "color" a => a
forall (x :: Symbol) a. IsLabel x a => a
#color)) DrawAttributes
-> (DrawAttributes -> DrawAttributes) -> DrawAttributes
forall a b. a -> (a -> b) -> b
&
  ((Last Texture -> Identity (Last Texture))
-> DrawAttributes -> Identity DrawAttributes
forall c. HasDrawAttributes c => Lens' c (Last Texture)
fillColor ((Last Texture -> Identity (Last Texture))
 -> DrawAttributes -> Identity DrawAttributes)
-> Last Texture -> DrawAttributes -> DrawAttributes
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Texture -> Last Texture
forall a. Maybe a -> Last a
Last (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 k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id (\LineCap
x -> (Last Cap -> Identity (Last Cap))
-> DrawAttributes -> Identity DrawAttributes
forall c. HasDrawAttributes c => Lens' c (Last Cap)
strokeLineCap ((Last Cap -> Identity (Last Cap))
 -> DrawAttributes -> Identity DrawAttributes)
-> Last Cap -> DrawAttributes -> DrawAttributes
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Cap -> Last Cap
forall a. Maybe a -> Last a
Last (Cap -> Maybe Cap
forall a. a -> Maybe a
Just (Cap -> Maybe Cap) -> Cap -> Maybe Cap
forall a b. (a -> b) -> a -> b
$ 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
^. Getting (Maybe LineCap) LineStyle (Maybe LineCap)
forall a. IsLabel "linecap" a => a
forall (x :: Symbol) a. IsLabel x a => a
#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 k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id (\LineJoin
x -> (Last LineJoin -> Identity (Last LineJoin))
-> DrawAttributes -> Identity DrawAttributes
forall c. HasDrawAttributes c => Lens' c (Last LineJoin)
strokeLineJoin ((Last LineJoin -> Identity (Last LineJoin))
 -> DrawAttributes -> Identity DrawAttributes)
-> Last LineJoin -> DrawAttributes -> DrawAttributes
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe LineJoin -> Last LineJoin
forall a. Maybe a -> Last a
Last (LineJoin -> Maybe LineJoin
forall a. a -> Maybe a
Just (LineJoin -> Maybe LineJoin) -> LineJoin -> Maybe LineJoin
forall a b. (a -> b) -> a -> b
$ 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
^. Getting (Maybe LineJoin) LineStyle (Maybe LineJoin)
forall a. IsLabel "linejoin" a => a
forall (x :: Symbol) a. IsLabel x a => a
#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 k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id (\Double
x -> (Last Number -> Identity (Last Number))
-> DrawAttributes -> Identity DrawAttributes
forall c. HasDrawAttributes c => Lens' c (Last Number)
strokeOffset ((Last Number -> Identity (Last Number))
 -> DrawAttributes -> Identity DrawAttributes)
-> Last Number -> DrawAttributes -> DrawAttributes
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Number -> Last Number
forall a. Maybe a -> Last a
Last (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
x))
  (LineStyle
o LineStyle
-> Getting (Maybe Double) LineStyle (Maybe Double) -> Maybe Double
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Double) LineStyle (Maybe Double)
forall a. IsLabel "dashoffset" a => a
forall (x :: Symbol) a. IsLabel x a => a
#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 k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id (\[Double]
xs -> (Last [Number] -> Identity (Last [Number]))
-> DrawAttributes -> Identity DrawAttributes
forall c. HasDrawAttributes c => Lens' c (Last [Number])
strokeDashArray ((Last [Number] -> Identity (Last [Number]))
 -> DrawAttributes -> Identity DrawAttributes)
-> Last [Number] -> DrawAttributes -> DrawAttributes
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe [Number] -> Last [Number]
forall a. Maybe a -> Last a
Last ([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
^. Getting (Maybe [Double]) LineStyle (Maybe [Double])
forall a. IsLabel "dasharray" a => a
forall (x :: Symbol) a. IsLabel x a => a
#dasharray)

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

fromLineJoin' :: C.LineJoin -> SvgTree.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
&
  ((Last Number -> Identity (Last Number))
-> DrawAttributes -> Identity DrawAttributes
forall c. HasDrawAttributes c => Lens' c (Last Number)
strokeWidth ((Last Number -> Identity (Last Number))
 -> DrawAttributes -> Identity DrawAttributes)
-> Last Number -> DrawAttributes -> DrawAttributes
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Number -> Last Number
forall a. Maybe a -> Last a
Last (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 (PathStyle
o PathStyle -> Getting Double PathStyle Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double PathStyle Double
forall a. IsLabel "borderSize" a => a
forall (x :: Symbol) a. IsLabel x a => a
#borderSize))) DrawAttributes
-> (DrawAttributes -> DrawAttributes) -> DrawAttributes
forall a b. a -> (a -> b) -> b
&
  ((Last Texture -> Identity (Last Texture))
-> DrawAttributes -> Identity DrawAttributes
forall c. HasDrawAttributes c => Lens' c (Last Texture)
strokeColor ((Last Texture -> Identity (Last Texture))
 -> DrawAttributes -> Identity DrawAttributes)
-> Last Texture -> DrawAttributes -> DrawAttributes
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Texture -> Last Texture
forall a. Maybe a -> Last a
Last
   (Texture -> Maybe Texture
forall a. a -> Maybe a
Just (Texture -> Maybe Texture) -> Texture -> Maybe Texture
forall a b. (a -> b) -> a -> b
$ 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
^. Getting Colour PathStyle Colour
forall a. IsLabel "borderColor" a => a
forall (x :: Symbol) a. IsLabel x a => a
#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
^. Getting Colour PathStyle Colour
forall a. IsLabel "borderColor" a => a
forall (x :: Symbol) a. IsLabel x a => a
#borderColor)) DrawAttributes
-> (DrawAttributes -> DrawAttributes) -> DrawAttributes
forall a b. a -> (a -> b) -> b
&
  ((Last Texture -> Identity (Last Texture))
-> DrawAttributes -> Identity DrawAttributes
forall c. HasDrawAttributes c => Lens' c (Last Texture)
fillColor ((Last Texture -> Identity (Last Texture))
 -> DrawAttributes -> Identity DrawAttributes)
-> Last Texture -> DrawAttributes -> DrawAttributes
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Texture -> Last Texture
forall a. Maybe a -> Last a
Last (Texture -> Maybe Texture
forall a. a -> Maybe a
Just (Texture -> Maybe Texture) -> Texture -> Maybe Texture
forall a b. (a -> b) -> a -> b
$ 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
^. Getting Colour PathStyle Colour
forall a. IsLabel "color" a => a
forall (x :: Symbol) a. IsLabel x a => a
#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
^. Getting Colour PathStyle Colour
forall a. IsLabel "color" a => a
forall (x :: Symbol) a. IsLabel x a => a
#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. FromIntegral a b => b -> a
fromIntegral (Double -> Int
forall a b. QuotientField a b => a -> b
floor (Double -> Int) -> Double -> Int
forall a b. (a -> b) -> a -> b
$ Double
r Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Double
256 :: Int))
    (Int -> Pixel8
forall a b. FromIntegral a b => b -> a
fromIntegral (Double -> Int
forall a b. QuotientField a b => a -> b
floor (Double -> Int) -> Double -> Int
forall a b. (a -> b) -> a -> b
$ Double
g Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Double
256 :: Int))
    (Int -> Pixel8
forall a b. FromIntegral a b => b -> a
fromIntegral (Double -> Int
forall a b. QuotientField a b => a -> b
floor (Double -> Int) -> Double -> Int
forall a b. (a -> b) -> a -> b
$ Double
b Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Double
256 :: Int))
    (Int -> Pixel8
forall a b. FromIntegral a b => b -> a
fromIntegral (Double -> Int
forall a b. QuotientField a b => a -> b
floor (Double -> Int) -> Double -> Int
forall a b. (a -> b) -> a -> b
$ Double
o Double -> Double -> Double
forall a. Multiplicative 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 :: Point Double -> (Number, Number)
pointSvg :: Point Double -> Point
pointSvg (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 -> Point Double -> s -> s
rotatePDA :: Double -> Point Double -> s -> s
rotatePDA Double
a (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 k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat 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
aDouble -> Double -> Double
forall a. Multiplicative a => a -> a -> a
*Double
180Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/Double
forall a. TrigField a => a
pi) ((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) => Point Double -> s -> s
translateDA :: Point Double -> s -> s
translateDA (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)

-- | convert a Rect to the svg co-ordinate system
rectSvg :: Rect Double -> Rectangle -> 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 k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat 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. Subtractive a => a -> a -> a
- Double
x)))
    (Rectangle -> Rectangle)
-> (Rectangle -> Rectangle) -> Rectangle -> Rectangle
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat 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. Subtractive a => a -> a -> a
- Double
y)))