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 qualified Data.Vector.Unboxed as V
19 import qualified Geom2D.CubicBezier.Linear as Bezier
20 import Graphics.SvgTree hiding (height, line, path, use, width)
21 import Linear.V2 hiding (angle)
22 import Linear.Vector
23 import Reanimate.Constants
24 import Reanimate.Svg.LineCommand
25 import qualified Reanimate.Transform as Transform
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 let bezier = Bezier.AnyBezier (V.fromList (from:ctrl))
71 in [ Bezier.evalBezier bezier (recip chunks*i) | i <- [0..chunks]] ++
72 worker (last ctrl) xs
73 LineEnd p -> p : worker p xs
74 chunks = 10
75
76 svgBoundingPoints :: Tree -> [RPoint]
77 svgBoundingPoints t = map (Transform.transformPoint m) $
78 case t of
79 None -> []
80 UseTree{} -> []
81 GroupTree g -> concatMap svgBoundingPoints (g^.groupChildren)
82 SymbolTree (Symbol g) -> concatMap svgBoundingPoints (g^.groupChildren)
83 FilterTree{} -> []
84 DefinitionTree{} -> []
85 PathTree p -> linePoints $ toLineCommands (p^.pathDefinition)
86 CircleTree c -> circleBoundingPoints c
87 PolyLineTree pl -> pl ^. polyLinePoints
88 EllipseTree e -> ellipseBoundingPoints e
89 LineTree line -> map pointToRPoint [line^.linePoint1, line^.linePoint2]
90 RectangleTree rect ->
91 case pointToRPoint (rect^.rectUpperLeftCorner) of
92 V2 x y -> V2 x y :
93 case mapTuple (fmap $ toUserUnit defaultDPI) (rect^.rectWidth, rect^.rectHeight) of
94 (Just (Num w), Just (Num h)) -> [V2 (x+w) (y+h)]
95 _ -> []
96 TextTree{} -> []
97 ImageTree img ->
98 case (img^.imageCornerUpperLeft, img^.imageWidth, img^.imageHeight) of
99 ((Num x, Num y), Num w, Num h) ->
100 [V2 x y, V2 (x+w) (y+h)]
101 _ -> []
102 MeshGradientTree{} -> []
103 _ -> []
104 where
105 m = Transform.mkMatrix (t^.transform)
106 mapTuple f = f *** f
107 pointToRPoint p =
108 case mapTuple (toUserUnit defaultDPI) p of
109 (Num x, Num y) -> V2 x y
110 _ -> error "Reanimate.Svg.svgBoundingPoints: Unrecognized number format."
111
112 circleBoundingPoints circ =
113 let (xnum, ynum) = circ ^. circleCenter
114 rnum = circ ^. circleRadius
115 in case mapMaybe unpackNumber [xnum, ynum, rnum] of
116 [x, y, r] -> [ V2 (x + r * cos angle) (y + r * sin angle) | angle <- [0, pi/10 .. 2 * pi]]
117 _ -> []
118
119 ellipseBoundingPoints e =
120 let (xnum,ynum) = e ^. ellipseCenter
121 xrnum = e ^. ellipseXRadius
122 yrnum = e ^. ellipseYRadius
123 in case mapMaybe unpackNumber [xnum, ynum, xrnum, yrnum] of
124 [x,y,xr,yr] -> [V2 (x + xr * cos angle) (y + yr * sin angle) | angle <- [0, pi/10 .. 2 * pi]]
125 _ -> []
126
127 unpackNumber n =
128 case toUserUnit defaultDPI n of
129 Num d -> Just d
130 _ -> Nothing