{-| Functions for creating basic SVG elements and applying transformations to them. -}
module Reanimate.Svg.Constructors
  ( -- * Primitive shapes
    mkCircle
  , mkEllipse
  , mkRect
  , mkLine
  , mkPath
  , mkPathString
  , mkPathText
  , mkLinePath
  , mkLinePathClosed
  , mkClipPath
  , mkText
  -- * Grouping shapes and definitions
  , mkGroup
  , mkDefinitions
  , mkUse
  -- * Attributes
  , withId
  , withStrokeColor
  , withStrokeColorPixel
  , withStrokeDashArray
  , withStrokeLineJoin
  , withFillColor
  , withFillColorPixel
  , withFillOpacity
  , withGroupOpacity
  , withStrokeWidth
  , withClipPathRef
  -- * Transformations
  , center
  , centerX
  , centerY
  , centerUsing
  , translate
  , rotate
  , rotateAroundCenter
  , rotateAround
  , scale
  , scaleToSize
  , scaleToWidth
  , scaleToHeight
  , scaleXY
  , flipXAxis
  , flipYAxis
  , aroundCenter
  , aroundCenterX
  , aroundCenterY
  , withTransformations
  , withViewBox
  -- * Other
  , mkColor
  , mkBackground
  , mkBackgroundPixel
  , gridLayout

  ) where

import           Codec.Picture                (PixelRGBA8 (..))
import           Control.Lens                 ((&), (.~), (?~))
import           Data.Attoparsec.Text         (parseOnly)
import qualified Data.Map                     as Map
import qualified Data.Text                    as T
import           Graphics.SvgTree
import           Graphics.SvgTree.NamedColors (svgNamedColors)
import           Graphics.SvgTree.PathParser  (pathParser)
import           Linear.V2                    (V2 (V2))
import           Reanimate.Constants          (screenHeight, screenWidth)
import           Reanimate.Svg.BoundingBox    (boundingBox)

-- | Apply list of transformations to given image.
withTransformations :: [Transformation] -> Tree -> Tree
withTransformations :: [Transformation] -> Tree -> Tree
withTransformations [Transformation]
transformations Tree
t =
  [Tree] -> Tree
mkGroup [Tree
t] Tree -> (Tree -> Tree) -> Tree
forall a b. a -> (a -> b) -> b
& (Maybe [Transformation] -> Identity (Maybe [Transformation]))
-> Tree -> Identity Tree
forall c. HasDrawAttributes c => Lens' c (Maybe [Transformation])
transform ((Maybe [Transformation] -> Identity (Maybe [Transformation]))
 -> Tree -> Identity Tree)
-> [Transformation] -> Tree -> Tree
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ [Transformation]
transformations

-- | @translate x y image@ moves the @image@ by @x@ along X-axis and by @y@ along Y-axis.
translate :: Double -> Double -> Tree -> Tree
translate :: Double -> Double -> Tree -> Tree
translate Double
x Double
y = [Transformation] -> Tree -> Tree
withTransformations [Double -> Double -> Transformation
Translate Double
x Double
y]

-- | @rotate angle image@ rotates the @image@ around origin @(0,0)@ counterclockwise by @angle@
--   given in degrees.
rotate :: Double -> Tree -> Tree
rotate :: Double -> Tree -> Tree
rotate Double
a = [Transformation] -> Tree -> Tree
withTransformations [Double -> Maybe (Double, Double) -> Transformation
Rotate Double
a Maybe (Double, Double)
forall a. Maybe a
Nothing]

-- | @rotate angle point image@ rotates the @image@ around given @point@ counterclockwise by
--   @angle@ given in degrees.
rotateAround :: Double -> RPoint -> Tree -> Tree
rotateAround :: Double -> RPoint -> Tree -> Tree
rotateAround Double
a (V2 Double
x Double
y) = [Transformation] -> Tree -> Tree
withTransformations [Double -> Maybe (Double, Double) -> Transformation
Rotate Double
a ((Double, Double) -> Maybe (Double, Double)
forall a. a -> Maybe a
Just (Double
x,Double
y))]

-- | @rotate angle image@ rotates the @image@ around the center of its bounding box counterclockwise
--   by @angle@ given in degrees.
rotateAroundCenter :: Double -> Tree -> Tree
rotateAroundCenter :: Double -> Tree -> Tree
rotateAroundCenter Double
a Tree
t =
    Double -> RPoint -> Tree -> Tree
rotateAround Double
a (Double -> Double -> RPoint
forall a. a -> a -> V2 a
V2 (Double
xDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
wDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
2) (Double
yDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
hDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
2)) Tree
t
  where
    (Double
x,Double
y,Double
w,Double
h) = Tree -> (Double, Double, Double, Double)
boundingBox Tree
t

-- | @aroundCenter f image@ first moves the image so the center of its bounding box is at the origin
--   @(0, 0)@, applies transformation @f@ to it and then moves the transformed image back to its
--   original position.
aroundCenter :: (Tree -> Tree) -> Tree -> Tree
aroundCenter :: (Tree -> Tree) -> Tree -> Tree
aroundCenter Tree -> Tree
fn Tree
t =
    Double -> Double -> Tree -> Tree
translate (-Double
offsetX) (-Double
offsetY) (Tree -> Tree) -> Tree -> Tree
forall a b. (a -> b) -> a -> b
$ Tree -> Tree
fn (Tree -> Tree) -> Tree -> Tree
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Tree -> Tree
translate Double
offsetX Double
offsetY Tree
t
  where
    offsetX :: Double
offsetX = -Double
xDouble -> Double -> Double
forall a. Num a => a -> a -> a
-Double
wDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
2
    offsetY :: Double
offsetY = -Double
yDouble -> Double -> Double
forall a. Num a => a -> a -> a
-Double
hDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
2
    (Double
x,Double
y,Double
w,Double
h) = Tree -> (Double, Double, Double, Double)
boundingBox Tree
t

-- | Same as 'aroundCenter' but only for the Y-axis.
aroundCenterY :: (Tree -> Tree) -> Tree -> Tree
aroundCenterY :: (Tree -> Tree) -> Tree -> Tree
aroundCenterY Tree -> Tree
fn Tree
t =
    Double -> Double -> Tree -> Tree
translate Double
0 (-Double
offsetY) (Tree -> Tree) -> Tree -> Tree
forall a b. (a -> b) -> a -> b
$ Tree -> Tree
fn (Tree -> Tree) -> Tree -> Tree
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Tree -> Tree
translate Double
0 Double
offsetY Tree
t
  where
    offsetY :: Double
offsetY = -Double
yDouble -> Double -> Double
forall a. Num a => a -> a -> a
-Double
hDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
2
    (Double
_x,Double
y,Double
_w,Double
h) = Tree -> (Double, Double, Double, Double)
boundingBox Tree
t

-- | Same as 'aroundCenter' but only for the X-axis.
aroundCenterX :: (Tree -> Tree) -> Tree -> Tree
aroundCenterX :: (Tree -> Tree) -> Tree -> Tree
aroundCenterX Tree -> Tree
fn Tree
t =
    Double -> Double -> Tree -> Tree
translate (-Double
offsetX) Double
0 (Tree -> Tree) -> Tree -> Tree
forall a b. (a -> b) -> a -> b
$ Tree -> Tree
fn (Tree -> Tree) -> Tree -> Tree
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Tree -> Tree
translate Double
offsetX Double
0 Tree
t
  where
    offsetX :: Double
offsetX = -Double
xDouble -> Double -> Double
forall a. Num a => a -> a -> a
-Double
wDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
2
    (Double
x,Double
_y,Double
w,Double
_h) = Tree -> (Double, Double, Double, Double)
boundingBox Tree
t

-- | Scale the image uniformly by given factor along both X and Y axes.
-- For example @scale 2 image@  makes the image twice as large, while @scale 0.5 image@ makes it
-- half the original size. Negative values are also allowed, and lead to flipping the image along
-- both X and Y axes.
scale :: Double -> Tree -> Tree
scale :: Double -> Tree -> Tree
scale Double
a = [Transformation] -> Tree -> Tree
withTransformations [Double -> Maybe Double -> Transformation
Scale Double
a Maybe Double
forall a. Maybe a
Nothing]

-- | @scaleToSize width height@ resizes the image so that its bounding box has corresponding @width@
--   and @height@.
scaleToSize :: Double -> Double -> Tree -> Tree
scaleToSize :: Double -> Double -> Tree -> Tree
scaleToSize Double
w Double
h Tree
t =
    Double -> Double -> Tree -> Tree
scaleXY (Double
wDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
w') (Double
hDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
h') Tree
t
  where
    (Double
_x, Double
_y, Double
w', Double
h') = Tree -> (Double, Double, Double, Double)
boundingBox Tree
t

-- | @scaleToWidth width@ scales the image so that the width of its bounding box ends up having
--   given @width@.
scaleToWidth :: Double -> Tree -> Tree
scaleToWidth :: Double -> Tree -> Tree
scaleToWidth Double
w Tree
t =
    Double -> Tree -> Tree
scale (Double
wDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
w') Tree
t
  where
    (Double
_x, Double
_y, Double
w', Double
_h') = Tree -> (Double, Double, Double, Double)
boundingBox Tree
t

-- | @scaleToHeight height@ scales the image so that the height of its bounding box ends up having
--   given @height@.
scaleToHeight :: Double -> Tree -> Tree
scaleToHeight :: Double -> Tree -> Tree
scaleToHeight Double
h Tree
t =
    Double -> Tree -> Tree
scale (Double
hDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
h') Tree
t
  where
    (Double
_x, Double
_y, Double
_w', Double
h') = Tree -> (Double, Double, Double, Double)
boundingBox Tree
t

-- | Similar to 'scale', except scale factors for X and Y axes are specified separately.
scaleXY :: Double -> Double -> Tree -> Tree
scaleXY :: Double -> Double -> Tree -> Tree
scaleXY Double
x Double
y = [Transformation] -> Tree -> Tree
withTransformations [Double -> Maybe Double -> Transformation
Scale Double
x (Double -> Maybe Double
forall a. a -> Maybe a
Just Double
y)]


-- | Flip the image along vertical axis so that what was on the right will end up on left and vice
--   versa.
flipXAxis :: Tree -> Tree
flipXAxis :: Tree -> Tree
flipXAxis = Double -> Double -> Tree -> Tree
scaleXY (-Double
1) Double
1

-- | Flip the image along horizontal so that what was on the top will end up in the bottom and vice
--   versa.
flipYAxis :: Tree -> Tree
flipYAxis :: Tree -> Tree
flipYAxis = Double -> Double -> Tree -> Tree
scaleXY Double
1 (-Double
1)

-- | Translate given image so that the center of its bouding box coincides with coordinates
--   @(0, 0)@.
center :: Tree -> Tree
center :: Tree -> Tree
center Tree
t = Tree -> Tree -> Tree
centerUsing Tree
t Tree
t

-- | Translate given image so that the X-coordinate of the center of its bouding box is 0.
centerX :: Tree -> Tree
centerX :: Tree -> Tree
centerX Tree
t = Double -> Double -> Tree -> Tree
translate (-Double
xDouble -> Double -> Double
forall a. Num a => a -> a -> a
-Double
wDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
2) Double
0 Tree
t
  where
    (Double
x, Double
_y, Double
w, Double
_h) = Tree -> (Double, Double, Double, Double)
boundingBox Tree
t

-- | Translate given image so that the Y-coordinate of the center of its bouding box is 0.
centerY :: Tree -> Tree
centerY :: Tree -> Tree
centerY Tree
t = Double -> Double -> Tree -> Tree
translate Double
0 (-Double
yDouble -> Double -> Double
forall a. Num a => a -> a -> a
-Double
hDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
2) Tree
t
  where
    (Double
_x, Double
y, Double
_w, Double
h) = Tree -> (Double, Double, Double, Double)
boundingBox Tree
t

-- | Center the second argument using the bounding-box of the first.
centerUsing :: Tree -> Tree -> Tree
centerUsing :: Tree -> Tree -> Tree
centerUsing Tree
a = Double -> Double -> Tree -> Tree
translate (-Double
xDouble -> Double -> Double
forall a. Num a => a -> a -> a
-Double
wDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
2) (-Double
yDouble -> Double -> Double
forall a. Num a => a -> a -> a
-Double
hDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
2)
  where
    (Double
x, Double
y, Double
w, Double
h) = Tree -> (Double, Double, Double, Double)
boundingBox Tree
a

-- | Create 'Texture' based on SVG color name.
--   See <https://en.wikipedia.org/wiki/Web_colors#X11_color_names> for the list of available names.
--   If the provided name doesn't correspond to valid SVG color name, white-ish color is used.
mkColor :: String -> Texture
mkColor :: String -> Texture
mkColor String
name =
  case Text -> Map Text PixelRGBA8 -> Maybe PixelRGBA8
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (String -> Text
T.pack String
name) Map Text PixelRGBA8
svgNamedColors of
    Maybe PixelRGBA8
Nothing -> PixelRGBA8 -> Texture
ColorRef (Pixel8 -> Pixel8 -> Pixel8 -> Pixel8 -> PixelRGBA8
PixelRGBA8 Pixel8
240 Pixel8
248 Pixel8
255 Pixel8
255)
    Just PixelRGBA8
c  -> PixelRGBA8 -> Texture
ColorRef PixelRGBA8
c

-- | See <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/stroke>
withStrokeColor :: String -> Tree -> Tree
withStrokeColor :: String -> Tree -> Tree
withStrokeColor String
color = (Last Texture -> Identity (Last Texture)) -> Tree -> Identity Tree
forall c. HasDrawAttributes c => Lens' c (Last Texture)
strokeColor ((Last Texture -> Identity (Last Texture))
 -> Tree -> Identity Tree)
-> Last Texture -> Tree -> Tree
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Texture -> Last Texture
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Texture
mkColor String
color)

-- | See <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/stroke>
withStrokeColorPixel :: PixelRGBA8 -> Tree -> Tree
withStrokeColorPixel :: PixelRGBA8 -> Tree -> Tree
withStrokeColorPixel PixelRGBA8
color = (Last Texture -> Identity (Last Texture)) -> Tree -> Identity Tree
forall c. HasDrawAttributes c => Lens' c (Last Texture)
strokeColor ((Last Texture -> Identity (Last Texture))
 -> Tree -> Identity Tree)
-> Last Texture -> Tree -> Tree
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Texture -> Last Texture
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PixelRGBA8 -> Texture
ColorRef PixelRGBA8
color)

-- | See <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/stroke-dasharray>
withStrokeDashArray :: [Double] -> Tree -> Tree
withStrokeDashArray :: [Double] -> Tree -> Tree
withStrokeDashArray [Double]
arr = (Last [Number] -> Identity (Last [Number]))
-> Tree -> Identity Tree
forall c. HasDrawAttributes c => Lens' c (Last [Number])
strokeDashArray ((Last [Number] -> Identity (Last [Number]))
 -> Tree -> Identity Tree)
-> Last [Number] -> Tree -> Tree
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Number] -> Last [Number]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Double -> Number) -> [Double] -> [Number]
forall a b. (a -> b) -> [a] -> [b]
map Double -> Number
Num [Double]
arr)

-- | See <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/stroke-linejoin>
withStrokeLineJoin :: LineJoin -> Tree -> Tree
withStrokeLineJoin :: LineJoin -> Tree -> Tree
withStrokeLineJoin LineJoin
ljoin = (Last LineJoin -> Identity (Last LineJoin))
-> Tree -> Identity Tree
forall c. HasDrawAttributes c => Lens' c (Last LineJoin)
strokeLineJoin ((Last LineJoin -> Identity (Last LineJoin))
 -> Tree -> Identity Tree)
-> Last LineJoin -> Tree -> Tree
forall s t a b. ASetter s t a b -> b -> s -> t
.~ LineJoin -> Last LineJoin
forall (f :: * -> *) a. Applicative f => a -> f a
pure LineJoin
ljoin

-- | See <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/fill>
withFillColor :: String -> Tree -> Tree
withFillColor :: String -> Tree -> Tree
withFillColor String
color = (Last Texture -> Identity (Last Texture)) -> Tree -> Identity Tree
forall c. HasDrawAttributes c => Lens' c (Last Texture)
fillColor ((Last Texture -> Identity (Last Texture))
 -> Tree -> Identity Tree)
-> Last Texture -> Tree -> Tree
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Texture -> Last Texture
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Texture
mkColor String
color)

-- | See <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/fill>
withFillColorPixel :: PixelRGBA8 -> Tree -> Tree
withFillColorPixel :: PixelRGBA8 -> Tree -> Tree
withFillColorPixel PixelRGBA8
color = (Last Texture -> Identity (Last Texture)) -> Tree -> Identity Tree
forall c. HasDrawAttributes c => Lens' c (Last Texture)
fillColor ((Last Texture -> Identity (Last Texture))
 -> Tree -> Identity Tree)
-> Last Texture -> Tree -> Tree
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Texture -> Last Texture
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PixelRGBA8 -> Texture
ColorRef PixelRGBA8
color)

-- | See <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/fill-opacity>
withFillOpacity :: Double -> Tree -> Tree
withFillOpacity :: Double -> Tree -> Tree
withFillOpacity Double
opacity = (Maybe Float -> Identity (Maybe Float)) -> Tree -> Identity Tree
forall c. HasDrawAttributes c => Lens' c (Maybe Float)
fillOpacity ((Maybe Float -> Identity (Maybe Float)) -> Tree -> Identity Tree)
-> Float -> Tree -> Tree
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 Double
opacity

-- | See <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/opacity>
withGroupOpacity :: Double -> Tree -> Tree
withGroupOpacity :: Double -> Tree -> Tree
withGroupOpacity Double
opacity = (Maybe Float -> Identity (Maybe Float)) -> Tree -> Identity Tree
forall c. HasDrawAttributes c => Lens' c (Maybe Float)
groupOpacity ((Maybe Float -> Identity (Maybe Float)) -> Tree -> Identity Tree)
-> Float -> Tree -> Tree
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 Double
opacity

-- | See <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/stroke-width>
withStrokeWidth :: Double -> Tree -> Tree
withStrokeWidth :: Double -> Tree -> Tree
withStrokeWidth Double
width = (Last Number -> Identity (Last Number)) -> Tree -> Identity Tree
forall c. HasDrawAttributes c => Lens' c (Last Number)
strokeWidth ((Last Number -> Identity (Last Number)) -> Tree -> Identity Tree)
-> Last Number -> Tree -> Tree
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Number -> Last Number
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Double -> Number
Num Double
width)

-- | See <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/clip-path>
withClipPathRef :: ElementRef -- ^ Reference to clip path defined previously (e.g. by 'mkClipPath')
                -> Tree -- ^ Image that will be clipped by the referenced clip path
                -> Tree
withClipPathRef :: ElementRef -> Tree -> Tree
withClipPathRef ElementRef
ref Tree
sub = [Tree] -> Tree
mkGroup [Tree
sub] Tree -> (Tree -> Tree) -> Tree
forall a b. a -> (a -> b) -> b
& (Last ElementRef -> Identity (Last ElementRef))
-> Tree -> Identity Tree
forall c. HasDrawAttributes c => Lens' c (Last ElementRef)
clipPathRef ((Last ElementRef -> Identity (Last ElementRef))
 -> Tree -> Identity Tree)
-> Last ElementRef -> Tree -> Tree
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ElementRef -> Last ElementRef
forall (f :: * -> *) a. Applicative f => a -> f a
pure ElementRef
ref

-- | Assigns ID attribute to given image.
withId :: String -> Tree -> Tree
withId :: String -> Tree -> Tree
withId String
idTag = (Maybe String -> Identity (Maybe String)) -> Tree -> Identity Tree
forall c. HasDrawAttributes c => Lens' c (Maybe String)
attrId ((Maybe String -> Identity (Maybe String))
 -> Tree -> Identity Tree)
-> String -> Tree -> Tree
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ String
idTag

-- | @mkRect width height@ creates a rectangle with given @with@ and @height@, centered at @(0, 0)@.
-- See <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/rect>
mkRect :: Double -> Double -> Tree
mkRect :: Double -> Double -> Tree
mkRect Double
width Double
height = Double -> Double -> Tree -> Tree
translate (-Double
widthDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
2) (-Double
heightDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
2) (Tree -> Tree) -> Tree -> Tree
forall a b. (a -> b) -> a -> b
$ Rectangle -> Tree
rectangleTree (Rectangle -> Tree) -> Rectangle -> Tree
forall a b. (a -> b) -> a -> b
$ Rectangle
forall a. WithDefaultSvg a => a
defaultSvg
  Rectangle -> (Rectangle -> Rectangle) -> Rectangle
forall a b. a -> (a -> b) -> b
& (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
0, Double -> Number
Num Double
0)
  Rectangle -> (Rectangle -> Rectangle) -> Rectangle
forall a b. a -> (a -> b) -> b
& (Maybe Number -> Identity (Maybe Number))
-> Rectangle -> Identity Rectangle
Lens' Rectangle (Maybe Number)
rectWidth ((Maybe Number -> Identity (Maybe Number))
 -> Rectangle -> Identity Rectangle)
-> Number -> Rectangle -> Rectangle
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Double -> Number
Num Double
width
  Rectangle -> (Rectangle -> Rectangle) -> Rectangle
forall a b. a -> (a -> b) -> b
& (Maybe Number -> Identity (Maybe Number))
-> Rectangle -> Identity Rectangle
Lens' Rectangle (Maybe Number)
rectHeight ((Maybe Number -> Identity (Maybe Number))
 -> Rectangle -> Identity Rectangle)
-> Number -> Rectangle -> Rectangle
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Double -> Number
Num Double
height

-- | Create a circle with given radius, centered at @(0, 0)@.
-- See <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/circle>
mkCircle :: Double -> Tree
mkCircle :: Double -> Tree
mkCircle Double
radius = Circle -> Tree
circleTree (Circle -> Tree) -> Circle -> Tree
forall a b. (a -> b) -> a -> b
$ Circle
forall a. WithDefaultSvg a => a
defaultSvg
  Circle -> (Circle -> Circle) -> Circle
forall a b. a -> (a -> b) -> b
& (Point -> Identity Point) -> Circle -> Identity Circle
Lens' Circle Point
circleCenter ((Point -> Identity Point) -> Circle -> Identity Circle)
-> Point -> Circle -> Circle
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Double -> Number
Num Double
0, Double -> Number
Num Double
0)
  Circle -> (Circle -> Circle) -> Circle
forall a b. a -> (a -> b) -> b
& (Number -> Identity Number) -> Circle -> Identity Circle
Lens' Circle Number
circleRadius ((Number -> Identity Number) -> Circle -> Identity Circle)
-> Number -> Circle -> Circle
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Double -> Number
Num Double
radius

-- | Create an ellipse given X-axis radius, and Y-axis radius, with center at @(0, 0)@.
-- See <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/ellipse>
mkEllipse :: Double -> Double -> Tree
mkEllipse :: Double -> Double -> Tree
mkEllipse Double
rx Double
ry = Ellipse -> Tree
ellipseTree (Ellipse -> Tree) -> Ellipse -> Tree
forall a b. (a -> b) -> a -> b
$ Ellipse
forall a. WithDefaultSvg a => a
defaultSvg
  Ellipse -> (Ellipse -> Ellipse) -> Ellipse
forall a b. a -> (a -> b) -> b
& (Point -> Identity Point) -> Ellipse -> Identity Ellipse
Lens' Ellipse Point
ellipseCenter ((Point -> Identity Point) -> Ellipse -> Identity Ellipse)
-> Point -> Ellipse -> Ellipse
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Double -> Number
Num Double
0, Double -> Number
Num Double
0)
  Ellipse -> (Ellipse -> Ellipse) -> Ellipse
forall a b. a -> (a -> b) -> b
& (Number -> Identity Number) -> Ellipse -> Identity Ellipse
Lens' Ellipse Number
ellipseXRadius ((Number -> Identity Number) -> Ellipse -> Identity Ellipse)
-> Number -> Ellipse -> Ellipse
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Double -> Number
Num Double
rx
  Ellipse -> (Ellipse -> Ellipse) -> Ellipse
forall a b. a -> (a -> b) -> b
& (Number -> Identity Number) -> Ellipse -> Identity Ellipse
Lens' Ellipse Number
ellipseYRadius ((Number -> Identity Number) -> Ellipse -> Identity Ellipse)
-> Number -> Ellipse -> Ellipse
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Double -> Number
Num Double
ry

-- | Create a line segment between two points given by their @(x, y)@ coordinates.
-- See <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/line>
mkLine :: (Double,Double) -> (Double, Double) -> Tree
mkLine :: (Double, Double) -> (Double, Double) -> Tree
mkLine (Double
x1,Double
y1) (Double
x2,Double
y2) = Line -> Tree
lineTree (Line -> Tree) -> Line -> Tree
forall a b. (a -> b) -> a -> b
$ Line
forall a. WithDefaultSvg a => a
defaultSvg
  Line -> (Line -> Line) -> Line
forall a b. a -> (a -> b) -> b
& (Point -> Identity Point) -> Line -> Identity Line
Lens' Line Point
linePoint1 ((Point -> Identity Point) -> Line -> Identity Line)
-> Point -> Line -> Line
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Double -> Number
Num Double
x1, Double -> Number
Num Double
y1)
  Line -> (Line -> Line) -> Line
forall a b. a -> (a -> b) -> b
& (Point -> Identity Point) -> Line -> Identity Line
Lens' Line Point
linePoint2 ((Point -> Identity Point) -> Line -> Identity Line)
-> Point -> Line -> Line
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Double -> Number
Num Double
x2, Double -> Number
Num Double
y2)

-- | Merges multiple images into one.
-- See <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/g>
mkGroup :: [Tree] -> Tree
mkGroup :: [Tree] -> Tree
mkGroup [Tree]
forest = Group -> Tree
groupTree (Group -> Tree) -> Group -> Tree
forall a b. (a -> b) -> a -> b
$ Group
forall a. WithDefaultSvg a => a
defaultSvg
  Group -> (Group -> Group) -> Group
forall a b. a -> (a -> b) -> 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]
forest

-- | Create definition of graphical objects that can be used at later time.
--   See <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/defs>
mkDefinitions :: [Tree] -> Tree
mkDefinitions :: [Tree] -> Tree
mkDefinitions [Tree]
forest = Group -> Tree
definitionTree (Group -> Tree) -> Group -> Tree
forall a b. (a -> b) -> a -> b
$ Group
forall a. WithDefaultSvg a => a
defaultSvg
  Group -> (Group -> Group) -> Group
forall a b. a -> (a -> b) -> 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]
forest

-- | Create an element by referring to existing element defined previously.
-- For example you can create a graphical element, assign ID to it using 'withId', wrap it in
-- 'mkDefinitions' and then use it via @use "myId"@.
-- See <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/use>
mkUse :: String -> Tree
mkUse :: String -> Tree
mkUse String
name = Use -> Tree
useTree (Use
forall a. WithDefaultSvg a => a
defaultSvg Use -> (Use -> Use) -> Use
forall a b. a -> (a -> b) -> b
& (String -> Identity String) -> Use -> Identity Use
Lens' Use String
useName ((String -> Identity String) -> Use -> Identity Use)
-> String -> Use -> Use
forall s t a b. ASetter s t a b -> b -> s -> t
.~ String
name)

-- | A clip path restricts the region to which paint can be applied.
-- See <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/clipPath>
mkClipPath :: String  -- ^ ID of the clip path, which can then be referred to by other elements
                      --   using 'withClipPathRef'.
           -> [Tree] -- ^ List of shapes that will determine the final shape of the clipping region
           -> Tree
mkClipPath :: String -> [Tree] -> Tree
mkClipPath String
idTag [Tree]
forest = String -> Tree -> Tree
withId String
idTag (Tree -> Tree) -> Tree -> Tree
forall a b. (a -> b) -> a -> b
$ ClipPath -> Tree
clipPathTree (ClipPath -> Tree) -> ClipPath -> Tree
forall a b. (a -> b) -> a -> b
$ ClipPath
forall a. WithDefaultSvg a => a
defaultSvg
  ClipPath -> (ClipPath -> ClipPath) -> ClipPath
forall a b. a -> (a -> b) -> b
& ([Tree] -> Identity [Tree]) -> ClipPath -> Identity ClipPath
Lens' ClipPath [Tree]
clipPathContent (([Tree] -> Identity [Tree]) -> ClipPath -> Identity ClipPath)
-> [Tree] -> ClipPath -> ClipPath
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Tree]
forest

-- | Create a path from the list of path commands.
--   See <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/d#Path_commands>
mkPath :: [PathCommand] -> Tree
mkPath :: [PathCommand] -> Tree
mkPath [PathCommand]
cmds = Path -> Tree
pathTree (Path -> Tree) -> Path -> Tree
forall a b. (a -> b) -> a -> b
$ Path
forall a. WithDefaultSvg a => a
defaultSvg Path -> (Path -> Path) -> Path
forall a b. a -> (a -> b) -> b
& ([PathCommand] -> Identity [PathCommand]) -> Path -> Identity Path
Lens' Path [PathCommand]
pathDefinition (([PathCommand] -> Identity [PathCommand])
 -> Path -> Identity Path)
-> [PathCommand] -> Path -> Path
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [PathCommand]
cmds

-- | Similar to 'mkPathText', but taking SVG path command as a String.
mkPathString :: String -> Tree
mkPathString :: String -> Tree
mkPathString = Text -> Tree
mkPathText (Text -> Tree) -> (String -> Text) -> String -> Tree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

-- | Create path from textual representation of SVG path command.
--   If the text doesn't represent valid path command, this function fails with 'Prelude.error'.
--   Use 'mkPath' for type safe way of creating paths.
mkPathText :: T.Text -> Tree
mkPathText :: Text -> Tree
mkPathText Text
str =
  case Parser [PathCommand] -> Text -> Either String [PathCommand]
forall a. Parser a -> Text -> Either String a
parseOnly Parser [PathCommand]
pathParser Text
str of
    Left String
err   -> String -> Tree
forall a. HasCallStack => String -> a
error String
err
    Right [PathCommand]
cmds -> [PathCommand] -> Tree
mkPath [PathCommand]
cmds

-- | Create a path from a list of @(x, y)@ coordinates of points along the path.
mkLinePath :: [(Double, Double)] -> Tree
mkLinePath :: [(Double, Double)] -> Tree
mkLinePath [] = [Tree] -> Tree
mkGroup []
mkLinePath ((Double
startX, Double
startY):[(Double, Double)]
rest) =
    Path -> Tree
pathTree (Path -> Tree) -> Path -> Tree
forall a b. (a -> b) -> a -> b
$ Path
forall a. WithDefaultSvg a => a
defaultSvg Path -> (Path -> Path) -> Path
forall a b. a -> (a -> b) -> b
& ([PathCommand] -> Identity [PathCommand]) -> Path -> Identity Path
Lens' Path [PathCommand]
pathDefinition (([PathCommand] -> Identity [PathCommand])
 -> Path -> Identity Path)
-> [PathCommand] -> Path -> Path
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [PathCommand]
cmds
  where
    cmds :: [PathCommand]
cmds = [ Origin -> [RPoint] -> PathCommand
MoveTo Origin
OriginAbsolute [Double -> Double -> RPoint
forall a. a -> a -> V2 a
V2 Double
startX Double
startY]
           , Origin -> [RPoint] -> PathCommand
LineTo Origin
OriginAbsolute [ Double -> Double -> RPoint
forall a. a -> a -> V2 a
V2 Double
x Double
y | (Double
x, Double
y) <- [(Double, Double)]
rest ] ]

-- | Create a path from a list of @(x, y)@ coordinates of points along the path.
mkLinePathClosed :: [(Double, Double)] -> Tree
mkLinePathClosed :: [(Double, Double)] -> Tree
mkLinePathClosed [] = [Tree] -> Tree
mkGroup []
mkLinePathClosed ((Double
startX, Double
startY):[(Double, Double)]
rest) =
    Path -> Tree
pathTree (Path -> Tree) -> Path -> Tree
forall a b. (a -> b) -> a -> b
$ Path
forall a. WithDefaultSvg a => a
defaultSvg Path -> (Path -> Path) -> Path
forall a b. a -> (a -> b) -> b
& ([PathCommand] -> Identity [PathCommand]) -> Path -> Identity Path
Lens' Path [PathCommand]
pathDefinition (([PathCommand] -> Identity [PathCommand])
 -> Path -> Identity Path)
-> [PathCommand] -> Path -> Path
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [PathCommand]
cmds
  where
    cmds :: [PathCommand]
cmds = [ Origin -> [RPoint] -> PathCommand
MoveTo Origin
OriginAbsolute [Double -> Double -> RPoint
forall a. a -> a -> V2 a
V2 Double
startX Double
startY]
           , Origin -> [RPoint] -> PathCommand
LineTo Origin
OriginAbsolute [ Double -> Double -> RPoint
forall a. a -> a -> V2 a
V2 Double
x Double
y | (Double
x, Double
y) <- [(Double, Double)]
rest ]
           , PathCommand
EndPath ]

-- | Rectangle with a uniform color and the same size as the screen.
--
--   Example:
--
-- @
-- 'Reanimate.animate' $ 'const' $ 'mkBackground' "yellow"
-- @
--
--   <<docs/gifs/doc_mkBackground.gif>>
mkBackground :: String -> Tree
mkBackground :: String -> Tree
mkBackground String
color = Double -> Tree -> Tree
withFillOpacity Double
1 (Tree -> Tree) -> Tree -> Tree
forall a b. (a -> b) -> a -> b
$  Double -> Tree -> Tree
withStrokeWidth Double
0 (Tree -> Tree) -> Tree -> Tree
forall a b. (a -> b) -> a -> b
$
  String -> Tree -> Tree
withFillColor String
color (Tree -> Tree) -> Tree -> Tree
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Tree
mkRect Double
forall a. Fractional a => a
screenWidth Double
forall a. Fractional a => a
screenHeight

-- | Rectangle with a uniform color and the same size as the screen.
mkBackgroundPixel :: PixelRGBA8 -> Tree
mkBackgroundPixel :: PixelRGBA8 -> Tree
mkBackgroundPixel PixelRGBA8
pixel =
    Double -> Tree -> Tree
withFillOpacity Double
1 (Tree -> Tree) -> Tree -> Tree
forall a b. (a -> b) -> a -> b
$ Double -> Tree -> Tree
withStrokeWidth Double
0 (Tree -> Tree) -> Tree -> Tree
forall a b. (a -> b) -> a -> b
$
    PixelRGBA8 -> Tree -> Tree
withFillColorPixel PixelRGBA8
pixel (Tree -> Tree) -> Tree -> Tree
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Tree
mkRect Double
forall a. Fractional a => a
screenWidth Double
forall a. Fractional a => a
screenHeight

-- | Take list of rows, where each row consists of number of images and display them in regular
--   grid structure.
--   All rows will get equal amount of vertical space.
--   The images within each row will get equal amount of horizontal space, independent of the other
--   rows. Each row can contain different number of cells.
gridLayout :: [[Tree]] -> Tree
gridLayout :: [[Tree]] -> Tree
gridLayout [[Tree]]
rows = [Tree] -> Tree
mkGroup
    [ Double -> Double -> Tree -> Tree
translate (-Double
forall a. Fractional a => a
screenWidthDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
2Double -> Double -> Double
forall a. Num a => a -> a -> a
+Double
colSepDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
nCol Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
colSepDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
0.5)
                (Double
forall a. Fractional a => a
screenHeightDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
2Double -> Double -> Double
forall a. Num a => a -> a -> a
-Double
rowSepDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
nRow Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
rowSepDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
0.5)
      Tree
elt
    | (Double
nRow, [Tree]
row) <- [Double] -> [[Tree]] -> [(Double, [Tree])]
forall a b. [a] -> [b] -> [(a, b)]
zip [Double
0..] [[Tree]]
rows
    , let nCols :: Int
nCols = [Tree] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Tree]
row
          colSep :: Double
colSep = Double
forall a. Fractional a => a
screenWidth Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nCols
    , (Double
nCol, Tree
elt) <- [Double] -> [Tree] -> [(Double, Tree)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Double
0..] [Tree]
row ]
  where
    rowSep :: Double
rowSep = Double
forall a. Fractional a => a
screenHeight Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nRows
    nRows :: Int
nRows = [[Tree]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Tree]]
rows

-- | Insert a native text object anchored at the middle.
--
--   Example:
--
-- @
-- 'Reanimate.mkAnimation' 2 $ \\t -> 'scale' 2 $ 'withStrokeWidth' 0.05 $ 'mkText' (T.take (round $ t*15) "text")
-- @
--
--   <<docs/gifs/doc_mkText.gif>>
mkText :: T.Text -> Tree
mkText :: Text -> Tree
mkText Text
str =
  Tree -> Tree
flipYAxis
  (Maybe TextPath -> Text -> Tree
TextTree Maybe TextPath
forall a. Maybe a
Nothing (Text -> Tree) -> Text -> Tree
forall a b. (a -> b) -> a -> b
$ Text
forall a. WithDefaultSvg a => a
defaultSvg
    Text -> (Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
& (TextSpan -> Identity TextSpan) -> Text -> Identity Text
Lens' Text TextSpan
textRoot ((TextSpan -> Identity TextSpan) -> Text -> Identity Text)
-> TextSpan -> Text -> Text
forall s t a b. ASetter s t a b -> b -> s -> t
.~ TextSpan
span_
    Text -> (Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
& (Last Number -> Identity (Last Number)) -> Text -> Identity Text
forall c. HasDrawAttributes c => Lens' c (Last Number)
fontSize ((Last Number -> Identity (Last Number)) -> Text -> Identity Text)
-> Last Number -> Text -> Text
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Number -> Last Number
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Double -> Number
Num Double
2))
    Tree -> (Tree -> Tree) -> Tree
forall a b. a -> (a -> b) -> b
& (Last TextAnchor -> Identity (Last TextAnchor))
-> Tree -> Identity Tree
forall c. HasDrawAttributes c => Lens' c (Last TextAnchor)
textAnchor ((Last TextAnchor -> Identity (Last TextAnchor))
 -> Tree -> Identity Tree)
-> Last TextAnchor -> Tree -> Tree
forall s t a b. ASetter s t a b -> b -> s -> t
.~ TextAnchor -> Last TextAnchor
forall (f :: * -> *) a. Applicative f => a -> f a
pure TextAnchor
TextAnchorMiddle
    -- Note: TextAnchorMiddle is placed on the 'flipYAxis' group such that it can easily
    -- be overwritten by the user.
  where
    span_ :: TextSpan
span_ = TextSpan
forall a. WithDefaultSvg a => a
defaultSvg TextSpan -> (TextSpan -> TextSpan) -> TextSpan
forall a b. a -> (a -> b) -> b
& ([TextSpanContent] -> Identity [TextSpanContent])
-> TextSpan -> Identity TextSpan
Lens' TextSpan [TextSpanContent]
spanContent (([TextSpanContent] -> Identity [TextSpanContent])
 -> TextSpan -> Identity TextSpan)
-> [TextSpanContent] -> TextSpan -> TextSpan
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Text -> TextSpanContent
SpanText Text
str]

-- | Switch from the default viewbox to a custom viewbox. Nesting custom viewboxes is
--   unlikely to give good results. If you need nested custom viewboxes, you will have
--   to configure them by hand.
--
--   The viewbox argument is (min-x, min-y, width, height).
--
--   Example:
--
-- @
-- 'withViewBox' (0,0,1,1) $ 'mkBackground' "yellow"
-- @
--
--   <<docs/gifs/doc_withViewBox.gif>>
withViewBox :: (Double, Double, Double, Double) -> Tree -> Tree
withViewBox :: (Double, Double, Double, Double) -> Tree -> Tree
withViewBox (Double, Double, Double, Double)
vbox Tree
child = Double -> Double -> Tree -> Tree
translate (-Double
forall a. Fractional a => a
screenWidthDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
2) (-Double
forall a. Fractional a => a
screenHeightDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
2) (Tree -> Tree) -> Tree -> Tree
forall a b. (a -> b) -> a -> b
$
  Document -> Tree
svgTree Document :: Maybe (Double, Double, Double, Double)
-> Maybe Number
-> Maybe Number
-> [Tree]
-> 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 :: [Tree]
_documentElements = [Tree
child]
  , _documentDescription :: String
_documentDescription = String
""
  , _documentLocation :: String
_documentLocation = String
""
  , _documentAspectRatio :: PreserveAspectRatio
_documentAspectRatio = Bool -> Alignment -> Maybe MeetSlice -> PreserveAspectRatio
PreserveAspectRatio Bool
False Alignment
AlignNone Maybe MeetSlice
forall a. Maybe a
Nothing
  }