never executed always true always false

    1 module Reanimate.Svg.Unuse
    2   ( replaceUses
    3   , unbox
    4   , embedDocument
    5   ) where
    6 
    7 import           Control.Lens               ((%~), (&), (.~), (?~), (^.))
    8 import qualified Data.Map                   as Map
    9 import           Data.Maybe
   10 import           Graphics.SvgTree           hiding (line, path, use)
   11 import           Reanimate.Constants
   12 import           Reanimate.Svg.Constructors
   13 
   14 replaceUses :: Document -> Document
   15 replaceUses doc = doc & elements %~ map (mapTree replace)
   16   where
   17     replaceDefinition PathTree{} = None
   18     replaceDefinition t          = t
   19 
   20     replace t@DefinitionTree{} = mapTree replaceDefinition t
   21     replace (UseTree _ Just{}) = error "replaceUses: subtree in use?"
   22     replace (UseTree use Nothing) =
   23       case Map.lookup (use^.useName) idMap of
   24         Nothing -> error $ "Unknown id: " ++ (use^.useName)
   25         Just tree -> mapTree replace $
   26           GroupTree $
   27           defaultSvg & groupChildren .~ [tree]
   28                      & transform ?~
   29                         fromMaybe [] (use^.transform) ++
   30                         [baseToTransformation (use^.useBase)]
   31     replace x = x
   32     baseToTransformation (x,y) =
   33       case (toUserUnit defaultDPI x, toUserUnit defaultDPI y) of
   34         (Num a, Num b) -> Translate a b
   35         _              -> TransformUnknown
   36     docTree = mkGroup (doc^.elements)
   37     idMap = foldTree updMap Map.empty docTree
   38     updMap m tree =
   39       case tree^.attrId of
   40         Nothing  -> m
   41         Just tid -> Map.insert tid tree m
   42 
   43 -- FIXME: the viewbox is ignored. Can we use the viewbox as a mask?
   44 -- Transform out viewbox. defs and CSS rules are discarded.
   45 unbox :: Document -> Tree
   46 unbox doc@Document{_viewBox = Just (_minx, _minw, _width, _height)} =
   47   GroupTree $ defaultSvg
   48           & groupChildren .~ doc^.elements
   49 unbox doc =
   50   GroupTree $ defaultSvg
   51     & groupChildren .~ doc^.elements
   52 
   53 embedDocument :: Document -> Tree
   54 embedDocument doc =
   55   translate (-screenWidth/2) (screenHeight/2) $
   56   withFillOpacity 1 $
   57   withStrokeWidth 0 $
   58   flipYAxis $
   59   SvgTree $ doc & width .~ Nothing
   60                 & height .~ Nothing