never executed always true always false
1 {-| Functions for creating basic SVG elements and applying transformations to them. -}
2 module Reanimate.Svg.Constructors
3 ( -- * Primitive shapes
4 mkCircle
5 , mkEllipse
6 , mkRect
7 , mkLine
8 , mkPath
9 , mkPathString
10 , mkPathText
11 , mkLinePath
12 , mkLinePathClosed
13 , mkClipPath
14 , mkText
15 -- * Grouping shapes and definitions
16 , mkGroup
17 , mkDefinitions
18 , mkUse
19 -- * Attributes
20 , withId
21 , withStrokeColor
22 , withStrokeColorPixel
23 , withStrokeDashArray
24 , withStrokeLineJoin
25 , withFillColor
26 , withFillColorPixel
27 , withFillOpacity
28 , withGroupOpacity
29 , withStrokeWidth
30 , withClipPathRef
31 -- * Transformations
32 , center
33 , centerX
34 , centerY
35 , centerUsing
36 , translate
37 , rotate
38 , rotateAroundCenter
39 , rotateAround
40 , scale
41 , scaleToSize
42 , scaleToWidth
43 , scaleToHeight
44 , scaleXY
45 , flipXAxis
46 , flipYAxis
47 , aroundCenter
48 , aroundCenterX
49 , aroundCenterY
50 , withTransformations
51 , withViewBox
52 -- * Other
53 , mkColor
54 , mkBackground
55 , mkBackgroundPixel
56 , gridLayout
57
58 ) where
59
60 import Codec.Picture (PixelRGBA8 (..))
61 import Control.Lens ((&), (.~), (?~))
62 import Data.Attoparsec.Text (parseOnly)
63 import qualified Data.Map as Map
64 import qualified Data.Text as T
65 import Graphics.SvgTree hiding (height, line, path, use,
66 width)
67 import Graphics.SvgTree.NamedColors
68 import Graphics.SvgTree.PathParser
69 import Linear.V2 hiding (angle)
70 import Reanimate.Constants
71 import Reanimate.Svg.BoundingBox
72
73 -- | Apply list of transformations to given image.
74 withTransformations :: [Transformation] -> Tree -> Tree
75 withTransformations transformations t =
76 mkGroup [t] & transform ?~ transformations
77
78 -- | @translate x y image@ moves the @image@ by @x@ along X-axis and by @y@ along Y-axis.
79 translate :: Double -> Double -> Tree -> Tree
80 translate x y = withTransformations [Translate x y]
81
82 -- | @rotate angle image@ rotates the @image@ around origin @(0,0)@ counterclockwise by @angle@
83 -- given in degrees.
84 rotate :: Double -> Tree -> Tree
85 rotate a = withTransformations [Rotate a Nothing]
86
87 -- | @rotate angle point image@ rotates the @image@ around given @point@ counterclockwise by
88 -- @angle@ given in degrees.
89 rotateAround :: Double -> RPoint -> Tree -> Tree
90 rotateAround a (V2 x y) = withTransformations [Rotate a (Just (x,y))]
91
92 -- | @rotate angle image@ rotates the @image@ around the center of its bounding box counterclockwise
93 -- by @angle@ given in degrees.
94 rotateAroundCenter :: Double -> Tree -> Tree
95 rotateAroundCenter a t =
96 rotateAround a (V2 (x+w/2) (y+h/2)) t
97 where
98 (x,y,w,h) = boundingBox t
99
100 -- | @aroundCenter f image@ first moves the image so the center of its bounding box is at the origin
101 -- @(0, 0)@, applies transformation @f@ to it and then moves the transformed image back to its
102 -- original position.
103 aroundCenter :: (Tree -> Tree) -> Tree -> Tree
104 aroundCenter fn t =
105 translate (-offsetX) (-offsetY) $ fn $ translate offsetX offsetY t
106 where
107 offsetX = -x-w/2
108 offsetY = -y-h/2
109 (x,y,w,h) = boundingBox t
110
111 -- | Same as 'aroundCenter' but only for the Y-axis.
112 aroundCenterY :: (Tree -> Tree) -> Tree -> Tree
113 aroundCenterY fn t =
114 translate 0 (-offsetY) $ fn $ translate 0 offsetY t
115 where
116 offsetY = -y-h/2
117 (_x,y,_w,h) = boundingBox t
118
119 -- | Same as 'aroundCenter' but only for the X-axis.
120 aroundCenterX :: (Tree -> Tree) -> Tree -> Tree
121 aroundCenterX fn t =
122 translate (-offsetX) 0 $ fn $ translate offsetX 0 t
123 where
124 offsetX = -x-w/2
125 (x,_y,w,_h) = boundingBox t
126
127 -- | Scale the image uniformly by given factor along both X and Y axes.
128 -- For example @scale 2 image@ makes the image twice as large, while @scale 0.5 image@ makes it
129 -- half the original size. Negative values are also allowed, and lead to flipping the image along
130 -- both X and Y axes.
131 scale :: Double -> Tree -> Tree
132 scale a = withTransformations [Scale a Nothing]
133
134 -- | @scaleToSize width height@ resizes the image so that its bounding box has corresponding @width@
135 -- and @height@.
136 scaleToSize :: Double -> Double -> Tree -> Tree
137 scaleToSize w h t =
138 scaleXY (w/w') (h/h') t
139 where
140 (_x, _y, w', h') = boundingBox t
141
142 -- | @scaleToWidth width@ scales the image so that the width of its bounding box ends up having
143 -- given @width@.
144 scaleToWidth :: Double -> Tree -> Tree
145 scaleToWidth w t =
146 scale (w/w') t
147 where
148 (_x, _y, w', _h') = boundingBox t
149
150 -- | @scaleToHeight height@ scales the image so that the height of its bounding box ends up having
151 -- given @height@.
152 scaleToHeight :: Double -> Tree -> Tree
153 scaleToHeight h t =
154 scale (h/h') t
155 where
156 (_x, _y, _w', h') = boundingBox t
157
158 -- | Similar to 'scale', except scale factors for X and Y axes are specified separately.
159 scaleXY :: Double -> Double -> Tree -> Tree
160 scaleXY x y = withTransformations [Scale x (Just y)]
161
162
163 -- | Flip the image along vertical axis so that what was on the right will end up on left and vice
164 -- versa.
165 flipXAxis :: Tree -> Tree
166 flipXAxis = scaleXY (-1) 1
167
168 -- | Flip the image along horizontal so that what was on the top will end up in the bottom and vice
169 -- versa.
170 flipYAxis :: Tree -> Tree
171 flipYAxis = scaleXY 1 (-1)
172
173 -- | Translate given image so that the center of its bouding box coincides with coordinates
174 -- @(0, 0)@.
175 center :: Tree -> Tree
176 center t = centerUsing t t
177
178 -- | Translate given image so that the X-coordinate of the center of its bouding box is 0.
179 centerX :: Tree -> Tree
180 centerX t = translate (-x-w/2) 0 t
181 where
182 (x, _y, w, _h) = boundingBox t
183
184 -- | Translate given image so that the Y-coordinate of the center of its bouding box is 0.
185 centerY :: Tree -> Tree
186 centerY t = translate 0 (-y-h/2) t
187 where
188 (_x, y, _w, h) = boundingBox t
189
190 -- | Center the second argument using the bounding-box of the first.
191 centerUsing :: Tree -> Tree -> Tree
192 centerUsing a = translate (-x-w/2) (-y-h/2)
193 where
194 (x, y, w, h) = boundingBox a
195
196 -- | Create 'Texture' based on SVG color name.
197 -- See <https://en.wikipedia.org/wiki/Web_colors#X11_color_names> for the list of available names.
198 -- If the provided name doesn't correspond to valid SVG color name, white-ish color is used.
199 mkColor :: String -> Texture
200 mkColor name =
201 case Map.lookup (T.pack name) svgNamedColors of
202 Nothing -> ColorRef (PixelRGBA8 240 248 255 255)
203 Just c -> ColorRef c
204
205 -- | See <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/stroke>
206 withStrokeColor :: String -> Tree -> Tree
207 withStrokeColor color = strokeColor .~ pure (mkColor color)
208
209 -- | See <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/stroke>
210 withStrokeColorPixel :: PixelRGBA8 -> Tree -> Tree
211 withStrokeColorPixel color = strokeColor .~ pure (ColorRef color)
212
213 -- | See <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/stroke-dasharray>
214 withStrokeDashArray :: [Double] -> Tree -> Tree
215 withStrokeDashArray arr = strokeDashArray .~ pure (map Num arr)
216
217 -- | See <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/stroke-linejoin>
218 withStrokeLineJoin :: LineJoin -> Tree -> Tree
219 withStrokeLineJoin ljoin = strokeLineJoin .~ pure ljoin
220
221 -- | See <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/fill>
222 withFillColor :: String -> Tree -> Tree
223 withFillColor color = fillColor .~ pure (mkColor color)
224
225 -- | See <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/fill>
226 withFillColorPixel :: PixelRGBA8 -> Tree -> Tree
227 withFillColorPixel color = fillColor .~ pure (ColorRef color)
228
229 -- | See <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/fill-opacity>
230 withFillOpacity :: Double -> Tree -> Tree
231 withFillOpacity opacity = fillOpacity ?~ realToFrac opacity
232
233 -- | See <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/opacity>
234 withGroupOpacity :: Double -> Tree -> Tree
235 withGroupOpacity opacity = groupOpacity ?~ realToFrac opacity
236
237 -- | See <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/stroke-width>
238 withStrokeWidth :: Double -> Tree -> Tree
239 withStrokeWidth width = strokeWidth .~ pure (Num width)
240
241 -- | See <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/clip-path>
242 withClipPathRef :: ElementRef -- ^ Reference to clip path defined previously (e.g. by 'mkClipPath')
243 -> Tree -- ^ Image that will be clipped by the referenced clip path
244 -> Tree
245 withClipPathRef ref sub = mkGroup [sub] & clipPathRef .~ pure ref
246
247 -- | Assigns ID attribute to given image.
248 withId :: String -> Tree -> Tree
249 withId idTag = attrId ?~ idTag
250
251 -- | @mkRect width height@ creates a rectangle with given @with@ and @height@, centered at @(0, 0)@.
252 -- See <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/rect>
253 mkRect :: Double -> Double -> Tree
254 mkRect width height = translate (-width/2) (-height/2) $ RectangleTree $ defaultSvg
255 & rectUpperLeftCorner .~ (Num 0, Num 0)
256 & rectWidth ?~ Num width
257 & rectHeight ?~ Num height
258
259 -- | Create a circle with given radius, centered at @(0, 0)@.
260 -- See <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/circle>
261 mkCircle :: Double -> Tree
262 mkCircle radius = CircleTree $ defaultSvg
263 & circleCenter .~ (Num 0, Num 0)
264 & circleRadius .~ Num radius
265
266 -- | Create an ellipse given X-axis radius, and Y-axis radius, with center at @(0, 0)@.
267 -- See <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/ellipse>
268 mkEllipse :: Double -> Double -> Tree
269 mkEllipse rx ry = EllipseTree $ defaultSvg
270 & ellipseCenter .~ (Num 0, Num 0)
271 & ellipseXRadius .~ Num rx
272 & ellipseYRadius .~ Num ry
273
274 -- | Create a line segment between two points given by their @(x, y)@ coordinates.
275 -- See <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/line>
276 mkLine :: (Double,Double) -> (Double, Double) -> Tree
277 mkLine (x1,y1) (x2,y2) = LineTree $ defaultSvg
278 & linePoint1 .~ (Num x1, Num y1)
279 & linePoint2 .~ (Num x2, Num y2)
280
281 -- | Merges multiple images into one.
282 -- See <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/g>
283 mkGroup :: [Tree] -> Tree
284 mkGroup forest = GroupTree $ defaultSvg
285 & groupChildren .~ forest
286
287 -- | Create definition of graphical objects that can be used at later time.
288 -- See <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/defs>
289 mkDefinitions :: [Tree] -> Tree
290 mkDefinitions forest = DefinitionTree $ defaultSvg
291 & groupChildren .~ forest
292
293 -- | Create an element by referring to existing element defined previously.
294 -- For example you can create a graphical element, assign ID to it using 'withId', wrap it in
295 -- 'mkDefinitions' and then use it via @use "myId"@.
296 -- See <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/use>
297 mkUse :: String -> Tree
298 mkUse name = UseTree (defaultSvg & useName .~ name) Nothing
299
300 -- | A clip path restricts the region to which paint can be applied.
301 -- See <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/clipPath>
302 mkClipPath :: String -- ^ ID of the clip path, which can then be referred to by other elements
303 -- using 'withClipPathRef'.
304 -> [Tree] -- ^ List of shapes that will determine the final shape of the clipping region
305 -> Tree
306 mkClipPath idTag forest = withId idTag $ ClipPathTree $ defaultSvg
307 & clipPathContent .~ forest
308
309 -- | Create a path from the list of path commands.
310 -- See <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/d#Path_commands>
311 mkPath :: [PathCommand] -> Tree
312 mkPath cmds = PathTree $ defaultSvg & pathDefinition .~ cmds
313
314 -- | Similar to 'mkPathText', but taking SVG path command as a String.
315 mkPathString :: String -> Tree
316 mkPathString = mkPathText . T.pack
317
318 -- | Create path from textual representation of SVG path command.
319 -- If the text doesn't represent valid path command, this function fails with 'Prelude.error'.
320 -- Use 'mkPath' for type safe way of creating paths.
321 mkPathText :: T.Text -> Tree
322 mkPathText str =
323 case parseOnly pathParser str of
324 Left err -> error err
325 Right cmds -> mkPath cmds
326
327 -- | Create a path from a list of @(x, y)@ coordinates of points along the path.
328 mkLinePath :: [(Double, Double)] -> Tree
329 mkLinePath [] = mkGroup []
330 mkLinePath ((startX, startY):rest) =
331 PathTree $ defaultSvg & pathDefinition .~ cmds
332 where
333 cmds = [ MoveTo OriginAbsolute [V2 startX startY]
334 , LineTo OriginAbsolute [ V2 x y | (x, y) <- rest ] ]
335
336 -- | Create a path from a list of @(x, y)@ coordinates of points along the path.
337 mkLinePathClosed :: [(Double, Double)] -> Tree
338 mkLinePathClosed [] = mkGroup []
339 mkLinePathClosed ((startX, startY):rest) =
340 PathTree $ defaultSvg & pathDefinition .~ cmds
341 where
342 cmds = [ MoveTo OriginAbsolute [V2 startX startY]
343 , LineTo OriginAbsolute [ V2 x y | (x, y) <- rest ]
344 , EndPath ]
345
346 -- | Rectangle with a uniform color and the same size as the screen.
347 --
348 -- Example:
349 --
350 -- @
351 -- 'Reanimate.animate' $ 'const' $ 'mkBackground' "yellow"
352 -- @
353 --
354 -- <<docs/gifs/doc_mkBackground.gif>>
355 mkBackground :: String -> Tree
356 mkBackground color = withFillOpacity 1 $ withStrokeWidth 0 $
357 withFillColor color $ mkRect screenWidth screenHeight
358
359 -- | Rectangle with a uniform color and the same size as the screen.
360 mkBackgroundPixel :: PixelRGBA8 -> Tree
361 mkBackgroundPixel pixel =
362 withFillOpacity 1 $ withStrokeWidth 0 $
363 withFillColorPixel pixel $ mkRect screenWidth screenHeight
364
365 -- | Take list of rows, where each row consists of number of images and display them in regular
366 -- grid structure.
367 -- All rows will get equal amount of vertical space.
368 -- The images within each row will get equal amount of horizontal space, independent of the other
369 -- rows. Each row can contain different number of cells.
370 gridLayout :: [[Tree]] -> Tree
371 gridLayout rows = mkGroup
372 [ translate (-screenWidth/2+colSep*nCol + colSep*0.5)
373 (screenHeight/2-rowSep*nRow - rowSep*0.5)
374 elt
375 | (nRow, row) <- zip [0..] rows
376 , let nCols = length row
377 colSep = screenWidth / fromIntegral nCols
378 , (nCol, elt) <- zip [0..] row ]
379 where
380 rowSep = screenHeight / fromIntegral nRows
381 nRows = length rows
382
383 -- | Insert a native text object anchored at the middle.
384 --
385 -- Example:
386 --
387 -- @
388 -- 'Reanimate.mkAnimation' 2 $ \\t -> 'scale' 2 $ 'withStrokeWidth' 0.05 $ 'mkText' (T.take (round $ t*15) "text")
389 -- @
390 --
391 -- <<docs/gifs/doc_mkText.gif>>
392 mkText :: T.Text -> Tree
393 mkText str =
394 flipYAxis
395 (TextTree Nothing $ defaultSvg
396 & textRoot .~ span_
397 & fontSize .~ pure (Num 2))
398 & textAnchor .~ pure TextAnchorMiddle
399 -- Note: TextAnchorMiddle is placed on the 'flipYAxis' group such that it can easily
400 -- be overwritten by the user.
401 where
402 span_ = defaultSvg & spanContent .~ [SpanText str]
403
404 -- | Switch from the default viewbox to a custom viewbox. Nesting custom viewboxes is
405 -- unlikely to give good results. If you need nested custom viewboxes, you will have
406 -- to configure them by hand.
407 --
408 -- The viewbox argument is (min-x, min-y, width, height).
409 --
410 -- Example:
411 --
412 -- @
413 -- 'withViewBox' (0,0,1,1) $ 'mkBackground' "yellow"
414 -- @
415 --
416 -- <<docs/gifs/doc_withViewBox.gif>>
417 withViewBox :: (Double, Double, Double, Double) -> Tree -> Tree
418 withViewBox vbox child = translate (-screenWidth/2) (-screenHeight/2) $
419 SvgTree $ Document
420 { _viewBox = Just vbox
421 , _width = Just (Num screenWidth)
422 , _height = Just (Num screenHeight)
423 , _elements = [child]
424 , _description = ""
425 , _documentLocation = ""
426 , _documentAspectRatio = PreserveAspectRatio False AlignNone Nothing
427 }