{-# LANGUAGE TypeFamilies, OverloadedStrings, FlexibleContexts #-}
--------------------------------------------------------------------
-- |
-- Module    : Diagrams.SVG.Tree
-- Copyright : (c) 2015 Tillmann Vogt <tillk.vogt@googlemail.com>
-- License   : BSD3
--
-- Maintainer: diagrams-discuss@googlegroups.com
-- Stability : stable
-- Portability: portable

module Diagrams.SVG.Tree
    (
    -- * Tree data type
      Tag(..)
    , HashMaps(..)
    -- * Extract data from the tree
    , nodes
    , Attrs(..)
    , NodesMap
    , CSSMap
    , GradientsMap
    , PreserveAR(..)
    , AlignSVG(..)
    , MeetOrSlice(..)
    , Place
    , ViewBox(..)
    , Gr(..)
    , GradientAttributes(..)
    , PresentationAttributes(..)
    , GradRefId
    , expandGradMap
    , insertRefs
    , preserveAspectRatio
    , FontContent(..)
    , FontData(..)
    , FontFace(..)
    , Glyph(..)
    , KernDir(..)
    , KernMaps(..)
    , SvgGlyphs(..)
    , Kern(..)
    )
where
import           Data.Maybe (isJust, fromJust , fromMaybe)
import qualified Data.HashMap.Strict as H
import qualified Data.Text as T
import           Data.Text(Text(..))
import           Data.Vector(Vector)
import           Diagrams.Prelude hiding (Vector)
import           Diagrams.TwoD.Size
-- import           Diagrams.SVG.Fonts.ReadFont
import           Debug.Trace

-- Note: Maybe we could use the Tree from diagrams here but on the other hand this makes diagrams-input 
-- more independent of changes of diagrams' internal structures

-------------------------------------------------------------------------------------
-- | A tree structure is needed to handle refences to parts of the tree itself.
-- The \<defs\>-section contains shapes that can be refered to, but the SVG standard allows to refer to
-- every tag in the SVG-file.
--
data Tag b n = Leaf Id (ViewBox n -> Path V2 n) ((HashMaps b n, ViewBox n) -> Diagram b)-- ^
-- A leaf consists of
--
-- * An Id
--
-- * A path so that this leaf can be used to clip some other part of a tree
--
-- * A diagram (Another option would have been to apply a function to the upper path)
     | Reference Id Id (ViewBox n -> Path V2 n) ((HashMaps b n, ViewBox n) -> Diagram b -> Diagram b)-- ^
--  A reference (\<use\>-tag) consists of:
--
-- * An Id
--
-- * A reference to an Id
--
-- * A viewbox so that percentages are relative to this viewbox
--
-- * Transformations applied to the reference
     | SubTree Bool Id (Double, Double)
                       (Maybe (ViewBox n)) 
                       (Maybe PreserveAR) 
                       (HashMaps b n -> Diagram b -> Diagram b) 
                       [Tag b n]-- ^
-- A subtree consists of:
--
-- * A Bool: Are we in a section that will be rendered directly (not in a \<defs\>-section)
--
-- * An Id of subdiagram
--
-- * A viewbox so that percentages are relative to this viewbox
--
-- * Aspect Ratio
--
-- * A transformation or application of a style to a subdiagram
--
-- * A list of subtrees
     | StyleTag [(Text, [(Text, Text)])] -- ^ A tag that contains CSS styles with selectors and attributes
     | FontTag (FontData b n)
     | Grad Id (Gr n) -- ^ A gradient
     | Stop (HashMaps b n -> [GradientStop n]) -- ^
-- We need to make this part of this data structure because Gradient tags can also contain description tags

type Id        = Maybe Text
type GradRefId = Maybe Text
type Attrs     = [(Text, Text)]

type Nodelist b n = [(Text, Tag b n)]
type CSSlist  = [(Text, Attrs)]
data Gr n = Gr GradRefId
               GradientAttributes
               (Maybe (ViewBox n))
               [CSSMap -> [GradientStop n]]
               (CSSMap -> GradientAttributes -> ViewBox n -> [CSSMap -> [GradientStop n]] -> Texture n)

type Gradlist n = [(Text, Gr n)]
type Fontlist b n = [(Text, FontData b n)]

type HashMaps b n = (NodesMap b n, CSSMap, GradientsMap n)
type NodesMap b n = H.HashMap Text (Tag b n)
type CSSMap = H.HashMap Text Attrs
type GradientsMap n = H.HashMap Text (Gr n)

type ViewBox n = (n,n,n,n) -- (MinX,MinY,Width,Height)

data PreserveAR = PAR AlignSVG MeetOrSlice -- ^ see <http://www.w3.org/TR/SVG11/coords.html#PreserveAspectRatioAttribute>
data AlignSVG = AlignXY Place Place -- ^ alignment in x and y direction
type Place = Double -- ^ A value between 0 and 1, where 0 is the minimal value and 1 the maximal value
data MeetOrSlice = Meet | Slice

instance Show (Tag b n) where
  show :: Tag b n -> String
show (Leaf Id
id1 ViewBox n -> Path V2 n
_ (HashMaps b n, ViewBox n) -> Diagram b
_)  = String
"Leaf "      forall a. [a] -> [a] -> [a]
++ (forall a. Show a => a -> String
show Id
id1) forall a. [a] -> [a] -> [a]
++ String
"\n"
  show (Reference Id
selfid Id
id1 ViewBox n -> Path V2 n
viewbox (HashMaps b n, ViewBox n) -> Diagram b -> Diagram b
f) = String
"Reference " forall a. [a] -> [a] -> [a]
++ (forall a. Show a => a -> String
show Id
id1) forall a. [a] -> [a] -> [a]
++ String
"\n"
  show (SubTree Bool
b Id
id1 (Double, Double)
wh Maybe (ViewBox n)
viewbox Maybe PreserveAR
ar HashMaps b n -> Diagram b -> Diagram b
f [Tag b n]
tree) = String
"Sub " forall a. [a] -> [a] -> [a]
++ (forall a. Show a => a -> String
show Id
id1) forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> String
show [Tag b n]
tree) forall a. [a] -> [a] -> [a]
++ String
"\n"
  show (StyleTag [(Text, [(Text, Text)])]
_)   = String
"Style "    forall a. [a] -> [a] -> [a]
++ String
"\n"
  show (Grad Id
id1 Gr n
gr) = String
"Grad id:" forall a. [a] -> [a] -> [a]
++ (forall a. Show a => a -> String
show Id
id1) -- ++ (show gr) ++ "\n"
  show (Stop HashMaps b n -> [GradientStop n]
_)   = String
"Stop " forall a. [a] -> [a] -> [a]
++ String
"\n"

-- instance Show (Gr n) where show (Gr gradRefId gattr vb stops tex) = "  ref:" ++ (show gradRefId) ++ "viewbox: " ++ (show vb)

----------------------------------------------------------------------------------
-- | Generate elements that can be referenced by their ID.
--   The tree nodes are splitted into 4 groups of lists of (ID,value)-pairs):
--
-- * Nodes that contain elements that can be transformed to a diagram
--
-- * CSS classes with corresponding (attribute,value)-pairs, from the <defs>-tag
--
-- * Gradients
--
-- * Fonts
nodes :: Maybe (ViewBox n) -> (Nodelist b n, CSSlist, Gradlist n, Fontlist b n) -> Tag b n -> 
                              (Nodelist b n, CSSlist, Gradlist n, Fontlist b n)
nodes :: forall n b.
Maybe (ViewBox n)
-> (Nodelist b n, [(Text, [(Text, Text)])], Gradlist n,
    Fontlist b n)
-> Tag b n
-> (Nodelist b n, [(Text, [(Text, Text)])], Gradlist n,
    Fontlist b n)
nodes Maybe (ViewBox n)
viewbox (Nodelist b n
ns,[(Text, [(Text, Text)])]
css,Gradlist n
grads,Fontlist b n
fonts) (Leaf Id
id1 ViewBox n -> Path V2 n
path (HashMaps b n, ViewBox n) -> Diagram b
diagram)
  | forall a. Maybe a -> Bool
isJust Id
id1 = (Nodelist b n
ns forall a. [a] -> [a] -> [a]
++ [(forall a. HasCallStack => Maybe a -> a
fromJust Id
id1, forall b n.
Id
-> (ViewBox n -> Path V2 n)
-> ((HashMaps b n, ViewBox n) -> Diagram b)
-> Tag b n
Leaf Id
id1 ViewBox n -> Path V2 n
path (HashMaps b n, ViewBox n) -> Diagram b
diagram)],[(Text, [(Text, Text)])]
css,Gradlist n
grads,Fontlist b n
fonts)
  | Bool
otherwise  = (Nodelist b n
ns,[(Text, [(Text, Text)])]
css,Gradlist n
grads,Fontlist b n
fonts)

-- A Reference element for the <use>-tag
nodes Maybe (ViewBox n)
viewbox (Nodelist b n
ns,[(Text, [(Text, Text)])]
css,Gradlist n
grads,Fontlist b n
fonts) (Reference Id
selfId Id
id1 ViewBox n -> Path V2 n
vb (HashMaps b n, ViewBox n) -> Diagram b -> Diagram b
f) = (Nodelist b n
ns,[(Text, [(Text, Text)])]
css,Gradlist n
grads,Fontlist b n
fonts)

nodes Maybe (ViewBox n)
viewbox (Nodelist b n
ns,[(Text, [(Text, Text)])]
css,Gradlist n
grads,Fontlist b n
fonts)                (SubTree Bool
b Id
id1 (Double, Double)
wh Maybe (ViewBox n)
Nothing Maybe PreserveAR
ar HashMaps b n -> Diagram b -> Diagram b
f [Tag b n]
children)
  | forall a. Maybe a -> Bool
isJust Id
id1 = forall b n.
[(Nodelist b n, [(Text, [(Text, Text)])], Gradlist n,
  Fontlist b n)]
-> (Nodelist b n, [(Text, [(Text, Text)])], Gradlist n,
    Fontlist b n)
myconcat [ (Nodelist b n
ns forall a. [a] -> [a] -> [a]
++ [(forall a. HasCallStack => Maybe a -> a
fromJust Id
id1, forall b n.
Bool
-> Id
-> (Double, Double)
-> Maybe (ViewBox n)
-> Maybe PreserveAR
-> (HashMaps b n -> Diagram b -> Diagram b)
-> [Tag b n]
-> Tag b n
SubTree Bool
b Id
id1 (Double, Double)
wh Maybe (ViewBox n)
viewbox Maybe PreserveAR
ar HashMaps b n -> Diagram b -> Diagram b
f [Tag b n]
children)],[(Text, [(Text, Text)])]
css,Gradlist n
grads,Fontlist b n
fonts) ,
                            (forall b n.
[(Nodelist b n, [(Text, [(Text, Text)])], Gradlist n,
  Fontlist b n)]
-> (Nodelist b n, [(Text, [(Text, Text)])], Gradlist n,
    Fontlist b n)
myconcat (forall a b. (a -> b) -> [a] -> [b]
map (forall n b.
Maybe (ViewBox n)
-> (Nodelist b n, [(Text, [(Text, Text)])], Gradlist n,
    Fontlist b n)
-> Tag b n
-> (Nodelist b n, [(Text, [(Text, Text)])], Gradlist n,
    Fontlist b n)
nodes Maybe (ViewBox n)
viewbox (Nodelist b n
ns,[(Text, [(Text, Text)])]
css,Gradlist n
grads,Fontlist b n
fonts)) [Tag b n]
children))                ]
  | Bool
otherwise  = forall b n.
[(Nodelist b n, [(Text, [(Text, Text)])], Gradlist n,
  Fontlist b n)]
-> (Nodelist b n, [(Text, [(Text, Text)])], Gradlist n,
    Fontlist b n)
myconcat (forall a b. (a -> b) -> [a] -> [b]
map (forall n b.
Maybe (ViewBox n)
-> (Nodelist b n, [(Text, [(Text, Text)])], Gradlist n,
    Fontlist b n)
-> Tag b n
-> (Nodelist b n, [(Text, [(Text, Text)])], Gradlist n,
    Fontlist b n)
nodes Maybe (ViewBox n)
viewbox (Nodelist b n
ns,[(Text, [(Text, Text)])]
css,Gradlist n
grads,Fontlist b n
fonts)) [Tag b n]
children)

nodes Maybe (ViewBox n)
viewbox (Nodelist b n
ns,[(Text, [(Text, Text)])]
css,Gradlist n
grads,Fontlist b n
fonts)                (SubTree Bool
b Id
id1 (Double, Double)
wh Maybe (ViewBox n)
vb Maybe PreserveAR
ar HashMaps b n -> Diagram b -> Diagram b
f [Tag b n]
children)
  | forall a. Maybe a -> Bool
isJust Id
id1 = forall b n.
[(Nodelist b n, [(Text, [(Text, Text)])], Gradlist n,
  Fontlist b n)]
-> (Nodelist b n, [(Text, [(Text, Text)])], Gradlist n,
    Fontlist b n)
myconcat [ (Nodelist b n
ns forall a. [a] -> [a] -> [a]
++ [(forall a. HasCallStack => Maybe a -> a
fromJust Id
id1, forall b n.
Bool
-> Id
-> (Double, Double)
-> Maybe (ViewBox n)
-> Maybe PreserveAR
-> (HashMaps b n -> Diagram b -> Diagram b)
-> [Tag b n]
-> Tag b n
SubTree Bool
b Id
id1 (Double, Double)
wh Maybe (ViewBox n)
vb Maybe PreserveAR
ar HashMaps b n -> Diagram b -> Diagram b
f [Tag b n]
children)],[(Text, [(Text, Text)])]
css,Gradlist n
grads,Fontlist b n
fonts) ,
                            (forall b n.
[(Nodelist b n, [(Text, [(Text, Text)])], Gradlist n,
  Fontlist b n)]
-> (Nodelist b n, [(Text, [(Text, Text)])], Gradlist n,
    Fontlist b n)
myconcat (forall a b. (a -> b) -> [a] -> [b]
map (forall n b.
Maybe (ViewBox n)
-> (Nodelist b n, [(Text, [(Text, Text)])], Gradlist n,
    Fontlist b n)
-> Tag b n
-> (Nodelist b n, [(Text, [(Text, Text)])], Gradlist n,
    Fontlist b n)
nodes Maybe (ViewBox n)
vb (Nodelist b n
ns,[(Text, [(Text, Text)])]
css,Gradlist n
grads,Fontlist b n
fonts)) [Tag b n]
children))                ]
  | Bool
otherwise  = forall b n.
[(Nodelist b n, [(Text, [(Text, Text)])], Gradlist n,
  Fontlist b n)]
-> (Nodelist b n, [(Text, [(Text, Text)])], Gradlist n,
    Fontlist b n)
myconcat (forall a b. (a -> b) -> [a] -> [b]
map (forall n b.
Maybe (ViewBox n)
-> (Nodelist b n, [(Text, [(Text, Text)])], Gradlist n,
    Fontlist b n)
-> Tag b n
-> (Nodelist b n, [(Text, [(Text, Text)])], Gradlist n,
    Fontlist b n)
nodes Maybe (ViewBox n)
vb (Nodelist b n
ns,[(Text, [(Text, Text)])]
css,Gradlist n
grads,Fontlist b n
fonts)) [Tag b n]
children)

nodes Maybe (ViewBox n)
viewbox (Nodelist b n
ns,[(Text, [(Text, Text)])]
css,Gradlist n
grads,Fontlist b n
fonts) (Grad Id
id1 (Gr Id
gradRefId GradientAttributes
gattr Maybe (ViewBox n)
vb [CSSMap -> [GradientStop n]]
stops CSSMap
-> GradientAttributes
-> ViewBox n
-> [CSSMap -> [GradientStop n]]
-> Texture n
texture))
  | forall a. Maybe a -> Bool
isJust Id
id1 = (Nodelist b n
ns,[(Text, [(Text, Text)])]
css, Gradlist n
grads forall a. [a] -> [a] -> [a]
++ [(forall a. HasCallStack => Maybe a -> a
fromJust Id
id1, forall n.
Id
-> GradientAttributes
-> Maybe (ViewBox n)
-> [CSSMap -> [GradientStop n]]
-> (CSSMap
    -> GradientAttributes
    -> ViewBox n
    -> [CSSMap -> [GradientStop n]]
    -> Texture n)
-> Gr n
Gr Id
gradRefId GradientAttributes
gattr Maybe (ViewBox n)
vb [CSSMap -> [GradientStop n]]
stops CSSMap
-> GradientAttributes
-> ViewBox n
-> [CSSMap -> [GradientStop n]]
-> Texture n
texture)], Fontlist b n
fonts)
  | Bool
otherwise  = (Nodelist b n
ns,[(Text, [(Text, Text)])]
css,Gradlist n
grads,Fontlist b n
fonts)

-- There is a global style tag in the defs section of some svg files
nodes Maybe (ViewBox n)
viewbox (Nodelist b n
ns,[(Text, [(Text, Text)])]
css,Gradlist n
grads,Fontlist b n
fonts) (StyleTag [(Text, [(Text, Text)])]
styles) = (Nodelist b n
ns,[(Text, [(Text, Text)])]
css forall a. [a] -> [a] -> [a]
++ [(Text, [(Text, Text)])]
styles,Gradlist n
grads,Fontlist b n
fonts)
-- stops are not extracted here but from the gradient parent node
nodes Maybe (ViewBox n)
viewbox (Nodelist b n, [(Text, [(Text, Text)])], Gradlist n, Fontlist b n)
lists (Stop HashMaps b n -> [GradientStop n]
_) = (Nodelist b n, [(Text, [(Text, Text)])], Gradlist n, Fontlist b n)
lists

nodes Maybe (ViewBox n)
viewbox (Nodelist b n
ns,[(Text, [(Text, Text)])]
css,Gradlist n
grads,Fontlist b n
fonts) (FontTag FontData b n
fontData) = (Nodelist b n
ns,[(Text, [(Text, Text)])]
css,Gradlist n
grads,Fontlist b n
fonts forall a. [a] -> [a] -> [a]
++ [(forall a. a -> Maybe a -> a
fromMaybe Text
"" (forall b n. FontData b n -> Id
fontId FontData b n
fontData), FontData b n
fontData)])

myconcat :: [(Nodelist b n, CSSlist, Gradlist n, Fontlist b n)] -> (Nodelist b n, CSSlist, Gradlist n, Fontlist b n)
myconcat :: forall b n.
[(Nodelist b n, [(Text, [(Text, Text)])], Gradlist n,
  Fontlist b n)]
-> (Nodelist b n, [(Text, [(Text, Text)])], Gradlist n,
    Fontlist b n)
myconcat [(Nodelist b n, [(Text, [(Text, Text)])], Gradlist n,
  Fontlist b n)]
list = (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall {a} {b} {c} {d}. (a, b, c, d) -> a
sel1 [(Nodelist b n, [(Text, [(Text, Text)])], Gradlist n,
  Fontlist b n)]
list, forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall {a} {b} {c} {d}. (a, b, c, d) -> b
sel2 [(Nodelist b n, [(Text, [(Text, Text)])], Gradlist n,
  Fontlist b n)]
list, forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall {a} {b} {c} {d}. (a, b, c, d) -> c
sel3 [(Nodelist b n, [(Text, [(Text, Text)])], Gradlist n,
  Fontlist b n)]
list, forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall {a} {b} {c} {d}. (a, b, c, d) -> d
sel4 [(Nodelist b n, [(Text, [(Text, Text)])], Gradlist n,
  Fontlist b n)]
list)
  where sel1 :: (a, b, c, d) -> a
sel1 (a
a,b
b,c
c,d
d) = a
a
        sel2 :: (a, b, c, d) -> b
sel2 (a
a,b
b,c
c,d
d) = b
b
        sel3 :: (a, b, c, d) -> c
sel3 (a
a,b
b,c
c,d
d) = c
c
        sel4 :: (a, b, c, d) -> d
sel4 (a
a,b
b,c
c,d
d) = d
d

------------------------------------------------------------------------------------------------------
-- The following code is necessary to handle nested xlink:href in gradients,
-- like in this example (#linearGradient3606 in radialGradient):
--
--    <linearGradient
--       id="linearGradient3606">
--      <stop
--         id="stop3608"
--         style="stop-color:#ff633e;stop-opacity:1"
--         offset="0" />
--      <stop
--         id="stop3610"
--         style="stop-color:#ff8346;stop-opacity:0.78225809"
--         offset="1" />
--    </linearGradient>
--    <radialGradient
--       cx="275.00681"
--       cy="685.96008"
--       r="112.80442"
--       fx="275.00681"
--       fy="685.96008"
--       id="radialGradient3612"
--       xlink:href="#linearGradient3606"
--       gradientUnits="userSpaceOnUse"
--       gradientTransform="matrix(1,0,0,1.049029,-63.38387,-67.864647)" />

-- | Gradients contain references to include attributes/stops from other gradients. 
--   expandGradMap expands the gradient with these attributes and stops

expandGradMap :: GradientsMap n ->  GradientsMap n -- GradientsMap n = H.HashMap Text (Gr n)
expandGradMap :: forall n. GradientsMap n -> GradientsMap n
expandGradMap GradientsMap n
gradMap = forall k v1 v2. (k -> v1 -> v2) -> HashMap k v1 -> HashMap k v2
H.mapWithKey (forall {n}. GradientsMap n -> Text -> Gr n -> Gr n
newGr GradientsMap n
gradMap) GradientsMap n
gradMap

newGr :: GradientsMap n -> Text -> Gr n -> Gr n
newGr GradientsMap n
grMap Text
key (Gr Id
gradRefId GradientAttributes
attrs Maybe (ViewBox n)
vb [CSSMap -> [GradientStop n]]
stops CSSMap
-> GradientAttributes
-> ViewBox n
-> [CSSMap -> [GradientStop n]]
-> Texture n
f) = (forall n.
Id
-> GradientAttributes
-> Maybe (ViewBox n)
-> [CSSMap -> [GradientStop n]]
-> (CSSMap
    -> GradientAttributes
    -> ViewBox n
    -> [CSSMap -> [GradientStop n]]
    -> Texture n)
-> Gr n
Gr Id
gradRefId GradientAttributes
newAttributes Maybe (ViewBox n)
vb [CSSMap -> [GradientStop n]]
newStops CSSMap
-> GradientAttributes
-> ViewBox n
-> [CSSMap -> [GradientStop n]]
-> Texture n
f)
  where newStops :: [CSSMap -> [GradientStop n]]
newStops = [CSSMap -> [GradientStop n]]
stops forall a. [a] -> [a] -> [a]
++ (forall n. GradientsMap n -> Id -> [CSSMap -> [GradientStop n]]
gradientStops GradientsMap n
grMap Id
gradRefId)
        newAttributes :: GradientAttributes
newAttributes = [GradientAttributes] -> GradientAttributes
overwriteDefaultAttributes forall a b. (a -> b) -> a -> b
$ forall n. GradientsMap n -> Id -> [GradientAttributes]
gradientAttributes GradientsMap n
grMap (forall a. a -> Maybe a
Just Text
key)

-- | Gradients that reference other gradients form a list of attributes
--   The last element of this list are the default attributes (thats why there is "reverse attrs")
--   Then the second last attributes overwrite these defaults (and so on until the root)
--   The whole idea of this nesting is that Nothing values don't overwrite Just values
overwriteDefaultAttributes :: [GradientAttributes] -> GradientAttributes
overwriteDefaultAttributes :: [GradientAttributes] -> GradientAttributes
overwriteDefaultAttributes [GradientAttributes
attrs] = GradientAttributes
attrs
overwriteDefaultAttributes [GradientAttributes]
attrs = forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 GradientAttributes -> GradientAttributes -> GradientAttributes
updateRec (forall a. [a] -> [a]
reverse [GradientAttributes]
attrs)

-- | Every reference is looked up in the gradient map and a record of attributes is added to a list
gradientAttributes :: GradientsMap n -> GradRefId -> [GradientAttributes] -- GradientsMap n = H.HashMap Text (Gr n)
gradientAttributes :: forall n. GradientsMap n -> Id -> [GradientAttributes]
gradientAttributes GradientsMap n
grMap Id
Nothing = []
gradientAttributes GradientsMap n
grMap (Just Text
refId) | forall a. Maybe a -> Bool
isJust Maybe (Gr n)
gr = (forall {n}. Gr n -> GradientAttributes
attrs forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => Maybe a -> a
fromJust Maybe (Gr n)
gr) forall a. a -> [a] -> [a]
: (forall n. GradientsMap n -> Id -> [GradientAttributes]
gradientAttributes GradientsMap n
grMap (forall {n}. Gr n -> Id
grRef forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => Maybe a -> a
fromJust Maybe (Gr n)
gr))
                                      | Bool
otherwise = []
  where gr :: Maybe (Gr n)
gr = forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
H.lookup Text
refId GradientsMap n
grMap
        grRef :: Gr n -> Id
grRef   (Gr Id
ref GradientAttributes
_ Maybe (ViewBox n)
_ [CSSMap -> [GradientStop n]]
_ CSSMap
-> GradientAttributes
-> ViewBox n
-> [CSSMap -> [GradientStop n]]
-> Texture n
_) = Id
ref

attrs :: Gr n -> GradientAttributes
attrs   (Gr Id
_ GradientAttributes
att Maybe (ViewBox n)
_ [CSSMap -> [GradientStop n]]
_ CSSMap
-> GradientAttributes
-> ViewBox n
-> [CSSMap -> [GradientStop n]]
-> Texture n
_) = GradientAttributes
att

-- | Every reference is looked up in the gradient map and the stops are added to a list
gradientStops :: GradientsMap n -> GradRefId -> [CSSMap -> [GradientStop n]]
gradientStops :: forall n. GradientsMap n -> Id -> [CSSMap -> [GradientStop n]]
gradientStops GradientsMap n
grMap Id
Nothing = []
gradientStops GradientsMap n
grMap (Just Text
refId) | forall a. Maybe a -> Bool
isJust Maybe (Gr n)
gr = (forall {n}. Gr n -> [CSSMap -> [GradientStop n]]
stops forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => Maybe a -> a
fromJust Maybe (Gr n)
gr) forall a. [a] -> [a] -> [a]
++ (forall n. GradientsMap n -> Id -> [CSSMap -> [GradientStop n]]
gradientStops GradientsMap n
grMap (forall {n}. Gr n -> Id
grRef forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => Maybe a -> a
fromJust Maybe (Gr n)
gr))
                                 | Bool
otherwise = []
  where gr :: Maybe (Gr n)
gr = forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
H.lookup Text
refId GradientsMap n
grMap
        grRef :: Gr n -> Id
grRef   (Gr Id
ref GradientAttributes
_ Maybe (ViewBox n)
_ [CSSMap -> [GradientStop n]]
_ CSSMap
-> GradientAttributes
-> ViewBox n
-> [CSSMap -> [GradientStop n]]
-> Texture n
_) = Id
ref
        stops :: Gr n -> [CSSMap -> [GradientStop n]]
stops   (Gr Id
_  GradientAttributes
_ Maybe (ViewBox n)
_ [CSSMap -> [GradientStop n]]
st CSSMap
-> GradientAttributes
-> ViewBox n
-> [CSSMap -> [GradientStop n]]
-> Texture n
_) = [CSSMap -> [GradientStop n]]
st

-- | Update the gradient record. The first argument is the leaf record, the second is the record that overwrites the leaf.
--   The upper example references gradients that have only stops (no overwriting of attributes).
--   See <http://www.w3.org/TR/SVG/pservers.html#RadialGradientElementHrefAttribute>
updateRec :: GradientAttributes -> GradientAttributes -> GradientAttributes
updateRec :: GradientAttributes -> GradientAttributes -> GradientAttributes
updateRec (GA PresentationAttributes
pa  Id
class_  Id
style  Id
x1  Id
y1  Id
x2  Id
y2  Id
cx  Id
cy  Id
r  Id
fx  Id
fy  Id
gradientUnits  Id
gradientTransform  Id
spreadMethod)
          (GA PresentationAttributes
paN Id
class1N Id
styleN Id
x1N Id
y1N Id
x2N Id
y2N Id
cxN Id
cyN Id
rN Id
fxN Id
fyN Id
gradientUnitsN Id
gradientTransformN Id
spreadMethodN)
  = (PresentationAttributes, [Id]) -> GradientAttributes
toGA (PresentationAttributes
paN, ([Id] -> [Id] -> [Id]
updateList [Id
class_,Id
style,Id
x1,Id
y1,Id
x2,Id
y2,Id
cx,Id
cy,Id
r,Id
fx,Id
fy,Id
gradientUnits,Id
gradientTransform,Id
spreadMethod] -- TODO: update pa
                           [Id
class1N,Id
styleN,Id
x1N,Id
y1N,Id
x2N,Id
y2N,Id
cxN,Id
cyN,Id
rN,Id
fxN,Id
fyN,Id
gradientUnitsN,Id
gradientTransformN,Id
spreadMethodN]))
  where
    updateList :: [Maybe Text] -> [Maybe Text] -> [Maybe Text]
    updateList :: [Id] -> [Id] -> [Id]
updateList (Id
defaultt:[Id]
xs) ((Just Text
t1):[Id]
ys) = (forall a. a -> Maybe a
Just Text
t1) forall a. a -> [a] -> [a]
: ([Id] -> [Id] -> [Id]
updateList [Id]
xs [Id]
ys)
    updateList ((Just Text
t0):[Id]
xs) (Id
Nothing  :[Id]
ys) = (forall a. a -> Maybe a
Just Text
t0) forall a. a -> [a] -> [a]
: ([Id] -> [Id] -> [Id]
updateList [Id]
xs [Id]
ys)
    updateList  (Id
Nothing :[Id]
xs) (Id
Nothing  :[Id]
ys) =  forall a. Maybe a
Nothing  forall a. a -> [a] -> [a]
: ([Id] -> [Id] -> [Id]
updateList [Id]
xs [Id]
ys)
    updateList [Id]
_ [Id]
_ = []

    toGA :: (PresentationAttributes, [Id]) -> GradientAttributes
toGA (PresentationAttributes
pa, [Id
class_,Id
style,Id
x1,Id
y1,Id
x2,Id
y2,Id
cx,Id
cy,Id
r,Id
fx,Id
fy,Id
gradientUnits,Id
gradientTransform,Id
spreadMethod]) =
       PresentationAttributes
-> Id
-> Id
-> Id
-> Id
-> Id
-> Id
-> Id
-> Id
-> Id
-> Id
-> Id
-> Id
-> Id
-> Id
-> GradientAttributes
GA PresentationAttributes
pa   Id
class_ Id
style Id
x1 Id
y1 Id
x2 Id
y2 Id
cx Id
cy Id
r Id
fx Id
fy Id
gradientUnits Id
gradientTransform Id
spreadMethod

------------------------------------------------------------------------------------------------------------

-- | Lookup a diagram and return an empty diagram in case the SVG-file has a wrong reference
lookUp :: HashMap a (Tag b n) -> Maybe a -> Tag b n
lookUp HashMap a (Tag b n)
hmap Maybe a
i | (forall a. Maybe a -> Bool
isJust Maybe a
i) Bool -> Bool -> Bool
&& (forall a. Maybe a -> Bool
isJust Maybe (Tag b n)
l) = forall a. HasCallStack => Maybe a -> a
fromJust Maybe (Tag b n)
l
              | Bool
otherwise = forall b n.
Id
-> (ViewBox n -> Path V2 n)
-> ((HashMaps b n, ViewBox n) -> Diagram b)
-> Tag b n
Leaf forall a. Maybe a
Nothing forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty -- an empty diagram if we can't find the id
  where l :: Maybe (Tag b n)
l = forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
H.lookup (forall a. HasCallStack => Maybe a -> a
fromJust Maybe a
i) HashMap a (Tag b n)
hmap

-- | Evaluate the tree into a diagram by inserting xlink:href references from nodes and gradients, 
--   applying clipping and passing the viewbox to the leafs
insertRefs :: (V b ~ V2, N b ~ n, RealFloat n, Place ~ n) => (HashMaps b n, ViewBox n) -> Tag b n -> Diagram b

insertRefs :: forall b n.
(V b ~ V2, N b ~ n, RealFloat n, Double ~ n) =>
(HashMaps b n, ViewBox n) -> Tag b n -> Diagram b
insertRefs (HashMaps b n
maps,ViewBox n
viewbox) (Leaf Id
id1 ViewBox n -> Path V2 n
path (HashMaps b n, ViewBox n) -> Diagram b
f) = ((HashMaps b n, ViewBox n) -> Diagram b
f (HashMaps b n
maps,ViewBox n
viewbox)) forall a b. a -> (a -> b) -> b
# (if forall a. Maybe a -> Bool
isJust Id
id1 then forall nm (v :: * -> *) n m b.
(IsName nm, Metric v, OrderedField n, Semigroup m) =>
nm -> QDiagram b v n m -> QDiagram b v n m
named (Text -> String
T.unpack forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => Maybe a -> a
fromJust Id
id1) else forall a. a -> a
id)
insertRefs (HashMaps b n
maps,ViewBox n
viewbox) (Grad Id
_ Gr n
_) = forall a. Monoid a => a
mempty
insertRefs (HashMaps b n
maps,ViewBox n
viewbox) (Stop HashMaps b n -> [GradientStop n]
f) = forall a. Monoid a => a
mempty
insertRefs (HashMaps b n
maps,ViewBox n
viewbox) (Reference Id
selfId Id
id1 ViewBox n -> Path V2 n
path (HashMaps b n, ViewBox n) -> Diagram b -> Diagram b
styles)
    | (forall n a. (InSpace V2 n a, Enveloped a) => a -> n
Diagrams.TwoD.Size.width Path V2 n
r) forall a. Ord a => a -> a -> Bool
<= Double
0 Bool -> Bool -> Bool
|| (forall n a. (InSpace V2 n a, Enveloped a) => a -> n
Diagrams.TwoD.Size.height Path V2 n
r) forall a. Ord a => a -> a -> Bool
<= Double
0 = forall a. Monoid a => a
mempty
    | Bool
otherwise = Diagram b
referencedDiagram forall a b. a -> (a -> b) -> b
# (HashMaps b n, ViewBox n) -> Diagram b -> Diagram b
styles (HashMaps b n
maps,ViewBox n
viewbox)
                                    # cutOutViewBox viewboxPAR
--                                    # stretchViewBox (fromJust w) (fromJust h) viewboxPAR
                                    # (if isJust selfId then named (T.unpack $ fromJust selfId) else id)
  where r :: Path V2 n
r = ViewBox n -> Path V2 n
path ViewBox n
viewbox
        viewboxPAR :: (Maybe (ViewBox n), Maybe PreserveAR)
viewboxPAR = forall {b} {n}. Tag b n -> (Maybe (ViewBox n), Maybe PreserveAR)
getViewboxPreserveAR Tag b n
subTree
        referencedDiagram :: Diagram b
referencedDiagram = forall b n.
(V b ~ V2, N b ~ n, RealFloat n, Double ~ n) =>
(HashMaps b n, ViewBox n) -> Tag b n -> Diagram b
insertRefs (HashMaps b n
maps,ViewBox n
viewbox) (forall {n} {b}. ViewBox n -> Tag b n -> Tag b n
makeSubTreeVisible ViewBox n
viewbox Tag b n
subTree)
        subTree :: Tag b n
subTree = forall {a} {b} {n}.
(Hashable a, Metric (V b), Floating (N b), Ord (N b)) =>
HashMap a (Tag b n) -> Maybe a -> Tag b n
lookUp (forall {a} {b} {c}. (a, b, c) -> a
sel1 HashMaps b n
maps) Id
id1
        getViewboxPreserveAR :: Tag b n -> (Maybe (ViewBox n), Maybe PreserveAR)
getViewboxPreserveAR (SubTree Bool
_ Id
id1 (Double, Double)
wh Maybe (ViewBox n)
viewbox Maybe PreserveAR
ar HashMaps b n -> Diagram b -> Diagram b
g [Tag b n]
children) = (Maybe (ViewBox n)
viewbox, Maybe PreserveAR
ar)
        getViewboxPreserveAR Tag b n
_ = (forall a. Maybe a
Nothing, forall a. Maybe a
Nothing)
        sel1 :: (a, b, c) -> a
sel1 (a
a,b
b,c
c) = a
a

insertRefs (HashMaps b n
maps,ViewBox n
viewbox) (SubTree Bool
False Id
_ (Double, Double)
_ Maybe (ViewBox n)
_ Maybe PreserveAR
_ HashMaps b n -> Diagram b -> Diagram b
_ [Tag b n]
_) = forall a. Monoid a => a
mempty
insertRefs (HashMaps b n
maps,ViewBox n
viewbox) (SubTree Bool
True Id
id1 (Double
w,Double
h) Maybe (ViewBox n)
viewb Maybe PreserveAR
ar HashMaps b n -> Diagram b -> Diagram b
styles [Tag b n]
children) =
    QDiagram b V2 Double Any
subdiagram forall a b. a -> (a -> b) -> b
# HashMaps b n -> Diagram b -> Diagram b
styles HashMaps b n
maps
               # cutOutViewBox (viewb, ar)
               # (if (w > 0) && (h > 0) then stretchViewBox w h (viewb, ar) else id)
               # (if isJust id1 then named (T.unpack $ fromJust id1) else id)
  where subdiagram :: QDiagram b V2 Double Any
subdiagram = forall a. Monoid a => [a] -> a
mconcat (forall a b. (a -> b) -> [a] -> [b]
map (forall b n.
(V b ~ V2, N b ~ n, RealFloat n, Double ~ n) =>
(HashMaps b n, ViewBox n) -> Tag b n -> Diagram b
insertRefs (HashMaps b n
maps, forall a. a -> Maybe a -> a
fromMaybe ViewBox n
viewbox Maybe (ViewBox n)
viewb)) [Tag b n]
children)

insertRefs (HashMaps b n
maps,ViewBox n
viewbox) (StyleTag [(Text, [(Text, Text)])]
_) = forall a. Monoid a => a
mempty
-------------------------------------------------------------------------------------------------------------------------------

makeSubTreeVisible :: ViewBox n -> Tag b n -> Tag b n
makeSubTreeVisible ViewBox n
viewbox (SubTree Bool
_    Id
id1 (Double, Double)
wh Maybe (ViewBox n)
vb Maybe PreserveAR
ar HashMaps b n -> Diagram b -> Diagram b
g [Tag b n]
children) =
                           (forall b n.
Bool
-> Id
-> (Double, Double)
-> Maybe (ViewBox n)
-> Maybe PreserveAR
-> (HashMaps b n -> Diagram b -> Diagram b)
-> [Tag b n]
-> Tag b n
SubTree Bool
True Id
id1 (Double, Double)
wh (forall a. a -> Maybe a
Just ViewBox n
viewbox) Maybe PreserveAR
ar HashMaps b n -> Diagram b -> Diagram b
g (forall a b. (a -> b) -> [a] -> [b]
map (ViewBox n -> Tag b n -> Tag b n
makeSubTreeVisible ViewBox n
viewbox) [Tag b n]
children))
makeSubTreeVisible ViewBox n
_ Tag b n
x = Tag b n
x

stretchViewBox :: Double
-> Double
-> (Maybe (Double, Double, Double, Double), Maybe PreserveAR)
-> a
-> a
stretchViewBox Double
w Double
h ((Just (Double
minX,Double
minY,Double
width,Double
height), Just PreserveAR
par)) = forall {a}.
(V a ~ V2, N a ~ Double, Fractional (N a), Transformable a,
 Alignable a, HasOrigin a, Additive (V a), R2 (V a)) =>
Double -> Double -> Double -> Double -> PreserveAR -> a -> a
preserveAspectRatio Double
w Double
h (Double
width forall a. Num a => a -> a -> a
- Double
minX) (Double
height forall a. Num a => a -> a -> a
- Double
minY) PreserveAR
par
stretchViewBox Double
w Double
h ((Just (Double
minX,Double
minY,Double
width,Double
height), Maybe PreserveAR
Nothing))  = -- Debug.Trace.trace "nothing" $
                                    forall {a}.
(V a ~ V2, N a ~ Double, Fractional (N a), Transformable a,
 Alignable a, HasOrigin a, Additive (V a), R2 (V a)) =>
Double -> Double -> Double -> Double -> PreserveAR -> a -> a
preserveAspectRatio Double
w Double
h (Double
width forall a. Num a => a -> a -> a
- Double
minX) (Double
height forall a. Num a => a -> a -> a
- Double
minY) (AlignSVG -> MeetOrSlice -> PreserveAR
PAR (Double -> Double -> AlignSVG
AlignXY Double
0.5 Double
0.5) MeetOrSlice
Meet)
stretchViewBox Double
w Double
h (Maybe (Double, Double, Double, Double), Maybe PreserveAR)
_ = forall a. a -> a
id

cutOutViewBox :: (Maybe (n, n, n, n), b) -> QDiagram b V2 n m -> QDiagram b V2 n m
cutOutViewBox (Just (n
minX,n
minY,n
width,n
height), b
_) = forall b n m.
(OrderedField n, Monoid' m) =>
Point V2 n -> V2 n -> QDiagram b V2 n m -> QDiagram b V2 n m
rectEnvelope (forall n. (n, n) -> P2 n
p2 (n
minX, n
minY)) (forall n. (n, n) -> V2 n
r2 ((n
width forall a. Num a => a -> a -> a
- n
minX), (n
height forall a. Num a => a -> a -> a
- n
minY)))
                                                 --  (clipBy (rect (width - minX) (height - minY)))
cutOutViewBox (Maybe (n, n, n, n), b)
_ = forall a. a -> a
id

-------------------------------------------------------------------------------------------------------------------------------
-- | preserveAspectRatio is needed to fit an image into a frame that has a different aspect ratio than the image
--  (e.g. 16:10 against 4:3).
--  SVG embeds images the same way: <http://www.w3.org/TR/SVG11/coords.html#PreserveAspectRatioAttribute>
--
-- > import Graphics.SVGFonts
-- >
-- > portrait preserveAR width height = stroke (readSVGFile preserveAR width height "portrait.svg") # showOrigin
-- > text' t = stroke (textSVG' $ TextOpts t lin INSIDE_H KERN False 1 1 ) # fc back # lc black # fillRule EvenOdd
-- > portraitMeet1 x y = (text' "PAR (AlignXY " ++ show x ++ " " show y ++ ") Meet") ===
-- >                     (portrait (PAR (AlignXY x y) Meet) 200 100 <> rect 200 100)
-- > portraitMeet2 x y = (text' "PAR (AlignXY " ++ show x ++ " " show y ++ ") Meet") ===
-- >                     (portrait (PAR (AlignXY x y) Meet) 100 200 <> rect 100 200)
-- > portraitSlice1 x y = (text' "PAR (AlignXY " ++ show x ++ " " show y ++ ") Slice") ===
-- >                      (portrait (PAR (AlignXY x y) Slice) 100 200 <> rect 100 200)
-- > portraitSlice2 x y = (text' "PAR (AlignXY " ++ show x ++ " " show y ++ ") Slice") ===
-- >                      (portrait (PAR (AlignXY x y) Slice) 200 100 <> rect 200 100)
-- > meetX = (text' "meet") === (portraitMeet1 0 0 ||| portraitMeet1 0.5 0 ||| portraitMeet1 1 0)
-- > meetY = (text' "meet") === (portraitMeet2 0 0 ||| portraitMeet2 0 0.5 ||| portraitMeet2 0 1)
-- > sliceX = (text' "slice") === (portraitSlice1 0 0 ||| portraitSlice1 0.5 0 ||| portraitSlice1 1 0)
-- > sliceY = (text' "slice") === (portraitSlice2 0 0 ||| portraitSlice2 0 0.5 ||| portraitSlice2 0 1)
-- > im = (text' "Image to fit") === (portrait (PAR (AlignXY 0 0) Meet) 123 456)
-- > viewport1 = (text' "Viewport1") === (rect 200 100)
-- > viewport2 = (text' "Viewport2") === (rect 100 200)
-- > imageAndViewports = im === viewport1 === viewport2
-- >
-- > par = imageAndViewports ||| ( ( meetX ||| meetY) === ( sliceX ||| sliceY) )
--
-- <<diagrams/src_Graphics_SVGFonts_ReadFont_textPic0.svg#diagram=par&width=300>>
-- preserveAspectRatio :: Width -> Height -> Width -> Height -> PreserveAR -> Diagram b -> Diagram b
preserveAspectRatio :: Double -> Double -> Double -> Double -> PreserveAR -> a -> a
preserveAspectRatio Double
newWidth Double
newHeight Double
oldWidth Double
oldHeight PreserveAR
preserveAR a
image
   | Double
aspectRatio forall a. Ord a => a -> a -> Bool
< Double
newAspectRatio = PreserveAR -> a -> a
xPlace PreserveAR
preserveAR a
image
   | Bool
otherwise                    = PreserveAR -> a -> a
yPlace PreserveAR
preserveAR a
image
  where aspectRatio :: Double
aspectRatio = Double
oldWidth forall a. Fractional a => a -> a -> a
/ Double
oldHeight
        newAspectRatio :: Double
newAspectRatio = Double
newWidth forall a. Fractional a => a -> a -> a
/ Double
newHeight
        scaX :: Double
scaX = Double
newHeight forall a. Fractional a => a -> a -> a
/ Double
oldHeight
        scaY :: Double
scaY = Double
newWidth forall a. Fractional a => a -> a -> a
/ Double
oldWidth
        xPlace :: PreserveAR -> a -> a
xPlace (PAR (AlignXY Double
x Double
y) MeetOrSlice
Meet)  a
i = a
i forall a b. a -> (a -> b) -> b
# forall (v :: * -> *) n a.
(InSpace v n a, Eq n, Fractional n, Transformable a) =>
n -> a -> a
scale Double
scaX forall a b. a -> (a -> b) -> b
# forall n a.
(InSpace V2 n a, Fractional n, Alignable a, HasOrigin a) =>
a -> a
alignBL forall a b. a -> (a -> b) -> b
# forall (v :: * -> *) n t.
(InSpace v n t, R1 v, Transformable t) =>
n -> t -> t
translateX ((Double
newWidth  forall a. Num a => a -> a -> a
- Double
oldWidthforall a. Num a => a -> a -> a
*Double
scaX)forall a. Num a => a -> a -> a
*Double
x)
        xPlace (PAR (AlignXY Double
x Double
y) MeetOrSlice
Slice) a
i = a
i forall a b. a -> (a -> b) -> b
# forall (v :: * -> *) n a.
(InSpace v n a, Eq n, Fractional n, Transformable a) =>
n -> a -> a
scale Double
scaY forall a b. a -> (a -> b) -> b
# forall n a.
(InSpace V2 n a, Fractional n, Alignable a, HasOrigin a) =>
a -> a
alignBL forall a b. a -> (a -> b) -> b
# forall (v :: * -> *) n t.
(InSpace v n t, R1 v, Transformable t) =>
n -> t -> t
translateX ((Double
newWidth  forall a. Num a => a -> a -> a
- Double
oldWidthforall a. Num a => a -> a -> a
*Double
scaX)forall a. Num a => a -> a -> a
*Double
x)
--                                               # view (p2 (0, 0)) (r2 (newWidth, newHeight))

        yPlace :: PreserveAR -> a -> a
yPlace (PAR (AlignXY Double
x Double
y) MeetOrSlice
Meet)  a
i = a
i forall a b. a -> (a -> b) -> b
# forall (v :: * -> *) n a.
(InSpace v n a, Eq n, Fractional n, Transformable a) =>
n -> a -> a
scale Double
scaY forall a b. a -> (a -> b) -> b
# forall n a.
(InSpace V2 n a, Fractional n, Alignable a, HasOrigin a) =>
a -> a
alignBL forall a b. a -> (a -> b) -> b
# forall (v :: * -> *) n t.
(InSpace v n t, R2 v, Transformable t) =>
n -> t -> t
translateY ((Double
newHeight forall a. Num a => a -> a -> a
- Double
oldHeightforall a. Num a => a -> a -> a
*Double
scaY)forall a. Num a => a -> a -> a
*Double
y)
        yPlace (PAR (AlignXY Double
x Double
y) MeetOrSlice
Slice) a
i = a
i forall a b. a -> (a -> b) -> b
# forall (v :: * -> *) n a.
(InSpace v n a, Eq n, Fractional n, Transformable a) =>
n -> a -> a
scale Double
scaX forall a b. a -> (a -> b) -> b
# forall n a.
(InSpace V2 n a, Fractional n, Alignable a, HasOrigin a) =>
a -> a
alignBL forall a b. a -> (a -> b) -> b
# forall (v :: * -> *) n t.
(InSpace v n t, R2 v, Transformable t) =>
n -> t -> t
translateY ((Double
newHeight forall a. Num a => a -> a -> a
- Double
oldHeightforall a. Num a => a -> a -> a
*Double
scaY)forall a. Num a => a -> a -> a
*Double
y)
--                                               # view (p2 (0, 0)) (r2 (newWidth, newHeight))


-- a combination of linear- and radial-attributes so that referenced gradients can replace Nothing-attributes
data GradientAttributes =
  GA { GradientAttributes -> PresentationAttributes
presentationAttributes :: PresentationAttributes
     , GradientAttributes -> Id
class_ :: Maybe Text
     , GradientAttributes -> Id
style  :: Maybe Text
     , GradientAttributes -> Id
x1  :: Maybe Text
     , GradientAttributes -> Id
y1  :: Maybe Text
     , GradientAttributes -> Id
x2  :: Maybe Text
     , GradientAttributes -> Id
y2  :: Maybe Text
     , GradientAttributes -> Id
cx  :: Maybe Text
     , GradientAttributes -> Id
cy  :: Maybe Text
     , GradientAttributes -> Id
r   :: Maybe Text
     , GradientAttributes -> Id
fx  :: Maybe Text
     , GradientAttributes -> Id
fy  :: Maybe Text
     , GradientAttributes -> Id
gradientUnits     :: Maybe Text
     , GradientAttributes -> Id
gradientTransform :: Maybe Text
     , GradientAttributes -> Id
spreadMethod      :: Maybe Text
     }

-- GA pa class_ style x1 y1 x2 y2 cx cy r fx fy gradientUnits gradientTransform spreadMethod

data PresentationAttributes =
   PA { PresentationAttributes -> Id
alignmentBaseline :: Maybe Text
      , PresentationAttributes -> Id
baselineShift :: Maybe Text
      , PresentationAttributes -> Id
clip :: Maybe Text
      , PresentationAttributes -> Id
clipPath :: Maybe Text
      , PresentationAttributes -> Id
clipRule :: Maybe Text
      , PresentationAttributes -> Id
color :: Maybe Text
      , PresentationAttributes -> Id
colorInterpolation :: Maybe Text
      , PresentationAttributes -> Id
colorInterpolationFilters :: Maybe Text
      , PresentationAttributes -> Id
colorProfile :: Maybe Text
      , PresentationAttributes -> Id
colorRendering :: Maybe Text
      , PresentationAttributes -> Id
cursor :: Maybe Text
      , PresentationAttributes -> Id
direction :: Maybe Text
      , PresentationAttributes -> Id
display :: Maybe Text
      , PresentationAttributes -> Id
dominantBaseline :: Maybe Text
      , PresentationAttributes -> Id
enableBackground :: Maybe Text
      , PresentationAttributes -> Id
fill :: Maybe Text
      , PresentationAttributes -> Id
fillOpacity :: Maybe Text
      , PresentationAttributes -> Id
fillRuleSVG :: Maybe Text
      , PresentationAttributes -> Id
filter :: Maybe Text
      , PresentationAttributes -> Id
floodColor :: Maybe Text
      , PresentationAttributes -> Id
floodOpacity :: Maybe Text
      , PresentationAttributes -> Id
fontFamily :: Maybe Text
      , PresentationAttributes -> Id
fntSize :: Maybe Text
      , PresentationAttributes -> Id
fontSizeAdjust :: Maybe Text
      , PresentationAttributes -> Id
fontStretch :: Maybe Text
      , PresentationAttributes -> Id
fontStyle :: Maybe Text
      , PresentationAttributes -> Id
fontVariant :: Maybe Text
      , PresentationAttributes -> Id
fontWeight :: Maybe Text
      , PresentationAttributes -> Id
glyphOrientationHorizontal :: Maybe Text
      , PresentationAttributes -> Id
glyphOrientationVertical :: Maybe Text
      , PresentationAttributes -> Id
imageRendering :: Maybe Text
      , PresentationAttributes -> Id
kerning :: Maybe Text
      , PresentationAttributes -> Id
letterSpacing :: Maybe Text
      , PresentationAttributes -> Id
lightingColor :: Maybe Text
      , PresentationAttributes -> Id
markerEnd :: Maybe Text
      , PresentationAttributes -> Id
markerMid :: Maybe Text
      , PresentationAttributes -> Id
markerStart :: Maybe Text
      , PresentationAttributes -> Id
mask :: Maybe Text
      , PresentationAttributes -> Id
opacity :: Maybe Text
      , PresentationAttributes -> Id
overflow :: Maybe Text
      , PresentationAttributes -> Id
pointerEvents :: Maybe Text
      , PresentationAttributes -> Id
shapeRendering :: Maybe Text
      , PresentationAttributes -> Id
stopColor :: Maybe Text
      , PresentationAttributes -> Id
stopOpacity :: Maybe Text
      , PresentationAttributes -> Id
strokeSVG :: Maybe Text
      , PresentationAttributes -> Id
strokeDasharray :: Maybe Text
      , PresentationAttributes -> Id
strokeDashoffset :: Maybe Text
      , PresentationAttributes -> Id
strokeLinecap :: Maybe Text
      , PresentationAttributes -> Id
strokeLinejoin :: Maybe Text
      , PresentationAttributes -> Id
strokeMiterlimit :: Maybe Text
      , PresentationAttributes -> Id
strokeOpacity :: Maybe Text
      , PresentationAttributes -> Id
strokeWidth :: Maybe Text
      , PresentationAttributes -> Id
textAnchor :: Maybe Text
      , PresentationAttributes -> Id
textDecoration :: Maybe Text
      , PresentationAttributes -> Id
textRendering :: Maybe Text
      , PresentationAttributes -> Id
unicodeBidi :: Maybe Text
      , PresentationAttributes -> Id
visibility :: Maybe Text
      , PresentationAttributes -> Id
wordSpacing :: Maybe Text
      , PresentationAttributes -> Id
writingMode :: Maybe Text
      } deriving Int -> PresentationAttributes -> ShowS
[PresentationAttributes] -> ShowS
PresentationAttributes -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PresentationAttributes] -> ShowS
$cshowList :: [PresentationAttributes] -> ShowS
show :: PresentationAttributes -> String
$cshow :: PresentationAttributes -> String
showsPrec :: Int -> PresentationAttributes -> ShowS
$cshowsPrec :: Int -> PresentationAttributes -> ShowS
Show

type SvgGlyphs n = H.HashMap Text (Maybe Text, n, Maybe Text)
-- ^ \[ (unicode, (glyph_name, horiz_advance, ds)) \]

data Kern n = Kern
  { forall n. Kern n -> KernDir
kernDir :: KernDir
  , forall n. Kern n -> [Text]
kernU1  :: [Text]
  , forall n. Kern n -> [Text]
kernU2  :: [Text]
  , forall n. Kern n -> [Text]
kernG1  :: [Text]
  , forall n. Kern n -> [Text]
kernG2  :: [Text]
  , forall n. Kern n -> n
kernK   :: n
  }

-- | Data from the subtags
data FontContent b n = FF (FontFace n) | GG (Glyph b n) | KK (Kern n)

-- | All data in the \<font\>-tag
data FontData b n = FontData
  {
    forall b n. FontData b n -> Id
fontId                         :: Maybe Text
  , forall b n. FontData b n -> Id
fontDataHorizontalOriginX      :: Maybe Text
  , forall b n. FontData b n -> Id
fontDataHorizontalOriginY      :: Maybe Text
  , forall b n. FontData b n -> n
fontDataHorizontalAdvance      :: n
  , forall b n. FontData b n -> Id
fontDataVerticalOriginX        :: Maybe Text
  , forall b n. FontData b n -> Id
fontDataVerticalOriginY        :: Maybe Text
  , forall b n. FontData b n -> Id
fontDataVerticalAdvance        :: Maybe Text
  -- ^ data gathered from subtags
  , forall b n. FontData b n -> FontFace n
fontFace                       :: FontFace n
  , forall b n. FontData b n -> Glyph b n
fontMissingGlyph               :: Glyph b n
  , forall b n. FontData b n -> SvgGlyphs n
fontDataGlyphs                 :: SvgGlyphs n
--  , fontDataRawKernings            :: [(Text, [Text], [Text], [Text], [Text])]
  , forall b n. FontData b n -> KernMaps n
fontDataKerning                :: KernMaps n
--  , fontDataFileName               :: Text
}

data FontFace n = FontFace
  { forall n. FontFace n -> Id
fontDataFamily                 :: Maybe Text
  , forall n. FontFace n -> Id
fontDataStyle                  :: Maybe Text
  , forall n. FontFace n -> Id
fontDataVariant                :: Maybe Text
  , forall n. FontFace n -> Id
fontDataWeight                 :: Maybe Text
  , forall n. FontFace n -> Id
fontDataStretch                :: Maybe Text
  , forall n. FontFace n -> Id
fontDataSize                   :: Maybe Text
  , forall n. FontFace n -> Id
fontDataUnicodeRange           :: Maybe Text
  , forall n. FontFace n -> Id
fontDataUnitsPerEm             :: Maybe Text
  , forall n. FontFace n -> Id
fontDataPanose                 :: Maybe Text
  , forall n. FontFace n -> Id
fontDataVerticalStem           :: Maybe Text
  , forall n. FontFace n -> Id
fontDataHorizontalStem         :: Maybe Text
  , forall n. FontFace n -> Id
fontDataSlope                  :: Maybe Text
  , forall n. FontFace n -> Id
fontDataCapHeight              :: Maybe Text
  , forall n. FontFace n -> Id
fontDataXHeight                :: Maybe Text
  , forall n. FontFace n -> Id
fontDataAccentHeight           :: Maybe Text
  , forall n. FontFace n -> Id
fontDataAscent                 :: Maybe Text
  , forall n. FontFace n -> Id
fontDataDescent                :: Maybe Text
  , forall n. FontFace n -> Id
fontDataWidths                 :: Maybe Text
  , forall n. FontFace n -> [n]
fontDataBoundingBox            :: [n]
  , forall n. FontFace n -> Id
fontDataIdeographicBaseline    :: Maybe Text
  , forall n. FontFace n -> Id
fontDataAlphabeticBaseline     :: Maybe Text
  , forall n. FontFace n -> Id
fontDataMathematicalBaseline   :: Maybe Text
  , forall n. FontFace n -> Id
fontDataHangingBaseline        :: Maybe Text
  , forall n. FontFace n -> Id
fontDataVIdeographicBaseline   :: Maybe Text
  , forall n. FontFace n -> Id
fontDataVAlphabeticBaseline    :: Maybe Text
  , forall n. FontFace n -> Id
fontDataVMathematicalBaseline  :: Maybe Text
  , forall n. FontFace n -> Id
fontDataVHangingBaseline       :: Maybe Text
  , forall n. FontFace n -> Id
fontDataUnderlinePos           :: Maybe Text
  , forall n. FontFace n -> Id
fontDataUnderlineThickness     :: Maybe Text
  , forall n. FontFace n -> Id
fontDataStrikethroughPos       :: Maybe Text
  , forall n. FontFace n -> Id
fontDataStrikethroughThickness :: Maybe Text
  , forall n. FontFace n -> Id
fontDataOverlinePos            :: Maybe Text
  , forall n. FontFace n -> Id
fontDataOverlineThickness      :: Maybe Text
  }

data Glyph b n = Glyph
  { forall b n. Glyph b n -> Id
glyphId     :: Maybe Text
  , forall b n. Glyph b n -> Tag b n
glyph       :: Tag b n
  , forall b n. Glyph b n -> Id
d           :: Maybe Text
  , forall b n. Glyph b n -> n
horizAdvX   :: n
  , forall b n. Glyph b n -> n
vertOriginX :: n
  , forall b n. Glyph b n -> n
vertOriginY :: n
  , forall b n. Glyph b n -> n
vertAdvY    :: n
  , forall b n. Glyph b n -> Id
unicode     :: Maybe Text
  , forall b n. Glyph b n -> Id
glyphName   :: Maybe Text
  , forall b n. Glyph b n -> Id
orientation :: Maybe Text
  , forall b n. Glyph b n -> Id
arabicForm  :: Maybe Text
  , forall b n. Glyph b n -> Id
lang        :: Maybe Text
  }

data KernDir = HKern | VKern

data KernMaps n = KernMaps
  { forall n. KernMaps n -> [KernDir]
kernDirs :: [KernDir]
  , forall n. KernMaps n -> HashMap Text [Int]
kernU1S :: H.HashMap Text [Int]
  , forall n. KernMaps n -> HashMap Text [Int]
kernU2S :: H.HashMap Text [Int]
  , forall n. KernMaps n -> HashMap Text [Int]
kernG1S :: H.HashMap Text [Int]
  , forall n. KernMaps n -> HashMap Text [Int]
kernG2S :: H.HashMap Text [Int]
  , forall n. KernMaps n -> Vector n
kernKs   :: Vector n
  }