{-# LANGUAGE OverloadedStrings, NoMonomorphismRestriction, TypeFamilies, FlexibleContexts #-}
module Diagrams.SVG.Attributes
(
initialStyles
, CoreAttributes(..)
, ConditionalProcessingAttributes(..)
, DocumentEventAttributes(..)
, GraphicalEventAttributes(..)
, XlinkAttributes(..)
, FilterPrimitiveAttributes(..)
, NameSpaces(..)
, separatedBy
, parseOne
, parseOne'
, compose
, parseDouble
, parseToDouble
, parsePoints
, parseTempl
, parseIRI
, applyTr
, parseTr
, applyStyleSVG
, parseStyles
, parseLengths
, parseViewBox
, parsePA
, cssStylesFromMap
, fragment
, p
, parseSpread
, parsePreserveAR
, PreserveAR(..)
, AlignSVG(..)
, Place(..)
, MeetOrSlice(..)
, SVGStyle(..)
, PresentationAttributes(..)
)
where
import Data.Attoparsec.Combinator
import Data.Attoparsec.Text
import qualified Data.Attoparsec.Text as AT
import Data.Char (isAlpha, isHexDigit, digitToInt)
import Data.Colour
import Data.Colour.Names (readColourName)
import Data.Colour.SRGB
import Data.Colour.RGBSpace.HSL (hsl)
import qualified Data.HashMap.Strict as H
import Data.Maybe (fromMaybe, fromJust, isJust, isNothing, maybeToList, catMaybes)
import qualified Data.Text as T
import Data.Text(Text(..), pack, unpack, empty, cons, snoc, append)
import Data.Typeable
import Data.Word (Word8)
import Diagrams.Prelude hiding (fillOpacity, strokeOpacity)
import Diagrams.SVG.Path
import Diagrams.SVG.Tree
import Text.CSS.Parse
import Diagrams.Core.Transform
import Data.Digits
data CoreAttributes =
CA { CoreAttributes -> Maybe Text
id1 :: Maybe Text
, CoreAttributes -> Maybe Text
xmlbase :: Maybe Text
, CoreAttributes -> Maybe Text
xmllang :: Maybe Text
, CoreAttributes -> Maybe Text
xmlspace :: Maybe Text
}
data ConditionalProcessingAttributes =
CPA { ConditionalProcessingAttributes -> Maybe Text
requiredFeatures :: Maybe Text
, ConditionalProcessingAttributes -> Maybe Text
requiredExtensions :: Maybe Text
, ConditionalProcessingAttributes -> Maybe Text
systemLanguage :: Maybe Text
}
data DocumentEventAttributes =
DEA { DocumentEventAttributes -> Maybe Text
onunload :: Maybe Text
, DocumentEventAttributes -> Maybe Text
onabort :: Maybe Text
, DocumentEventAttributes -> Maybe Text
onerror :: Maybe Text
, DocumentEventAttributes -> Maybe Text
onresize :: Maybe Text
, DocumentEventAttributes -> Maybe Text
onscroll :: Maybe Text
, DocumentEventAttributes -> Maybe Text
onzoom :: Maybe Text
}
data GraphicalEventAttributes =
GEA { GraphicalEventAttributes -> Maybe Text
onfocusin :: Maybe Text
, GraphicalEventAttributes -> Maybe Text
onfocusout :: Maybe Text
, GraphicalEventAttributes -> Maybe Text
onactivate :: Maybe Text
, GraphicalEventAttributes -> Maybe Text
onclick :: Maybe Text
, GraphicalEventAttributes -> Maybe Text
onmousedown :: Maybe Text
, GraphicalEventAttributes -> Maybe Text
onmouseup :: Maybe Text
, GraphicalEventAttributes -> Maybe Text
onmouseover :: Maybe Text
, GraphicalEventAttributes -> Maybe Text
onmousemove :: Maybe Text
, GraphicalEventAttributes -> Maybe Text
onmouseout :: Maybe Text
, GraphicalEventAttributes -> Maybe Text
onload :: Maybe Text
}
data XlinkAttributes =
XLA { XlinkAttributes -> Maybe Text
xlinkHref :: Maybe Text
, XlinkAttributes -> Maybe Text
xlinkShow :: Maybe Text
, XlinkAttributes -> Maybe Text
xlinkActuate :: Maybe Text
, XlinkAttributes -> Maybe Text
xlinkType :: Maybe Text
, XlinkAttributes -> Maybe Text
xlinkRole :: Maybe Text
, XlinkAttributes -> Maybe Text
xlinkArcrole :: Maybe Text
, XlinkAttributes -> Maybe Text
xlinkTitle :: Maybe Text
}
data FilterPrimitiveAttributes =
FPA { FilterPrimitiveAttributes -> Maybe Text
x :: Maybe Text
, FilterPrimitiveAttributes -> Maybe Text
y :: Maybe Text
, FilterPrimitiveAttributes -> Maybe Text
width :: Maybe Text
, FilterPrimitiveAttributes -> Maybe Text
height :: Maybe Text
, FilterPrimitiveAttributes -> Maybe Text
result :: Maybe Text
}
data NameSpaces =
NSP { NameSpaces -> Maybe Text
xlink :: Maybe Text
, NameSpaces -> Maybe Text
dc :: Maybe Text
, NameSpaces -> Maybe Text
cc :: Maybe Text
, NameSpaces -> Maybe Text
rdf :: Maybe Text
, NameSpaces -> Maybe Text
svg :: Maybe Text
, NameSpaces -> Maybe Text
sodipodi :: Maybe Text
, NameSpaces -> Maybe Text
inkscape :: Maybe Text
} deriving Int -> NameSpaces -> ShowS
[NameSpaces] -> ShowS
NameSpaces -> String
(Int -> NameSpaces -> ShowS)
-> (NameSpaces -> String)
-> ([NameSpaces] -> ShowS)
-> Show NameSpaces
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NameSpaces] -> ShowS
$cshowList :: [NameSpaces] -> ShowS
show :: NameSpaces -> String
$cshow :: NameSpaces -> String
showsPrec :: Int -> NameSpaces -> ShowS
$cshowsPrec :: Int -> NameSpaces -> ShowS
Show
separatedBy :: Parser Text a -> Text -> Parser Text [a]
separatedBy Parser Text a
parse Text
sep = do [a]
ls <- Parser Text a -> Parser Text [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many1 ([Parser Text a] -> Parser Text a
forall (f :: * -> *) a. Alternative f => [f a] -> f a
choice [Parser Text a -> Text -> Parser Text a
forall b. Parser Text b -> Text -> Parser Text b
parseOne Parser Text a
parse Text
sep, Parser Text a -> Parser Text a
forall b. Parser Text b -> Parser Text b
parseOne' Parser Text a
parse])
[a] -> Parser Text [a]
forall (m :: * -> *) a. Monad m => a -> m a
return [a]
ls
parseOne :: Parser Text b -> Text -> Parser Text b
parseOne Parser Text b
parse Text
sep = do Parser ()
AT.skipSpace
b
s <- Parser Text b
parse
Text -> Parser Text
AT.string Text
sep
b -> Parser Text b
forall (m :: * -> *) a. Monad m => a -> m a
return b
s
parseOne' :: Parser Text b -> Parser Text b
parseOne' Parser Text b
parse = do Parser ()
AT.skipSpace
b
s <- Parser Text b
parse
b -> Parser Text b
forall (m :: * -> *) a. Monad m => a -> m a
return b
s
compose :: [a -> a] -> a -> a
compose :: [a -> a] -> a -> a
compose [a -> a]
fs a
v = ((a -> a) -> (a -> a) -> a -> a) -> (a -> a) -> [a -> a] -> a -> a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Prelude.foldl (((a -> a) -> (a -> a) -> a -> a) -> (a -> a) -> (a -> a) -> a -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.)) a -> a
forall a. a -> a
id [a -> a]
fs (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ a
v
parseDouble :: RealFloat n => Text -> n
parseDouble :: Text -> n
parseDouble Text
l = (String -> n) -> (Double -> n) -> Either String Double -> n
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (n -> String -> n
forall a b. a -> b -> a
const n
0) (Rational -> n
forall a. Fractional a => Rational -> a
fromRational (Rational -> n) -> (Double -> Rational) -> Double -> n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Rational
forall a. Real a => a -> Rational
toRational) (Parser Double -> Text -> Either String Double
forall a. Parser a -> Text -> Either String a
AT.parseOnly Parser Double
myDouble Text
l)
parseToDouble :: RealFloat n => Maybe Text -> Maybe n
parseToDouble :: Maybe Text -> Maybe n
parseToDouble Maybe Text
l | Maybe Text -> Bool
forall a. Maybe a -> Bool
isJust Maybe Text
l = (String -> Maybe n)
-> (Double -> Maybe n) -> Either String Double -> Maybe n
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe n -> String -> Maybe n
forall a b. a -> b -> a
const Maybe n
forall a. Maybe a
Nothing) (n -> Maybe n
forall a. a -> Maybe a
Just (n -> Maybe n) -> (Double -> n) -> Double -> Maybe n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> n
forall a. Fractional a => Rational -> a
fromRational (Rational -> n) -> (Double -> Rational) -> Double -> n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Rational
forall a. Real a => a -> Rational
toRational) (Parser Double -> Text -> Either String Double
forall a. Parser a -> Text -> Either String a
AT.parseOnly Parser Double
myDouble (Maybe Text -> Text
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Text
l))
| Bool
otherwise = Maybe n
forall a. Maybe a
Nothing
pp :: String -> c
pp = Text -> c
forall n. RealFloat n => Text -> n
parseDouble (Text -> c) -> (String -> Text) -> String -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack
myDouble :: Parser Double
myDouble = [Parser Double] -> Parser Double
forall (f :: * -> *) a. Alternative f => [f a] -> f a
AT.choice [Parser Double
forall b. Fractional b => Parser Text b
dotDouble, Parser Double
double]
dotDouble :: Parser Text b
dotDouble =
do Parser ()
AT.skipSpace
Char -> Parser Char
AT.char Char
'.'
Integer
frac <- Parser Integer
forall a. Integral a => Parser a
AT.decimal
let denominator :: b
denominator = Integer -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer
10Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^([Integer] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Integer] -> Int) -> [Integer] -> Int
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> [Integer]
forall n. Integral n => n -> n -> [n]
digits Integer
10 Integer
frac))
b -> Parser Text b
forall (m :: * -> *) a. Monad m => a -> m a
return ((Integer -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
frac) b -> b -> b
forall a. Fractional a => a -> a -> a
/ b
denominator)
parsePoints :: RealFloat n => Text -> [(n, n)]
parsePoints :: Text -> [(n, n)]
parsePoints Text
t = (String -> [(n, n)])
-> ([(n, n)] -> [(n, n)]) -> Either String [(n, n)] -> [(n, n)]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ([(n, n)] -> String -> [(n, n)]
forall a b. a -> b -> a
const []) [(n, n)] -> [(n, n)]
forall a. a -> a
id (Parser [(n, n)] -> Text -> Either String [(n, n)]
forall a. Parser a -> Text -> Either String a
AT.parseOnly (Parser Text (n, n) -> Parser [(n, n)]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' Parser Text (n, n)
forall n. RealFloat n => Parser (n, n)
parsePoint) Text
t)
parsePoint :: RealFloat n => Parser (n, n)
parsePoint :: Parser (n, n)
parsePoint =
do Parser ()
AT.skipSpace
Double
a <- Parser Double
double
Char -> Parser Char
AT.char Char
','
Double
b <- Parser Double
double
(n, n) -> Parser (n, n)
forall (m :: * -> *) a. Monad m => a -> m a
return ( (Rational -> n
forall a. Fractional a => Rational -> a
fromRational (Rational -> n) -> (Double -> Rational) -> Double -> n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Rational
forall a. Real a => a -> Rational
toRational) Double
a, (Rational -> n
forall a. Fractional a => Rational -> a
fromRational (Rational -> n) -> (Double -> Rational) -> Double -> n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Rational
forall a. Real a => a -> Rational
toRational) Double
b)
parseUntil :: Char -> Parser Text String
parseUntil Char
c = Parser Char -> Parser Char -> Parser Text String
forall (f :: * -> *) a b. Alternative f => f a -> f b -> f [a]
AT.manyTill Parser Char
AT.anyChar (Char -> Parser Char
AT.char Char
c)
data Tup n = TS1 Text | TS2 Text Text | TS3 Text Text Text
| T1 n | T2 n n | T3 n n n
deriving Int -> Tup n -> ShowS
[Tup n] -> ShowS
Tup n -> String
(Int -> Tup n -> ShowS)
-> (Tup n -> String) -> ([Tup n] -> ShowS) -> Show (Tup n)
forall n. Show n => Int -> Tup n -> ShowS
forall n. Show n => [Tup n] -> ShowS
forall n. Show n => Tup n -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Tup n] -> ShowS
$cshowList :: forall n. Show n => [Tup n] -> ShowS
show :: Tup n -> String
$cshow :: forall n. Show n => Tup n -> String
showsPrec :: Int -> Tup n -> ShowS
$cshowsPrec :: forall n. Show n => Int -> Tup n -> ShowS
Show
parse1 :: Parser Text (Tup n)
parse1 =
do Parser ()
AT.skipSpace
Char -> Parser Char
AT.char Char
'('
Text
a <- (Char -> Bool) -> Parser Text
AT.takeTill (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
')')
Char -> Parser Char
AT.char Char
')'
Tup n -> Parser Text (Tup n)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Tup n
forall n. Text -> Tup n
TS1 Text
a)
parse2 :: Parser Text (Tup n)
parse2 =
do Parser ()
AT.skipSpace
Char -> Parser Char
AT.char Char
'('
Text
a <- (Char -> Bool) -> Parser Text
AT.takeTill (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
',' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ')
[Parser Char] -> Parser Char
forall (f :: * -> *) a. Alternative f => [f a] -> f a
AT.choice [Char -> Parser Char
AT.char Char
',', Char -> Parser Char
AT.char Char
' ']
Parser ()
AT.skipSpace
Text
b <- (Char -> Bool) -> Parser Text
AT.takeTill (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
')')
Char -> Parser Char
AT.char Char
')'
Tup n -> Parser Text (Tup n)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Text -> Tup n
forall n. Text -> Text -> Tup n
TS2 Text
a Text
b)
parse3 :: Parser Text (Tup n)
parse3 =
do Parser ()
AT.skipSpace
Char -> Parser Char
AT.char Char
'('
Text
a <- (Char -> Bool) -> Parser Text
AT.takeTill (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
',' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ')
[Parser Char] -> Parser Char
forall (f :: * -> *) a. Alternative f => [f a] -> f a
AT.choice [Char -> Parser Char
AT.char Char
',', Char -> Parser Char
AT.char Char
' ']
Text
b <- (Char -> Bool) -> Parser Text
AT.takeTill (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
',' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ')
[Parser Char] -> Parser Char
forall (f :: * -> *) a. Alternative f => [f a] -> f a
AT.choice [Char -> Parser Char
AT.char Char
',', Char -> Parser Char
AT.char Char
' ']
Text
c <- (Char -> Bool) -> Parser Text
AT.takeTill (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
')')
Char -> Parser Char
AT.char Char
')'
Tup n -> Parser Text (Tup n)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Text -> Text -> Tup n
forall n. Text -> Text -> Text -> Tup n
TS3 Text
a Text
b Text
c)
data Transform n = Tr (Tup n)
| Matrix n n n n n n
| Rotate (Tup n)
| Scale (Tup n)
| SkewX (Tup n)
| SkewY (Tup n) deriving Int -> Transform n -> ShowS
[Transform n] -> ShowS
Transform n -> String
(Int -> Transform n -> ShowS)
-> (Transform n -> String)
-> ([Transform n] -> ShowS)
-> Show (Transform n)
forall n. Show n => Int -> Transform n -> ShowS
forall n. Show n => [Transform n] -> ShowS
forall n. Show n => Transform n -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Transform n] -> ShowS
$cshowList :: forall n. Show n => [Transform n] -> ShowS
show :: Transform n -> String
$cshow :: forall n. Show n => Transform n -> String
showsPrec :: Int -> Transform n -> ShowS
$cshowsPrec :: forall n. Show n => Int -> Transform n -> ShowS
Show
parseTr :: RealFloat n => Maybe Text -> [Transform n]
parseTr :: Maybe Text -> [Transform n]
parseTr = [Transform n] -> [Transform n]
forall a. [a] -> [a]
reverse ([Transform n] -> [Transform n])
-> (Maybe Text -> [Transform n]) -> Maybe Text -> [Transform n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
[Maybe (Transform n)] -> [Transform n]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (Transform n)] -> [Transform n])
-> (Maybe Text -> [Maybe (Transform n)])
-> Maybe Text
-> [Transform n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
((String -> [Maybe (Transform n)])
-> ([Maybe (Transform n)] -> [Maybe (Transform n)])
-> Either String [Maybe (Transform n)]
-> [Maybe (Transform n)]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ([Maybe (Transform n)] -> String -> [Maybe (Transform n)]
forall a b. a -> b -> a
const []) [Maybe (Transform n)] -> [Maybe (Transform n)]
forall a. a -> a
id) (Either String [Maybe (Transform n)] -> [Maybe (Transform n)])
-> (Maybe Text -> Either String [Maybe (Transform n)])
-> Maybe Text
-> [Maybe (Transform n)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
( Parser [Maybe (Transform n)]
-> Text -> Either String [Maybe (Transform n)]
forall a. Parser a -> Text -> Either String a
AT.parseOnly (Parser Text (Maybe (Transform n)) -> Parser [Maybe (Transform n)]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
AT.many1 Parser Text (Maybe (Transform n))
forall n. RealFloat n => Parser Text (Maybe (Transform n))
parseTransform)) (Text -> Either String [Maybe (Transform n)])
-> (Maybe Text -> Text)
-> Maybe Text
-> Either String [Maybe (Transform n)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
empty)
parseTransform :: Parser Text (Maybe (Transform n))
parseTransform = [Parser Text (Maybe (Transform n))]
-> Parser Text (Maybe (Transform n))
forall (f :: * -> *) a. Alternative f => [f a] -> f a
AT.choice [Parser Text (Maybe (Transform n))
forall n. RealFloat n => Parser Text (Maybe (Transform n))
matr, Parser Text (Maybe (Transform n))
forall n. RealFloat n => Parser Text (Maybe (Transform n))
trans, Parser Text (Maybe (Transform n))
forall n. RealFloat n => Parser Text (Maybe (Transform n))
scle, Parser Text (Maybe (Transform n))
forall n. RealFloat n => Parser Text (Maybe (Transform n))
rot, Parser Text (Maybe (Transform n))
forall n. RealFloat n => Parser Text (Maybe (Transform n))
skewX, Parser Text (Maybe (Transform n))
forall n. RealFloat n => Parser Text (Maybe (Transform n))
skewY]
applyTr :: [Transform (N a)] -> a -> a
applyTr [Transform (N a)]
trs = [a -> a] -> a -> a
forall a. [a -> a] -> a -> a
compose ((Transform (N a) -> a -> a) -> [Transform (N a)] -> [a -> a]
forall a b. (a -> b) -> [a] -> [b]
map Transform (N a) -> a -> a
forall t.
(RealFloat (N t), Transformable t, V t ~ V2) =>
Transform (N t) -> t -> t
getTransformations [Transform (N a)]
trs)
getTransformations :: Transform (N t) -> t -> t
getTransformations (Tr (T1 N t
x)) = N t -> t -> t
forall (v :: * -> *) n t.
(InSpace v n t, R1 v, Transformable t) =>
n -> t -> t
translateX N t
x
getTransformations (Tr (T2 N t
x N t
y)) = (N t -> t -> t
forall (v :: * -> *) n t.
(InSpace v n t, R1 v, Transformable t) =>
n -> t -> t
translateX N t
x) (t -> t) -> (t -> t) -> t -> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (N t -> t -> t
forall (v :: * -> *) n t.
(InSpace v n t, R2 v, Transformable t) =>
n -> t -> t
translateY N t
y)
getTransformations (Matrix N t
a N t
b N t
c N t
d N t
e N t
f)
= (N t -> t -> t
forall (v :: * -> *) n t.
(InSpace v n t, R1 v, Transformable t) =>
n -> t -> t
translateX N t
x) (t -> t) -> (t -> t) -> t -> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (N t -> t -> t
forall (v :: * -> *) n t.
(InSpace v n t, R2 v, Transformable t) =>
n -> t -> t
translateY N t
y) (t -> t) -> (t -> t) -> t -> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (N t -> t -> t
forall n t.
(InSpace V2 n t, Transformable t, Floating n) =>
n -> t -> t
rotateBy N t
angle) (t -> t) -> (t -> t) -> t -> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (N t -> t -> t
forall (v :: * -> *) n t.
(InSpace v n t, R2 v, Fractional n, Transformable t) =>
n -> t -> t
scaleX N t
scX) (t -> t) -> (t -> t) -> t -> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (N t -> t -> t
forall (v :: * -> *) n t.
(InSpace v n t, R2 v, Fractional n, Transformable t) =>
n -> t -> t
scaleY N t
scY)
where (N t
angle, N t
scX, N t
scY, N t
x, N t
y) = Transform (N t) -> (N t, N t, N t, N t, N t)
forall e. RealFloat e => Transform e -> (e, e, e, e, e)
matrixDecompose (N t -> N t -> N t -> N t -> N t -> N t -> Transform (N t)
forall n. n -> n -> n -> n -> n -> n -> Transform n
Matrix N t
a N t
b N t
c N t
d N t
e N t
f)
getTransformations (Rotate (T1 N t
angle)) = N t -> t -> t
forall n t.
(InSpace V2 n t, Transformable t, Floating n) =>
n -> t -> t
rotateBy N t
angle
getTransformations (Rotate (T3 N t
angle N t
x N t
y)) = t -> t
forall a. a -> a
id
getTransformations (Scale (T1 N t
x)) = N t -> t -> t
forall (v :: * -> *) n t.
(InSpace v n t, R2 v, Fractional n, Transformable t) =>
n -> t -> t
scaleX N t
x
getTransformations (Scale (T2 N t
x N t
y)) = (N t -> t -> t
forall (v :: * -> *) n t.
(InSpace v n t, R2 v, Fractional n, Transformable t) =>
n -> t -> t
scaleX N t
x) (t -> t) -> (t -> t) -> t -> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (N t -> t -> t
forall (v :: * -> *) n t.
(InSpace v n t, R2 v, Fractional n, Transformable t) =>
n -> t -> t
scaleY N t
y)
getTransformations (SkewX (T1 N t
x)) = t -> t
forall a. a -> a
id
getTransformations (SkewY (T1 N t
y)) = t -> t
forall a. a -> a
id
matrixDecompose :: Transform e -> (e, e, e, e, e)
matrixDecompose (Matrix e
m11 e
m12 e
m21 e
m22 e
m31 e
m32) = (e
rotation, e
scX, e
scY, e
transX, e
transY)
where
rotation :: e
rotation = (e -> e -> e
forall a. RealFloat a => a -> a -> a
atan2 e
m12 e
m22) e -> e -> e
forall a. Fractional a => a -> a -> a
/ (e
2e -> e -> e
forall a. Num a => a -> a -> a
*e
forall a. Floating a => a
pi)
scX :: e
scX | e
m11 e -> e -> Bool
forall a. Ord a => a -> a -> Bool
>= e
0 = e -> e
forall a. Floating a => a -> a
sqrt (e
m11e -> e -> e
forall a. Num a => a -> a -> a
*e
m11 e -> e -> e
forall a. Num a => a -> a -> a
+ e
m21e -> e -> e
forall a. Num a => a -> a -> a
*e
m21)
| Bool
otherwise = - e -> e
forall a. Floating a => a -> a
sqrt (e
m11e -> e -> e
forall a. Num a => a -> a -> a
*e
m11 e -> e -> e
forall a. Num a => a -> a -> a
+ e
m21e -> e -> e
forall a. Num a => a -> a -> a
*e
m21)
scY :: e
scY | e
m22 e -> e -> Bool
forall a. Ord a => a -> a -> Bool
>= e
0 = e -> e
forall a. Floating a => a -> a
sqrt (e
m12e -> e -> e
forall a. Num a => a -> a -> a
*e
m12 e -> e -> e
forall a. Num a => a -> a -> a
+ e
m22e -> e -> e
forall a. Num a => a -> a -> a
*e
m22)
| Bool
otherwise = - e -> e
forall a. Floating a => a -> a
sqrt (e
m12e -> e -> e
forall a. Num a => a -> a -> a
*e
m12 e -> e -> e
forall a. Num a => a -> a -> a
+ e
m22e -> e -> e
forall a. Num a => a -> a -> a
*e
m22)
(e
transX, e
transY) = (e
m31, e
m32)
matr :: Parser Text (Maybe (Transform n))
matr =
do Parser ()
AT.skipSpace
Text -> Parser Text
AT.string Text
"matrix"
Parser ()
AT.skipSpace
Char -> Parser Char
AT.char Char
'('
String
a <- Char -> Parser Text String
parseUntil Char
','
String
b <- Char -> Parser Text String
parseUntil Char
','
String
c <- Char -> Parser Text String
parseUntil Char
','
String
d <- Char -> Parser Text String
parseUntil Char
','
String
e <- Char -> Parser Text String
parseUntil Char
','
String
f <- Char -> Parser Text String
parseUntil Char
')'
Maybe (Transform n) -> Parser Text (Maybe (Transform n))
forall (m :: * -> *) a. Monad m => a -> m a
return (Transform n -> Maybe (Transform n)
forall a. a -> Maybe a
Just (Transform n -> Maybe (Transform n))
-> Transform n -> Maybe (Transform n)
forall a b. (a -> b) -> a -> b
$ n -> n -> n -> n -> n -> n -> Transform n
forall n. n -> n -> n -> n -> n -> n -> Transform n
Matrix (String -> n
forall c. RealFloat c => String -> c
pp String
a) (String -> n
forall c. RealFloat c => String -> c
pp String
b) (String -> n
forall c. RealFloat c => String -> c
pp String
c) (String -> n
forall c. RealFloat c => String -> c
pp String
d) (String -> n
forall c. RealFloat c => String -> c
pp String
e) (String -> n
forall c. RealFloat c => String -> c
pp String
f) )
evalTup :: Tup n -> Tup n
evalTup (TS1 Text
x) = n -> Tup n
forall n. n -> Tup n
T1 (Text -> n
forall n. RealFloat n => Text -> n
parseDouble Text
x)
evalTup (TS2 Text
x Text
y) = n -> n -> Tup n
forall n. n -> n -> Tup n
T2 (Text -> n
forall n. RealFloat n => Text -> n
parseDouble Text
x) (Text -> n
forall n. RealFloat n => Text -> n
parseDouble Text
y)
evalTup (TS3 Text
x Text
y Text
z) = n -> n -> n -> Tup n
forall n. n -> n -> n -> Tup n
T3 (Text -> n
forall n. RealFloat n => Text -> n
parseDouble Text
x) (Text -> n
forall n. RealFloat n => Text -> n
parseDouble Text
y) (Text -> n
forall n. RealFloat n => Text -> n
parseDouble Text
z)
trans :: Parser Text (Maybe (Transform n))
trans =
do Parser ()
AT.skipSpace
Text -> Parser Text
AT.string Text
"translate"
Tup Any
tup <- [Parser Text (Tup Any)] -> Parser Text (Tup Any)
forall (f :: * -> *) a. Alternative f => [f a] -> f a
AT.choice [Parser Text (Tup Any)
forall n. Parser Text (Tup n)
parse2, Parser Text (Tup Any)
forall n. Parser Text (Tup n)
parse1]
Maybe (Transform n) -> Parser Text (Maybe (Transform n))
forall (m :: * -> *) a. Monad m => a -> m a
return (Transform n -> Maybe (Transform n)
forall a. a -> Maybe a
Just (Transform n -> Maybe (Transform n))
-> Transform n -> Maybe (Transform n)
forall a b. (a -> b) -> a -> b
$ Tup n -> Transform n
forall n. Tup n -> Transform n
Tr (Tup Any -> Tup n
forall n n. RealFloat n => Tup n -> Tup n
evalTup Tup Any
tup))
scle :: Parser Text (Maybe (Transform n))
scle =
do Parser ()
AT.skipSpace
Text -> Parser Text
AT.string Text
"scale"
Tup Any
tup <- [Parser Text (Tup Any)] -> Parser Text (Tup Any)
forall (f :: * -> *) a. Alternative f => [f a] -> f a
AT.choice [Parser Text (Tup Any)
forall n. Parser Text (Tup n)
parse2, Parser Text (Tup Any)
forall n. Parser Text (Tup n)
parse1]
Maybe (Transform n) -> Parser Text (Maybe (Transform n))
forall (m :: * -> *) a. Monad m => a -> m a
return (Transform n -> Maybe (Transform n)
forall a. a -> Maybe a
Just (Transform n -> Maybe (Transform n))
-> Transform n -> Maybe (Transform n)
forall a b. (a -> b) -> a -> b
$ Tup n -> Transform n
forall n. Tup n -> Transform n
Scale (Tup Any -> Tup n
forall n n. RealFloat n => Tup n -> Tup n
evalTup Tup Any
tup))
rot :: Parser Text (Maybe (Transform n))
rot =
do Parser ()
AT.skipSpace
Text -> Parser Text
AT.string Text
"rotate"
Tup Any
tup <- [Parser Text (Tup Any)] -> Parser Text (Tup Any)
forall (f :: * -> *) a. Alternative f => [f a] -> f a
AT.choice [Parser Text (Tup Any)
forall n. Parser Text (Tup n)
parse1, Parser Text (Tup Any)
forall n. Parser Text (Tup n)
parse3]
Maybe (Transform n) -> Parser Text (Maybe (Transform n))
forall (m :: * -> *) a. Monad m => a -> m a
return (Transform n -> Maybe (Transform n)
forall a. a -> Maybe a
Just (Transform n -> Maybe (Transform n))
-> Transform n -> Maybe (Transform n)
forall a b. (a -> b) -> a -> b
$ Tup n -> Transform n
forall n. Tup n -> Transform n
Rotate (Tup Any -> Tup n
forall n n. RealFloat n => Tup n -> Tup n
evalTup Tup Any
tup))
skewX :: Parser Text (Maybe (Transform n))
skewX =
do Parser ()
AT.skipSpace
Text -> Parser Text
AT.string Text
"skewX"
Tup Any
angle <- Parser Text (Tup Any)
forall n. Parser Text (Tup n)
parse1
Maybe (Transform n) -> Parser Text (Maybe (Transform n))
forall (m :: * -> *) a. Monad m => a -> m a
return (Transform n -> Maybe (Transform n)
forall a. a -> Maybe a
Just (Transform n -> Maybe (Transform n))
-> Transform n -> Maybe (Transform n)
forall a b. (a -> b) -> a -> b
$ Tup n -> Transform n
forall n. Tup n -> Transform n
SkewX (Tup Any -> Tup n
forall n n. RealFloat n => Tup n -> Tup n
evalTup Tup Any
angle))
skewY :: Parser Text (Maybe (Transform n))
skewY =
do Parser ()
AT.skipSpace
Text -> Parser Text
AT.string Text
"skewY"
Tup Any
angle <- Parser Text (Tup Any)
forall n. Parser Text (Tup n)
parse1
Maybe (Transform n) -> Parser Text (Maybe (Transform n))
forall (m :: * -> *) a. Monad m => a -> m a
return (Transform n -> Maybe (Transform n)
forall a. a -> Maybe a
Just (Transform n -> Maybe (Transform n))
-> Transform n -> Maybe (Transform n)
forall a b. (a -> b) -> a -> b
$ Tup n -> Transform n
forall n. Tup n -> Transform n
SkewY (Tup Any -> Tup n
forall n n. RealFloat n => Tup n -> Tup n
evalTup Tup Any
angle))
parsePA :: (RealFloat n, RealFloat a, Read a) => PresentationAttributes -> HashMaps b n -> [(SVGStyle n a)]
parsePA :: PresentationAttributes -> HashMaps b n -> [SVGStyle n a]
parsePA PresentationAttributes
pa (NodesMap b n
nodes,CSSMap
css,GradientsMap n
grad) = [SVGStyle n a]
l
where l :: [SVGStyle n a]
l = [Maybe (SVGStyle n a)] -> [SVGStyle n a]
forall a. [Maybe a] -> [a]
catMaybes
[(Parser (SVGStyle n a) -> Maybe Text -> Maybe (SVGStyle n a)
forall a. Parser a -> Maybe Text -> Maybe a
parseTempl (CSSMap -> GradientsMap n -> Parser (SVGStyle n a)
forall a n.
(Floating a, RealFrac a, Num n) =>
CSSMap -> HashMap Text (Gr n) -> Parser Text (SVGStyle n a)
styleFillVal CSSMap
css GradientsMap n
grad)) (PresentationAttributes -> Maybe Text
fill PresentationAttributes
pa),
(Parser (SVGStyle n a) -> Maybe Text -> Maybe (SVGStyle n a)
forall a. Parser a -> Maybe Text -> Maybe a
parseTempl Parser (SVGStyle n a)
forall n a. Parser Text (SVGStyle n a)
styleFillRuleVal) (PresentationAttributes -> Maybe Text
fillRuleSVG PresentationAttributes
pa),
(Parser (SVGStyle n a) -> Maybe Text -> Maybe (SVGStyle n a)
forall a. Parser a -> Maybe Text -> Maybe a
parseTempl Parser (SVGStyle n a)
forall n a. Parser Text (SVGStyle n a)
styleFillOpacityVal) (PresentationAttributes -> Maybe Text
fillOpacity PresentationAttributes
pa),
(Parser (SVGStyle n a) -> Maybe Text -> Maybe (SVGStyle n a)
forall a. Parser a -> Maybe Text -> Maybe a
parseTempl Parser (SVGStyle n a)
forall n a. Parser Text (SVGStyle n a)
styleOpacityVal) (PresentationAttributes -> Maybe Text
Diagrams.SVG.Tree.opacity PresentationAttributes
pa),
(Parser (SVGStyle n a) -> Maybe Text -> Maybe (SVGStyle n a)
forall a. Parser a -> Maybe Text -> Maybe a
parseTempl Parser (SVGStyle n a)
forall n a. Parser Text (SVGStyle n a)
styleStrokeOpacityVal) (PresentationAttributes -> Maybe Text
strokeOpacity PresentationAttributes
pa),
(Parser (SVGStyle n a) -> Maybe Text -> Maybe (SVGStyle n a)
forall a. Parser a -> Maybe Text -> Maybe a
parseTempl (CSSMap -> GradientsMap n -> Parser (SVGStyle n a)
forall a n.
(Floating a, RealFrac a, Num n) =>
CSSMap -> HashMap Text (Gr n) -> Parser Text (SVGStyle n a)
styleStrokeVal CSSMap
css GradientsMap n
grad)) (PresentationAttributes -> Maybe Text
strokeSVG PresentationAttributes
pa),
(Parser (SVGStyle n a) -> Maybe Text -> Maybe (SVGStyle n a)
forall a. Parser a -> Maybe Text -> Maybe a
parseTempl Parser (SVGStyle n a)
forall n a. Fractional n => Parser Text (SVGStyle n a)
styleStrokeWidthVal) (PresentationAttributes -> Maybe Text
strokeWidth PresentationAttributes
pa),
(Parser (SVGStyle n a) -> Maybe Text -> Maybe (SVGStyle n a)
forall a. Parser a -> Maybe Text -> Maybe a
parseTempl Parser (SVGStyle n a)
forall n a. Parser Text (SVGStyle n a)
styleStrokeLineCapVal) (PresentationAttributes -> Maybe Text
strokeLinecap PresentationAttributes
pa),
(Parser (SVGStyle n a) -> Maybe Text -> Maybe (SVGStyle n a)
forall a. Parser a -> Maybe Text -> Maybe a
parseTempl Parser (SVGStyle n a)
forall n a. Parser Text (SVGStyle n a)
styleStrokeLineJoinVal) (PresentationAttributes -> Maybe Text
strokeLinejoin PresentationAttributes
pa),
(Parser (SVGStyle n a) -> Maybe Text -> Maybe (SVGStyle n a)
forall a. Parser a -> Maybe Text -> Maybe a
parseTempl Parser (SVGStyle n a)
forall n a. Fractional n => Parser Text (SVGStyle n a)
styleStrokeMiterLimitVal) (PresentationAttributes -> Maybe Text
strokeMiterlimit PresentationAttributes
pa),
(Parser (SVGStyle n a) -> Maybe Text -> Maybe (SVGStyle n a)
forall a. Parser a -> Maybe Text -> Maybe a
parseTempl Parser (SVGStyle n a)
forall n a. Parser Text (SVGStyle n a)
styleFontFamily) (PresentationAttributes -> Maybe Text
fontFamily PresentationAttributes
pa),
(Parser (SVGStyle n a) -> Maybe Text -> Maybe (SVGStyle n a)
forall a. Parser a -> Maybe Text -> Maybe a
parseTempl Parser (SVGStyle n a)
forall n a. Fractional n => Parser Text (SVGStyle n a)
styleFontSize) (PresentationAttributes -> Maybe Text
fntSize PresentationAttributes
pa),
(Parser (SVGStyle n a) -> Maybe Text -> Maybe (SVGStyle n a)
forall a. Parser a -> Maybe Text -> Maybe a
parseTempl (NodesMap b n -> Parser (SVGStyle n a)
forall n b a.
RealFloat n =>
HashMap Text (Tag b n) -> Parser Text (SVGStyle n a)
styleClipPathVal NodesMap b n
nodes)) (PresentationAttributes -> Maybe Text
clipPath PresentationAttributes
pa),
(Parser (SVGStyle n a) -> Maybe Text -> Maybe (SVGStyle n a)
forall a. Parser a -> Maybe Text -> Maybe a
parseTempl Parser (SVGStyle n a)
forall n a. Fractional n => Parser Text (SVGStyle n a)
styleStrokeDashArrayVal) (PresentationAttributes -> Maybe Text
strokeDasharray PresentationAttributes
pa) ]
data SVGStyle n a = Fill (AlphaColour a) | FillTex (Texture n) | FillOpacity Double | FillRule FR | Opacity Double
| Stroke (AlphaColour a) | StrokeTex (Texture n) | StrokeWidth (LenPercent n) | StrokeLineCap LineCap
| StrokeLineJoin LineJoin | StrokeMiterLimit n | StrokeDasharray [LenPercent n] | StrokeOpacity Double
| FontFamily String | FontStyle FStyle | FontVariant FVariant | FontWeight FWeight | FontStretch FStretch
| FontSize (LenPercent n)
| ClipPath (Path V2 n)
| EmptyStyle
data Unit = EM | EX | PX | IN | CM | MM | PT | PC deriving Int -> Unit -> ShowS
[Unit] -> ShowS
Unit -> String
(Int -> Unit -> ShowS)
-> (Unit -> String) -> ([Unit] -> ShowS) -> Show Unit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Unit] -> ShowS
$cshowList :: [Unit] -> ShowS
show :: Unit -> String
$cshow :: Unit -> String
showsPrec :: Int -> Unit -> ShowS
$cshowsPrec :: Int -> Unit -> ShowS
Show
data FR = Even_Odd | Nonzero | Inherit deriving Int -> FR -> ShowS
[FR] -> ShowS
FR -> String
(Int -> FR -> ShowS)
-> (FR -> String) -> ([FR] -> ShowS) -> Show FR
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FR] -> ShowS
$cshowList :: [FR] -> ShowS
show :: FR -> String
$cshow :: FR -> String
showsPrec :: Int -> FR -> ShowS
$cshowsPrec :: Int -> FR -> ShowS
Show
data LenPercent n = Len n | Percent n
instance Show (SVGStyle n a) where
show :: SVGStyle n a -> String
show (Fill AlphaColour a
c) = String
"Fill"
show (FillTex Texture n
t) = String
"Filltex"
show (FillRule FR
r) = String
"FillRule"
show (FillOpacity Double
d) = String
"FillOpacity"
show (FontFamily String
f) = String
"FontFamily"
show (FontStyle FStyle
f) = String
"FontStyle"
show (FontVariant FVariant
f) = String
"FontVariant"
show (FontWeight FWeight
f) = String
"FontWeight"
show (FontStretch FStretch
f) = String
"FontStretch"
show (FontSize LenPercent n
f) = String
"FontSize"
show (Diagrams.SVG.Attributes.Opacity Double
d) = String
"Opacity"
show (StrokeOpacity Double
o) = String
"StrokeOpacity"
show (Stroke AlphaColour a
s) = String
"Stroke"
show (StrokeTex Texture n
s) = String
"StrokeTex"
show (StrokeWidth LenPercent n
w) = String
"StrokeWidth"
show (StrokeLineCap LineCap
l) = String
"StrokeLineCap"
show (StrokeLineJoin LineJoin
l) = String
"StrokeLineJoin"
show (StrokeMiterLimit n
l) = String
"StrokeMiterLimit"
show (StrokeDasharray [LenPercent n]
l) = String
"StrokeDasharray"
show (ClipPath Path V2 n
path) = String
"ClipPath"
show (SVGStyle n a
EmptyStyle) = String
""
instance Show (LenPercent n) where
show :: LenPercent n -> String
show (Len n
x) = String
""
show (Percent n
x) = String
""
parseStyles :: Maybe Text
-> (HashMap Text (Tag b n), CSSMap, HashMap Text (Gr n))
-> [SVGStyle n a]
parseStyles Maybe Text
text (HashMap Text (Tag b n), CSSMap, HashMap Text (Gr n))
hmaps = (String -> [SVGStyle n a])
-> ([SVGStyle n a] -> [SVGStyle n a])
-> Either String [SVGStyle n a]
-> [SVGStyle n a]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ([SVGStyle n a] -> String -> [SVGStyle n a]
forall a b. a -> b -> a
const []) [SVGStyle n a] -> [SVGStyle n a]
forall a. a -> a
id (Either String [SVGStyle n a] -> [SVGStyle n a])
-> Either String [SVGStyle n a] -> [SVGStyle n a]
forall a b. (a -> b) -> a -> b
$
Parser [SVGStyle n a] -> Text -> Either String [SVGStyle n a]
forall a. Parser a -> Text -> Either String a
AT.parseOnly (Parser Text (SVGStyle n a) -> Text -> Parser [SVGStyle n a]
forall a. Parser Text a -> Text -> Parser Text [a]
separatedBy ((HashMap Text (Tag b n), CSSMap, HashMap Text (Gr n))
-> Parser Text (SVGStyle n a)
forall n a b.
(RealFloat n, RealFrac a, Floating a) =>
(HashMap Text (Tag b n), CSSMap, HashMap Text (Gr n))
-> Parser Text (SVGStyle n a)
parseStyleAttr (HashMap Text (Tag b n), CSSMap, HashMap Text (Gr n))
hmaps) Text
";") (Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
empty Maybe Text
text)
parseStyleAttr :: (HashMap Text (Tag b n), CSSMap, HashMap Text (Gr n))
-> Parser Text (SVGStyle n a)
parseStyleAttr (HashMap Text (Tag b n)
ns,CSSMap
css,HashMap Text (Gr n)
grad) =
[Parser Text (SVGStyle n a)] -> Parser Text (SVGStyle n a)
forall (f :: * -> *) a. Alternative f => [f a] -> f a
AT.choice [Parser Text (SVGStyle n a)
forall n a. Parser Text (SVGStyle n a)
styleFillRule, Parser Text (SVGStyle n a)
forall n a. Fractional n => Parser Text (SVGStyle n a)
styleStrokeWidth, Parser Text (SVGStyle n a)
forall n a. Fractional n => Parser Text (SVGStyle n a)
styleStrokeDashArray, CSSMap -> HashMap Text (Gr n) -> Parser Text (SVGStyle n a)
forall a n.
(Floating a, RealFrac a, Num n) =>
CSSMap -> HashMap Text (Gr n) -> Parser Text (SVGStyle n a)
styleFill CSSMap
css HashMap Text (Gr n)
grad, CSSMap -> HashMap Text (Gr n) -> Parser Text (SVGStyle n a)
forall a n.
(Floating a, RealFrac a, Num n) =>
CSSMap -> HashMap Text (Gr n) -> Parser Text (SVGStyle n a)
styleStroke CSSMap
css HashMap Text (Gr n)
grad, Parser Text (SVGStyle n a)
forall a n. (Floating a, RealFrac a) => Parser Text (SVGStyle n a)
styleStopColor,
Parser Text (SVGStyle n a)
forall n a. Parser Text (SVGStyle n a)
styleStopOpacity, Parser Text (SVGStyle n a)
forall n a. Parser Text (SVGStyle n a)
styleFillOpacity, Parser Text (SVGStyle n a)
forall n a. Parser Text (SVGStyle n a)
styleStrokeOpacity, Parser Text (SVGStyle n a)
forall n a. Parser Text (SVGStyle n a)
styleOpacity,
Parser Text (SVGStyle n a)
forall n a. Parser Text (SVGStyle n a)
styleFontFamily, Parser Text (SVGStyle n a)
forall n a. Parser Text (SVGStyle n a)
styleFontStyle, Parser Text (SVGStyle n a)
forall n a. Parser Text (SVGStyle n a)
styleFontVariant, Parser Text (SVGStyle n a)
forall n a. Parser Text (SVGStyle n a)
styleFontWeight, Parser Text (SVGStyle n a)
forall n a. Parser Text (SVGStyle n a)
styleFontStretch, Parser Text (SVGStyle n a)
forall n a. Fractional n => Parser Text (SVGStyle n a)
styleFontSize,
Parser Text (SVGStyle n a)
forall n a. Parser Text (SVGStyle n a)
styleStrokeLineCap, Parser Text (SVGStyle n a)
forall n a. Parser Text (SVGStyle n a)
styleStrokeLineJoin, Parser Text (SVGStyle n a)
forall n a. Fractional n => Parser Text (SVGStyle n a)
styleStrokeMiterLimit, HashMap Text (Tag b n) -> Parser Text (SVGStyle n a)
forall n b a.
RealFloat n =>
HashMap Text (Tag b n) -> Parser Text (SVGStyle n a)
styleClipPath HashMap Text (Tag b n)
ns, Parser Text (SVGStyle n a)
forall n a. Parser Text (SVGStyle n a)
skipOne]
skipOne :: Parser Text (SVGStyle n a)
skipOne = do String
str <- Parser Char -> Parser Char -> Parser Text String
forall (f :: * -> *) a b. Alternative f => f a -> f b -> f [a]
AT.manyTill Parser Char
AT.anyChar (Char -> Parser Char
AT.char Char
';')
SVGStyle n a -> Parser Text (SVGStyle n a)
forall (m :: * -> *) a. Monad m => a -> m a
return SVGStyle n a
forall n a. SVGStyle n a
EmptyStyle
cssStylesFromMap :: (HashMap Text (Tag b n), CSSMap, HashMap Text (Gr n))
-> Text -> Maybe Text -> Maybe Text -> [SVGStyle n a]
cssStylesFromMap (HashMap Text (Tag b n)
ns,CSSMap
css,HashMap Text (Gr n)
grad) Text
tagName Maybe Text
id_ Maybe Text
class_ = Maybe Text
-> (HashMap Text (Tag b n), CSSMap, HashMap Text (Gr n))
-> [SVGStyle n a]
forall n a b.
(RealFloat n, RealFrac a, Floating a) =>
Maybe Text
-> (HashMap Text (Tag b n), CSSMap, HashMap Text (Gr n))
-> [SVGStyle n a]
parseStyles ( Text -> Maybe Text
forall a. a -> Maybe a
Just ( [Text] -> Text
T.concat ( ((Text, Text) -> Text) -> [(Text, Text)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Text) -> Text
f [(Text, Text)]
attributes ) ) ) (HashMap Text (Tag b n)
ns,CSSMap
css,HashMap Text (Gr n)
grad)
where f :: (Text, Text) -> Text
f (Text
attr, Text
val) = (Text
attr Text -> Char -> Text
`Data.Text.snoc` Char
':') Text -> Text -> Text
`append` (Text
val Text -> Char -> Text
`Data.Text.snoc` Char
';')
styleFromClass :: Text -> [Maybe [(Text, Text)]]
styleFromClass Text
cl = [Text -> CSSMap -> Maybe [(Text, Text)]
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
H.lookup (Char
'.' Char -> Text -> Text
`Data.Text.cons` Text
cl) CSSMap
css] [Maybe [(Text, Text)]]
-> [Maybe [(Text, Text)]] -> [Maybe [(Text, Text)]]
forall a. [a] -> [a] -> [a]
++ [Text -> CSSMap -> Maybe [(Text, Text)]
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
H.lookup (Text
tagName Text -> Text -> Text
`append` (Char
'.' Char -> Text -> Text
`Data.Text.cons` Text
cl)) CSSMap
css]
attributes :: [(Text, Text)]
attributes = [[(Text, Text)]] -> [(Text, Text)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[(Text, Text)]] -> [(Text, Text)])
-> [[(Text, Text)]] -> [(Text, Text)]
forall a b. (a -> b) -> a -> b
$ [Maybe [(Text, Text)]] -> [[(Text, Text)]]
forall a. [Maybe a] -> [a]
catMaybes
( [Text -> CSSMap -> Maybe [(Text, Text)]
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
H.lookup Text
"*" CSSMap
css] [Maybe [(Text, Text)]]
-> [Maybe [(Text, Text)]] -> [Maybe [(Text, Text)]]
forall a. [a] -> [a] -> [a]
++
(if Maybe Text -> Bool
forall a. Maybe a -> Bool
isJust Maybe Text
id_ then [Text -> CSSMap -> Maybe [(Text, Text)]
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
H.lookup (Char
'#' Char -> Text -> Text
`Data.Text.cons` (Maybe Text -> Text
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Text
id_)) CSSMap
css] else []) [Maybe [(Text, Text)]]
-> [Maybe [(Text, Text)]] -> [Maybe [(Text, Text)]]
forall a. [a] -> [a] -> [a]
++
([[Maybe [(Text, Text)]]] -> [Maybe [(Text, Text)]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ((Text -> [Maybe [(Text, Text)]])
-> [Text] -> [[Maybe [(Text, Text)]]]
forall a b. (a -> b) -> [a] -> [b]
map Text -> [Maybe [(Text, Text)]]
styleFromClass (if Maybe Text -> Bool
forall a. Maybe a -> Bool
isJust Maybe Text
class_ then Text -> [Text]
T.words (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Text
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Text
class_ else [])))
)
parseTempl :: Parser a -> Maybe Text -> Maybe a
parseTempl :: Parser a -> Maybe Text -> Maybe a
parseTempl Parser a
p = ((String -> Maybe a) -> (a -> Maybe a) -> Either String a -> Maybe a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe a -> String -> Maybe a
forall a b. a -> b -> a
const Maybe a
forall a. Maybe a
Nothing) a -> Maybe a
forall a. a -> Maybe a
Just) (Either String a -> Maybe a)
-> (Maybe Text -> Either String a) -> Maybe Text -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(Parser a -> Text -> Either String a
forall a. Parser a -> Text -> Either String a
AT.parseOnly Parser a
p)(Text -> Either String a)
-> (Maybe Text -> Text) -> Maybe Text -> Either String a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
empty)
p :: RealFloat n => (n,n) -> n -> Maybe Text -> n
p :: (n, n) -> n -> Maybe Text -> n
p (n
minx,n
maxx) n
def Maybe Text
x = LenPercent n -> n
unL (LenPercent n -> n) -> LenPercent n -> n
forall a b. (a -> b) -> a -> b
$ LenPercent n -> Maybe (LenPercent n) -> LenPercent n
forall a. a -> Maybe a -> a
fromMaybe (n -> LenPercent n
forall n. n -> LenPercent n
Len n
def) (Maybe (LenPercent n) -> LenPercent n)
-> Maybe (LenPercent n) -> LenPercent n
forall a b. (a -> b) -> a -> b
$ Parser (LenPercent n) -> Maybe Text -> Maybe (LenPercent n)
forall a. Parser a -> Maybe Text -> Maybe a
parseTempl Parser (LenPercent n)
forall n. Fractional n => Parser Text (LenPercent n)
styleLength Maybe Text
x
where unL :: LenPercent n -> n
unL (Len n
x) = n
x
unL (Percent n
x) = n
xn -> n -> n
forall a. Fractional a => a -> a -> a
/n
100 n -> n -> n
forall a. Num a => a -> a -> a
* (n
maxxn -> n -> n
forall a. Num a => a -> a -> a
-n
minx)
parseIRI :: Parser Text (Text, Text)
parseIRI = do [Parser Text (Text, Text)] -> Parser Text (Text, Text)
forall (f :: * -> *) a. Alternative f => [f a] -> f a
AT.choice [ Parser Text (Text, Text)
funcIRI, Parser Text (Text, Text)
absoluteOrRelativeIRI ]
funcIRI :: Parser Text (Text, Text)
funcIRI =
do Parser ()
AT.skipSpace
Text -> Parser Text
AT.string Text
"url("
String
absrel <- Char -> Parser Text String
parseUntil Char
'#'
String
frag <- Char -> Parser Text String
parseUntil Char
')'
(Text, Text) -> Parser Text (Text, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Text
T.pack String
absrel, String -> Text
T.pack String
frag)
absoluteOrRelativeIRI :: Parser Text (Text, Text)
absoluteOrRelativeIRI =
do Parser ()
AT.skipSpace
String
absrel <- Char -> Parser Text String
parseUntil Char
'#'
Text
frag <- Parser Text
takeText
(Text, Text) -> Parser Text (Text, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Text
T.pack String
absrel, Text
frag)
fragment :: Maybe Text -> Maybe Text
fragment Maybe Text
x = ((Text, Text) -> Text) -> Maybe (Text, Text) -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text, Text) -> Text
forall a b. (a, b) -> b
snd (Parser Text (Text, Text) -> Maybe Text -> Maybe (Text, Text)
forall a. Parser a -> Maybe Text -> Maybe a
parseTempl Parser Text (Text, Text)
parseIRI Maybe Text
x)
initialStyles :: c -> c
initialStyles = N c -> c -> c
forall a n. (N a ~ n, HasStyle a, Typeable n, Num n) => n -> a -> a
lwL N c
1 (c -> c) -> (c -> c) -> c -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Colour Double -> c -> c
forall n a.
(InSpace V2 n a, Floating n, Typeable n, HasStyle a) =>
Colour Double -> a -> a
fc Colour Double
forall a. Num a => Colour a
black (c -> c) -> (c -> c) -> c -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LineCap -> c -> c
forall a. HasStyle a => LineCap -> a -> a
lineCap LineCap
LineCapButt (c -> c) -> (c -> c) -> c -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LineJoin -> c -> c
forall a. HasStyle a => LineJoin -> a -> a
lineJoin LineJoin
LineJoinMiter (c -> c) -> (c -> c) -> c -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> c -> c
forall a. HasStyle a => Double -> a -> a
lineMiterLimit Double
4 (c -> c) -> (c -> c) -> c -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AlphaColour Double -> c -> c
forall n a.
(InSpace V2 n a, Typeable n, Floating n, HasStyle a) =>
AlphaColour Double -> a -> a
lcA AlphaColour Double
forall a. Num a => AlphaColour a
transparent
(c -> c) -> (c -> c) -> c -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Measure (N c) -> c -> c
forall a n.
(N a ~ n, Typeable n, HasStyle a) =>
Measure n -> a -> a
fontSize Measure (N c)
forall n. OrderedField n => Measure n
medium
applyStyleSVG :: (t -> [SVGStyle (N a) Double]) -> t -> a -> a
applyStyleSVG t -> [SVGStyle (N a) Double]
stylesFromMap t
hmap = [a -> a] -> a -> a
forall a. [a -> a] -> a -> a
compose ((SVGStyle (N a) Double -> a -> a)
-> [SVGStyle (N a) Double] -> [a -> a]
forall a b. (a -> b) -> [a] -> [b]
map SVGStyle (N a) Double -> a -> a
forall a.
(HasStyle a, Typeable (N a), RealFloat (N a), V a ~ V2) =>
SVGStyle (N a) Double -> a -> a
getStyles (t -> [SVGStyle (N a) Double]
stylesFromMap t
hmap))
getStyles :: SVGStyle (N a) Double -> a -> a
getStyles (Fill AlphaColour Double
c) = AlphaColour Double -> a -> a
forall n a.
(InSpace V2 n a, Floating n, Typeable n, HasStyle a) =>
AlphaColour Double -> a -> a
fcA AlphaColour Double
c
getStyles (FillTex Texture (N a)
x) = Texture (N a) -> a -> a
forall n a.
(InSpace V2 n a, Typeable n, Floating n, HasStyle a) =>
Texture n -> a -> a
fillTexture Texture (N a)
x
getStyles (FillRule FR
Even_Odd) = FillRule -> a -> a
forall a. HasStyle a => FillRule -> a -> a
fillRule FillRule
EvenOdd
getStyles (FillRule FR
Nonzero) = a -> a
forall a. a -> a
id
getStyles (FillRule FR
Inherit) = a -> a
forall a. a -> a
id
getStyles (FillOpacity Double
x) = Double -> a -> a
forall a. HasStyle a => Double -> a -> a
Diagrams.Prelude.opacity Double
x
getStyles (FontFamily String
str) = String -> a -> a
forall a. HasStyle a => String -> a -> a
font String
str
getStyles (FontStyle FStyle
s) = a -> a
forall a. a -> a
id
getStyles (FontVariant FVariant
s) = a -> a
forall a. a -> a
id
getStyles (FontWeight FWeight
s) = a -> a
forall a. a -> a
id
getStyles (FontStretch FStretch
s) = a -> a
forall a. a -> a
id
getStyles (FontSize (Len N a
len)) = Measure (N a) -> a -> a
forall a n.
(N a ~ n, Typeable n, HasStyle a) =>
Measure n -> a -> a
fontSize (N a -> Measure (N a)
forall n. Num n => n -> Measure n
local N a
len)
getStyles (Diagrams.SVG.Attributes.Opacity Double
x) = Double -> a -> a
forall a. HasStyle a => Double -> a -> a
Diagrams.Prelude.opacity Double
x
getStyles (StrokeOpacity Double
x) | Double
x Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
0 = N a -> a -> a
forall a n. (N a ~ n, HasStyle a, Typeable n, Num n) => n -> a -> a
lwL N a
0
| Bool
otherwise = Double -> a -> a
forall a. HasStyle a => Double -> a -> a
Diagrams.Prelude.opacity Double
x
getStyles (Stroke AlphaColour Double
x) = AlphaColour Double -> a -> a
forall n a.
(InSpace V2 n a, Typeable n, Floating n, HasStyle a) =>
AlphaColour Double -> a -> a
lcA AlphaColour Double
x
getStyles (StrokeTex Texture (N a)
x) = Texture (N a) -> a -> a
forall n a.
(InSpace V2 n a, Typeable n, Floating n, HasStyle a) =>
Texture n -> a -> a
lineTexture Texture (N a)
x
getStyles (StrokeWidth (Len N a
x)) = N a -> a -> a
forall a n. (N a ~ n, HasStyle a, Typeable n, Num n) => n -> a -> a
lwL (N a -> a -> a) -> N a -> a -> a
forall a b. (a -> b) -> a -> b
$ Rational -> N a
forall a. Fractional a => Rational -> a
fromRational (Rational -> N a) -> Rational -> N a
forall a b. (a -> b) -> a -> b
$ N a -> Rational
forall a. Real a => a -> Rational
toRational N a
x
getStyles (StrokeWidth (Percent N a
x)) = N a -> a -> a
forall a n. (N a ~ n, HasStyle a, Typeable n, Num n) => n -> a -> a
lwG N a
x
getStyles (StrokeLineCap LineCap
x) = LineCap -> a -> a
forall a. HasStyle a => LineCap -> a -> a
lineCap LineCap
x
getStyles (StrokeLineJoin LineJoin
x) = LineJoin -> a -> a
forall a. HasStyle a => LineJoin -> a -> a
lineJoin LineJoin
x
getStyles (StrokeMiterLimit N a
x) = a -> a
forall a. a -> a
id
getStyles (StrokeDasharray [LenPercent (N a)]
array) = [N a] -> N a -> a -> a
forall a n.
(N a ~ n, HasStyle a, Typeable n, Num n) =>
[n] -> n -> a -> a
dashingL ((LenPercent (N a) -> N a) -> [LenPercent (N a)] -> [N a]
forall a b. (a -> b) -> [a] -> [b]
map LenPercent (N a) -> N a
forall p. LenPercent p -> p
dash [LenPercent (N a)]
array) N a
0
where dash :: LenPercent p -> p
dash (Len p
x) = p
x
dash (Percent p
x) = p
x
getStyles (ClipPath Path V2 (N a)
path) = Path V2 (N a) -> a -> a
forall a n.
(HasStyle a, V a ~ V2, N a ~ n, TypeableFloat n) =>
Path V2 n -> a -> a
clipBy Path V2 (N a)
path
getStyles SVGStyle (N a) Double
_ = a -> a
forall a. a -> a
id
styleFill :: CSSMap -> HashMap Text (Gr n) -> Parser Text (SVGStyle n a)
styleFill CSSMap
css HashMap Text (Gr n)
hmap =
do Parser ()
AT.skipSpace
Text -> Parser Text
AT.string Text
"fill:"
Parser ()
AT.skipSpace
CSSMap -> HashMap Text (Gr n) -> Parser Text (SVGStyle n a)
forall a n.
(Floating a, RealFrac a, Num n) =>
CSSMap -> HashMap Text (Gr n) -> Parser Text (SVGStyle n a)
styleFillVal CSSMap
css HashMap Text (Gr n)
hmap
styleFillVal :: CSSMap -> HashMap Text (Gr n) -> Parser Text (SVGStyle n a)
styleFillVal CSSMap
css HashMap Text (Gr n)
gradients = [Parser Text (SVGStyle n a)] -> Parser Text (SVGStyle n a)
forall (f :: * -> *) a. Alternative f => [f a] -> f a
AT.choice [ Parser Text (SVGStyle n a)
forall a n. (Floating a, RealFrac a) => Parser Text (SVGStyle n a)
styleFillColourVal, CSSMap -> HashMap Text (Gr n) -> Parser Text (SVGStyle n a)
forall n a.
Num n =>
CSSMap -> HashMap Text (Gr n) -> Parser Text (SVGStyle n a)
styleFillTexURL CSSMap
css HashMap Text (Gr n)
gradients ]
styleFillColourVal :: Parser Text (SVGStyle n a)
styleFillColourVal =
do AlphaColour a
c <- [Parser Text (AlphaColour a)] -> Parser Text (AlphaColour a)
forall (f :: * -> *) a. Alternative f => [f a] -> f a
AT.choice [Parser Text (AlphaColour a)
forall a. (Ord a, Floating a) => Parser Text (AlphaColour a)
colorRRGGBB, Parser Text (AlphaColour a)
forall a. (Ord a, Floating a) => Parser Text (AlphaColour a)
colorRGB, Parser Text (AlphaColour a)
forall a. (Ord a, Floating a) => Parser Text (AlphaColour a)
colorString, Parser Text (AlphaColour a)
forall a. (Floating a, Ord a) => Parser Text (AlphaColour a)
colorRGBPercent, Parser Text (AlphaColour a)
forall a. (RealFrac a, Floating a) => Parser Text (AlphaColour a)
colorHSLPercent, Parser Text (AlphaColour a)
forall a. Num a => Parser Text (AlphaColour a)
colorNone, Parser Text (AlphaColour a)
forall a. (Floating a, Ord a) => Parser Text (AlphaColour a)
colorRGBWord]
SVGStyle n a -> Parser Text (SVGStyle n a)
forall (m :: * -> *) a. Monad m => a -> m a
return (AlphaColour a -> SVGStyle n a
forall n a. AlphaColour a -> SVGStyle n a
Fill AlphaColour a
c)
styleFillTexURL :: CSSMap -> HashMap Text (Gr n) -> Parser Text (SVGStyle n a)
styleFillTexURL CSSMap
css HashMap Text (Gr n)
gradients =
do (Text
absrel,Text
frag) <- Parser Text (Text, Text)
parseIRI
let t :: Maybe (Gr n)
t = Text -> HashMap Text (Gr n) -> Maybe (Gr n)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
H.lookup Text
frag HashMap Text (Gr n)
gradients
if Maybe (Gr n) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (Gr n)
t then SVGStyle n a -> Parser Text (SVGStyle n a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Texture n -> SVGStyle n a
forall n a. Texture n -> SVGStyle n a
FillTex (Gr n -> Texture n
getTexture (Maybe (Gr n) -> Gr n
forall a. HasCallStack => Maybe a -> a
fromJust Maybe (Gr n)
t)))
else SVGStyle n a -> Parser Text (SVGStyle n a)
forall (m :: * -> *) a. Monad m => a -> m a
return SVGStyle n a
forall n a. SVGStyle n a
EmptyStyle
where getTexture :: Gr n -> Texture n
getTexture (Gr Maybe Text
refId GradientAttributes
ga Maybe (ViewBox n)
vb [CSSMap -> [GradientStop n]]
stops CSSMap
-> GradientAttributes
-> ViewBox n
-> [CSSMap -> [GradientStop n]]
-> Texture n
f) = CSSMap
-> GradientAttributes
-> ViewBox n
-> [CSSMap -> [GradientStop n]]
-> Texture n
f CSSMap
css GradientAttributes
ga (ViewBox n -> Maybe (ViewBox n) -> ViewBox n
forall a. a -> Maybe a -> a
fromMaybe (n
0,n
0,n
0,n
0) Maybe (ViewBox n)
vb) [CSSMap -> [GradientStop n]]
stops
styleFillRule :: Parser Text (SVGStyle n a)
styleFillRule =
do Parser ()
AT.skipSpace
Text -> Parser Text
AT.string Text
"fill-rule:"
Parser ()
AT.skipSpace
Parser Text (SVGStyle n a)
forall n a. Parser Text (SVGStyle n a)
styleFillRuleVal
styleFillRuleVal :: Parser Text (SVGStyle n a)
styleFillRuleVal =
do [Parser Text (SVGStyle n a)] -> Parser Text (SVGStyle n a)
forall (f :: * -> *) a. Alternative f => [f a] -> f a
AT.choice [ (do{ Text -> Parser Text
AT.string Text
"evenodd"; SVGStyle n a -> Parser Text (SVGStyle n a)
forall (m :: * -> *) a. Monad m => a -> m a
return (SVGStyle n a -> Parser Text (SVGStyle n a))
-> SVGStyle n a -> Parser Text (SVGStyle n a)
forall a b. (a -> b) -> a -> b
$ FR -> SVGStyle n a
forall n a. FR -> SVGStyle n a
FillRule FR
Even_Odd }),
(do{ Text -> Parser Text
AT.string Text
"nonzero"; SVGStyle n a -> Parser Text (SVGStyle n a)
forall (m :: * -> *) a. Monad m => a -> m a
return (SVGStyle n a -> Parser Text (SVGStyle n a))
-> SVGStyle n a -> Parser Text (SVGStyle n a)
forall a b. (a -> b) -> a -> b
$ FR -> SVGStyle n a
forall n a. FR -> SVGStyle n a
FillRule FR
Nonzero }),
(do{ Text -> Parser Text
AT.string Text
"inherit"; SVGStyle n a -> Parser Text (SVGStyle n a)
forall (m :: * -> *) a. Monad m => a -> m a
return (SVGStyle n a -> Parser Text (SVGStyle n a))
-> SVGStyle n a -> Parser Text (SVGStyle n a)
forall a b. (a -> b) -> a -> b
$ FR -> SVGStyle n a
forall n a. FR -> SVGStyle n a
FillRule FR
Inherit })
]
styleFillOpacity :: Parser Text (SVGStyle n a)
styleFillOpacity =
do Parser ()
AT.skipSpace
Text -> Parser Text
AT.string Text
"fill-opacity:"
Parser ()
AT.skipSpace
Parser Text (SVGStyle n a)
forall n a. Parser Text (SVGStyle n a)
styleFillOpacityVal
styleFillOpacityVal :: Parser Text (SVGStyle n a)
styleFillOpacityVal =
do Double
o <- Parser Double
myDouble
SVGStyle n a -> Parser Text (SVGStyle n a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Double -> SVGStyle n a
forall n a. Double -> SVGStyle n a
FillOpacity (Double -> SVGStyle n a) -> Double -> SVGStyle n a
forall a b. (a -> b) -> a -> b
$ Rational -> Double
forall a. Fractional a => Rational -> a
fromRational (Rational -> Double) -> Rational -> Double
forall a b. (a -> b) -> a -> b
$ Double -> Rational
forall a. Real a => a -> Rational
toRational Double
o)
styleOpacity :: Parser Text (SVGStyle n a)
styleOpacity =
do Parser ()
AT.skipSpace
Text -> Parser Text
AT.string Text
"opacity:"
Parser ()
AT.skipSpace
Parser Text (SVGStyle n a)
forall n a. Parser Text (SVGStyle n a)
styleOpacityVal
styleOpacityVal :: Parser Text (SVGStyle n a)
styleOpacityVal =
do Double
o <- Parser Double
myDouble
SVGStyle n a -> Parser Text (SVGStyle n a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Double -> SVGStyle n a
forall n a. Double -> SVGStyle n a
Diagrams.SVG.Attributes.Opacity (Double -> SVGStyle n a) -> Double -> SVGStyle n a
forall a b. (a -> b) -> a -> b
$ Rational -> Double
forall a. Fractional a => Rational -> a
fromRational (Rational -> Double) -> Rational -> Double
forall a b. (a -> b) -> a -> b
$ Double -> Rational
forall a. Real a => a -> Rational
toRational Double
o)
styleStroke :: CSSMap -> HashMap Text (Gr n) -> Parser Text (SVGStyle n a)
styleStroke CSSMap
css HashMap Text (Gr n)
hmap =
do Parser ()
AT.skipSpace
Text -> Parser Text
AT.string Text
"stroke:"
Parser ()
AT.skipSpace
CSSMap -> HashMap Text (Gr n) -> Parser Text (SVGStyle n a)
forall a n.
(Floating a, RealFrac a, Num n) =>
CSSMap -> HashMap Text (Gr n) -> Parser Text (SVGStyle n a)
styleStrokeVal CSSMap
css HashMap Text (Gr n)
hmap
styleStrokeVal :: CSSMap -> HashMap Text (Gr n) -> Parser Text (SVGStyle n a)
styleStrokeVal CSSMap
css HashMap Text (Gr n)
gradients = [Parser Text (SVGStyle n a)] -> Parser Text (SVGStyle n a)
forall (f :: * -> *) a. Alternative f => [f a] -> f a
AT.choice [ Parser Text (SVGStyle n a)
forall a n. (Floating a, RealFrac a) => Parser Text (SVGStyle n a)
styleStrokeColourVal, CSSMap -> HashMap Text (Gr n) -> Parser Text (SVGStyle n a)
forall n a.
Num n =>
CSSMap -> HashMap Text (Gr n) -> Parser Text (SVGStyle n a)
styleStrokeTexURL CSSMap
css HashMap Text (Gr n)
gradients ]
styleStrokeColourVal :: Parser Text (SVGStyle n a)
styleStrokeColourVal =
do AlphaColour a
c <- [Parser Text (AlphaColour a)] -> Parser Text (AlphaColour a)
forall (f :: * -> *) a. Alternative f => [f a] -> f a
AT.choice [Parser Text (AlphaColour a)
forall a. (Ord a, Floating a) => Parser Text (AlphaColour a)
colorRRGGBB, Parser Text (AlphaColour a)
forall a. (Ord a, Floating a) => Parser Text (AlphaColour a)
colorRGB, Parser Text (AlphaColour a)
forall a. (Ord a, Floating a) => Parser Text (AlphaColour a)
colorString, Parser Text (AlphaColour a)
forall a. (Floating a, Ord a) => Parser Text (AlphaColour a)
colorRGBPercent, Parser Text (AlphaColour a)
forall a. (RealFrac a, Floating a) => Parser Text (AlphaColour a)
colorHSLPercent, Parser Text (AlphaColour a)
forall a. Num a => Parser Text (AlphaColour a)
colorNone, Parser Text (AlphaColour a)
forall a. (Floating a, Ord a) => Parser Text (AlphaColour a)
colorRGBWord]
SVGStyle n a -> Parser Text (SVGStyle n a)
forall (m :: * -> *) a. Monad m => a -> m a
return (AlphaColour a -> SVGStyle n a
forall n a. AlphaColour a -> SVGStyle n a
Stroke AlphaColour a
c)
styleStrokeTexURL :: CSSMap -> HashMap Text (Gr n) -> Parser Text (SVGStyle n a)
styleStrokeTexURL CSSMap
css HashMap Text (Gr n)
gradients =
do (Text
absrel,Text
frag) <- Parser Text (Text, Text)
parseIRI
let t :: Maybe (Gr n)
t = Text -> HashMap Text (Gr n) -> Maybe (Gr n)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
H.lookup Text
frag HashMap Text (Gr n)
gradients
if Maybe (Gr n) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (Gr n)
t then SVGStyle n a -> Parser Text (SVGStyle n a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Texture n -> SVGStyle n a
forall n a. Texture n -> SVGStyle n a
StrokeTex (Gr n -> Texture n
getTexture (Maybe (Gr n) -> Gr n
forall a. HasCallStack => Maybe a -> a
fromJust Maybe (Gr n)
t)))
else SVGStyle n a -> Parser Text (SVGStyle n a)
forall (m :: * -> *) a. Monad m => a -> m a
return SVGStyle n a
forall n a. SVGStyle n a
EmptyStyle
where getTexture :: Gr n -> Texture n
getTexture (Gr Maybe Text
refId GradientAttributes
ga Maybe (ViewBox n)
vb [CSSMap -> [GradientStop n]]
stops CSSMap
-> GradientAttributes
-> ViewBox n
-> [CSSMap -> [GradientStop n]]
-> Texture n
f) = CSSMap
-> GradientAttributes
-> ViewBox n
-> [CSSMap -> [GradientStop n]]
-> Texture n
f CSSMap
css GradientAttributes
ga (ViewBox n -> Maybe (ViewBox n) -> ViewBox n
forall a. a -> Maybe a -> a
fromMaybe (n
0,n
0,n
0,n
0) Maybe (ViewBox n)
vb) [CSSMap -> [GradientStop n]]
stops
styleStrokeWidth :: Parser Text (SVGStyle n a)
styleStrokeWidth =
do Parser ()
AT.skipSpace
Text -> Parser Text
AT.string Text
"stroke-width:"
Parser Text (SVGStyle n a)
forall n a. Fractional n => Parser Text (SVGStyle n a)
styleStrokeWidthVal
styleStrokeWidthVal :: Parser Text (SVGStyle n a)
styleStrokeWidthVal =
do LenPercent n
len <- Parser Text (LenPercent n)
forall n. Fractional n => Parser Text (LenPercent n)
styleLength
SVGStyle n a -> Parser Text (SVGStyle n a)
forall (m :: * -> *) a. Monad m => a -> m a
return (LenPercent n -> SVGStyle n a
forall n a. LenPercent n -> SVGStyle n a
StrokeWidth LenPercent n
len)
styleFontFamily :: Parser Text (SVGStyle n a)
styleFontFamily =
do Parser ()
AT.skipSpace
Text -> Parser Text
AT.string Text
"font-family:"
String
str <- Parser Char -> Parser Char -> Parser Text String
forall (f :: * -> *) a b. Alternative f => f a -> f b -> f [a]
AT.manyTill Parser Char
AT.anyChar Parser Char
theEnd
SVGStyle n a -> Parser Text (SVGStyle n a)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> SVGStyle n a
forall n a. String -> SVGStyle n a
FontFamily String
str)
theEnd :: Parser Char
theEnd = do [Parser Char] -> Parser Char
forall (f :: * -> *) a. Alternative f => [f a] -> f a
AT.choice [Char -> Parser Char
AT.char Char
';', do { Parser ()
forall t. Chunk t => Parser t ()
endOfInput; Char -> Parser Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
' '}]
data FStyle = NormalStyle | Italic | Oblique | FSInherit
styleFontStyle :: Parser Text (SVGStyle n a)
styleFontStyle =
do Parser ()
AT.skipSpace
Text -> Parser Text
AT.string Text
"font-style:"
[Parser Text (SVGStyle n a)] -> Parser Text (SVGStyle n a)
forall (f :: * -> *) a. Alternative f => [f a] -> f a
AT.choice [ do { Text -> Parser Text
string Text
"normal"; SVGStyle n a -> Parser Text (SVGStyle n a)
forall (m :: * -> *) a. Monad m => a -> m a
return (FStyle -> SVGStyle n a
forall n a. FStyle -> SVGStyle n a
FontStyle FStyle
NormalStyle)}
, do { Text -> Parser Text
string Text
"italic"; SVGStyle n a -> Parser Text (SVGStyle n a)
forall (m :: * -> *) a. Monad m => a -> m a
return (FStyle -> SVGStyle n a
forall n a. FStyle -> SVGStyle n a
FontStyle FStyle
Italic)}
, do { Text -> Parser Text
string Text
"oblique"; SVGStyle n a -> Parser Text (SVGStyle n a)
forall (m :: * -> *) a. Monad m => a -> m a
return (FStyle -> SVGStyle n a
forall n a. FStyle -> SVGStyle n a
FontStyle FStyle
Oblique)}
, do { Text -> Parser Text
string Text
"inherit"; SVGStyle n a -> Parser Text (SVGStyle n a)
forall (m :: * -> *) a. Monad m => a -> m a
return (FStyle -> SVGStyle n a
forall n a. FStyle -> SVGStyle n a
FontStyle FStyle
FSInherit)}
]
data FVariant = NormalVariant | SmallCaps | VInherit
styleFontVariant :: Parser Text (SVGStyle n a)
styleFontVariant =
do Parser ()
AT.skipSpace
Text -> Parser Text
AT.string Text
"font-variant:"
[Parser Text (SVGStyle n a)] -> Parser Text (SVGStyle n a)
forall (f :: * -> *) a. Alternative f => [f a] -> f a
AT.choice [ do { Text -> Parser Text
string Text
"normal"; SVGStyle n a -> Parser Text (SVGStyle n a)
forall (m :: * -> *) a. Monad m => a -> m a
return (FVariant -> SVGStyle n a
forall n a. FVariant -> SVGStyle n a
FontVariant FVariant
NormalVariant)}
, do { Text -> Parser Text
string Text
"small-caps"; SVGStyle n a -> Parser Text (SVGStyle n a)
forall (m :: * -> *) a. Monad m => a -> m a
return (FVariant -> SVGStyle n a
forall n a. FVariant -> SVGStyle n a
FontVariant FVariant
SmallCaps)}
, do { Text -> Parser Text
string Text
"inherit"; SVGStyle n a -> Parser Text (SVGStyle n a)
forall (m :: * -> *) a. Monad m => a -> m a
return (FVariant -> SVGStyle n a
forall n a. FVariant -> SVGStyle n a
FontVariant FVariant
VInherit)}
]
data FWeight = NormalWeight | Bold | Bolder | Lighter
| N100 | N200 | N300 | N400 | N500 | N600 | N700 | N800 | N900
| FWInherit
styleFontWeight :: Parser Text (SVGStyle n a)
styleFontWeight =
do Parser ()
AT.skipSpace
Text -> Parser Text
AT.string Text
"font-weight:"
[Parser Text (SVGStyle n a)] -> Parser Text (SVGStyle n a)
forall (f :: * -> *) a. Alternative f => [f a] -> f a
AT.choice [ do { Text -> Parser Text
string Text
"normal"; SVGStyle n a -> Parser Text (SVGStyle n a)
forall (m :: * -> *) a. Monad m => a -> m a
return (FWeight -> SVGStyle n a
forall n a. FWeight -> SVGStyle n a
FontWeight FWeight
NormalWeight)}
, do { Text -> Parser Text
string Text
"bold"; SVGStyle n a -> Parser Text (SVGStyle n a)
forall (m :: * -> *) a. Monad m => a -> m a
return (FWeight -> SVGStyle n a
forall n a. FWeight -> SVGStyle n a
FontWeight FWeight
Bold)}
, do { Text -> Parser Text
string Text
"bolder"; SVGStyle n a -> Parser Text (SVGStyle n a)
forall (m :: * -> *) a. Monad m => a -> m a
return (FWeight -> SVGStyle n a
forall n a. FWeight -> SVGStyle n a
FontWeight FWeight
Bolder)}
, do { Text -> Parser Text
string Text
"lighter"; SVGStyle n a -> Parser Text (SVGStyle n a)
forall (m :: * -> *) a. Monad m => a -> m a
return (FWeight -> SVGStyle n a
forall n a. FWeight -> SVGStyle n a
FontWeight FWeight
Lighter)}
, do { Text -> Parser Text
string Text
"100"; SVGStyle n a -> Parser Text (SVGStyle n a)
forall (m :: * -> *) a. Monad m => a -> m a
return (FWeight -> SVGStyle n a
forall n a. FWeight -> SVGStyle n a
FontWeight FWeight
N100)}
, do { Text -> Parser Text
string Text
"200"; SVGStyle n a -> Parser Text (SVGStyle n a)
forall (m :: * -> *) a. Monad m => a -> m a
return (FWeight -> SVGStyle n a
forall n a. FWeight -> SVGStyle n a
FontWeight FWeight
N200)}
, do { Text -> Parser Text
string Text
"300"; SVGStyle n a -> Parser Text (SVGStyle n a)
forall (m :: * -> *) a. Monad m => a -> m a
return (FWeight -> SVGStyle n a
forall n a. FWeight -> SVGStyle n a
FontWeight FWeight
N300)}
, do { Text -> Parser Text
string Text
"400"; SVGStyle n a -> Parser Text (SVGStyle n a)
forall (m :: * -> *) a. Monad m => a -> m a
return (FWeight -> SVGStyle n a
forall n a. FWeight -> SVGStyle n a
FontWeight FWeight
N400)}
, do { Text -> Parser Text
string Text
"500"; SVGStyle n a -> Parser Text (SVGStyle n a)
forall (m :: * -> *) a. Monad m => a -> m a
return (FWeight -> SVGStyle n a
forall n a. FWeight -> SVGStyle n a
FontWeight FWeight
N500)}
, do { Text -> Parser Text
string Text
"600"; SVGStyle n a -> Parser Text (SVGStyle n a)
forall (m :: * -> *) a. Monad m => a -> m a
return (FWeight -> SVGStyle n a
forall n a. FWeight -> SVGStyle n a
FontWeight FWeight
N600)}
, do { Text -> Parser Text
string Text
"700"; SVGStyle n a -> Parser Text (SVGStyle n a)
forall (m :: * -> *) a. Monad m => a -> m a
return (FWeight -> SVGStyle n a
forall n a. FWeight -> SVGStyle n a
FontWeight FWeight
N700)}
, do { Text -> Parser Text
string Text
"800"; SVGStyle n a -> Parser Text (SVGStyle n a)
forall (m :: * -> *) a. Monad m => a -> m a
return (FWeight -> SVGStyle n a
forall n a. FWeight -> SVGStyle n a
FontWeight FWeight
N800)}
, do { Text -> Parser Text
string Text
"900"; SVGStyle n a -> Parser Text (SVGStyle n a)
forall (m :: * -> *) a. Monad m => a -> m a
return (FWeight -> SVGStyle n a
forall n a. FWeight -> SVGStyle n a
FontWeight FWeight
N900)}
, do { Text -> Parser Text
string Text
"inherit"; SVGStyle n a -> Parser Text (SVGStyle n a)
forall (m :: * -> *) a. Monad m => a -> m a
return (FWeight -> SVGStyle n a
forall n a. FWeight -> SVGStyle n a
FontWeight FWeight
FWInherit)}
]
data FStretch = NormalStretch | Wider | Narrower | UltraCondensed | | Condensed
| SemiCondensed | SemiExpanded | Expanded | ExtraExpanded | UltraExpanded | SInherit
styleFontStretch :: Parser Text (SVGStyle n a)
styleFontStretch =
do Parser ()
AT.skipSpace
Text -> Parser Text
AT.string Text
"font-stretch:"
[Parser Text (SVGStyle n a)] -> Parser Text (SVGStyle n a)
forall (f :: * -> *) a. Alternative f => [f a] -> f a
AT.choice [ do { Text -> Parser Text
string Text
"normal"; SVGStyle n a -> Parser Text (SVGStyle n a)
forall (m :: * -> *) a. Monad m => a -> m a
return (FStretch -> SVGStyle n a
forall n a. FStretch -> SVGStyle n a
FontStretch FStretch
NormalStretch)}
, do { Text -> Parser Text
string Text
"wider"; SVGStyle n a -> Parser Text (SVGStyle n a)
forall (m :: * -> *) a. Monad m => a -> m a
return (FStretch -> SVGStyle n a
forall n a. FStretch -> SVGStyle n a
FontStretch FStretch
Wider)}
, do { Text -> Parser Text
string Text
"narrower"; SVGStyle n a -> Parser Text (SVGStyle n a)
forall (m :: * -> *) a. Monad m => a -> m a
return (FStretch -> SVGStyle n a
forall n a. FStretch -> SVGStyle n a
FontStretch FStretch
Narrower)}
, do { Text -> Parser Text
string Text
"ultra-condensed"; SVGStyle n a -> Parser Text (SVGStyle n a)
forall (m :: * -> *) a. Monad m => a -> m a
return (FStretch -> SVGStyle n a
forall n a. FStretch -> SVGStyle n a
FontStretch FStretch
UltraCondensed)}
, do { Text -> Parser Text
string Text
"extra-condensed"; SVGStyle n a -> Parser Text (SVGStyle n a)
forall (m :: * -> *) a. Monad m => a -> m a
return (FStretch -> SVGStyle n a
forall n a. FStretch -> SVGStyle n a
FontStretch FStretch
ExtraCondensed)}
, do { Text -> Parser Text
string Text
"condensed"; SVGStyle n a -> Parser Text (SVGStyle n a)
forall (m :: * -> *) a. Monad m => a -> m a
return (FStretch -> SVGStyle n a
forall n a. FStretch -> SVGStyle n a
FontStretch FStretch
Condensed)}
, do { Text -> Parser Text
string Text
"semi-condensed"; SVGStyle n a -> Parser Text (SVGStyle n a)
forall (m :: * -> *) a. Monad m => a -> m a
return (FStretch -> SVGStyle n a
forall n a. FStretch -> SVGStyle n a
FontStretch FStretch
SemiCondensed)}
, do { Text -> Parser Text
string Text
"semi-expanded"; SVGStyle n a -> Parser Text (SVGStyle n a)
forall (m :: * -> *) a. Monad m => a -> m a
return (FStretch -> SVGStyle n a
forall n a. FStretch -> SVGStyle n a
FontStretch FStretch
SemiExpanded)}
, do { Text -> Parser Text
string Text
"expanded"; SVGStyle n a -> Parser Text (SVGStyle n a)
forall (m :: * -> *) a. Monad m => a -> m a
return (FStretch -> SVGStyle n a
forall n a. FStretch -> SVGStyle n a
FontStretch FStretch
Expanded)}
, do { Text -> Parser Text
string Text
"extra-expanded"; SVGStyle n a -> Parser Text (SVGStyle n a)
forall (m :: * -> *) a. Monad m => a -> m a
return (FStretch -> SVGStyle n a
forall n a. FStretch -> SVGStyle n a
FontStretch FStretch
ExtraExpanded)}
, do { Text -> Parser Text
string Text
"ultra-expanded"; SVGStyle n a -> Parser Text (SVGStyle n a)
forall (m :: * -> *) a. Monad m => a -> m a
return (FStretch -> SVGStyle n a
forall n a. FStretch -> SVGStyle n a
FontStretch FStretch
UltraExpanded)}
, do { Text -> Parser Text
string Text
"inherit"; SVGStyle n a -> Parser Text (SVGStyle n a)
forall (m :: * -> *) a. Monad m => a -> m a
return (FStretch -> SVGStyle n a
forall n a. FStretch -> SVGStyle n a
FontStretch FStretch
SInherit)}
]
styleFontSize :: Parser Text (SVGStyle n a)
styleFontSize =
do Parser ()
AT.skipSpace
Text -> Parser Text
AT.string Text
"font-size:"
LenPercent n
len <- Parser Text (LenPercent n)
forall n. Fractional n => Parser Text (LenPercent n)
styleLength
SVGStyle n a -> Parser Text (SVGStyle n a)
forall (m :: * -> *) a. Monad m => a -> m a
return (LenPercent n -> SVGStyle n a
forall n a. LenPercent n -> SVGStyle n a
FontSize LenPercent n
len)
styleLength :: Parser Text (LenPercent n)
styleLength =
do Parser ()
AT.skipSpace
Double
d <- Parser Double
myDouble
Parser ()
AT.skipSpace
[Parser Text (LenPercent n)] -> Parser Text (LenPercent n)
forall (f :: * -> *) a. Alternative f => [f a] -> f a
AT.choice [ n -> Parser Text (LenPercent n)
forall n. Fractional n => n -> Parser Text (LenPercent n)
styleLengthWithUnit (Rational -> n
forall a. Fractional a => Rational -> a
fromRational (Rational -> n) -> Rational -> n
forall a b. (a -> b) -> a -> b
$ Double -> Rational
forall a. Real a => a -> Rational
toRational Double
d),
n -> Parser Text (LenPercent n)
forall n. n -> Parser Text (LenPercent n)
lengthPercent (Rational -> n
forall a. Fractional a => Rational -> a
fromRational (Rational -> n) -> Rational -> n
forall a b. (a -> b) -> a -> b
$ Double -> Rational
forall a. Real a => a -> Rational
toRational Double
d), LenPercent n -> Parser Text (LenPercent n)
forall (m :: * -> *) a. Monad m => a -> m a
return (n -> LenPercent n
forall n. n -> LenPercent n
Len (Rational -> n
forall a. Fractional a => Rational -> a
fromRational (Rational -> n) -> Rational -> n
forall a b. (a -> b) -> a -> b
$ Double -> Rational
forall a. Real a => a -> Rational
toRational Double
d)) ]
styleLengthWithUnit :: n -> Parser Text (LenPercent n)
styleLengthWithUnit n
d =
do Unit
u <- Parser Text Unit
styleUnit
LenPercent n -> Parser Text (LenPercent n)
forall (m :: * -> *) a. Monad m => a -> m a
return (n -> LenPercent n
forall n. n -> LenPercent n
Len (n
d n -> n -> n
forall a. Num a => a -> a -> a
* (Unit -> n
forall p. Fractional p => Unit -> p
unitFactor Unit
u)))
lengthPercent :: n -> Parser Text (LenPercent n)
lengthPercent n
d =
do Text -> Parser Text
AT.string Text
"%"
LenPercent n -> Parser Text (LenPercent n)
forall (m :: * -> *) a. Monad m => a -> m a
return (n -> LenPercent n
forall n. n -> LenPercent n
Percent n
d)
styleUnit :: Parser Text Unit
styleUnit = do [Parser Text Unit] -> Parser Text Unit
forall (f :: * -> *) a. Alternative f => [f a] -> f a
AT.choice [Parser Text Unit
styleEM,Parser Text Unit
styleEX,Parser Text Unit
stylePX,Parser Text Unit
styleIN,Parser Text Unit
styleCM,Parser Text Unit
styleMM,Parser Text Unit
stylePT,Parser Text Unit
stylePC]
styleEM :: Parser Text Unit
styleEM = do { [Parser Text] -> Parser Text
forall (f :: * -> *) a. Alternative f => [f a] -> f a
AT.choice [Text -> Parser Text
AT.string Text
"em", Text -> Parser Text
AT.string Text
"EM"]; Unit -> Parser Text Unit
forall (m :: * -> *) a. Monad m => a -> m a
return Unit
EM }
styleEX :: Parser Text Unit
styleEX = do { [Parser Text] -> Parser Text
forall (f :: * -> *) a. Alternative f => [f a] -> f a
AT.choice [Text -> Parser Text
AT.string Text
"ex", Text -> Parser Text
AT.string Text
"EX"]; Unit -> Parser Text Unit
forall (m :: * -> *) a. Monad m => a -> m a
return Unit
EX }
stylePX :: Parser Text Unit
stylePX = do { [Parser Text] -> Parser Text
forall (f :: * -> *) a. Alternative f => [f a] -> f a
AT.choice [Text -> Parser Text
AT.string Text
"px", Text -> Parser Text
AT.string Text
"PX"]; Unit -> Parser Text Unit
forall (m :: * -> *) a. Monad m => a -> m a
return Unit
PX }
styleIN :: Parser Text Unit
styleIN = do { [Parser Text] -> Parser Text
forall (f :: * -> *) a. Alternative f => [f a] -> f a
AT.choice [Text -> Parser Text
AT.string Text
"in", Text -> Parser Text
AT.string Text
"IN"]; Unit -> Parser Text Unit
forall (m :: * -> *) a. Monad m => a -> m a
return Unit
IN }
styleCM :: Parser Text Unit
styleCM = do { [Parser Text] -> Parser Text
forall (f :: * -> *) a. Alternative f => [f a] -> f a
AT.choice [Text -> Parser Text
AT.string Text
"cm", Text -> Parser Text
AT.string Text
"CM"]; Unit -> Parser Text Unit
forall (m :: * -> *) a. Monad m => a -> m a
return Unit
CM }
styleMM :: Parser Text Unit
styleMM = do { [Parser Text] -> Parser Text
forall (f :: * -> *) a. Alternative f => [f a] -> f a
AT.choice [Text -> Parser Text
AT.string Text
"mm", Text -> Parser Text
AT.string Text
"MM"]; Unit -> Parser Text Unit
forall (m :: * -> *) a. Monad m => a -> m a
return Unit
MM }
stylePT :: Parser Text Unit
stylePT = do { [Parser Text] -> Parser Text
forall (f :: * -> *) a. Alternative f => [f a] -> f a
AT.choice [Text -> Parser Text
AT.string Text
"pt", Text -> Parser Text
AT.string Text
"PT"]; Unit -> Parser Text Unit
forall (m :: * -> *) a. Monad m => a -> m a
return Unit
PT }
stylePC :: Parser Text Unit
stylePC = do { [Parser Text] -> Parser Text
forall (f :: * -> *) a. Alternative f => [f a] -> f a
AT.choice [Text -> Parser Text
AT.string Text
"pc", Text -> Parser Text
AT.string Text
"PC"]; Unit -> Parser Text Unit
forall (m :: * -> *) a. Monad m => a -> m a
return Unit
PC }
unitFactor :: Unit -> p
unitFactor Unit
EM = p
1
unitFactor Unit
EX = p
1
unitFactor Unit
PX = p
1
unitFactor Unit
IN = p
90
unitFactor Unit
CM = p
35.43307
unitFactor Unit
MM = p
3.543307
unitFactor Unit
PT = p
1.25
unitFactor Unit
PC = p
15
styleStrokeLineCap :: Parser Text (SVGStyle n a)
styleStrokeLineCap =
do Parser ()
AT.skipSpace
Text -> Parser Text
AT.string Text
"stroke-linecap:"
Parser ()
AT.skipSpace
Parser Text (SVGStyle n a)
forall n a. Parser Text (SVGStyle n a)
styleStrokeLineCapVal
styleStrokeLineCapVal :: Parser Text (SVGStyle n a)
styleStrokeLineCapVal =
do LineCap
lc <- [Parser Text LineCap] -> Parser Text LineCap
forall (f :: * -> *) a. Alternative f => [f a] -> f a
AT.choice [Parser Text LineCap
butt,Parser Text LineCap
round0,Parser Text LineCap
square0]
SVGStyle n a -> Parser Text (SVGStyle n a)
forall (m :: * -> *) a. Monad m => a -> m a
return (LineCap -> SVGStyle n a
forall n a. LineCap -> SVGStyle n a
StrokeLineCap LineCap
lc)
butt :: Parser Text LineCap
butt = do { Text -> Parser Text
AT.string Text
"butt"; LineCap -> Parser Text LineCap
forall (m :: * -> *) a. Monad m => a -> m a
return LineCap
LineCapButt }
round0 :: Parser Text LineCap
round0 = do { Text -> Parser Text
AT.string Text
"round"; LineCap -> Parser Text LineCap
forall (m :: * -> *) a. Monad m => a -> m a
return LineCap
LineCapRound }
square0 :: Parser Text LineCap
square0 = do { Text -> Parser Text
AT.string Text
"square"; LineCap -> Parser Text LineCap
forall (m :: * -> *) a. Monad m => a -> m a
return LineCap
LineCapSquare }
styleStrokeLineJoin :: Parser Text (SVGStyle n a)
styleStrokeLineJoin =
do Parser ()
AT.skipSpace
Text -> Parser Text
AT.string Text
"stroke-linejoin:"
Parser ()
AT.skipSpace
Parser Text (SVGStyle n a)
forall n a. Parser Text (SVGStyle n a)
styleStrokeLineJoinVal
styleStrokeLineJoinVal :: Parser Text (SVGStyle n a)
styleStrokeLineJoinVal =
do LineJoin
lj <- [Parser Text LineJoin] -> Parser Text LineJoin
forall (f :: * -> *) a. Alternative f => [f a] -> f a
AT.choice [Parser Text LineJoin
miter,Parser Text LineJoin
round1,Parser Text LineJoin
bevel]
SVGStyle n a -> Parser Text (SVGStyle n a)
forall (m :: * -> *) a. Monad m => a -> m a
return (LineJoin -> SVGStyle n a
forall n a. LineJoin -> SVGStyle n a
StrokeLineJoin LineJoin
lj)
miter :: Parser Text LineJoin
miter = do { Text -> Parser Text
AT.string Text
"miter"; LineJoin -> Parser Text LineJoin
forall (m :: * -> *) a. Monad m => a -> m a
return LineJoin
LineJoinMiter }
round1 :: Parser Text LineJoin
round1 = do { Text -> Parser Text
AT.string Text
"round"; LineJoin -> Parser Text LineJoin
forall (m :: * -> *) a. Monad m => a -> m a
return LineJoin
LineJoinRound }
bevel :: Parser Text LineJoin
bevel = do { Text -> Parser Text
AT.string Text
"bevel"; LineJoin -> Parser Text LineJoin
forall (m :: * -> *) a. Monad m => a -> m a
return LineJoin
LineJoinBevel }
styleClipPath :: HashMap Text (Tag b n) -> Parser Text (SVGStyle n a)
styleClipPath HashMap Text (Tag b n)
hmap =
do Parser ()
AT.skipSpace
Text -> Parser Text
AT.string Text
"clip-path:"
Parser ()
AT.skipSpace
HashMap Text (Tag b n) -> Parser Text (SVGStyle n a)
forall n b a.
RealFloat n =>
HashMap Text (Tag b n) -> Parser Text (SVGStyle n a)
styleClipPathVal HashMap Text (Tag b n)
hmap
styleClipPathVal :: HashMap Text (Tag b n) -> Parser Text (SVGStyle n a)
styleClipPathVal HashMap Text (Tag b n)
hmap =
do (Text
absrel,Text
frag) <- Parser Text (Text, Text)
parseIRI
let t :: Maybe (Tag b n)
t = Text -> HashMap Text (Tag b n) -> Maybe (Tag b n)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
H.lookup Text
frag HashMap Text (Tag b n)
hmap
if Maybe (Tag b n) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (Tag b n)
t then SVGStyle n a -> Parser Text (SVGStyle n a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Path V2 n -> SVGStyle n a
forall n a. Path V2 n -> SVGStyle n a
ClipPath (Path V2 n -> SVGStyle n a) -> Path V2 n -> SVGStyle n a
forall a b. (a -> b) -> a -> b
$ HashMap Text (Tag b n) -> Maybe (ViewBox n) -> Tag b n -> Path V2 n
forall n b.
RealFloat n =>
HashMap Text (Tag b n) -> Maybe (ViewBox n) -> Tag b n -> Path V2 n
evalPath HashMap Text (Tag b n)
hmap Maybe (ViewBox n)
forall a. Maybe a
Nothing (Maybe (Tag b n) -> Tag b n
forall a. HasCallStack => Maybe a -> a
fromJust Maybe (Tag b n)
t))
else SVGStyle n a -> Parser Text (SVGStyle n a)
forall (m :: * -> *) a. Monad m => a -> m a
return SVGStyle n a
forall n a. SVGStyle n a
EmptyStyle
evalPath :: RealFloat n => H.HashMap Text (Tag b n) -> Maybe (ViewBox n) -> (Tag b n) -> Path V2 n
evalPath :: HashMap Text (Tag b n) -> Maybe (ViewBox n) -> Tag b n -> Path V2 n
evalPath HashMap Text (Tag b n)
hmap (Just ViewBox n
viewBox) (Leaf Maybe Text
id1 ViewBox n -> Path V2 n
path (HashMaps b n, ViewBox n) -> Diagram b
diagram) = ViewBox n -> Path V2 n
path ViewBox n
viewBox
evalPath HashMap Text (Tag b n)
hmap Maybe (ViewBox n)
Nothing (Leaf Maybe Text
id1 ViewBox n -> Path V2 n
path (HashMaps b n, ViewBox n) -> Diagram b
diagram) = ViewBox n -> Path V2 n
path (n
0,n
0,n
1,n
1)
evalPath HashMap Text (Tag b n)
hmap Maybe (ViewBox n)
_ (SubTree Bool
_ Maybe Text
id1 (Double, Double)
_ (Just ViewBox n
viewBox) Maybe PreserveAR
ar HashMaps b n -> Diagram b -> Diagram b
f [Tag b n]
children) = [Path V2 n] -> Path V2 n
forall a. Monoid a => [a] -> a
mconcat ((Tag b n -> Path V2 n) -> [Tag b n] -> [Path V2 n]
forall a b. (a -> b) -> [a] -> [b]
map (HashMap Text (Tag b n) -> Maybe (ViewBox n) -> Tag b n -> Path V2 n
forall n b.
RealFloat n =>
HashMap Text (Tag b n) -> Maybe (ViewBox n) -> Tag b n -> Path V2 n
evalPath HashMap Text (Tag b n)
hmap (ViewBox n -> Maybe (ViewBox n)
forall a. a -> Maybe a
Just ViewBox n
viewBox)) [Tag b n]
children)
evalPath HashMap Text (Tag b n)
hmap (Just ViewBox n
viewBox) (SubTree Bool
_ Maybe Text
id1 (Double, Double)
_ Maybe (ViewBox n)
Nothing Maybe PreserveAR
ar HashMaps b n -> Diagram b -> Diagram b
f [Tag b n]
children) = [Path V2 n] -> Path V2 n
forall a. Monoid a => [a] -> a
mconcat ((Tag b n -> Path V2 n) -> [Tag b n] -> [Path V2 n]
forall a b. (a -> b) -> [a] -> [b]
map (HashMap Text (Tag b n) -> Maybe (ViewBox n) -> Tag b n -> Path V2 n
forall n b.
RealFloat n =>
HashMap Text (Tag b n) -> Maybe (ViewBox n) -> Tag b n -> Path V2 n
evalPath HashMap Text (Tag b n)
hmap (ViewBox n -> Maybe (ViewBox n)
forall a. a -> Maybe a
Just ViewBox n
viewBox)) [Tag b n]
children)
evalPath HashMap Text (Tag b n)
hmap Maybe (ViewBox n)
_ Tag b n
_ = Path V2 n
forall a. Monoid a => a
mempty
lookUp :: HashMap k (Tag b n) -> k -> Tag b n
lookUp HashMap k (Tag b n)
hmap k
i | 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 = Maybe Text
-> (ViewBox n -> Path V2 n)
-> ((HashMaps b n, ViewBox n) -> Diagram b)
-> Tag b n
forall b n.
Maybe Text
-> (ViewBox n -> Path V2 n)
-> ((HashMaps b n, ViewBox n) -> Diagram b)
-> Tag b n
Leaf Maybe Text
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
where l :: Maybe (Tag b n)
l = k -> HashMap k (Tag b n) -> Maybe (Tag b n)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
H.lookup k
i HashMap k (Tag b n)
hmap
styleStrokeMiterLimit :: Parser Text (SVGStyle n a)
styleStrokeMiterLimit =
do Parser ()
AT.skipSpace
Text -> Parser Text
AT.string Text
"stroke-miterlimit:"
Parser ()
AT.skipSpace
Parser Text (SVGStyle n a)
forall n a. Fractional n => Parser Text (SVGStyle n a)
styleStrokeMiterLimitVal
styleStrokeMiterLimitVal :: Parser Text (SVGStyle n a)
styleStrokeMiterLimitVal =
do Double
l <- Parser Double
myDouble
SVGStyle n a -> Parser Text (SVGStyle n a)
forall (m :: * -> *) a. Monad m => a -> m a
return (SVGStyle n a -> Parser Text (SVGStyle n a))
-> SVGStyle n a -> Parser Text (SVGStyle n a)
forall a b. (a -> b) -> a -> b
$ n -> SVGStyle n a
forall n a. n -> SVGStyle n a
StrokeMiterLimit (n -> SVGStyle n a) -> n -> SVGStyle n a
forall a b. (a -> b) -> a -> b
$ (Rational -> n
forall a. Fractional a => Rational -> a
fromRational (Rational -> n) -> (Double -> Rational) -> Double -> n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Rational
forall a. Real a => a -> Rational
toRational) Double
l
styleStrokeDashArray :: Parser Text (SVGStyle n a)
styleStrokeDashArray =
do Parser ()
AT.skipSpace
Text -> Parser Text
AT.string Text
"stroke-dasharray:"
Parser Text (SVGStyle n a)
forall n a. Fractional n => Parser Text (SVGStyle n a)
styleStrokeDashArrayVal
styleStrokeDashArrayVal :: Parser Text (SVGStyle n a)
styleStrokeDashArrayVal =
do [LenPercent n]
len <- Parser Text [LenPercent n]
forall n. Fractional n => Parser Text [LenPercent n]
parseLengths
SVGStyle n a -> Parser Text (SVGStyle n a)
forall (m :: * -> *) a. Monad m => a -> m a
return ([LenPercent n] -> SVGStyle n a
forall n a. [LenPercent n] -> SVGStyle n a
StrokeDasharray [LenPercent n]
len)
parseLengths :: Parser Text [LenPercent n]
parseLengths = Parser Text (LenPercent n) -> Text -> Parser Text [LenPercent n]
forall a. Parser Text a -> Text -> Parser Text [a]
separatedBy Parser Text (LenPercent n)
forall n. Fractional n => Parser Text (LenPercent n)
styleLength Text
","
styleStrokeOpacity :: Parser Text (SVGStyle n a)
styleStrokeOpacity =
do Parser ()
AT.skipSpace
Text -> Parser Text
AT.string Text
"stroke-opacity:"
Parser ()
AT.skipSpace
Parser Text (SVGStyle n a)
forall n a. Parser Text (SVGStyle n a)
styleStrokeOpacityVal
styleStrokeOpacityVal :: Parser Text (SVGStyle n a)
styleStrokeOpacityVal =
do Double
l <- Parser Double
myDouble
SVGStyle n a -> Parser Text (SVGStyle n a)
forall (m :: * -> *) a. Monad m => a -> m a
return (SVGStyle n a -> Parser Text (SVGStyle n a))
-> SVGStyle n a -> Parser Text (SVGStyle n a)
forall a b. (a -> b) -> a -> b
$ Double -> SVGStyle n a
forall n a. Double -> SVGStyle n a
StrokeOpacity (Double -> SVGStyle n a) -> Double -> SVGStyle n a
forall a b. (a -> b) -> a -> b
$ (Rational -> Double
forall a. Fractional a => Rational -> a
fromRational (Rational -> Double) -> (Double -> Rational) -> Double -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Rational
forall a. Real a => a -> Rational
toRational) Double
l
styleStopColor :: Parser Text (SVGStyle n a)
styleStopColor =
do Parser ()
AT.skipSpace
Text -> Parser Text
AT.string Text
"stop-color:"
Parser ()
AT.skipSpace
Parser Text (SVGStyle n a)
forall a n. (Floating a, RealFrac a) => Parser Text (SVGStyle n a)
styleFillColourVal
styleStopOpacity :: Parser Text (SVGStyle n a)
styleStopOpacity =
do Parser ()
AT.skipSpace
Text -> Parser Text
AT.string Text
"stop-opacity:"
Parser ()
AT.skipSpace
Parser Text (SVGStyle n a)
forall n a. Parser Text (SVGStyle n a)
styleFillOpacityVal
colorString :: Parser Text (AlphaColour a)
colorString =
do Text
a <- (Char -> Bool) -> Parser Text
Data.Attoparsec.Text.takeWhile Char -> Bool
isAlpha
Colour a
c <- String -> Parser Text (Colour a)
forall (m :: * -> *) a.
(MonadFail m, Monad m, Ord a, Floating a) =>
String -> m (Colour a)
readColourName (Text -> String
unpack Text
a)
AlphaColour a -> Parser Text (AlphaColour a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Colour a -> AlphaColour a
forall a. Num a => Colour a -> AlphaColour a
opaque Colour a
c)
colorRGB :: Parser Text (AlphaColour a)
colorRGB =
do Char -> Parser Char
AT.char Char
'#'
Char
h0 <- (Char -> Bool) -> Parser Char
satisfy Char -> Bool
isHexDigit
Char
h1 <- (Char -> Bool) -> Parser Char
satisfy Char -> Bool
isHexDigit
Char
h2 <- (Char -> Bool) -> Parser Char
satisfy Char -> Bool
isHexDigit
AlphaColour a -> Parser Text (AlphaColour a)
forall (m :: * -> *) a. Monad m => a -> m a
return (AlphaColour a -> Parser Text (AlphaColour a))
-> AlphaColour a -> Parser Text (AlphaColour a)
forall a b. (a -> b) -> a -> b
$ Colour a -> AlphaColour a
forall a. Num a => Colour a -> AlphaColour a
opaque ( Word8 -> Word8 -> Word8 -> Colour a
forall b.
(Ord b, Floating b) =>
Word8 -> Word8 -> Word8 -> Colour b
sRGB24 (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Char -> Int
digitToInt Char
h0) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
16))
(Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Char -> Int
digitToInt Char
h1) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
16))
(Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Char -> Int
digitToInt Char
h2) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
16)) )
colorRRGGBB :: Parser Text (AlphaColour a)
colorRRGGBB =
do Char -> Parser Char
AT.char Char
'#'
Char
h0 <- (Char -> Bool) -> Parser Char
satisfy Char -> Bool
isHexDigit
Char
h1 <- (Char -> Bool) -> Parser Char
satisfy Char -> Bool
isHexDigit
Char
h2 <- (Char -> Bool) -> Parser Char
satisfy Char -> Bool
isHexDigit
Char
h3 <- (Char -> Bool) -> Parser Char
satisfy Char -> Bool
isHexDigit
Char
h4 <- (Char -> Bool) -> Parser Char
satisfy Char -> Bool
isHexDigit
Char
h5 <- (Char -> Bool) -> Parser Char
satisfy Char -> Bool
isHexDigit
AlphaColour a -> Parser Text (AlphaColour a)
forall (m :: * -> *) a. Monad m => a -> m a
return (AlphaColour a -> Parser Text (AlphaColour a))
-> AlphaColour a -> Parser Text (AlphaColour a)
forall a b. (a -> b) -> a -> b
$ Colour a -> AlphaColour a
forall a. Num a => Colour a -> AlphaColour a
opaque ( Word8 -> Word8 -> Word8 -> Colour a
forall b.
(Ord b, Floating b) =>
Word8 -> Word8 -> Word8 -> Colour b
sRGB24 (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Char -> Int
digitToInt Char
h0) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
16 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Char -> Int
digitToInt Char
h1)) )
(Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Char -> Int
digitToInt Char
h2) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
16 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Char -> Int
digitToInt Char
h3)) )
(Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Char -> Int
digitToInt Char
h4) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
16 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Char -> Int
digitToInt Char
h5)) ) )
colorRGBWord :: Parser Text (AlphaColour a)
colorRGBWord =
do Text -> Parser Text
AT.string Text
"rgb("
Parser ()
AT.skipSpace
Integer
r <- Parser Integer
forall a. Integral a => Parser a
decimal
Parser ()
AT.skipSpace
Char -> Parser Char
AT.char Char
','
Parser ()
AT.skipSpace
Integer
g <- Parser Integer
forall a. Integral a => Parser a
decimal
Parser ()
AT.skipSpace
Char -> Parser Char
AT.char Char
','
Parser ()
AT.skipSpace
Integer
b <- Parser Integer
forall a. Integral a => Parser a
decimal
Parser ()
AT.skipSpace
Char -> Parser Char
AT.char Char
')'
AlphaColour a -> Parser Text (AlphaColour a)
forall (m :: * -> *) a. Monad m => a -> m a
return (AlphaColour a -> Parser Text (AlphaColour a))
-> AlphaColour a -> Parser Text (AlphaColour a)
forall a b. (a -> b) -> a -> b
$ Colour a -> AlphaColour a
forall a. Num a => Colour a -> AlphaColour a
opaque (a -> a -> a -> Colour a
forall b. (Ord b, Floating b) => b -> b -> b -> Colour b
sRGB ((Integer -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
r)a -> a -> a
forall a. Fractional a => a -> a -> a
/a
255) ((Integer -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
g)a -> a -> a
forall a. Fractional a => a -> a -> a
/a
255) ((Integer -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
b)a -> a -> a
forall a. Fractional a => a -> a -> a
/a
255))
colorRGBPercent :: Parser Text (AlphaColour a)
colorRGBPercent =
do Text -> Parser Text
AT.string Text
"rgb("
Parser ()
AT.skipSpace
Integer
r <- Parser Integer
forall a. Integral a => Parser a
decimal
Char -> Parser Char
AT.char Char
'%'
Parser ()
AT.skipSpace
Char -> Parser Char
AT.char Char
','
Parser ()
AT.skipSpace
Integer
g <- Parser Integer
forall a. Integral a => Parser a
decimal
Char -> Parser Char
AT.char Char
'%'
Parser ()
AT.skipSpace
Char -> Parser Char
AT.char Char
','
Parser ()
AT.skipSpace
Integer
b <- Parser Integer
forall a. Integral a => Parser a
decimal
Char -> Parser Char
AT.char Char
'%'
Parser ()
AT.skipSpace
Char -> Parser Char
AT.char Char
')'
AlphaColour a -> Parser Text (AlphaColour a)
forall (m :: * -> *) a. Monad m => a -> m a
return (AlphaColour a -> Parser Text (AlphaColour a))
-> AlphaColour a -> Parser Text (AlphaColour a)
forall a b. (a -> b) -> a -> b
$ Colour a -> AlphaColour a
forall a. Num a => Colour a -> AlphaColour a
opaque (a -> a -> a -> Colour a
forall b. (Ord b, Floating b) => b -> b -> b -> Colour b
sRGB ((Integer -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
r)a -> a -> a
forall a. Fractional a => a -> a -> a
/a
100) ((Integer -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
g)a -> a -> a
forall a. Fractional a => a -> a -> a
/a
100) ((Integer -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
b)a -> a -> a
forall a. Fractional a => a -> a -> a
/a
100))
colorHSLPercent :: Parser Text (AlphaColour a)
colorHSLPercent =
do Text -> Parser Text
AT.string Text
"hsl("
Parser ()
AT.skipSpace
Integer
h <- Parser Integer
forall a. Integral a => Parser a
decimal
Char -> Parser Char
AT.char Char
'%'
Parser ()
AT.skipSpace
Char -> Parser Char
AT.char Char
','
Parser ()
AT.skipSpace
Integer
s <- Parser Integer
forall a. Integral a => Parser a
decimal
Char -> Parser Char
AT.char Char
'%'
Parser ()
AT.skipSpace
Char -> Parser Char
AT.char Char
','
Parser ()
AT.skipSpace
Integer
l <- Parser Integer
forall a. Integral a => Parser a
decimal
Char -> Parser Char
AT.char Char
'%'
Parser ()
AT.skipSpace
Char -> Parser Char
AT.char Char
')'
let c :: RGB a
c = a -> a -> a -> RGB a
forall a. (RealFrac a, Ord a) => a -> a -> a -> RGB a
hsl (Integer -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
h) (Integer -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
s) (Integer -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
l)
AlphaColour a -> Parser Text (AlphaColour a)
forall (m :: * -> *) a. Monad m => a -> m a
return (AlphaColour a -> Parser Text (AlphaColour a))
-> AlphaColour a -> Parser Text (AlphaColour a)
forall a b. (a -> b) -> a -> b
$ Colour a -> AlphaColour a
forall a. Num a => Colour a -> AlphaColour a
opaque (a -> a -> a -> Colour a
forall b. (Ord b, Floating b) => b -> b -> b -> Colour b
sRGB (RGB a -> a
forall a. RGB a -> a
channelRed RGB a
c) (RGB a -> a
forall a. RGB a -> a
channelGreen RGB a
c) (RGB a -> a
forall a. RGB a -> a
channelBlue RGB a
c))
colorNone :: Parser Text (AlphaColour a)
colorNone =
do Text -> Parser Text
AT.string Text
"none"
AlphaColour a -> Parser Text (AlphaColour a)
forall (m :: * -> *) a. Monad m => a -> m a
return AlphaColour a
forall a. Num a => AlphaColour a
transparent
parseSpread :: Maybe Text -> SpreadMethod
parseSpread :: Maybe Text -> SpreadMethod
parseSpread Maybe Text
spr | Maybe SpreadMethod -> Bool
forall a. Maybe a -> Bool
isJust Maybe SpreadMethod
parsedSpread = Maybe SpreadMethod -> SpreadMethod
forall a. HasCallStack => Maybe a -> a
fromJust Maybe SpreadMethod
parsedSpread
| Bool
otherwise = SpreadMethod
GradPad
where parsedSpread :: Maybe SpreadMethod
parsedSpread = Parser SpreadMethod -> Maybe Text -> Maybe SpreadMethod
forall a. Parser a -> Maybe Text -> Maybe a
parseTempl Parser SpreadMethod
gradSpread Maybe Text
spr
gradSpread :: Parser SpreadMethod
gradSpread = [Parser SpreadMethod] -> Parser SpreadMethod
forall (f :: * -> *) a. Alternative f => [f a] -> f a
AT.choice [Parser SpreadMethod
gradPad, Parser SpreadMethod
gradReflect, Parser SpreadMethod
gradRepeat ]
gradPad :: Parser SpreadMethod
gradPad = do Text -> Parser Text
AT.string Text
"pad"
SpreadMethod -> Parser SpreadMethod
forall (m :: * -> *) a. Monad m => a -> m a
return SpreadMethod
GradPad
gradReflect :: Parser SpreadMethod
gradReflect = do Text -> Parser Text
AT.string Text
"reflect"
SpreadMethod -> Parser SpreadMethod
forall (m :: * -> *) a. Monad m => a -> m a
return SpreadMethod
GradReflect
gradRepeat :: Parser SpreadMethod
gradRepeat = do Text -> Parser Text
AT.string Text
"repeat"
SpreadMethod -> Parser SpreadMethod
forall (m :: * -> *) a. Monad m => a -> m a
return SpreadMethod
GradRepeat
parseViewBox :: RealFloat n => Maybe Text -> Maybe Text -> Maybe Text -> Maybe (ViewBox n)
parseViewBox :: Maybe Text -> Maybe Text -> Maybe Text -> Maybe (ViewBox n)
parseViewBox Maybe Text
vb Maybe Text
w Maybe Text
h | Maybe (ViewBox n) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (ViewBox n)
parsedVB = Maybe (ViewBox n)
parsedVB
| n
pw n -> n -> Bool
forall a. Eq a => a -> a -> Bool
== n
0 Bool -> Bool -> Bool
|| n
ph n -> n -> Bool
forall a. Eq a => a -> a -> Bool
== n
0 = Maybe (ViewBox n)
forall a. Maybe a
Nothing
| Bool
otherwise = ViewBox n -> Maybe (ViewBox n)
forall a. a -> Maybe a
Just (n
0,n
0,n
pw, n
ph)
where parsedVB :: Maybe (ViewBox n)
parsedVB = Parser (ViewBox n) -> Maybe Text -> Maybe (ViewBox n)
forall a. Parser a -> Maybe Text -> Maybe a
parseTempl Parser (ViewBox n)
forall a b c d.
(Fractional a, Fractional b, Fractional c, Fractional d) =>
Parser Text (a, b, c, d)
viewBox Maybe Text
vb
pw :: n
pw | Maybe Text -> Bool
forall a. Maybe a -> Bool
isJust Maybe Text
w = Text -> n
forall n. RealFloat n => Text -> n
parseDouble (Text -> n) -> Text -> n
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Text
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Text
w
| Bool
otherwise = n
0
ph :: n
ph | Maybe Text -> Bool
forall a. Maybe a -> Bool
isJust Maybe Text
h = Text -> n
forall n. RealFloat n => Text -> n
parseDouble (Text -> n) -> Text -> n
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Text
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Text
h
| Bool
otherwise = n
0
viewBox :: Parser Text (a, b, c, d)
viewBox =
do Parser ()
AT.skipSpace
Double
minx <- Parser Double
myDouble
Parser ()
AT.skipSpace
Double
miny <- Parser Double
myDouble
Parser ()
AT.skipSpace
Double
width <- Parser Double
myDouble
Parser ()
AT.skipSpace
Double
height <- Parser Double
myDouble
Parser ()
AT.skipSpace
(a, b, c, d) -> Parser Text (a, b, c, d)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Rational -> a
forall a. Fractional a => Rational -> a
fromRational (Rational -> a) -> (Double -> Rational) -> Double -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Rational
forall a. Real a => a -> Rational
toRational) Double
minx,
(Rational -> b
forall a. Fractional a => Rational -> a
fromRational (Rational -> b) -> (Double -> Rational) -> Double -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Rational
forall a. Real a => a -> Rational
toRational) Double
miny,
(Rational -> c
forall a. Fractional a => Rational -> a
fromRational (Rational -> c) -> (Double -> Rational) -> Double -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Rational
forall a. Real a => a -> Rational
toRational) Double
width,
(Rational -> d
forall a. Fractional a => Rational -> a
fromRational (Rational -> d) -> (Double -> Rational) -> Double -> d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Rational
forall a. Real a => a -> Rational
toRational) Double
height)
parsePreserveAR :: Maybe Text -> Maybe PreserveAR
parsePreserveAR Maybe Text
x = Parser PreserveAR -> Maybe Text -> Maybe PreserveAR
forall a. Parser a -> Maybe Text -> Maybe a
parseTempl Parser PreserveAR
preserveAR Maybe Text
x
preserveAR :: Parser PreserveAR
preserveAR =
do Parser ()
AT.skipSpace
AlignSVG
align <- [Parser Text AlignSVG] -> Parser Text AlignSVG
forall (f :: * -> *) a. Alternative f => [f a] -> f a
AT.choice [Parser Text AlignSVG
alignXMinYMin,Parser Text AlignSVG
alignXMidYMin,Parser Text AlignSVG
alignXMaxYMin,Parser Text AlignSVG
alignXMinYMid,Parser Text AlignSVG
alignXMidYMid,
Parser Text AlignSVG
alignXMaxYMid,Parser Text AlignSVG
alignXMinYMax,Parser Text AlignSVG
alignXMidYMax,Parser Text AlignSVG
alignXMaxYMax]
Parser ()
AT.skipSpace
MeetOrSlice
meetOrSlice <- [Parser Text MeetOrSlice] -> Parser Text MeetOrSlice
forall (f :: * -> *) a. Alternative f => [f a] -> f a
AT.choice [Parser Text MeetOrSlice
meet, Parser Text MeetOrSlice
slice]
PreserveAR -> Parser PreserveAR
forall (m :: * -> *) a. Monad m => a -> m a
return (AlignSVG -> MeetOrSlice -> PreserveAR
PAR AlignSVG
align MeetOrSlice
meetOrSlice)
meet :: Parser Text MeetOrSlice
meet =
do Text -> Parser Text
AT.string Text
"meet"
MeetOrSlice -> Parser Text MeetOrSlice
forall (m :: * -> *) a. Monad m => a -> m a
return MeetOrSlice
Meet
slice :: Parser Text MeetOrSlice
slice =
do Text -> Parser Text
AT.string Text
"slice"
MeetOrSlice -> Parser Text MeetOrSlice
forall (m :: * -> *) a. Monad m => a -> m a
return MeetOrSlice
Slice
alignXMinYMin :: Parser Text AlignSVG
alignXMinYMin =
do Text -> Parser Text
AT.string Text
"xMinYMin"
AlignSVG -> Parser Text AlignSVG
forall (m :: * -> *) a. Monad m => a -> m a
return (Double -> Double -> AlignSVG
AlignXY Double
0 Double
0)
alignXMidYMin :: Parser Text AlignSVG
alignXMidYMin =
do Text -> Parser Text
AT.string Text
"xMidYMin"
AlignSVG -> Parser Text AlignSVG
forall (m :: * -> *) a. Monad m => a -> m a
return (Double -> Double -> AlignSVG
AlignXY Double
0.5 Double
0)
alignXMaxYMin :: Parser Text AlignSVG
alignXMaxYMin =
do Text -> Parser Text
AT.string Text
"xMaxYMin"
AlignSVG -> Parser Text AlignSVG
forall (m :: * -> *) a. Monad m => a -> m a
return (Double -> Double -> AlignSVG
AlignXY Double
1 Double
0)
alignXMinYMid :: Parser Text AlignSVG
alignXMinYMid =
do Text -> Parser Text
AT.string Text
"xMinYMid"
AlignSVG -> Parser Text AlignSVG
forall (m :: * -> *) a. Monad m => a -> m a
return (Double -> Double -> AlignSVG
AlignXY Double
0 Double
0.5)
alignXMidYMid :: Parser Text AlignSVG
alignXMidYMid =
do Text -> Parser Text
AT.string Text
"xMidYMid"
AlignSVG -> Parser Text AlignSVG
forall (m :: * -> *) a. Monad m => a -> m a
return (Double -> Double -> AlignSVG
AlignXY Double
0.5 Double
0.5)
alignXMaxYMid :: Parser Text AlignSVG
alignXMaxYMid =
do Text -> Parser Text
AT.string Text
"xMaxYMid"
AlignSVG -> Parser Text AlignSVG
forall (m :: * -> *) a. Monad m => a -> m a
return (Double -> Double -> AlignSVG
AlignXY Double
1 Double
0.5)
alignXMinYMax :: Parser Text AlignSVG
alignXMinYMax =
do Text -> Parser Text
AT.string Text
"xMinYMax"
AlignSVG -> Parser Text AlignSVG
forall (m :: * -> *) a. Monad m => a -> m a
return (Double -> Double -> AlignSVG
AlignXY Double
0 Double
1)
alignXMidYMax :: Parser Text AlignSVG
alignXMidYMax =
do Text -> Parser Text
AT.string Text
"xMidYMax"
AlignSVG -> Parser Text AlignSVG
forall (m :: * -> *) a. Monad m => a -> m a
return (Double -> Double -> AlignSVG
AlignXY Double
0.5 Double
1)
alignXMaxYMax :: Parser Text AlignSVG
alignXMaxYMax =
do Text -> Parser Text
AT.string Text
"xMaxYMax"
AlignSVG -> Parser Text AlignSVG
forall (m :: * -> *) a. Monad m => a -> m a
return (Double -> Double -> AlignSVG
AlignXY Double
1 Double
1)