{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoMonomorphismRestriction #-}

-------------------------------------------------------------------------------------
-- Parsing the SVG path command, see <http://www.w3.org/TR/SVG/paths.html#PathData>
-------------------------------------------------------------------------------------

module Diagrams.SVG.Path
    (
    -- * Converting Path Commands
      commandsToPaths
    , splittedCommands
    , outline
    , nextSegment
    , svgArc
    , myDouble
    -- * Parsing (Generating Path Commands)
    , PathCommand(..)
    , parsePathCommand
    , commands
    )
where

import Data.Attoparsec.Combinator
import Data.Attoparsec.Text
import qualified Data.Attoparsec.Text as AT
import Data.Char (digitToInt, isAlpha, isHexDigit)
import Data.Colour.Names (readColourName)
import Data.Colour.SRGB
import Data.Digits (digits)
import Data.List (foldl')
import qualified Data.List.Split as S
import Data.Maybe (catMaybes, fromJust, fromMaybe, isJust, isNothing, maybeToList)
import Data.Text (Text (..), empty, pack, unpack)
import qualified Data.Text as T
import Diagrams.Attributes
import Diagrams.Path
import Diagrams.Prelude
import Diagrams.Segment
import Diagrams.TwoD.Types

data AbsRel = Abs | Rel deriving Int -> AbsRel -> ShowS
[AbsRel] -> ShowS
AbsRel -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AbsRel] -> ShowS
$cshowList :: [AbsRel] -> ShowS
show :: AbsRel -> String
$cshow :: AbsRel -> String
showsPrec :: Int -> AbsRel -> ShowS
$cshowsPrec :: Int -> AbsRel -> ShowS
Show
data PathCommand n =
  M AbsRel !(n,n) | -- ^AbsRel (x,y): Establish a new current point (with absolute coords)
  Z | -- ^Close current subpath by drawing a straight line from current point to current subpath's initial point
  L AbsRel !(n,n) | -- ^AbsRel (X,Y): A line from the current point to Tup which becomes the new current point
  H AbsRel !n | -- ^AbsRel x: A horizontal line from the current point (cpx, cpy) to (x, cpy)
  V AbsRel !n | -- ^AbsRel y: A vertical line from the current point (cpx, cpy) to (cpx, y)
  C AbsRel !(n,n,n,n,n,n) | -- ^AbsRel (X1,Y1,X2,Y2,X,Y): Draws a cubic Bézier curve from the current point to (x,y) using (x1,y1) as the
  -- ^control point at the beginning of the curve and (x2,y2) as the control point at the end of the curve.
  S AbsRel !(n,n,n,n) | -- ^AbsRel (X2,Y2,X,Y): Draws a cubic Bézier curve from the current point to (x,y). The first control point is
-- assumed to be the reflection of the second control point on the previous command relative to the current point.
-- (If there is no previous command or if the previous command was not an C, c, S or s, assume the first control
-- point is coincident with the current point.) (x2,y2) is the second control point (i.e., the control point at
-- the end of the curve).
  Q AbsRel !(n,n,n,n) | -- ^AbsRel (X1,Y1,X,Y): A quadr. Bézier curve from the curr. point to (x,y) using (x1,y1) as the control point.
-- Nearly the same as cubic, but with one point less
  T AbsRel !(n,n) | -- ^AbsRel (X,Y): T_Abs = Shorthand/smooth quadratic Bezier curveto
  A AbsRel !(n,n,n,n,n,n,n) -- ^AbsRel (rx,ry,xAxisRot,fl0,fl1,x,y): Elliptic arc
   deriving Int -> PathCommand n -> ShowS
forall n. Show n => Int -> PathCommand n -> ShowS
forall n. Show n => [PathCommand n] -> ShowS
forall n. Show n => PathCommand n -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PathCommand n] -> ShowS
$cshowList :: forall n. Show n => [PathCommand n] -> ShowS
show :: PathCommand n -> String
$cshow :: forall n. Show n => PathCommand n -> String
showsPrec :: Int -> PathCommand n -> ShowS
$cshowsPrec :: forall n. Show n => Int -> PathCommand n -> ShowS
Show


-- | The parser to parse the lines and curves that make an outline
parsePathCommand :: Parser Text (Maybe [PathCommand n])
parsePathCommand = do { Parser ()
AT.skipSpace;
                        forall (f :: * -> *) a. Alternative f => [f a] -> f a
AT.choice [forall {n}. Fractional n => Parser Text (Maybe [PathCommand n])
parse_m, forall {n}. Fractional n => Parser Text (Maybe [PathCommand n])
parse_M, forall {n}. Fractional n => Parser Text (Maybe [PathCommand n])
parse_l, forall {n}. Fractional n => Parser Text (Maybe [PathCommand n])
parse_L, forall {n}. Fractional n => Parser Text (Maybe [PathCommand n])
parse_h, forall {n}. Fractional n => Parser Text (Maybe [PathCommand n])
parse_H,
                                   forall {n}. Fractional n => Parser Text (Maybe [PathCommand n])
parse_v, forall {n}. Fractional n => Parser Text (Maybe [PathCommand n])
parse_V, forall {n}. Fractional n => Parser Text (Maybe [PathCommand n])
parse_c, forall {n}. Fractional n => Parser Text (Maybe [PathCommand n])
parse_C, forall {n}. Fractional n => Parser Text (Maybe [PathCommand n])
parse_S, forall {n}. Fractional n => Parser Text (Maybe [PathCommand n])
parse_s,
                                   forall {n}. Fractional n => Parser Text (Maybe [PathCommand n])
parse_q, forall {n}. Fractional n => Parser Text (Maybe [PathCommand n])
parse_Q, forall {n}. Fractional n => Parser Text (Maybe [PathCommand n])
parse_t, forall {n}. Fractional n => Parser Text (Maybe [PathCommand n])
parse_T, forall {n}. Fractional n => Parser Text (Maybe [PathCommand n])
parse_a, forall {n}. Fractional n => Parser Text (Maybe [PathCommand n])
parse_A, forall {n}. Parser Text (Maybe [PathCommand n])
parse_z]
                      }

-- Although it makes no sense, some programs produce several M in sucession
parse_m :: Parser Text (Maybe [PathCommand n])
parse_m = do { Text -> Parser Text
AT.string Text
"m"; [(n, n)]
t <- forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' forall {a} {b}. (Fractional a, Fractional b) => Parser Text (a, b)
tuple2; forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ (forall n. AbsRel -> (n, n) -> PathCommand n
M AbsRel
Rel forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head [(n, n)]
t)forall a. a -> [a] -> [a]
: (forall a b. (a -> b) -> [a] -> [b]
map (forall n. AbsRel -> (n, n) -> PathCommand n
L AbsRel
Rel) (forall a. [a] -> [a]
tail [(n, n)]
t)) ) } -- that's why we need many'
parse_M :: Parser Text (Maybe [PathCommand n])
parse_M = do { Text -> Parser Text
AT.string Text
"M"; [(n, n)]
t <- forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' forall {a} {b}. (Fractional a, Fractional b) => Parser Text (a, b)
tuple2; forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall n. AbsRel -> (n, n) -> PathCommand n
M AbsRel
Abs) [(n, n)]
t) }
parse_z :: Parser Text (Maybe [PathCommand n])
parse_z = do { forall (f :: * -> *) a. Alternative f => [f a] -> f a
AT.choice [Text -> Parser Text
AT.string Text
"z", Text -> Parser Text
AT.string Text
"Z"]; forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just [forall n. PathCommand n
Z]) }
parse_l :: Parser Text (Maybe [PathCommand n])
parse_l = do { Text -> Parser Text
AT.string Text
"l"; [(n, n)]
t <- forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' forall {a} {b}. (Fractional a, Fractional b) => Parser Text (a, b)
tuple2; forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall n. AbsRel -> (n, n) -> PathCommand n
L AbsRel
Rel) [(n, n)]
t) }
parse_L :: Parser Text (Maybe [PathCommand n])
parse_L = do { Text -> Parser Text
AT.string Text
"L"; [(n, n)]
t <- forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' forall {a} {b}. (Fractional a, Fractional b) => Parser Text (a, b)
tuple2; forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall n. AbsRel -> (n, n) -> PathCommand n
L AbsRel
Abs) [(n, n)]
t) }
parse_h :: Parser Text (Maybe [PathCommand a])
parse_h = do { Text -> Parser Text
AT.string Text
"h"; [a]
t <- forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' forall {b}. Fractional b => Parser Text b
spaceDouble; forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall n. AbsRel -> n -> PathCommand n
H AbsRel
Rel) [a]
t) }
parse_H :: Parser Text (Maybe [PathCommand a])
parse_H = do { Text -> Parser Text
AT.string Text
"H"; [a]
t <- forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' forall {b}. Fractional b => Parser Text b
spaceDouble; forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall n. AbsRel -> n -> PathCommand n
H AbsRel
Abs) [a]
t) }
parse_v :: Parser Text (Maybe [PathCommand a])
parse_v = do { Text -> Parser Text
AT.string Text
"v"; [a]
t <- forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' forall {b}. Fractional b => Parser Text b
spaceDouble; forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall n. AbsRel -> n -> PathCommand n
V AbsRel
Rel) [a]
t) }
parse_V :: Parser Text (Maybe [PathCommand a])
parse_V = do { Text -> Parser Text
AT.string Text
"V"; [a]
t <- forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' forall {b}. Fractional b => Parser Text b
spaceDouble; forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall n. AbsRel -> n -> PathCommand n
V AbsRel
Abs) [a]
t) }
parse_c :: Parser Text (Maybe [PathCommand n])
parse_c = do { Text -> Parser Text
AT.string Text
"c"; [(n, n, n, n, n, n)]
t <- forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' forall {a} {b} {c} {d} {e} {f}.
(Fractional a, Fractional b, Fractional c, Fractional d,
 Fractional e, Fractional f) =>
Parser Text (a, b, c, d, e, f)
tuple6; forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall n. AbsRel -> (n, n, n, n, n, n) -> PathCommand n
C AbsRel
Rel) [(n, n, n, n, n, n)]
t) }
parse_C :: Parser Text (Maybe [PathCommand n])
parse_C = do { Text -> Parser Text
AT.string Text
"C"; [(n, n, n, n, n, n)]
t <- forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' forall {a} {b} {c} {d} {e} {f}.
(Fractional a, Fractional b, Fractional c, Fractional d,
 Fractional e, Fractional f) =>
Parser Text (a, b, c, d, e, f)
tuple6; forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall n. AbsRel -> (n, n, n, n, n, n) -> PathCommand n
C AbsRel
Abs) [(n, n, n, n, n, n)]
t) }
parse_s :: Parser Text (Maybe [PathCommand n])
parse_s = do { Text -> Parser Text
AT.string Text
"s"; [(n, n, n, n)]
t <- forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' forall {a} {b} {c} {d}.
(Fractional a, Fractional b, Fractional c, Fractional d) =>
Parser Text (a, b, c, d)
tuple4; forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall n. AbsRel -> (n, n, n, n) -> PathCommand n
S AbsRel
Rel) [(n, n, n, n)]
t) }
parse_S :: Parser Text (Maybe [PathCommand n])
parse_S = do { Text -> Parser Text
AT.string Text
"S"; [(n, n, n, n)]
t <- forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' forall {a} {b} {c} {d}.
(Fractional a, Fractional b, Fractional c, Fractional d) =>
Parser Text (a, b, c, d)
tuple4; forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall n. AbsRel -> (n, n, n, n) -> PathCommand n
S AbsRel
Abs) [(n, n, n, n)]
t) }
parse_q :: Parser Text (Maybe [PathCommand n])
parse_q = do { Text -> Parser Text
AT.string Text
"q"; [(n, n, n, n)]
t <- forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' forall {a} {b} {c} {d}.
(Fractional a, Fractional b, Fractional c, Fractional d) =>
Parser Text (a, b, c, d)
tuple4; forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall n. AbsRel -> (n, n, n, n) -> PathCommand n
Q AbsRel
Rel) [(n, n, n, n)]
t) }
parse_Q :: Parser Text (Maybe [PathCommand n])
parse_Q = do { Text -> Parser Text
AT.string Text
"Q"; [(n, n, n, n)]
t <- forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' forall {a} {b} {c} {d}.
(Fractional a, Fractional b, Fractional c, Fractional d) =>
Parser Text (a, b, c, d)
tuple4; forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall n. AbsRel -> (n, n, n, n) -> PathCommand n
Q AbsRel
Abs) [(n, n, n, n)]
t) }
parse_t :: Parser Text (Maybe [PathCommand n])
parse_t = do { Text -> Parser Text
AT.string Text
"t"; [(n, n)]
t <- forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' forall {a} {b}. (Fractional a, Fractional b) => Parser Text (a, b)
tuple2; forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall n. AbsRel -> (n, n) -> PathCommand n
T AbsRel
Rel) [(n, n)]
t) }
parse_T :: Parser Text (Maybe [PathCommand n])
parse_T = do { Text -> Parser Text
AT.string Text
"T"; [(n, n)]
t <- forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' forall {a} {b}. (Fractional a, Fractional b) => Parser Text (a, b)
tuple2; forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall n. AbsRel -> (n, n) -> PathCommand n
T AbsRel
Abs) [(n, n)]
t) }
parse_a :: Parser Text (Maybe [PathCommand n])
parse_a = do { Text -> Parser Text
AT.string Text
"a"; [(n, n, n, n, n, n, n)]
t <- forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' forall {a} {b} {c} {f} {g} {d} {e}.
(Fractional a, Fractional b, Fractional c, Fractional f,
 Fractional g, Num d, Num e) =>
Parser Text (a, b, c, d, e, f, g)
tuple7; forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall n. AbsRel -> (n, n, n, n, n, n, n) -> PathCommand n
A AbsRel
Rel) [(n, n, n, n, n, n, n)]
t) }
parse_A :: Parser Text (Maybe [PathCommand n])
parse_A = do { Text -> Parser Text
AT.string Text
"A"; [(n, n, n, n, n, n, n)]
t <- forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' forall {a} {b} {c} {f} {g} {d} {e}.
(Fractional a, Fractional b, Fractional c, Fractional f,
 Fractional g, Num d, Num e) =>
Parser Text (a, b, c, d, e, f, g)
tuple7; forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall n. AbsRel -> (n, n, n, n, n, n, n) -> PathCommand n
A AbsRel
Abs) [(n, n, n, n, n, n, n)]
t) }

-- | In SVG values can be separated with a "," but don't have to be
withOptional :: Parser Text a -> Char -> Parser Text a
withOptional Parser Text a
parser Char
a = do { Parser ()
AT.skipSpace;
                             forall (f :: * -> *) a. Alternative f => [f a] -> f a
AT.choice [ do { Char -> Parser Char
AT.char Char
a; a
b <- Parser Text a
parser; forall (m :: * -> *) a. Monad m => a -> m a
return a
b},
                                         do {            a
b <- Parser Text a
parser; forall (m :: * -> *) a. Monad m => a -> m a
return a
b} ] }

myDouble :: Parser Text Double
myDouble = forall (f :: * -> *) a. Alternative f => [f a] -> f a
AT.choice [forall {b}. Fractional b => Parser Text b
dotDouble, Parser Text Double
double]

dotDouble :: Parser Text b
dotDouble =
   do Parser ()
AT.skipSpace
      Char -> Parser Char
AT.char Char
'.'
      Integer
frac <- forall a. Integral a => Parser a
AT.decimal
      let denominator :: b
denominator = forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer
10forall a b. (Num a, Integral b) => a -> b -> a
^(forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ forall n. Integral n => n -> n -> [n]
digits Integer
10 Integer
frac))
      forall (m :: * -> *) a. Monad m => a -> m a
return ((forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
frac) forall a. Fractional a => a -> a -> a
/ forall {b}. Num b => b
denominator)

doubleWithOptional :: Char -> Parser Text b
doubleWithOptional Char
a = do { Double
d <- Parser Text Double
myDouble forall {a}. Parser Text a -> Char -> Parser Text a
`withOptional` Char
a ; forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Fractional a => Rational -> a
fromRational forall a b. (a -> b) -> a -> b
$ forall a. Real a => a -> Rational
toRational Double
d) }

spaceDouble :: Parser Text b
spaceDouble = do { Parser ()
AT.skipSpace; Double
d <- Parser Text Double
myDouble; forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Fractional a => Rational -> a
fromRational forall a b. (a -> b) -> a -> b
$ forall a. Real a => a -> Rational
toRational Double
d) }

tuple2 :: Parser Text (a, b)
tuple2 = do { a
a <- forall {b}. Fractional b => Parser Text b
spaceDouble; b
b <- forall {b}. Fractional b => Char -> Parser Text b
doubleWithOptional Char
','; forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, b
b) }

tuple4 :: Parser Text (a, b, c, d)
tuple4 = do { a
a <- forall {b}. Fractional b => Parser Text b
spaceDouble;
              b
b <- forall {b}. Fractional b => Char -> Parser Text b
doubleWithOptional Char
',';
              c
c <- forall {b}. Fractional b => Char -> Parser Text b
doubleWithOptional Char
',';
              d
d <- forall {b}. Fractional b => Char -> Parser Text b
doubleWithOptional Char
',';
              forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, b
b, c
c, d
d) }

tuple6 :: Parser Text (a, b, c, d, e, f)
tuple6 = do { a
a <- forall {b}. Fractional b => Parser Text b
spaceDouble;
              b
b <- forall {b}. Fractional b => Char -> Parser Text b
doubleWithOptional Char
',';
              c
c <- forall {b}. Fractional b => Char -> Parser Text b
doubleWithOptional Char
',';
              d
d <- forall {b}. Fractional b => Char -> Parser Text b
doubleWithOptional Char
',';
              e
e <- forall {b}. Fractional b => Char -> Parser Text b
doubleWithOptional Char
',';
              f
f <- forall {b}. Fractional b => Char -> Parser Text b
doubleWithOptional Char
','; forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, b
b, c
c, d
d, e
e, f
f) }

tuple7 :: Parser Text (a, b, c, d, e, f, g)
tuple7 = do { a
a <- forall {b}. Fractional b => Parser Text b
spaceDouble;
              b
b <- forall {b}. Fractional b => Char -> Parser Text b
doubleWithOptional Char
',';
              c
c <- forall {b}. Fractional b => Char -> Parser Text b
doubleWithOptional Char
',';
              Integer
d <- forall a. Integral a => Parser a
decimal forall {a}. Parser Text a -> Char -> Parser Text a
`withOptional` Char
',';
              Integer
e <- forall a. Integral a => Parser a
decimal forall {a}. Parser Text a -> Char -> Parser Text a
`withOptional` Char
',';
              f
f <- forall {b}. Fractional b => Char -> Parser Text b
doubleWithOptional Char
',';
              g
g <- forall {b}. Fractional b => Char -> Parser Text b
doubleWithOptional Char
',';
              forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ -- Debug.Trace.trace (show (a, b, c, fromIntegral d, fromIntegral e, f, g)) 
                       (a
a, b
b, c
c, forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
d, forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
e, f
f, g
g) }


-- | Convert a path string into path commands
commands :: (RealFloat n, Show n) => Maybe Text -> [PathCommand n]
commands :: forall n. (RealFloat n, Show n) => Maybe Text -> [PathCommand n]
commands =  forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
.
            forall a. [Maybe a] -> [a]
catMaybes forall b c a. (b -> c) -> (a -> b) -> a -> c
.
           (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const []) forall a. a -> a
id) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
           (forall a. Parser a -> Text -> Either String a
AT.parseOnly (forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' forall {n}. Fractional n => Parser Text (Maybe [PathCommand n])
parsePathCommand)) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
           (forall a. a -> Maybe a -> a
fromMaybe Text
T.empty)


-- | Convert path commands into trails
commandsToPaths :: (RealFloat n, Show n) => [PathCommand n] -> [Path V2 n]
commandsToPaths :: forall n. (RealFloat n, Show n) => [PathCommand n] -> [Path V2 n]
commandsToPaths [PathCommand n]
pathCommands = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall n.
(RealFloat n, Show n) =>
[(Path V2 n, (n, n))] -> [PathCommand n] -> [(Path V2 n, (n, n))]
outline [] (forall {n}. RealFloat n => [PathCommand n] -> [[PathCommand n]]
splittedCommands [PathCommand n]
pathCommands)


-- | split list when there is a Z(closePath) and also when there is a (M)oveto command (keep the M)
--   and merge repeated lists of single Ms into one M command
splittedCommands :: [PathCommand n] -> [[PathCommand n]]
splittedCommands [PathCommand n]
pathCommands = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a. Splitter a -> [a] -> [[a]]
S.split (forall a. Splitter a -> Splitter a
S.keepDelimsR (forall a. (a -> Bool) -> Splitter a
S.whenElt forall {n}. PathCommand n -> Bool
isZ))) forall a b. (a -> b) -> a -> b
$ -- a path ends with a Z
                                forall n. RealFloat n => [[PathCommand n]] -> [[PathCommand n]]
mergeMs forall a b. (a -> b) -> a -> b
$                                 -- now it is one M
                                forall a. Splitter a -> [a] -> [[a]]
S.split (forall a. Splitter a -> Splitter a
S.keepDelimsL (forall a. (a -> Bool) -> Splitter a
S.whenElt forall {n}. PathCommand n -> Bool
isM))   -- a path starts with Ms
                                [PathCommand n]
pathCommands
  where
    isM :: PathCommand n -> Bool
isM (M AbsRel
ar (n, n)
p) = Bool
True
    isM PathCommand n
_        = Bool
False
    isZ :: PathCommand n -> Bool
isZ PathCommand n
Z = Bool
True
    isZ PathCommand n
_ = Bool
False
    -- single Ms are a problem, because we would move something empty that we don't remember.
    mergeMs :: RealFloat n => [[PathCommand n]] -> [[PathCommand n]]
    mergeMs :: forall n. RealFloat n => [[PathCommand n]] -> [[PathCommand n]]
mergeMs ( [M AbsRel
Rel (n
x,n
y)] : ( ((M AbsRel
Rel (n
x0,n
y0)):[PathCommand n]
cs):[[PathCommand n]]
ds ) ) = forall n. RealFloat n => [[PathCommand n]] -> [[PathCommand n]]
mergeMs (((forall n. AbsRel -> (n, n) -> PathCommand n
M AbsRel
Rel (n
xforall a. Num a => a -> a -> a
+n
x0,n
yforall a. Num a => a -> a -> a
+n
y0))forall a. a -> [a] -> [a]
:[PathCommand n]
cs)forall a. a -> [a] -> [a]
:[[PathCommand n]]
ds)
    mergeMs ( [M AbsRel
Rel (n
x,n
y)] : ( ((M AbsRel
Abs (n
x0,n
y0)):[PathCommand n]
cs):[[PathCommand n]]
ds ) ) = forall n. RealFloat n => [[PathCommand n]] -> [[PathCommand n]]
mergeMs (((forall n. AbsRel -> (n, n) -> PathCommand n
M AbsRel
Abs (n
x0,    n
y0))forall a. a -> [a] -> [a]
:[PathCommand n]
cs)forall a. a -> [a] -> [a]
:[[PathCommand n]]
ds)
    mergeMs ( [M AbsRel
Abs (n
x,n
y)] : ( ((M AbsRel
Rel (n
x0,n
y0)):[PathCommand n]
cs):[[PathCommand n]]
ds ) ) = forall n. RealFloat n => [[PathCommand n]] -> [[PathCommand n]]
mergeMs (((forall n. AbsRel -> (n, n) -> PathCommand n
M AbsRel
Abs (n
xforall a. Num a => a -> a -> a
+n
x0,n
yforall a. Num a => a -> a -> a
+n
y0))forall a. a -> [a] -> [a]
:[PathCommand n]
cs)forall a. a -> [a] -> [a]
:[[PathCommand n]]
ds)
    mergeMs ( [M AbsRel
Abs (n
x,n
y)] : ( ((M AbsRel
Abs (n
x0,n
y0)):[PathCommand n]
cs):[[PathCommand n]]
ds ) ) = forall n. RealFloat n => [[PathCommand n]] -> [[PathCommand n]]
mergeMs (((forall n. AbsRel -> (n, n) -> PathCommand n
M AbsRel
Abs (n
x0,    n
y0))forall a. a -> [a] -> [a]
:[PathCommand n]
cs)forall a. a -> [a] -> [a]
:[[PathCommand n]]
ds)
    mergeMs ([PathCommand n]
c:[[PathCommand n]]
cs) = [PathCommand n]
c forall a. a -> [a] -> [a]
: (forall n. RealFloat n => [[PathCommand n]] -> [[PathCommand n]]
mergeMs [[PathCommand n]]
cs)
    mergeMs [] = []

data ClosedTrail a = O a | Closed a
isClosed :: ClosedTrail a -> Bool
isClosed (Closed a
_) = Bool
True
isClosed ClosedTrail a
_          = Bool
False

getTrail :: ClosedTrail a -> a
getTrail (Closed a
a) = a
a
getTrail (O a
a)      = a
a

-- | Take the endpoint of the latest path, append another path that has been generated from the path commands
-- and return this whole path
outline :: (RealFloat n, Show n) => [(Path V2 n, (n, n))] -> [PathCommand n] -> [(Path V2 n, (n, n))]
outline :: forall n.
(RealFloat n, Show n) =>
[(Path V2 n, (n, n))] -> [PathCommand n] -> [(Path V2 n, (n, n))]
outline [(Path V2 n, (n, n))]
paths [PathCommand n]
cs = [(Path V2 n, (n, n))]
paths forall a. [a] -> [a] -> [a]
++ [(Path V2 n
newPath,(n, n)
newPoint)]
 where
  newPath :: Path V2 n
newPath = forall t. Transformable t => Vn t -> t -> t
translate (forall n. (n, n) -> V2 n
r2 (n
trx,n
try)) forall a b. (a -> b) -> a -> b
$
            forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Trail v n -> Path v n
pathFromTrail forall a b. (a -> b) -> a -> b
$
            if forall {a}. ClosedTrail a -> Bool
isClosed ClosedTrail [Trail' Line V2 n]
trail
            then forall (v :: * -> *) n. Trail' Loop v n -> Trail v n
wrapLoop forall a b. (a -> b) -> a -> b
$ forall (v :: * -> *) n. Trail' Line v n -> Trail' Loop v n
closeLine (forall a. Monoid a => [a] -> a
mconcat (forall {a}. ClosedTrail a -> a
getTrail ClosedTrail [Trail' Line V2 n]
trail))
            else forall (v :: * -> *) n. Trail' Loop v n -> Trail v n
wrapLoop forall a b. (a -> b) -> a -> b
$ forall (v :: * -> *) n. Trail' Line v n -> Trail' Loop v n
closeLine (forall a. Monoid a => [a] -> a
mconcat (forall {a}. ClosedTrail a -> a
getTrail ClosedTrail [Trail' Line V2 n]
trail)) -- unfortunately this has to be closed also, 
                                                                 -- because some svgs fill paths that are open

  newPoint :: (n, n)
newPoint | forall {a}. ClosedTrail a -> Bool
isClosed ClosedTrail [Trail' Line V2 n]
trail = (n
trx, n
try) -- the endpoint is the old startpoint
           | Bool
otherwise      = (n, n)
startPoint

  ((n, n)
ctrlPoint, (n, n)
startPoint, ClosedTrail [Trail' Line V2 n]
trail) = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall n.
(RealFloat n, Show n) =>
((n, n), (n, n), ClosedTrail [Trail' Line V2 n])
-> PathCommand n
-> ((n, n), (n, n), ClosedTrail [Trail' Line V2 n])
nextSegment ((n
x,n
y), (n
x,n
y), forall a. a -> ClosedTrail a
O []) [PathCommand n]
cs

  (n
trx,n
try) | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PathCommand n]
cs   = (n
0,n
0)
            | Bool
otherwise = forall {a} {b} {c}. (a, b, c) -> a
sel2 forall a b. (a -> b) -> a -> b
$ forall n.
(RealFloat n, Show n) =>
((n, n), (n, n), ClosedTrail [Trail' Line V2 n])
-> PathCommand n
-> ((n, n), (n, n), ClosedTrail [Trail' Line V2 n])
nextSegment ((n
x,n
y), (n
x,n
y), forall a. a -> ClosedTrail a
O []) (forall a. [a] -> a
head [PathCommand n]
cs) -- cs usually always starts with a M-command,
                                                                            -- because we splitted the commands like that
  (n
x,n
y) | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Path V2 n, (n, n))]
paths = (n
0,n
0)
        | Bool
otherwise  = forall a b. (a, b) -> b
snd (forall a. [a] -> a
last [(Path V2 n, (n, n))]
paths)
  sel2 :: (a, b, c) -> a
sel2 (a
a,b
b,c
c) = a
a


-- | The last control point and end point of the last path are needed to calculate the next line to append
--             endpoint -> (controlPoint, startPoint, line) ->
nextSegment :: (RealFloat n, Show n) => ((n,n), (n,n), ClosedTrail [Trail' Line V2 n]) -> PathCommand n -> ( (n,n), (n,n), ClosedTrail [Trail' Line V2 n])
nextSegment :: forall n.
(RealFloat n, Show n) =>
((n, n), (n, n), ClosedTrail [Trail' Line V2 n])
-> PathCommand n
-> ((n, n), (n, n), ClosedTrail [Trail' Line V2 n])
nextSegment ((n, n)
ctrlPoint, (n, n)
startPoint, O [Trail' Line V2 n]
trail) PathCommand n
Z  = ((n, n)
ctrlPoint, (n, n)
startPoint, forall a. a -> ClosedTrail a
Closed [Trail' Line V2 n]
trail)
nextSegment ((n, n)
_, (n, n)
_,       ClosedTrail [Trail' Line V2 n]
_      ) (M AbsRel
Abs (n, n)
point) = ((n, n)
point, (n, n)
point, forall a. a -> ClosedTrail a
O [])
nextSegment ((n, n)
_, (n
x0,n
y0), ClosedTrail [Trail' Line V2 n]
_      ) (M AbsRel
Rel (n
x,n
y)) = ((n
xforall a. Num a => a -> a -> a
+n
x0, n
yforall a. Num a => a -> a -> a
+n
y0), (n
xforall a. Num a => a -> a -> a
+n
x0, n
yforall a. Num a => a -> a -> a
+n
y0), forall a. a -> ClosedTrail a
O [])
nextSegment ((n, n)
_, (n
x0,n
y0), O [Trail' Line V2 n]
trail) (L AbsRel
Abs (n
x,n
y)) = ((n
x,    n
y   ), (n
x,    n
y   ), forall a. a -> ClosedTrail a
O forall a b. (a -> b) -> a -> b
$ [Trail' Line V2 n]
trail forall a. [a] -> [a] -> [a]
++ [forall {n}. (Floating n, Ord n) => (n, n) -> Trail' Line V2 n
straight' (n
xforall a. Num a => a -> a -> a
-n
x0, n
yforall a. Num a => a -> a -> a
-n
y0)])
nextSegment ((n, n)
_, (n
x0,n
y0), O [Trail' Line V2 n]
trail) (L AbsRel
Rel (n
x,n
y)) = ((n
xforall a. Num a => a -> a -> a
+n
x0, n
yforall a. Num a => a -> a -> a
+n
y0), (n
xforall a. Num a => a -> a -> a
+n
x0, n
yforall a. Num a => a -> a -> a
+n
y0), forall a. a -> ClosedTrail a
O forall a b. (a -> b) -> a -> b
$ [Trail' Line V2 n]
trail forall a. [a] -> [a] -> [a]
++ [forall {n}. (Floating n, Ord n) => (n, n) -> Trail' Line V2 n
straight' (n
x,    n
y   )])
nextSegment ((n, n)
_, (n
x0,n
y0), O [Trail' Line V2 n]
trail) (H AbsRel
Abs n
x)     = ((n
x,      n
y0), (n
x,      n
y0), forall a. a -> ClosedTrail a
O forall a b. (a -> b) -> a -> b
$ [Trail' Line V2 n]
trail forall a. [a] -> [a] -> [a]
++ [forall {n}. (Floating n, Ord n) => (n, n) -> Trail' Line V2 n
straight' (n
xforall a. Num a => a -> a -> a
-n
x0,    n
0)])
nextSegment ((n, n)
_, (n
x0,n
y0), O [Trail' Line V2 n]
trail) (H AbsRel
Rel n
x)     = ((n
xforall a. Num a => a -> a -> a
+n
x0,   n
y0), (n
xforall a. Num a => a -> a -> a
+n
x0,   n
y0), forall a. a -> ClosedTrail a
O forall a b. (a -> b) -> a -> b
$ [Trail' Line V2 n]
trail forall a. [a] -> [a] -> [a]
++ [forall {n}. (Floating n, Ord n) => (n, n) -> Trail' Line V2 n
straight' (n
x,       n
0)])
nextSegment ((n, n)
_, (n
x0,n
y0), O [Trail' Line V2 n]
trail) (V AbsRel
Abs n
y)     = ((  n
x0, n
y   ), (  n
x0, n
y   ), forall a. a -> ClosedTrail a
O forall a b. (a -> b) -> a -> b
$ [Trail' Line V2 n]
trail forall a. [a] -> [a] -> [a]
++ [forall {n}. (Floating n, Ord n) => (n, n) -> Trail' Line V2 n
straight' (n
0 ,   n
yforall a. Num a => a -> a -> a
-n
y0)])
nextSegment ((n, n)
_, (n
x0,n
y0), O [Trail' Line V2 n]
trail) (V AbsRel
Rel n
y)     = ((  n
x0, n
yforall a. Num a => a -> a -> a
+n
y0), (  n
x0, n
yforall a. Num a => a -> a -> a
+n
y0), forall a. a -> ClosedTrail a
O forall a b. (a -> b) -> a -> b
$ [Trail' Line V2 n]
trail forall a. [a] -> [a] -> [a]
++ [forall {n}. (Floating n, Ord n) => (n, n) -> Trail' Line V2 n
straight' (n
0,    n
y   )])

nextSegment ((n, n)
_, (n
x0,n
y0), O [Trail' Line V2 n]
trail) (C AbsRel
Abs (n
x1,n
y1,n
x2,n
y2,n
x,n
y)) = ((n
x2,n
y2), (n
x,n
y), forall a. a -> ClosedTrail a
O forall a b. (a -> b) -> a -> b
$ [Trail' Line V2 n]
trail forall a. [a] -> [a] -> [a]
++ [forall {n}.
(Floating n, Ord n) =>
(n, n) -> (n, n) -> (n, n) -> Trail' Line V2 n
bez3 (n
x1forall a. Num a => a -> a -> a
-n
x0, n
y1forall a. Num a => a -> a -> a
-n
y0) (n
x2forall a. Num a => a -> a -> a
-n
x0, n
y2forall a. Num a => a -> a -> a
-n
y0) (n
xforall a. Num a => a -> a -> a
-n
x0,n
yforall a. Num a => a -> a -> a
-n
y0)])
nextSegment ((n, n)
_, (n
x0,n
y0), O [Trail' Line V2 n]
trail) (C AbsRel
Rel (n
x1,n
y1,n
x2,n
y2,n
x,n
y)) = ((n
x2forall a. Num a => a -> a -> a
+n
x0, n
y2forall a. Num a => a -> a -> a
+n
y0), (n
xforall a. Num a => a -> a -> a
+n
x0, n
yforall a. Num a => a -> a -> a
+n
y0), forall a. a -> ClosedTrail a
O forall a b. (a -> b) -> a -> b
$ [Trail' Line V2 n]
trail forall a. [a] -> [a] -> [a]
++ [forall {n}.
(Floating n, Ord n) =>
(n, n) -> (n, n) -> (n, n) -> Trail' Line V2 n
bez3 (n
x1, n
y1) (n
x2, n
y2) (n
x,n
y)])

nextSegment ((n
cx,n
cy),(n
x0,n
y0), O [Trail' Line V2 n]
trail) (S AbsRel
Abs (n
x2,n
y2,n
x,n
y)) = ((n
x2, n
y2), (n
x, n
y), forall a. a -> ClosedTrail a
O forall a b. (a -> b) -> a -> b
$ [Trail' Line V2 n]
trail forall a. [a] -> [a] -> [a]
++ [forall {n}.
(Floating n, Ord n) =>
(n, n) -> (n, n) -> (n, n) -> Trail' Line V2 n
bez3 (n
x0forall a. Num a => a -> a -> a
-n
cx, n
y0forall a. Num a => a -> a -> a
-n
cy) (n
x2forall a. Num a => a -> a -> a
-n
x0, n
y2forall a. Num a => a -> a -> a
-n
y0) (n
xforall a. Num a => a -> a -> a
-n
x0, n
yforall a. Num a => a -> a -> a
-n
y0)])
nextSegment ((n
cx,n
cy),(n
x0,n
y0), O [Trail' Line V2 n]
trail) (S AbsRel
Rel (n
x2,n
y2,n
x,n
y)) = ((n
x2forall a. Num a => a -> a -> a
+n
x0, n
y2forall a. Num a => a -> a -> a
+n
y0), (n
xforall a. Num a => a -> a -> a
+n
x0, n
yforall a. Num a => a -> a -> a
+n
y0), forall a. a -> ClosedTrail a
O forall a b. (a -> b) -> a -> b
$ [Trail' Line V2 n]
trail forall a. [a] -> [a] -> [a]
++ [forall {n}.
(Floating n, Ord n) =>
(n, n) -> (n, n) -> (n, n) -> Trail' Line V2 n
bez3 (n
x0forall a. Num a => a -> a -> a
-n
cx, n
y0forall a. Num a => a -> a -> a
-n
cy) (n
x2, n
y2) (n
x, n
y)])

nextSegment ((n, n)
_, (n
x0,n
y0), O [Trail' Line V2 n]
trail) (Q AbsRel
Abs (n
x1,n
y1,n
x,n
y)) = ((n
x1, n
y1),       (n
x, n
y), forall a. a -> ClosedTrail a
O forall a b. (a -> b) -> a -> b
$ [Trail' Line V2 n]
trail forall a. [a] -> [a] -> [a]
++ [forall {n}.
(Floating n, Ord n) =>
(n, n) -> (n, n) -> (n, n) -> Trail' Line V2 n
bez3 (n
x1forall a. Num a => a -> a -> a
-n
x0, n
y1forall a. Num a => a -> a -> a
-n
y0) (n
xforall a. Num a => a -> a -> a
-n
x0, n
yforall a. Num a => a -> a -> a
-n
y0) (n
xforall a. Num a => a -> a -> a
-n
x0, n
yforall a. Num a => a -> a -> a
-n
y0)])
nextSegment ((n, n)
_, (n
x0,n
y0), O [Trail' Line V2 n]
trail) (Q AbsRel
Rel (n
x1,n
y1,n
x,n
y)) = ((n
x1forall a. Num a => a -> a -> a
+n
x0, n
y1forall a. Num a => a -> a -> a
+n
y0), (n
xforall a. Num a => a -> a -> a
+n
x0, n
yforall a. Num a => a -> a -> a
+n
y0), forall a. a -> ClosedTrail a
O forall a b. (a -> b) -> a -> b
$ [Trail' Line V2 n]
trail forall a. [a] -> [a] -> [a]
++ [forall {n}.
(Floating n, Ord n) =>
(n, n) -> (n, n) -> (n, n) -> Trail' Line V2 n
bez3 (n
x1, n
y1) (n
x, n
y) (n
x, n
y)])

nextSegment ((n
cx,n
cy), (n
x0,n
y0), O [Trail' Line V2 n]
trail) (T AbsRel
Abs (n
x,n
y)) = ((n
2forall a. Num a => a -> a -> a
*n
x0forall a. Num a => a -> a -> a
-n
cx, n
2forall a. Num a => a -> a -> a
*n
y0forall a. Num a => a -> a -> a
-n
cy ), (n
x, n
y), forall a. a -> ClosedTrail a
O forall a b. (a -> b) -> a -> b
$ [Trail' Line V2 n]
trail forall a. [a] -> [a] -> [a]
++ [forall {n}.
(Floating n, Ord n) =>
(n, n) -> (n, n) -> (n, n) -> Trail' Line V2 n
bez3 (n
x0forall a. Num a => a -> a -> a
-n
cx, n
y0forall a. Num a => a -> a -> a
-n
cy) (n
xforall a. Num a => a -> a -> a
-n
x0, n
yforall a. Num a => a -> a -> a
-n
y0) (n
xforall a. Num a => a -> a -> a
-n
x0, n
yforall a. Num a => a -> a -> a
-n
y0)])
nextSegment ((n
cx,n
cy), (n
x0,n
y0), O [Trail' Line V2 n]
trail) (T AbsRel
Rel (n
x,n
y)) = ((n
2forall a. Num a => a -> a -> a
*n
x0forall a. Num a => a -> a -> a
-n
cx, n
2forall a. Num a => a -> a -> a
*n
y0forall a. Num a => a -> a -> a
-n
cy),  (n
x, n
y), forall a. a -> ClosedTrail a
O forall a b. (a -> b) -> a -> b
$ [Trail' Line V2 n]
trail forall a. [a] -> [a] -> [a]
++ [forall {n}.
(Floating n, Ord n) =>
(n, n) -> (n, n) -> (n, n) -> Trail' Line V2 n
bez3 (n
x0forall a. Num a => a -> a -> a
-n
cx, n
y0forall a. Num a => a -> a -> a
-n
cy) (n
x, n
y) (n
x, n
y)])

nextSegment ((n, n)
_, (n
x0,n
y0), O [Trail' Line V2 n]
trail) (A AbsRel
Abs (n
rx,n
ry,n
xAxisRot,n
fl0,n
fl1,n
x,n
y) ) = ((n
x, n
y), (n
x, n
y), forall a. a -> ClosedTrail a
O forall a b. (a -> b) -> a -> b
$ [Trail' Line V2 n]
trail forall a. [a] -> [a] -> [a]
++ [forall n.
(RealFloat n, Show n) =>
(n, n) -> n -> n -> n -> (n, n) -> Trail' Line V2 n
svgArc (n
rx,n
ry) n
xAxisRot n
fl0 n
fl1 (n
xforall a. Num a => a -> a -> a
-n
x0, n
yforall a. Num a => a -> a -> a
-n
y0)])
nextSegment ((n, n)
_, (n
x0,n
y0), O [Trail' Line V2 n]
trail) (A AbsRel
Rel (n
rx,n
ry,n
xAxisRot,n
fl0,n
fl1,n
x,n
y) ) = ((n
xforall a. Num a => a -> a -> a
+n
x0, n
yforall a. Num a => a -> a -> a
+n
y0), (n
xforall a. Num a => a -> a -> a
+n
x0, n
yforall a. Num a => a -> a -> a
+n
y0), forall a. a -> ClosedTrail a
O forall a b. (a -> b) -> a -> b
$ [Trail' Line V2 n]
trail forall a. [a] -> [a] -> [a]
++ [forall n.
(RealFloat n, Show n) =>
(n, n) -> n -> n -> n -> (n, n) -> Trail' Line V2 n
svgArc (n
rx,n
ry) n
xAxisRot n
fl0 n
fl1 (n
x, n
y)])

straight' :: (n, n) -> Trail' Line V2 n
straight' = forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
[Segment Closed v n] -> Trail' Line v n
lineFromSegments forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> [a] -> [a]
:[]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (v :: * -> *) n. v n -> Segment Closed v n
straight forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. (n, n) -> V2 n
r2

bez3 :: (n, n) -> (n, n) -> (n, n) -> Trail' Line V2 n
bez3 (n, n)
point1 (n, n)
point2 (n, n)
point3 = forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
[Segment Closed v n] -> Trail' Line v n
lineFromSegments [forall (v :: * -> *) n. v n -> v n -> v n -> Segment Closed v n
bezier3 (forall n. (n, n) -> V2 n
r2 (n, n)
point1) (forall n. (n, n) -> V2 n
r2 (n, n)
point2) (forall n. (n, n) -> V2 n
r2 (n, n)
point3)]

-- | The arc command: see <http://www.w3.org/TR/SVG11/implnote.html#ArcImplementationNotes>
-- Conversion from endpoint to center parametrization, see B.2.4
-- To Do: scale if rx,ry,xAxisRot are such that there is no solution
svgArc :: (RealFloat n, Show n) => (n, n) -> n -> n -> n -> (n,n) -> Trail' Line V2 n
svgArc :: forall n.
(RealFloat n, Show n) =>
(n, n) -> n -> n -> n -> (n, n) -> Trail' Line V2 n
svgArc (n
rxx, n
ryy) n
xAxisRot n
largeArcFlag n
sweepFlag (n
x2, n
y2)
     | n
x2 forall a. Eq a => a -> a -> Bool
== n
0 Bool -> Bool -> Bool
&& n
y2 forall a. Eq a => a -> a -> Bool
== n
0 = forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Trail' Line v n
emptyLine -- spec F6.2
     | n
rx forall a. Eq a => a -> a -> Bool
== n
0 Bool -> Bool -> Bool
|| n
ry forall a. Eq a => a -> a -> Bool
== n
0 = forall {n}. (Floating n, Ord n) => (n, n) -> Trail' Line V2 n
straight' (n
x2,n
y2) -- spec F6.2
     | Bool
otherwise = -- Debug.Trace.trace (show (dtheta) ++ show dir1) $
-- https://hackage.haskell.org/package/diagrams-lib-1.4.6/docs/Diagrams-TwoD-Arc.html
                   forall a. Located a -> a
unLoc (forall n t.
(InSpace V2 n t, OrderedField n, TrailLike t) =>
n -> Direction V2 n -> Angle n -> t
arc' n
1 Direction V2 n
dir1 (n
dtheta forall b a. b -> AReview a b -> a
@@ forall n. Iso' (Angle n) n
rad) forall a b. a -> (a -> b) -> b
# forall (v :: * -> *) n t.
(InSpace v n t, R2 v, Fractional n, Transformable t) =>
n -> t -> t
scaleY n
ry forall a b. a -> (a -> b) -> b
# forall (v :: * -> *) n t.
(InSpace v n t, R2 v, Fractional n, Transformable t) =>
n -> t -> t
scaleX n
rx forall a b. a -> (a -> b) -> b
# forall n t.
(InSpace V2 n t, Transformable t, Floating n) =>
Angle n -> t -> t
rotate (n
phi forall b a. b -> AReview a b -> a
@@ forall n. Iso' (Angle n) n
rad))
  where rx :: n
rx | n
rxx forall a. Ord a => a -> a -> Bool
< n
0   = -n
rxx  -- spec F6.2
           | Bool
otherwise =  n
rxx
        ry :: n
ry | n
ryy forall a. Ord a => a -> a -> Bool
< n
0   = -n
ryy  -- spec F6.2
           | Bool
otherwise =  n
ryy
        fa :: a
fa | n
largeArcFlag forall a. Eq a => a -> a -> Bool
== n
0 = a
0
           | Bool
otherwise         = a
1 -- spec F6.2
        fs :: a
fs | n
sweepFlag forall a. Eq a => a -> a -> Bool
== n
0 = a
0
           | Bool
otherwise      = a
1 -- spec F6.2
        phi :: n
phi = n
xAxisRot forall a. Num a => a -> a -> a
* forall a. Floating a => a
pi forall a. Fractional a => a -> a -> a
/ n
180
        (a
x1,b
y1) = (a
0,b
0)
        x1x2 :: n
x1x2 = (forall {b}. Num b => b
x1 forall a. Num a => a -> a -> a
- n
x2)forall a. Fractional a => a -> a -> a
/n
2
        y1y2 :: n
y1y2 = (forall {b}. Num b => b
y1 forall a. Num a => a -> a -> a
- n
y2)forall a. Fractional a => a -> a -> a
/n
2
        x1' :: n
x1' =  (forall a. Floating a => a -> a
cos n
phi) forall a. Num a => a -> a -> a
* n
x1x2 forall a. Num a => a -> a -> a
+ (forall a. Floating a => a -> a
sin n
phi) forall a. Num a => a -> a -> a
* n
y1y2
        y1' :: n
y1' = -(forall a. Floating a => a -> a
sin n
phi) forall a. Num a => a -> a -> a
* n
x1x2 forall a. Num a => a -> a -> a
+ (forall a. Floating a => a -> a
cos n
phi) forall a. Num a => a -> a -> a
* n
y1y2
        s :: n
s = (n
rxforall a. Num a => a -> a -> a
*n
rxforall a. Num a => a -> a -> a
*n
ryforall a. Num a => a -> a -> a
*n
ry forall a. Num a => a -> a -> a
- n
rxforall a. Num a => a -> a -> a
*n
rxforall a. Num a => a -> a -> a
*n
y1'forall a. Num a => a -> a -> a
*n
y1' forall a. Num a => a -> a -> a
- n
ryforall a. Num a => a -> a -> a
*n
ryforall a. Num a => a -> a -> a
*n
x1'forall a. Num a => a -> a -> a
*n
x1') forall a. Fractional a => a -> a -> a
/ (n
rxforall a. Num a => a -> a -> a
*n
rxforall a. Num a => a -> a -> a
*n
y1'forall a. Num a => a -> a -> a
*n
y1' forall a. Num a => a -> a -> a
+ n
ryforall a. Num a => a -> a -> a
*n
ryforall a. Num a => a -> a -> a
*n
x1'forall a. Num a => a -> a -> a
*n
x1' )
        root :: n
root | n
s forall a. Ord a => a -> a -> Bool
<= n
0 = n
0 -- Should only happen because of rounding errors, s usually being very close to 0
             | Bool
otherwise = forall a. Floating a => a -> a
sqrt n
s -- This bug happened: <https://ghc.haskell.org/trac/ghc/ticket/10010>
        cx' :: n
cx' | forall {b}. Num b => b
fa forall a. Eq a => a -> a -> Bool
/= forall {b}. Num b => b
fs  =   n
root forall a. Num a => a -> a -> a
* n
rx forall a. Num a => a -> a -> a
* n
y1' forall a. Fractional a => a -> a -> a
/ n
ry
            | Bool
otherwise = - n
root forall a. Num a => a -> a -> a
* n
rx forall a. Num a => a -> a -> a
* n
y1' forall a. Fractional a => a -> a -> a
/ n
ry
        cy' :: n
cy' | forall {b}. Num b => b
fa forall a. Eq a => a -> a -> Bool
/= forall {b}. Num b => b
fs  = - n
root forall a. Num a => a -> a -> a
* n
ry forall a. Num a => a -> a -> a
* n
x1' forall a. Fractional a => a -> a -> a
/ n
rx
            | Bool
otherwise =   n
root forall a. Num a => a -> a -> a
* n
ry forall a. Num a => a -> a -> a
* n
x1' forall a. Fractional a => a -> a -> a
/ n
rx
        cx :: n
cx = (forall a. Floating a => a -> a
cos n
phi) forall a. Num a => a -> a -> a
* n
cx' forall a. Num a => a -> a -> a
- (forall a. Floating a => a -> a
sin n
phi) forall a. Num a => a -> a -> a
* n
cy' forall a. Num a => a -> a -> a
+ ((forall {b}. Num b => b
x1forall a. Num a => a -> a -> a
+n
x2)forall a. Fractional a => a -> a -> a
/n
2)
        cy :: n
cy = (forall a. Floating a => a -> a
sin n
phi) forall a. Num a => a -> a -> a
* n
cx' forall a. Num a => a -> a -> a
+ (forall a. Floating a => a -> a
cos n
phi) forall a. Num a => a -> a -> a
* n
cy' forall a. Num a => a -> a -> a
+ ((forall {b}. Num b => b
y1forall a. Num a => a -> a -> a
+n
y2)forall a. Fractional a => a -> a -> a
/n
2)
        dir1 :: Direction V2 n
dir1 = forall (v :: * -> *) n.
(Additive v, Num n) =>
Point v n -> Point v n -> Direction v n
dirBetween forall (f :: * -> *) a. (Additive f, Num a) => Point f a
origin (forall n. (n, n) -> P2 n
p2 ((n
x1'forall a. Num a => a -> a -> a
-n
cx')forall a. Fractional a => a -> a -> a
/n
rx, (n
y1'forall a. Num a => a -> a -> a
-n
cy')forall a. Fractional a => a -> a -> a
/n
ry))
        v1 :: V2 n
v1 = forall n. (n, n) -> V2 n
r2 (( n
x1'forall a. Num a => a -> a -> a
-n
cx')forall a. Fractional a => a -> a -> a
/n
rx,  (n
y1'forall a. Num a => a -> a -> a
-n
cy')forall a. Fractional a => a -> a -> a
/n
ry)
        v2 :: V2 n
v2 = forall n. (n, n) -> V2 n
r2 ((-n
x1'forall a. Num a => a -> a -> a
-n
cx')forall a. Fractional a => a -> a -> a
/n
rx, (-n
y1'forall a. Num a => a -> a -> a
-n
cy')forall a. Fractional a => a -> a -> a
/n
ry)
        -- angleV1V2 is unfortunately necessary probably because of something like <https://ghc.haskell.org/trac/ghc/ticket/10010>
        angleV1V2 :: n
angleV1V2 | (forall (f :: * -> *) a. (Metric f, Floating a) => f a -> f a
signorm V2 n
v1 forall (f :: * -> *) a. (Metric f, Num a) => f a -> f a -> a
`dot` forall (f :: * -> *) a. (Metric f, Floating a) => f a -> f a
signorm V2 n
v2) forall a. Ord a => a -> a -> Bool
>=  n
1 = (forall n. Floating n => n -> Angle n
acosA   n
1 ) forall s a. s -> Getting a s a -> a
^. forall n. Iso' (Angle n) n
rad
                  | (forall (f :: * -> *) a. (Metric f, Floating a) => f a -> f a
signorm V2 n
v1 forall (f :: * -> *) a. (Metric f, Num a) => f a -> f a -> a
`dot` forall (f :: * -> *) a. (Metric f, Floating a) => f a -> f a
signorm V2 n
v2) forall a. Ord a => a -> a -> Bool
<= -n
1 = (forall n. Floating n => n -> Angle n
acosA (-n
1)) forall s a. s -> Getting a s a -> a
^. forall n. Iso' (Angle n) n
rad
                  | Bool
otherwise = (forall n. RealFloat n => V2 n -> V2 n -> Angle n
signedAngleBetween V2 n
v2 V2 n
v1) forall s a. s -> Getting a s a -> a
^. forall n. Iso' (Angle n) n
rad
        dtheta :: n
dtheta | forall {b}. Num b => b
fs forall a. Eq a => a -> a -> Bool
== Integer
0   = if n
angleV1V2 forall a. Ord a => a -> a -> Bool
> n
0 then n
angleV1V2 forall a. Num a => a -> a -> a
- (n
2forall a. Num a => a -> a -> a
*forall a. Floating a => a
pi) else n
angleV1V2
               | Bool
otherwise = if n
angleV1V2 forall a. Ord a => a -> a -> Bool
< n
0 then n
angleV1V2 forall a. Num a => a -> a -> a
+ (n
2forall a. Num a => a -> a -> a
*forall a. Floating a => a
pi) else n
angleV1V2