never executed always true always false

    1 {-|
    2 Copyright   : Written by David Himmelstrup
    3 License     : Unlicense
    4 Maintainer  : lemmih@gmail.com
    5 Stability   : experimental
    6 Portability : POSIX
    7 -}
    8 module Reanimate.Svg.Unuse
    9   ( replaceUses
   10   , unbox
   11   , embedDocument
   12   ) where
   13 
   14 import           Control.Lens               ((%~), (&), (.~), (?~), (^.))
   15 import qualified Data.Map                   as Map
   16 import           Data.Maybe
   17 import           Graphics.SvgTree           hiding (line, path, use)
   18 import           Reanimate.Constants
   19 import           Reanimate.Svg.Constructors
   20 
   21 -- | Replace all @<use>@ nodes with their definition.
   22 replaceUses :: Document -> Document
   23 replaceUses doc = doc & elements %~ map (mapTree replace)
   24   where
   25     replaceDefinition PathTree{} = None
   26     replaceDefinition t          = t
   27 
   28     replace t@DefinitionTree{} = mapTree replaceDefinition t
   29     replace (UseTree _ Just{}) = error "replaceUses: subtree in use?"
   30     replace (UseTree use Nothing) =
   31       case Map.lookup (use^.useName) idMap of
   32         Nothing -> error $ "Unknown id: " ++ (use^.useName)
   33         Just tree -> mapTree replace $
   34           GroupTree $
   35           defaultSvg & groupChildren .~ [tree]
   36                      & transform ?~
   37                         fromMaybe [] (use^.transform) ++
   38                         [baseToTransformation (use^.useBase)]
   39     replace x = x
   40     baseToTransformation (x,y) =
   41       case (toUserUnit defaultDPI x, toUserUnit defaultDPI y) of
   42         (Num a, Num b) -> Translate a b
   43         _              -> TransformUnknown
   44     docTree = mkGroup (doc^.elements)
   45     idMap = foldTree updMap Map.empty docTree
   46     updMap m tree =
   47       case tree^.attrId of
   48         Nothing  -> m
   49         Just tid -> Map.insert tid tree m
   50 
   51 -- FIXME: the viewbox is ignored. Can we use the viewbox as a mask?
   52 -- | Transform out viewbox. Definitions and CSS rules are discarded.
   53 unbox :: Document -> Tree
   54 unbox doc@Document{_viewBox = Just (_minx, _minw, _width, _height)} =
   55   GroupTree $ defaultSvg
   56           & groupChildren .~ doc^.elements
   57 unbox doc =
   58   GroupTree $ defaultSvg
   59     & groupChildren .~ doc^.elements
   60 
   61 -- | Embed 'Document'. This keeps the entire document intact but makes
   62 --   it more difficult to use, say, `Reanimate.Svg.pathify` on it.
   63 embedDocument :: Document -> Tree
   64 embedDocument doc =
   65   translate (-screenWidth/2) (screenHeight/2) $
   66   withFillOpacity 1 $
   67   withStrokeWidth 0 $
   68   flipYAxis $
   69   SvgTree $ doc & width .~ Nothing
   70                 & height .~ Nothing