never executed always true always false
1 {-|
2 Bounding-boxes can be immensely useful for aligning objects
3 but they are not part of the SVG specification and cannot be
4 computed for all SVG nodes. In particular, you'll get bad results
5 when asking for the bounding boxes of Text nodes (because fonts
6 are difficult), clipped nodes, and filtered nodes.
7 -}
8 module Reanimate.Svg.BoundingBox
9 ( boundingBox
10 , svgHeight
11 , svgWidth
12 ) where
13
14 import Control.Arrow ((***))
15 import Control.Lens ((^.))
16 import Data.List
17 import Data.Maybe (mapMaybe)
18 import Graphics.SvgTree hiding (height, line, path, use,
19 width)
20 import Linear.V2 hiding (angle)
21 import Linear.Vector
22 import Reanimate.Constants
23 import Reanimate.Svg.LineCommand
24 import qualified Reanimate.Transform as Transform
25 -- import qualified Geom2D.CubicBezier as Bezier
26
27 -- | Return bounding box of SVG tree.
28 -- The four numbers returned are (minimal X-coordinate, minimal Y-coordinate, width, height)
29 --
30 -- Note: Bounding boxes are computed on a best-effort basis and will not work
31 -- in all cases. The only supported SVG nodes are: path, circle, polyline,
32 -- ellipse, line, rectangle, image. All other nodes return (0,0,0,0).
33 boundingBox :: Tree -> (Double, Double, Double, Double)
34 boundingBox t =
35 case svgBoundingPoints t of
36 [] -> (0,0,0,0)
37 (V2 x y:rest) ->
38 let (minx, miny, maxx, maxy) = foldl' worker (x, y, x, y) rest
39 in (minx, miny, maxx-minx, maxy-miny)
40 where
41 worker (minx, miny, maxx, maxy) (V2 x y) =
42 (min minx x, min miny y, max maxx x, max maxy y)
43
44 -- | Height of SVG node in local units (not pixels). Computed on best-effort basis
45 -- and will not give accurate results for all SVG nodes.
46 svgHeight :: Tree -> Double
47 svgHeight t = h
48 where
49 (_x, _y, _w, h) = boundingBox t
50
51 -- | Width of SVG node in local units (not pixels). Computed on best-effort basis
52 -- and will not give accurate results for all SVG nodes.
53 svgWidth :: Tree -> Double
54 svgWidth t = w
55 where
56 (_x, _y, w, _h) = boundingBox t
57
58 -- | Sampling of points in a line path.
59 linePoints :: [LineCommand] -> [RPoint]
60 linePoints = worker zero
61 where
62 worker _from [] = []
63 worker from (x:xs) =
64 case x of
65 LineMove to -> worker to xs
66 -- LineDraw to -> from:to:worker to xs
67 LineBezier [p] ->
68 p : worker p xs
69 LineBezier ctrl -> -- approximation
70 [ last (partialBezierPoints (from:ctrl) 0 (recip chunks*i)) | i <- [0..chunks]] ++
71 worker (last ctrl) xs
72 LineEnd p -> p : worker p xs
73 chunks = 10
74
75 svgBoundingPoints :: Tree -> [RPoint]
76 svgBoundingPoints t = map (Transform.transformPoint m) $
77 case t of
78 None -> []
79 UseTree{} -> []
80 GroupTree g -> concatMap svgBoundingPoints (g^.groupChildren)
81 SymbolTree (Symbol g) -> concatMap svgBoundingPoints (g^.groupChildren)
82 FilterTree{} -> []
83 DefinitionTree{} -> []
84 PathTree p -> linePoints $ toLineCommands (p^.pathDefinition)
85 CircleTree c -> circleBoundingPoints c
86 PolyLineTree pl -> pl ^. polyLinePoints
87 EllipseTree e -> ellipseBoundingPoints e
88 LineTree line -> map pointToRPoint [line^.linePoint1, line^.linePoint2]
89 RectangleTree rect ->
90 case pointToRPoint (rect^.rectUpperLeftCorner) of
91 V2 x y -> V2 x y :
92 case mapTuple (fmap $ toUserUnit defaultDPI) (rect^.rectWidth, rect^.rectHeight) of
93 (Just (Num w), Just (Num h)) -> [V2 (x+w) (y+h)]
94 _ -> []
95 TextTree{} -> []
96 ImageTree img ->
97 case (img^.imageCornerUpperLeft, img^.imageWidth, img^.imageHeight) of
98 ((Num x, Num y), Num w, Num h) ->
99 [V2 x y, V2 (x+w) (y+h)]
100 _ -> []
101 MeshGradientTree{} -> []
102 _ -> []
103 where
104 m = Transform.mkMatrix (t^.transform)
105 mapTuple f = f *** f
106 pointToRPoint p =
107 case mapTuple (toUserUnit defaultDPI) p of
108 (Num x, Num y) -> V2 x y
109 _ -> error "Reanimate.Svg.svgBoundingPoints: Unrecognized number format."
110
111 circleBoundingPoints circ =
112 let (xnum, ynum) = circ ^. circleCenter
113 rnum = circ ^. circleRadius
114 in case mapMaybe unpackNumber [xnum, ynum, rnum] of
115 [x, y, r] -> [ V2 (x + r * cos angle) (y + r * sin angle) | angle <- [0, pi/10 .. 2 * pi]]
116 _ -> []
117
118 ellipseBoundingPoints e =
119 let (xnum,ynum) = e ^. ellipseCenter
120 xrnum = e ^. ellipseXRadius
121 yrnum = e ^. ellipseYRadius
122 in case mapMaybe unpackNumber [xnum, ynum, xrnum, yrnum] of
123 [x,y,xr,yr] -> [V2 (x + xr * cos angle) (y + yr * sin angle) | angle <- [0, pi/10 .. 2 * pi]]
124 _ -> []
125
126 unpackNumber n =
127 case toUserUnit defaultDPI n of
128 Num d -> Just d
129 _ -> Nothing