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
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 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