{-# 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 "      String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Id -> String
forall a. Show a => a -> String
show Id
id1) String -> ShowS
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 " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Id -> String
forall a. Show a => a -> String
show Id
id1) String -> ShowS
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 " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Id -> String
forall a. Show a => a -> String
show Id
id1) String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ((Tag b n -> String) -> [Tag b n] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Tag b n -> String
forall a. Show a => a -> String
show [Tag b n]
tree) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
  show (StyleTag [(Text, [(Text, Text)])]
_)   = String
"Style "    String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
  show (Grad Id
id1 Gr n
gr) = String
"Grad id:" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Id -> String
forall a. Show a => a -> String
show Id
id1) -- ++ (show gr) ++ "\n"
  show (Stop HashMaps b n -> [GradientStop n]
_)   = String
"Stop " String -> ShowS
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 :: 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)
  | Id -> Bool
forall a. Maybe a -> Bool
isJust Id
id1 = (Nodelist b n
ns Nodelist b n -> Nodelist b n -> Nodelist b n
forall a. [a] -> [a] -> [a]
++ [(Id -> Text
forall a. HasCallStack => Maybe a -> a
fromJust Id
id1, Id
-> (ViewBox n -> Path V2 n)
-> ((HashMaps b n, ViewBox n) -> Diagram b)
-> Tag b n
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)
  | Id -> Bool
forall a. Maybe a -> Bool
isJust Id
id1 = [(Nodelist b n, [(Text, [(Text, Text)])], Gradlist n,
  Fontlist b n)]
-> (Nodelist b n, [(Text, [(Text, Text)])], Gradlist n,
    Fontlist b n)
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 Nodelist b n -> Nodelist b n -> Nodelist b n
forall a. [a] -> [a] -> [a]
++ [(Id -> Text
forall a. HasCallStack => Maybe a -> a
fromJust Id
id1, Bool
-> Id
-> (Double, Double)
-> Maybe (ViewBox n)
-> Maybe PreserveAR
-> (HashMaps b n -> Diagram b -> Diagram b)
-> [Tag b n]
-> Tag b n
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) ,
                            ([(Nodelist b n, [(Text, [(Text, Text)])], Gradlist n,
  Fontlist b n)]
-> (Nodelist b n, [(Text, [(Text, Text)])], Gradlist n,
    Fontlist b n)
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 ((Tag b 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)]
forall a b. (a -> b) -> [a] -> [b]
map (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)
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  = [(Nodelist b n, [(Text, [(Text, Text)])], Gradlist n,
  Fontlist b n)]
-> (Nodelist b n, [(Text, [(Text, Text)])], Gradlist n,
    Fontlist b n)
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 ((Tag b 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)]
forall a b. (a -> b) -> [a] -> [b]
map (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)
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)
  | Id -> Bool
forall a. Maybe a -> Bool
isJust Id
id1 = [(Nodelist b n, [(Text, [(Text, Text)])], Gradlist n,
  Fontlist b n)]
-> (Nodelist b n, [(Text, [(Text, Text)])], Gradlist n,
    Fontlist b n)
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 Nodelist b n -> Nodelist b n -> Nodelist b n
forall a. [a] -> [a] -> [a]
++ [(Id -> Text
forall a. HasCallStack => Maybe a -> a
fromJust Id
id1, Bool
-> Id
-> (Double, Double)
-> Maybe (ViewBox n)
-> Maybe PreserveAR
-> (HashMaps b n -> Diagram b -> Diagram b)
-> [Tag b n]
-> Tag b n
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) ,
                            ([(Nodelist b n, [(Text, [(Text, Text)])], Gradlist n,
  Fontlist b n)]
-> (Nodelist b n, [(Text, [(Text, Text)])], Gradlist n,
    Fontlist b n)
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 ((Tag b 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)]
forall a b. (a -> b) -> [a] -> [b]
map (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)
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  = [(Nodelist b n, [(Text, [(Text, Text)])], Gradlist n,
  Fontlist b n)]
-> (Nodelist b n, [(Text, [(Text, Text)])], Gradlist n,
    Fontlist b n)
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 ((Tag b 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)]
forall a b. (a -> b) -> [a] -> [b]
map (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)
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))
  | Id -> Bool
forall a. Maybe a -> Bool
isJust Id
id1 = (Nodelist b n
ns,[(Text, [(Text, Text)])]
css, Gradlist n
grads Gradlist n -> Gradlist n -> Gradlist n
forall a. [a] -> [a] -> [a]
++ [(Id -> Text
forall a. HasCallStack => Maybe a -> a
fromJust Id
id1, Id
-> GradientAttributes
-> Maybe (ViewBox n)
-> [CSSMap -> [GradientStop n]]
-> (CSSMap
    -> GradientAttributes
    -> ViewBox n
    -> [CSSMap -> [GradientStop n]]
    -> Texture n)
-> Gr n
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 [(Text, [(Text, Text)])]
-> [(Text, [(Text, Text)])] -> [(Text, [(Text, Text)])]
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 Fontlist b n -> Fontlist b n -> Fontlist b n
forall a. [a] -> [a] -> [a]
++ [(Text -> Id -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" (FontData b n -> Id
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 :: [(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 = ([Nodelist b n] -> Nodelist b n
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([Nodelist b n] -> Nodelist b n) -> [Nodelist b n] -> Nodelist b n
forall a b. (a -> b) -> a -> b
$ ((Nodelist b n, [(Text, [(Text, Text)])], Gradlist n, Fontlist b n)
 -> Nodelist b n)
-> [(Nodelist b n, [(Text, [(Text, Text)])], Gradlist n,
     Fontlist b n)]
-> [Nodelist b n]
forall a b. (a -> b) -> [a] -> [b]
map (Nodelist b n, [(Text, [(Text, Text)])], Gradlist n, Fontlist b n)
-> Nodelist b n
forall a b c d. (a, b, c, d) -> a
sel1 [(Nodelist b n, [(Text, [(Text, Text)])], Gradlist n,
  Fontlist b n)]
list, [[(Text, [(Text, Text)])]] -> [(Text, [(Text, Text)])]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[(Text, [(Text, Text)])]] -> [(Text, [(Text, Text)])])
-> [[(Text, [(Text, Text)])]] -> [(Text, [(Text, Text)])]
forall a b. (a -> b) -> a -> b
$ ((Nodelist b n, [(Text, [(Text, Text)])], Gradlist n, Fontlist b n)
 -> [(Text, [(Text, Text)])])
-> [(Nodelist b n, [(Text, [(Text, Text)])], Gradlist n,
     Fontlist b n)]
-> [[(Text, [(Text, Text)])]]
forall a b. (a -> b) -> [a] -> [b]
map (Nodelist b n, [(Text, [(Text, Text)])], Gradlist n, Fontlist b n)
-> [(Text, [(Text, Text)])]
forall a b c d. (a, b, c, d) -> b
sel2 [(Nodelist b n, [(Text, [(Text, Text)])], Gradlist n,
  Fontlist b n)]
list, [Gradlist n] -> Gradlist n
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([Gradlist n] -> Gradlist n) -> [Gradlist n] -> Gradlist n
forall a b. (a -> b) -> a -> b
$ ((Nodelist b n, [(Text, [(Text, Text)])], Gradlist n, Fontlist b n)
 -> Gradlist n)
-> [(Nodelist b n, [(Text, [(Text, Text)])], Gradlist n,
     Fontlist b n)]
-> [Gradlist n]
forall a b. (a -> b) -> [a] -> [b]
map (Nodelist b n, [(Text, [(Text, Text)])], Gradlist n, Fontlist b n)
-> Gradlist n
forall a b c d. (a, b, c, d) -> c
sel3 [(Nodelist b n, [(Text, [(Text, Text)])], Gradlist n,
  Fontlist b n)]
list, [Fontlist b n] -> Fontlist b n
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([Fontlist b n] -> Fontlist b n) -> [Fontlist b n] -> Fontlist b n
forall a b. (a -> b) -> a -> b
$ ((Nodelist b n, [(Text, [(Text, Text)])], Gradlist n, Fontlist b n)
 -> Fontlist b n)
-> [(Nodelist b n, [(Text, [(Text, Text)])], Gradlist n,
     Fontlist b n)]
-> [Fontlist b n]
forall a b. (a -> b) -> [a] -> [b]
map (Nodelist b n, [(Text, [(Text, Text)])], Gradlist n, Fontlist b n)
-> Fontlist b n
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 :: GradientsMap n -> GradientsMap n
expandGradMap GradientsMap n
gradMap = (Text -> Gr n -> Gr n) -> GradientsMap n -> GradientsMap n
forall k v1 v2. (k -> v1 -> v2) -> HashMap k v1 -> HashMap k v2
H.mapWithKey (GradientsMap n -> Text -> Gr n -> Gr n
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) = (Id
-> GradientAttributes
-> Maybe (ViewBox n)
-> [CSSMap -> [GradientStop n]]
-> (CSSMap
    -> GradientAttributes
    -> ViewBox n
    -> [CSSMap -> [GradientStop n]]
    -> Texture n)
-> Gr n
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 [CSSMap -> [GradientStop n]]
-> [CSSMap -> [GradientStop n]] -> [CSSMap -> [GradientStop n]]
forall a. [a] -> [a] -> [a]
++ (GradientsMap n -> Id -> [CSSMap -> [GradientStop n]]
forall n. GradientsMap n -> Id -> [CSSMap -> [GradientStop n]]
gradientStops GradientsMap n
grMap Id
gradRefId)
        newAttributes :: GradientAttributes
newAttributes = [GradientAttributes] -> GradientAttributes
overwriteDefaultAttributes ([GradientAttributes] -> GradientAttributes)
-> [GradientAttributes] -> GradientAttributes
forall a b. (a -> b) -> a -> b
$ GradientsMap n -> Id -> [GradientAttributes]
forall n. GradientsMap n -> Id -> [GradientAttributes]
gradientAttributes GradientsMap n
grMap (Text -> Id
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 = (GradientAttributes -> GradientAttributes -> GradientAttributes)
-> [GradientAttributes] -> GradientAttributes
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 GradientAttributes -> GradientAttributes -> GradientAttributes
updateRec ([GradientAttributes] -> [GradientAttributes]
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 :: GradientsMap n -> Id -> [GradientAttributes]
gradientAttributes GradientsMap n
grMap Id
Nothing = []
gradientAttributes GradientsMap n
grMap (Just Text
refId) | Maybe (Gr n) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (Gr n)
gr = (Gr n -> GradientAttributes
forall n. Gr n -> GradientAttributes
attrs (Gr n -> GradientAttributes) -> Gr n -> GradientAttributes
forall a b. (a -> b) -> a -> b
$ Maybe (Gr n) -> Gr n
forall a. HasCallStack => Maybe a -> a
fromJust Maybe (Gr n)
gr) GradientAttributes -> [GradientAttributes] -> [GradientAttributes]
forall a. a -> [a] -> [a]
: (GradientsMap n -> Id -> [GradientAttributes]
forall n. GradientsMap n -> Id -> [GradientAttributes]
gradientAttributes GradientsMap n
grMap (Gr n -> Id
forall n. Gr n -> Id
grRef (Gr n -> Id) -> Gr n -> Id
forall a b. (a -> b) -> a -> b
$ Maybe (Gr n) -> Gr n
forall a. HasCallStack => Maybe a -> a
fromJust Maybe (Gr n)
gr))
                                      | Bool
otherwise = []
  where gr :: Maybe (Gr n)
gr = Text -> GradientsMap n -> Maybe (Gr n)
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 :: GradientsMap n -> Id -> [CSSMap -> [GradientStop n]]
gradientStops GradientsMap n
grMap Id
Nothing = []
gradientStops GradientsMap n
grMap (Just Text
refId) | Maybe (Gr n) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (Gr n)
gr = (Gr n -> [CSSMap -> [GradientStop n]]
forall n. Gr n -> [CSSMap -> [GradientStop n]]
stops (Gr n -> [CSSMap -> [GradientStop n]])
-> Gr n -> [CSSMap -> [GradientStop n]]
forall a b. (a -> b) -> a -> b
$ Maybe (Gr n) -> Gr n
forall a. HasCallStack => Maybe a -> a
fromJust Maybe (Gr n)
gr) [CSSMap -> [GradientStop n]]
-> [CSSMap -> [GradientStop n]] -> [CSSMap -> [GradientStop n]]
forall a. [a] -> [a] -> [a]
++ (GradientsMap n -> Id -> [CSSMap -> [GradientStop n]]
forall n. GradientsMap n -> Id -> [CSSMap -> [GradientStop n]]
gradientStops GradientsMap n
grMap (Gr n -> Id
forall n. Gr n -> Id
grRef (Gr n -> Id) -> Gr n -> Id
forall a b. (a -> b) -> a -> b
$ Maybe (Gr n) -> Gr n
forall a. HasCallStack => Maybe a -> a
fromJust Maybe (Gr n)
gr))
                                 | Bool
otherwise = []
  where gr :: Maybe (Gr n)
gr = Text -> GradientsMap n -> Maybe (Gr n)
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) = (Text -> Id
forall a. a -> Maybe a
Just Text
t1) Id -> [Id] -> [Id]
forall a. a -> [a] -> [a]
: ([Id] -> [Id] -> [Id]
updateList [Id]
xs [Id]
ys)
    updateList ((Just Text
t0):[Id]
xs) (Id
Nothing  :[Id]
ys) = (Text -> Id
forall a. a -> Maybe a
Just Text
t0) Id -> [Id] -> [Id]
forall a. a -> [a] -> [a]
: ([Id] -> [Id] -> [Id]
updateList [Id]
xs [Id]
ys)
    updateList  (Id
Nothing :[Id]
xs) (Id
Nothing  :[Id]
ys) =  Id
forall a. Maybe a
Nothing  Id -> [Id] -> [Id]
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 | (Maybe a -> Bool
forall a. Maybe a -> Bool
isJust Maybe a
i) Bool -> Bool -> Bool
&& (Maybe (Tag b n) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (Tag b n)
l) = Maybe (Tag b n) -> Tag b n
forall a. HasCallStack => Maybe a -> a
fromJust Maybe (Tag b n)
l
              | Bool
otherwise = Id
-> (ViewBox n -> Path V2 n)
-> ((HashMaps b n, ViewBox n) -> Diagram b)
-> Tag b n
forall b n.
Id
-> (ViewBox n -> Path V2 n)
-> ((HashMaps b n, ViewBox n) -> Diagram b)
-> Tag b n
Leaf Id
forall a. Maybe a
Nothing ViewBox n -> Path V2 n
forall a. Monoid a => a
mempty (HashMaps b n, ViewBox n) -> Diagram b
forall a. Monoid a => a
mempty -- an empty diagram if we can't find the id
  where l :: Maybe (Tag b n)
l = a -> HashMap a (Tag b n) -> Maybe (Tag b n)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
H.lookup (Maybe a -> a
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 :: (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)) QDiagram b V2 Double Any
-> (QDiagram b V2 Double Any -> QDiagram b V2 Double Any)
-> QDiagram b V2 Double Any
forall a b. a -> (a -> b) -> b
# (if Id -> Bool
forall a. Maybe a -> Bool
isJust Id
id1 then String -> QDiagram b V2 Double Any -> QDiagram b V2 Double Any
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 (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Id -> Text
forall a. HasCallStack => Maybe a -> a
fromJust Id
id1) else QDiagram b V2 Double Any -> QDiagram b V2 Double Any
forall a. a -> a
id)
insertRefs (HashMaps b n
maps,ViewBox n
viewbox) (Grad Id
_ Gr n
_) = Diagram b
forall a. Monoid a => a
mempty
insertRefs (HashMaps b n
maps,ViewBox n
viewbox) (Stop HashMaps b n -> [GradientStop n]
f) = Diagram b
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)
    | (Path V2 n -> Double
forall n a. (InSpace V2 n a, Enveloped a) => a -> n
Diagrams.TwoD.Size.width Path V2 n
r) Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
0 Bool -> Bool -> Bool
|| (Path V2 n -> Double
forall n a. (InSpace V2 n a, Enveloped a) => a -> n
Diagrams.TwoD.Size.height Path V2 n
r) Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
0 = Diagram b
forall a. Monoid a => a
mempty
    | Bool
otherwise = Diagram b
QDiagram b V2 Double Any
referencedDiagram QDiagram b V2 Double Any
-> (QDiagram b V2 Double Any -> QDiagram b V2 n Any)
-> QDiagram b V2 n Any
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 = Tag b n -> (Maybe (ViewBox n), Maybe PreserveAR)
forall b n. Tag b n -> (Maybe (ViewBox n), Maybe PreserveAR)
getViewboxPreserveAR Tag b n
subTree
        referencedDiagram :: Diagram b
referencedDiagram = (HashMaps b n, ViewBox n) -> Tag b n -> Diagram b
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) (ViewBox n -> Tag b n -> Tag b n
forall n b. ViewBox n -> Tag b n -> Tag b n
makeSubTreeVisible ViewBox n
viewbox Tag b n
subTree)
        subTree :: Tag b n
subTree = HashMap Text (Tag b n) -> Id -> Tag b n
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 (HashMaps b n -> HashMap Text (Tag b n)
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
_ = (Maybe (ViewBox n)
forall a. Maybe a
Nothing, Maybe PreserveAR
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]
_) = Diagram b
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 QDiagram b V2 Double Any
-> (QDiagram b V2 Double Any -> QDiagram b V2 n Any)
-> QDiagram b V2 n Any
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 = [QDiagram b V2 Double Any] -> QDiagram b V2 Double Any
forall a. Monoid a => [a] -> a
mconcat ((Tag b n -> QDiagram b V2 Double Any)
-> [Tag b n] -> [QDiagram b V2 Double Any]
forall a b. (a -> b) -> [a] -> [b]
map ((HashMaps b n, ViewBox n) -> Tag b n -> Diagram b
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 -> Maybe (ViewBox n) -> ViewBox n
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)])]
_) = Diagram b
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) =
                           (Bool
-> Id
-> (Double, Double)
-> Maybe (ViewBox n)
-> Maybe PreserveAR
-> (HashMaps b n -> Diagram b -> Diagram b)
-> [Tag b n]
-> Tag b n
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 (ViewBox n -> Maybe (ViewBox n)
forall a. a -> Maybe a
Just ViewBox n
viewbox) Maybe PreserveAR
ar HashMaps b n -> Diagram b -> Diagram b
g ((Tag b n -> Tag b n) -> [Tag b n] -> [Tag b n]
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)
-> b
-> b
stretchViewBox Double
w Double
h ((Just (Double
minX,Double
minY,Double
width,Double
height), Just PreserveAR
par)) = Double -> Double -> Double -> Double -> PreserveAR -> b -> b
forall b.
(Transformable b, Alignable b, HasOrigin b, N b ~ Double,
 V b ~ V2) =>
Double -> Double -> Double -> Double -> PreserveAR -> b -> b
preserveAspectRatio Double
w Double
h (Double
width Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
minX) (Double
height Double -> Double -> Double
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" $
                                    Double -> Double -> Double -> Double -> PreserveAR -> b -> b
forall b.
(Transformable b, Alignable b, HasOrigin b, N b ~ Double,
 V b ~ V2) =>
Double -> Double -> Double -> Double -> PreserveAR -> b -> b
preserveAspectRatio Double
w Double
h (Double
width Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
minX) (Double
height Double -> Double -> Double
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)
_ = b -> b
forall a. a -> a
id

cutOutViewBox :: (Maybe (a, a, a, a), b) -> QDiagram b V2 a m -> QDiagram b V2 a m
cutOutViewBox (Just (a
minX,a
minY,a
width,a
height), b
_) = Point V2 a -> V2 a -> QDiagram b V2 a m -> QDiagram b V2 a m
forall b n m.
(OrderedField n, Monoid' m) =>
Point V2 n -> V2 n -> QDiagram b V2 n m -> QDiagram b V2 n m
rectEnvelope ((a, a) -> Point V2 a
forall n. (n, n) -> P2 n
p2 (a
minX, a
minY)) ((a, a) -> V2 a
forall n. (n, n) -> V2 n
r2 ((a
width a -> a -> a
forall a. Num a => a -> a -> a
- a
minX), (a
height a -> a -> a
forall a. Num a => a -> a -> a
- a
minY)))
                                                 --  (clipBy (rect (width - minX) (height - minY)))
cutOutViewBox (Maybe (a, a, a, a), b)
_ = QDiagram b V2 a m -> QDiagram b V2 a m
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 -> b -> b
preserveAspectRatio Double
newWidth Double
newHeight Double
oldWidth Double
oldHeight PreserveAR
preserveAR b
image
   | Double
aspectRatio Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
newAspectRatio = PreserveAR -> b -> b
xPlace PreserveAR
preserveAR b
image
   | Bool
otherwise                    = PreserveAR -> b -> b
yPlace PreserveAR
preserveAR b
image
  where aspectRatio :: Double
aspectRatio = Double
oldWidth Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
oldHeight
        newAspectRatio :: Double
newAspectRatio = Double
newWidth Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
newHeight
        scaX :: Double
scaX = Double
newHeight Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
oldHeight
        scaY :: Double
scaY = Double
newWidth Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
oldWidth
        xPlace :: PreserveAR -> b -> b
xPlace (PAR (AlignXY Double
x Double
y) MeetOrSlice
Meet)  b
i = b
i b -> (b -> b) -> b
forall a b. a -> (a -> b) -> b
# Double -> b -> b
forall (v :: * -> *) n a.
(InSpace v n a, Eq n, Fractional n, Transformable a) =>
n -> a -> a
scale Double
scaX b -> (b -> b) -> b
forall a b. a -> (a -> b) -> b
# b -> b
forall n a.
(InSpace V2 n a, Fractional n, Alignable a, HasOrigin a) =>
a -> a
alignBL b -> (b -> b) -> b
forall a b. a -> (a -> b) -> b
# Double -> b -> b
forall (v :: * -> *) n t.
(InSpace v n t, R1 v, Transformable t) =>
n -> t -> t
translateX ((Double
newWidth  Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
oldWidthDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
scaX)Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
x)
        xPlace (PAR (AlignXY Double
x Double
y) MeetOrSlice
Slice) b
i = b
i b -> (b -> b) -> b
forall a b. a -> (a -> b) -> b
# Double -> b -> b
forall (v :: * -> *) n a.
(InSpace v n a, Eq n, Fractional n, Transformable a) =>
n -> a -> a
scale Double
scaY b -> (b -> b) -> b
forall a b. a -> (a -> b) -> b
# b -> b
forall n a.
(InSpace V2 n a, Fractional n, Alignable a, HasOrigin a) =>
a -> a
alignBL b -> (b -> b) -> b
forall a b. a -> (a -> b) -> b
# Double -> b -> b
forall (v :: * -> *) n t.
(InSpace v n t, R1 v, Transformable t) =>
n -> t -> t
translateX ((Double
newWidth  Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
oldWidthDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
scaX)Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
x)
--                                               # view (p2 (0, 0)) (r2 (newWidth, newHeight))

        yPlace :: PreserveAR -> b -> b
yPlace (PAR (AlignXY Double
x Double
y) MeetOrSlice
Meet)  b
i = b
i b -> (b -> b) -> b
forall a b. a -> (a -> b) -> b
# Double -> b -> b
forall (v :: * -> *) n a.
(InSpace v n a, Eq n, Fractional n, Transformable a) =>
n -> a -> a
scale Double
scaY b -> (b -> b) -> b
forall a b. a -> (a -> b) -> b
# b -> b
forall n a.
(InSpace V2 n a, Fractional n, Alignable a, HasOrigin a) =>
a -> a
alignBL b -> (b -> b) -> b
forall a b. a -> (a -> b) -> b
# Double -> b -> b
forall (v :: * -> *) n t.
(InSpace v n t, R2 v, Transformable t) =>
n -> t -> t
translateY ((Double
newHeight Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
oldHeightDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
scaY)Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
y)
        yPlace (PAR (AlignXY Double
x Double
y) MeetOrSlice
Slice) b
i = b
i b -> (b -> b) -> b
forall a b. a -> (a -> b) -> b
# Double -> b -> b
forall (v :: * -> *) n a.
(InSpace v n a, Eq n, Fractional n, Transformable a) =>
n -> a -> a
scale Double
scaX b -> (b -> b) -> b
forall a b. a -> (a -> b) -> b
# b -> b
forall n a.
(InSpace V2 n a, Fractional n, Alignable a, HasOrigin a) =>
a -> a
alignBL b -> (b -> b) -> b
forall a b. a -> (a -> b) -> b
# Double -> b -> b
forall (v :: * -> *) n t.
(InSpace v n t, R2 v, Transformable t) =>
n -> t -> t
translateY ((Double
newHeight Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
oldHeightDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
scaY)Double -> Double -> Double
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
(Int -> PresentationAttributes -> ShowS)
-> (PresentationAttributes -> String)
-> ([PresentationAttributes] -> ShowS)
-> Show PresentationAttributes
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
  { Kern n -> KernDir
kernDir :: KernDir
  , Kern n -> [Text]
kernU1  :: [Text]
  , Kern n -> [Text]
kernU2  :: [Text]
  , Kern n -> [Text]
kernG1  :: [Text]
  , Kern n -> [Text]
kernG2  :: [Text]
  , 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
  {
    FontData b n -> Id
fontId                         :: Maybe Text
  , FontData b n -> Id
fontDataHorizontalOriginX      :: Maybe Text
  , FontData b n -> Id
fontDataHorizontalOriginY      :: Maybe Text
  , FontData b n -> n
fontDataHorizontalAdvance      :: n
  , FontData b n -> Id
fontDataVerticalOriginX        :: Maybe Text
  , FontData b n -> Id
fontDataVerticalOriginY        :: Maybe Text
  , FontData b n -> Id
fontDataVerticalAdvance        :: Maybe Text
  -- ^ data gathered from subtags
  , FontData b n -> FontFace n
fontFace                       :: FontFace n
  , FontData b n -> Glyph b n
fontMissingGlyph               :: Glyph b n
  , FontData b n -> SvgGlyphs n
fontDataGlyphs                 :: SvgGlyphs n
--  , fontDataRawKernings            :: [(Text, [Text], [Text], [Text], [Text])]
  , FontData b n -> KernMaps n
fontDataKerning                :: KernMaps n
--  , fontDataFileName               :: Text
}

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

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

data KernDir = HKern | VKern

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