never executed always true always false

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