{-# 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 qualified Data.List.NonEmpty as NE
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
(Int -> AbsRel -> ShowS)
-> (AbsRel -> String) -> ([AbsRel] -> ShowS) -> Show AbsRel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AbsRel -> ShowS
showsPrec :: Int -> AbsRel -> ShowS
$cshow :: AbsRel -> String
show :: AbsRel -> String
$cshowList :: [AbsRel] -> ShowS
showList :: [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
[PathCommand n] -> ShowS
PathCommand n -> String
(Int -> PathCommand n -> ShowS)
-> (PathCommand n -> String)
-> ([PathCommand n] -> ShowS)
-> Show (PathCommand n)
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
$cshowsPrec :: forall n. Show n => Int -> PathCommand n -> ShowS
showsPrec :: Int -> PathCommand n -> ShowS
$cshow :: forall n. Show n => PathCommand n -> String
show :: PathCommand n -> String
$cshowList :: forall n. Show n => [PathCommand n] -> ShowS
showList :: [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;
                        [Parser Text (Maybe [PathCommand n])]
-> Parser Text (Maybe [PathCommand n])
forall (f :: * -> *) a. Alternative f => [f a] -> f a
AT.choice [Parser Text (Maybe [PathCommand n])
forall {n}. Fractional n => Parser Text (Maybe [PathCommand n])
parse_m, Parser Text (Maybe [PathCommand n])
forall {n}. Fractional n => Parser Text (Maybe [PathCommand n])
parse_M, Parser Text (Maybe [PathCommand n])
forall {n}. Fractional n => Parser Text (Maybe [PathCommand n])
parse_l, Parser Text (Maybe [PathCommand n])
forall {n}. Fractional n => Parser Text (Maybe [PathCommand n])
parse_L, Parser Text (Maybe [PathCommand n])
forall {n}. Fractional n => Parser Text (Maybe [PathCommand n])
parse_h, Parser Text (Maybe [PathCommand n])
forall {n}. Fractional n => Parser Text (Maybe [PathCommand n])
parse_H,
                                   Parser Text (Maybe [PathCommand n])
forall {n}. Fractional n => Parser Text (Maybe [PathCommand n])
parse_v, Parser Text (Maybe [PathCommand n])
forall {n}. Fractional n => Parser Text (Maybe [PathCommand n])
parse_V, Parser Text (Maybe [PathCommand n])
forall {n}. Fractional n => Parser Text (Maybe [PathCommand n])
parse_c, Parser Text (Maybe [PathCommand n])
forall {n}. Fractional n => Parser Text (Maybe [PathCommand n])
parse_C, Parser Text (Maybe [PathCommand n])
forall {n}. Fractional n => Parser Text (Maybe [PathCommand n])
parse_S, Parser Text (Maybe [PathCommand n])
forall {n}. Fractional n => Parser Text (Maybe [PathCommand n])
parse_s,
                                   Parser Text (Maybe [PathCommand n])
forall {n}. Fractional n => Parser Text (Maybe [PathCommand n])
parse_q, Parser Text (Maybe [PathCommand n])
forall {n}. Fractional n => Parser Text (Maybe [PathCommand n])
parse_Q, Parser Text (Maybe [PathCommand n])
forall {n}. Fractional n => Parser Text (Maybe [PathCommand n])
parse_t, Parser Text (Maybe [PathCommand n])
forall {n}. Fractional n => Parser Text (Maybe [PathCommand n])
parse_T, Parser Text (Maybe [PathCommand n])
forall {n}. Fractional n => Parser Text (Maybe [PathCommand n])
parse_a, Parser Text (Maybe [PathCommand n])
forall {n}. Fractional n => Parser Text (Maybe [PathCommand n])
parse_A, Parser Text (Maybe [PathCommand n])
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)
ht:[(n, n)]
tt) <- Parser Text (n, n) -> Parser Text [(n, n)]
forall {a}. Parser Text a -> Parser Text [a]
sepCommaSpace Parser Text (n, n)
forall {a} {b}. (Fractional a, Fractional b) => Parser Text (a, b)
tuple2; Maybe [PathCommand n] -> Parser Text (Maybe [PathCommand n])
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return ([PathCommand n] -> Maybe [PathCommand n]
forall a. a -> Maybe a
Just ([PathCommand n] -> Maybe [PathCommand n])
-> [PathCommand n] -> Maybe [PathCommand n]
forall a b. (a -> b) -> a -> b
$ (AbsRel -> (n, n) -> PathCommand n
forall n. AbsRel -> (n, n) -> PathCommand n
M AbsRel
Rel (n, n)
ht)PathCommand n -> [PathCommand n] -> [PathCommand n]
forall a. a -> [a] -> [a]
: (((n, n) -> PathCommand n) -> [(n, n)] -> [PathCommand n]
forall a b. (a -> b) -> [a] -> [b]
map (AbsRel -> (n, n) -> PathCommand n
forall n. AbsRel -> (n, n) -> PathCommand n
L AbsRel
Rel) [(n, n)]
tt) ) } -- 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 <- Parser Text (n, n) -> Parser Text [(n, n)]
forall {a}. Parser Text a -> Parser Text [a]
sepCommaSpace Parser Text (n, n)
forall {a} {b}. (Fractional a, Fractional b) => Parser Text (a, b)
tuple2; Maybe [PathCommand n] -> Parser Text (Maybe [PathCommand n])
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return ([PathCommand n] -> Maybe [PathCommand n]
forall a. a -> Maybe a
Just ([PathCommand n] -> Maybe [PathCommand n])
-> [PathCommand n] -> Maybe [PathCommand n]
forall a b. (a -> b) -> a -> b
$ ((n, n) -> PathCommand n) -> [(n, n)] -> [PathCommand n]
forall a b. (a -> b) -> [a] -> [b]
map (AbsRel -> (n, n) -> PathCommand n
forall n. AbsRel -> (n, n) -> PathCommand n
M AbsRel
Abs) [(n, n)]
t) }
parse_z :: Parser Text (Maybe [PathCommand n])
parse_z = do { [Parser Text] -> Parser Text
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"]; Maybe [PathCommand n] -> Parser Text (Maybe [PathCommand n])
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return ([PathCommand n] -> Maybe [PathCommand n]
forall a. a -> Maybe a
Just [PathCommand n
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 <- Parser Text (n, n) -> Parser Text [(n, n)]
forall {a}. Parser Text a -> Parser Text [a]
sepCommaSpace Parser Text (n, n)
forall {a} {b}. (Fractional a, Fractional b) => Parser Text (a, b)
tuple2; Maybe [PathCommand n] -> Parser Text (Maybe [PathCommand n])
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return ([PathCommand n] -> Maybe [PathCommand n]
forall a. a -> Maybe a
Just ([PathCommand n] -> Maybe [PathCommand n])
-> [PathCommand n] -> Maybe [PathCommand n]
forall a b. (a -> b) -> a -> b
$ ((n, n) -> PathCommand n) -> [(n, n)] -> [PathCommand n]
forall a b. (a -> b) -> [a] -> [b]
map (AbsRel -> (n, n) -> PathCommand n
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 <- Parser Text (n, n) -> Parser Text [(n, n)]
forall {a}. Parser Text a -> Parser Text [a]
sepCommaSpace Parser Text (n, n)
forall {a} {b}. (Fractional a, Fractional b) => Parser Text (a, b)
tuple2; Maybe [PathCommand n] -> Parser Text (Maybe [PathCommand n])
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return ([PathCommand n] -> Maybe [PathCommand n]
forall a. a -> Maybe a
Just ([PathCommand n] -> Maybe [PathCommand n])
-> [PathCommand n] -> Maybe [PathCommand n]
forall a b. (a -> b) -> a -> b
$ ((n, n) -> PathCommand n) -> [(n, n)] -> [PathCommand n]
forall a b. (a -> b) -> [a] -> [b]
map (AbsRel -> (n, n) -> PathCommand n
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 <- Parser Text a -> Parser Text [a]
forall {a}. Parser Text a -> Parser Text [a]
sepCommaSpace Parser Text a
forall {b}. Fractional b => Parser Text b
spaceDouble; Maybe [PathCommand a] -> Parser Text (Maybe [PathCommand a])
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return ([PathCommand a] -> Maybe [PathCommand a]
forall a. a -> Maybe a
Just ([PathCommand a] -> Maybe [PathCommand a])
-> [PathCommand a] -> Maybe [PathCommand a]
forall a b. (a -> b) -> a -> b
$ (a -> PathCommand a) -> [a] -> [PathCommand a]
forall a b. (a -> b) -> [a] -> [b]
map (AbsRel -> a -> PathCommand a
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 <- Parser Text a -> Parser Text [a]
forall {a}. Parser Text a -> Parser Text [a]
sepCommaSpace Parser Text a
forall {b}. Fractional b => Parser Text b
spaceDouble; Maybe [PathCommand a] -> Parser Text (Maybe [PathCommand a])
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return ([PathCommand a] -> Maybe [PathCommand a]
forall a. a -> Maybe a
Just ([PathCommand a] -> Maybe [PathCommand a])
-> [PathCommand a] -> Maybe [PathCommand a]
forall a b. (a -> b) -> a -> b
$ (a -> PathCommand a) -> [a] -> [PathCommand a]
forall a b. (a -> b) -> [a] -> [b]
map (AbsRel -> a -> PathCommand a
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 <- Parser Text a -> Parser Text [a]
forall {a}. Parser Text a -> Parser Text [a]
sepCommaSpace Parser Text a
forall {b}. Fractional b => Parser Text b
spaceDouble; Maybe [PathCommand a] -> Parser Text (Maybe [PathCommand a])
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return ([PathCommand a] -> Maybe [PathCommand a]
forall a. a -> Maybe a
Just ([PathCommand a] -> Maybe [PathCommand a])
-> [PathCommand a] -> Maybe [PathCommand a]
forall a b. (a -> b) -> a -> b
$ (a -> PathCommand a) -> [a] -> [PathCommand a]
forall a b. (a -> b) -> [a] -> [b]
map (AbsRel -> a -> PathCommand a
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 <- Parser Text a -> Parser Text [a]
forall {a}. Parser Text a -> Parser Text [a]
sepCommaSpace Parser Text a
forall {b}. Fractional b => Parser Text b
spaceDouble; Maybe [PathCommand a] -> Parser Text (Maybe [PathCommand a])
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return ([PathCommand a] -> Maybe [PathCommand a]
forall a. a -> Maybe a
Just ([PathCommand a] -> Maybe [PathCommand a])
-> [PathCommand a] -> Maybe [PathCommand a]
forall a b. (a -> b) -> a -> b
$ (a -> PathCommand a) -> [a] -> [PathCommand a]
forall a b. (a -> b) -> [a] -> [b]
map (AbsRel -> a -> PathCommand a
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 <- Parser Text (n, n, n, n, n, n) -> Parser Text [(n, n, n, n, n, n)]
forall {a}. Parser Text a -> Parser Text [a]
sepCommaSpace Parser Text (n, n, n, n, n, n)
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; Maybe [PathCommand n] -> Parser Text (Maybe [PathCommand n])
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return ([PathCommand n] -> Maybe [PathCommand n]
forall a. a -> Maybe a
Just ([PathCommand n] -> Maybe [PathCommand n])
-> [PathCommand n] -> Maybe [PathCommand n]
forall a b. (a -> b) -> a -> b
$ ((n, n, n, n, n, n) -> PathCommand n)
-> [(n, n, n, n, n, n)] -> [PathCommand n]
forall a b. (a -> b) -> [a] -> [b]
map (AbsRel -> (n, n, n, n, n, n) -> PathCommand n
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 <- Parser Text (n, n, n, n, n, n) -> Parser Text [(n, n, n, n, n, n)]
forall {a}. Parser Text a -> Parser Text [a]
sepCommaSpace Parser Text (n, n, n, n, n, n)
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; Maybe [PathCommand n] -> Parser Text (Maybe [PathCommand n])
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return ([PathCommand n] -> Maybe [PathCommand n]
forall a. a -> Maybe a
Just ([PathCommand n] -> Maybe [PathCommand n])
-> [PathCommand n] -> Maybe [PathCommand n]
forall a b. (a -> b) -> a -> b
$ ((n, n, n, n, n, n) -> PathCommand n)
-> [(n, n, n, n, n, n)] -> [PathCommand n]
forall a b. (a -> b) -> [a] -> [b]
map (AbsRel -> (n, n, n, n, n, n) -> PathCommand n
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 <- Parser Text (n, n, n, n) -> Parser Text [(n, n, n, n)]
forall {a}. Parser Text a -> Parser Text [a]
sepCommaSpace Parser Text (n, n, n, n)
forall {a} {b} {c} {d}.
(Fractional a, Fractional b, Fractional c, Fractional d) =>
Parser Text (a, b, c, d)
tuple4; Maybe [PathCommand n] -> Parser Text (Maybe [PathCommand n])
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return ([PathCommand n] -> Maybe [PathCommand n]
forall a. a -> Maybe a
Just ([PathCommand n] -> Maybe [PathCommand n])
-> [PathCommand n] -> Maybe [PathCommand n]
forall a b. (a -> b) -> a -> b
$ ((n, n, n, n) -> PathCommand n)
-> [(n, n, n, n)] -> [PathCommand n]
forall a b. (a -> b) -> [a] -> [b]
map (AbsRel -> (n, n, n, n) -> PathCommand n
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 <- Parser Text (n, n, n, n) -> Parser Text [(n, n, n, n)]
forall {a}. Parser Text a -> Parser Text [a]
sepCommaSpace Parser Text (n, n, n, n)
forall {a} {b} {c} {d}.
(Fractional a, Fractional b, Fractional c, Fractional d) =>
Parser Text (a, b, c, d)
tuple4; Maybe [PathCommand n] -> Parser Text (Maybe [PathCommand n])
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return ([PathCommand n] -> Maybe [PathCommand n]
forall a. a -> Maybe a
Just ([PathCommand n] -> Maybe [PathCommand n])
-> [PathCommand n] -> Maybe [PathCommand n]
forall a b. (a -> b) -> a -> b
$ ((n, n, n, n) -> PathCommand n)
-> [(n, n, n, n)] -> [PathCommand n]
forall a b. (a -> b) -> [a] -> [b]
map (AbsRel -> (n, n, n, n) -> PathCommand n
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 <- Parser Text (n, n, n, n) -> Parser Text [(n, n, n, n)]
forall {a}. Parser Text a -> Parser Text [a]
sepCommaSpace Parser Text (n, n, n, n)
forall {a} {b} {c} {d}.
(Fractional a, Fractional b, Fractional c, Fractional d) =>
Parser Text (a, b, c, d)
tuple4; Maybe [PathCommand n] -> Parser Text (Maybe [PathCommand n])
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return ([PathCommand n] -> Maybe [PathCommand n]
forall a. a -> Maybe a
Just ([PathCommand n] -> Maybe [PathCommand n])
-> [PathCommand n] -> Maybe [PathCommand n]
forall a b. (a -> b) -> a -> b
$ ((n, n, n, n) -> PathCommand n)
-> [(n, n, n, n)] -> [PathCommand n]
forall a b. (a -> b) -> [a] -> [b]
map (AbsRel -> (n, n, n, n) -> PathCommand n
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 <- Parser Text (n, n, n, n) -> Parser Text [(n, n, n, n)]
forall {a}. Parser Text a -> Parser Text [a]
sepCommaSpace Parser Text (n, n, n, n)
forall {a} {b} {c} {d}.
(Fractional a, Fractional b, Fractional c, Fractional d) =>
Parser Text (a, b, c, d)
tuple4; Maybe [PathCommand n] -> Parser Text (Maybe [PathCommand n])
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return ([PathCommand n] -> Maybe [PathCommand n]
forall a. a -> Maybe a
Just ([PathCommand n] -> Maybe [PathCommand n])
-> [PathCommand n] -> Maybe [PathCommand n]
forall a b. (a -> b) -> a -> b
$ ((n, n, n, n) -> PathCommand n)
-> [(n, n, n, n)] -> [PathCommand n]
forall a b. (a -> b) -> [a] -> [b]
map (AbsRel -> (n, n, n, n) -> PathCommand n
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 <- Parser Text (n, n) -> Parser Text [(n, n)]
forall {a}. Parser Text a -> Parser Text [a]
sepCommaSpace Parser Text (n, n)
forall {a} {b}. (Fractional a, Fractional b) => Parser Text (a, b)
tuple2; Maybe [PathCommand n] -> Parser Text (Maybe [PathCommand n])
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return ([PathCommand n] -> Maybe [PathCommand n]
forall a. a -> Maybe a
Just ([PathCommand n] -> Maybe [PathCommand n])
-> [PathCommand n] -> Maybe [PathCommand n]
forall a b. (a -> b) -> a -> b
$ ((n, n) -> PathCommand n) -> [(n, n)] -> [PathCommand n]
forall a b. (a -> b) -> [a] -> [b]
map (AbsRel -> (n, n) -> PathCommand n
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 <- Parser Text (n, n) -> Parser Text [(n, n)]
forall {a}. Parser Text a -> Parser Text [a]
sepCommaSpace Parser Text (n, n)
forall {a} {b}. (Fractional a, Fractional b) => Parser Text (a, b)
tuple2; Maybe [PathCommand n] -> Parser Text (Maybe [PathCommand n])
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return ([PathCommand n] -> Maybe [PathCommand n]
forall a. a -> Maybe a
Just ([PathCommand n] -> Maybe [PathCommand n])
-> [PathCommand n] -> Maybe [PathCommand n]
forall a b. (a -> b) -> a -> b
$ ((n, n) -> PathCommand n) -> [(n, n)] -> [PathCommand n]
forall a b. (a -> b) -> [a] -> [b]
map (AbsRel -> (n, n) -> PathCommand n
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 <- Parser Text (n, n, n, n, n, n, n)
-> Parser Text [(n, n, n, n, n, n, n)]
forall {a}. Parser Text a -> Parser Text [a]
sepCommaSpace Parser Text (n, n, n, n, n, n, n)
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; Maybe [PathCommand n] -> Parser Text (Maybe [PathCommand n])
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return ([PathCommand n] -> Maybe [PathCommand n]
forall a. a -> Maybe a
Just ([PathCommand n] -> Maybe [PathCommand n])
-> [PathCommand n] -> Maybe [PathCommand n]
forall a b. (a -> b) -> a -> b
$ ((n, n, n, n, n, n, n) -> PathCommand n)
-> [(n, n, n, n, n, n, n)] -> [PathCommand n]
forall a b. (a -> b) -> [a] -> [b]
map (AbsRel -> (n, n, n, n, n, n, n) -> PathCommand n
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 <- Parser Text (n, n, n, n, n, n, n)
-> Parser Text [(n, n, n, n, n, n, n)]
forall {a}. Parser Text a -> Parser Text [a]
sepCommaSpace Parser Text (n, n, n, n, n, n, n)
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; Maybe [PathCommand n] -> Parser Text (Maybe [PathCommand n])
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return ([PathCommand n] -> Maybe [PathCommand n]
forall a. a -> Maybe a
Just ([PathCommand n] -> Maybe [PathCommand n])
-> [PathCommand n] -> Maybe [PathCommand n]
forall a b. (a -> b) -> a -> b
$ ((n, n, n, n, n, n, n) -> PathCommand n)
-> [(n, n, n, n, n, n, n)] -> [PathCommand n]
forall a b. (a -> b) -> [a] -> [b]
map (AbsRel -> (n, n, n, n, n, n, n) -> PathCommand n
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;
                             [Parser Text a] -> Parser Text a
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; a -> Parser Text a
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return a
b},
                                         do {            a
b <- Parser Text a
parser; a -> Parser Text a
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return a
b} ] }

sepCommaSpace :: Parser Text a -> Parser Text [a]
sepCommaSpace Parser Text a
p = Parser Text a
p Parser Text a -> Parser () -> Parser Text [a]
forall (m :: * -> *) a s. MonadPlus m => m a -> m s -> m [a]
`AT.sepBy'` (Parser () -> Char -> Parser ()
forall {a}. Parser Text a -> Char -> Parser Text a
withOptional Parser ()
AT.skipSpace Char
',')

myDouble :: Parser Text Double
myDouble = [Parser Text Double] -> Parser Text Double
forall (f :: * -> *) a. Alternative f => [f a] -> f a
AT.choice [Parser Text Double
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 <- 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 a. [a] -> 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 a. a -> Parser Text a
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
forall {b}. Num b => b
denominator)

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

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

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

tuple4 :: Parser Text (a, b, c, d)
tuple4 = do { a
a <- Parser Text a
forall {b}. Fractional b => Parser Text b
spaceDouble;
              b
b <- Char -> Parser Text b
forall {b}. Fractional b => Char -> Parser Text b
doubleWithOptional Char
',';
              c
c <- Char -> Parser Text c
forall {b}. Fractional b => Char -> Parser Text b
doubleWithOptional Char
',';
              d
d <- Char -> Parser Text d
forall {b}. Fractional b => Char -> Parser Text b
doubleWithOptional Char
',';
              (a, b, c, d) -> Parser Text (a, b, c, d)
forall a. a -> Parser Text a
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 <- Parser Text a
forall {b}. Fractional b => Parser Text b
spaceDouble;
              b
b <- Char -> Parser Text b
forall {b}. Fractional b => Char -> Parser Text b
doubleWithOptional Char
',';
              c
c <- Char -> Parser Text c
forall {b}. Fractional b => Char -> Parser Text b
doubleWithOptional Char
',';
              d
d <- Char -> Parser Text d
forall {b}. Fractional b => Char -> Parser Text b
doubleWithOptional Char
',';
              e
e <- Char -> Parser Text e
forall {b}. Fractional b => Char -> Parser Text b
doubleWithOptional Char
',';
              f
f <- Char -> Parser Text f
forall {b}. Fractional b => Char -> Parser Text b
doubleWithOptional Char
','; (a, b, c, d, e, f) -> Parser Text (a, b, c, d, e, f)
forall a. a -> Parser Text a
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 <- Parser Text a
forall {b}. Fractional b => Parser Text b
spaceDouble;
              b
b <- Char -> Parser Text b
forall {b}. Fractional b => Char -> Parser Text b
doubleWithOptional Char
',';
              c
c <- Char -> Parser Text c
forall {b}. Fractional b => Char -> Parser Text b
doubleWithOptional Char
',';
              Integer
d <- Parser Integer
forall a. Integral a => Parser a
decimal Parser Integer -> Char -> Parser Integer
forall {a}. Parser Text a -> Char -> Parser Text a
`withOptional` Char
',';
              Integer
e <- Parser Integer
forall a. Integral a => Parser a
decimal Parser Integer -> Char -> Parser Integer
forall {a}. Parser Text a -> Char -> Parser Text a
`withOptional` Char
',';
              f
f <- Char -> Parser Text f
forall {b}. Fractional b => Char -> Parser Text b
doubleWithOptional Char
',';
              g
g <- Char -> Parser Text g
forall {b}. Fractional b => Char -> Parser Text b
doubleWithOptional Char
',';
              (a, b, c, d, e, f, g) -> Parser Text (a, b, c, d, e, f, g)
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return ((a, b, c, d, e, f, g) -> Parser Text (a, b, c, d, e, f, g))
-> (a, b, c, d, e, f, g) -> Parser Text (a, b, c, d, e, f, g)
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, Integer -> d
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
d, Integer -> e
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 =  [[PathCommand n]] -> [PathCommand n]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[PathCommand n]] -> [PathCommand n])
-> (Maybe Text -> [[PathCommand n]])
-> Maybe Text
-> [PathCommand n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
            [Maybe [PathCommand n]] -> [[PathCommand n]]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe [PathCommand n]] -> [[PathCommand n]])
-> (Maybe Text -> [Maybe [PathCommand n]])
-> Maybe Text
-> [[PathCommand n]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
           ((String -> [Maybe [PathCommand n]])
-> ([Maybe [PathCommand n]] -> [Maybe [PathCommand n]])
-> Either String [Maybe [PathCommand n]]
-> [Maybe [PathCommand n]]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ([Maybe [PathCommand n]] -> String -> [Maybe [PathCommand n]]
forall a b. a -> b -> a
const []) [Maybe [PathCommand n]] -> [Maybe [PathCommand n]]
forall a. a -> a
id) (Either String [Maybe [PathCommand n]] -> [Maybe [PathCommand n]])
-> (Maybe Text -> Either String [Maybe [PathCommand n]])
-> Maybe Text
-> [Maybe [PathCommand n]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
           (Parser [Maybe [PathCommand n]]
-> Text -> Either String [Maybe [PathCommand n]]
forall a. Parser a -> Text -> Either String a
AT.parseOnly (Parser Text (Maybe [PathCommand n])
-> Parser [Maybe [PathCommand n]]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' Parser Text (Maybe [PathCommand n])
forall {n}. Fractional n => Parser Text (Maybe [PathCommand n])
parsePathCommand)) (Text -> Either String [Maybe [PathCommand n]])
-> (Maybe Text -> Text)
-> Maybe Text
-> Either String [Maybe [PathCommand n]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
           (Text -> Maybe Text -> Text
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 = ((Path V2 n, (n, n)) -> Path V2 n)
-> [(Path V2 n, (n, n))] -> [Path V2 n]
forall a b. (a -> b) -> [a] -> [b]
map (Path V2 n, (n, n)) -> Path V2 n
forall a b. (a, b) -> a
fst ([(Path V2 n, (n, n))] -> [Path V2 n])
-> [(Path V2 n, (n, n))] -> [Path V2 n]
forall a b. (a -> b) -> a -> b
$ ([(Path V2 n, (n, n))] -> [PathCommand n] -> [(Path V2 n, (n, n))])
-> [(Path V2 n, (n, n))]
-> [[PathCommand n]]
-> [(Path V2 n, (n, n))]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' [(Path V2 n, (n, n))] -> [PathCommand n] -> [(Path V2 n, (n, n))]
forall n.
(RealFloat n, Show n) =>
[(Path V2 n, (n, n))] -> [PathCommand n] -> [(Path V2 n, (n, n))]
outline [] ([PathCommand n] -> [[PathCommand n]]
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 = [[[PathCommand n]]] -> [[PathCommand n]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[[PathCommand n]]] -> [[PathCommand n]])
-> [[[PathCommand n]]] -> [[PathCommand n]]
forall a b. (a -> b) -> a -> b
$ ([PathCommand n] -> [[PathCommand n]])
-> [[PathCommand n]] -> [[[PathCommand n]]]
forall a b. (a -> b) -> [a] -> [b]
map (Splitter (PathCommand n) -> [PathCommand n] -> [[PathCommand n]]
forall a. Splitter a -> [a] -> [[a]]
S.split (Splitter (PathCommand n) -> Splitter (PathCommand n)
forall a. Splitter a -> Splitter a
S.keepDelimsR ((PathCommand n -> Bool) -> Splitter (PathCommand n)
forall a. (a -> Bool) -> Splitter a
S.whenElt PathCommand n -> Bool
forall {n}. PathCommand n -> Bool
isZ))) ([[PathCommand n]] -> [[[PathCommand n]]])
-> [[PathCommand n]] -> [[[PathCommand n]]]
forall a b. (a -> b) -> a -> b
$ -- a path ends with a Z
                                [[PathCommand n]] -> [[PathCommand n]]
forall n. RealFloat n => [[PathCommand n]] -> [[PathCommand n]]
mergeMs ([[PathCommand n]] -> [[PathCommand n]])
-> [[PathCommand n]] -> [[PathCommand n]]
forall a b. (a -> b) -> a -> b
$                                 -- now it is one M
                                Splitter (PathCommand n) -> [PathCommand n] -> [[PathCommand n]]
forall a. Splitter a -> [a] -> [[a]]
S.split (Splitter (PathCommand n) -> Splitter (PathCommand n)
forall a. Splitter a -> Splitter a
S.keepDelimsL ((PathCommand n -> Bool) -> Splitter (PathCommand n)
forall a. (a -> Bool) -> Splitter a
S.whenElt PathCommand n -> Bool
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 ) ) = [[PathCommand n]] -> [[PathCommand n]]
forall n. RealFloat n => [[PathCommand n]] -> [[PathCommand n]]
mergeMs (((AbsRel -> (n, n) -> PathCommand n
forall n. AbsRel -> (n, n) -> PathCommand n
M AbsRel
Rel (n
xn -> n -> n
forall a. Num a => a -> a -> a
+n
x0,n
yn -> n -> n
forall a. Num a => a -> a -> a
+n
y0))PathCommand n -> [PathCommand n] -> [PathCommand n]
forall a. a -> [a] -> [a]
:[PathCommand n]
cs)[PathCommand n] -> [[PathCommand n]] -> [[PathCommand n]]
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 ) ) = [[PathCommand n]] -> [[PathCommand n]]
forall n. RealFloat n => [[PathCommand n]] -> [[PathCommand n]]
mergeMs (((AbsRel -> (n, n) -> PathCommand n
forall n. AbsRel -> (n, n) -> PathCommand n
M AbsRel
Abs (n
x0,    n
y0))PathCommand n -> [PathCommand n] -> [PathCommand n]
forall a. a -> [a] -> [a]
:[PathCommand n]
cs)[PathCommand n] -> [[PathCommand n]] -> [[PathCommand n]]
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 ) ) = [[PathCommand n]] -> [[PathCommand n]]
forall n. RealFloat n => [[PathCommand n]] -> [[PathCommand n]]
mergeMs (((AbsRel -> (n, n) -> PathCommand n
forall n. AbsRel -> (n, n) -> PathCommand n
M AbsRel
Abs (n
xn -> n -> n
forall a. Num a => a -> a -> a
+n
x0,n
yn -> n -> n
forall a. Num a => a -> a -> a
+n
y0))PathCommand n -> [PathCommand n] -> [PathCommand n]
forall a. a -> [a] -> [a]
:[PathCommand n]
cs)[PathCommand n] -> [[PathCommand n]] -> [[PathCommand n]]
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 ) ) = [[PathCommand n]] -> [[PathCommand n]]
forall n. RealFloat n => [[PathCommand n]] -> [[PathCommand n]]
mergeMs (((AbsRel -> (n, n) -> PathCommand n
forall n. AbsRel -> (n, n) -> PathCommand n
M AbsRel
Abs (n
x0,    n
y0))PathCommand n -> [PathCommand n] -> [PathCommand n]
forall a. a -> [a] -> [a]
:[PathCommand n]
cs)[PathCommand n] -> [[PathCommand n]] -> [[PathCommand n]]
forall a. a -> [a] -> [a]
:[[PathCommand n]]
ds)
    mergeMs ([PathCommand n]
c:[[PathCommand n]]
cs) = [PathCommand n]
c [PathCommand n] -> [[PathCommand n]] -> [[PathCommand n]]
forall a. a -> [a] -> [a]
: ([[PathCommand n]] -> [[PathCommand n]]
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 [(Path V2 n, (n, n))]
-> [(Path V2 n, (n, n))] -> [(Path V2 n, (n, n))]
forall a. [a] -> [a] -> [a]
++ [(Path V2 n
newPath,(n, n)
newPoint)]
 where
  newPath :: Path V2 n
newPath = Vn (Path V2 n) -> Path V2 n -> Path V2 n
forall t. Transformable t => Vn t -> t -> t
translate ((n, n) -> V2 n
forall n. (n, n) -> V2 n
r2 (n
trx,n
try)) (Path V2 n -> Path V2 n) -> Path V2 n -> Path V2 n
forall a b. (a -> b) -> a -> b
$
            Trail V2 n -> Path V2 n
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Trail v n -> Path v n
pathFromTrail (Trail V2 n -> Path V2 n) -> Trail V2 n -> Path V2 n
forall a b. (a -> b) -> a -> b
$
            if ClosedTrail [Trail' Line V2 n] -> Bool
forall {a}. ClosedTrail a -> Bool
isClosed ClosedTrail [Trail' Line V2 n]
trail
            then Trail' Loop V2 n -> Trail V2 n
forall (v :: * -> *) n. Trail' Loop v n -> Trail v n
wrapLoop (Trail' Loop V2 n -> Trail V2 n) -> Trail' Loop V2 n -> Trail V2 n
forall a b. (a -> b) -> a -> b
$ Trail' Line V2 n -> Trail' Loop V2 n
forall (v :: * -> *) n. Trail' Line v n -> Trail' Loop v n
closeLine ([Trail' Line V2 n] -> Trail' Line V2 n
forall a. Monoid a => [a] -> a
mconcat (ClosedTrail [Trail' Line V2 n] -> [Trail' Line V2 n]
forall {a}. ClosedTrail a -> a
getTrail ClosedTrail [Trail' Line V2 n]
trail))
            else Trail' Loop V2 n -> Trail V2 n
forall (v :: * -> *) n. Trail' Loop v n -> Trail v n
wrapLoop (Trail' Loop V2 n -> Trail V2 n) -> Trail' Loop V2 n -> Trail V2 n
forall a b. (a -> b) -> a -> b
$ Trail' Line V2 n -> Trail' Loop V2 n
forall (v :: * -> *) n. Trail' Line v n -> Trail' Loop v n
closeLine ([Trail' Line V2 n] -> Trail' Line V2 n
forall a. Monoid a => [a] -> a
mconcat (ClosedTrail [Trail' Line V2 n] -> [Trail' Line V2 n]
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 | ClosedTrail [Trail' Line V2 n] -> Bool
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) = (((n, n), (n, n), ClosedTrail [Trail' Line V2 n])
 -> PathCommand n
 -> ((n, n), (n, n), ClosedTrail [Trail' Line V2 n]))
-> ((n, n), (n, n), ClosedTrail [Trail' Line V2 n])
-> [PathCommand n]
-> ((n, n), (n, n), ClosedTrail [Trail' Line V2 n])
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((n, n), (n, n), ClosedTrail [Trail' Line V2 n])
-> PathCommand n
-> ((n, n), (n, n), ClosedTrail [Trail' Line V2 n])
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), [Trail' Line V2 n] -> ClosedTrail [Trail' Line V2 n]
forall a. a -> ClosedTrail a
O []) [PathCommand n]
cs

  (n
trx,n
try) = case [PathCommand n]
cs of
    [] -> (n
0,n
0)
    (PathCommand n
c:[PathCommand n]
_) -> ((n, n), (n, n), ClosedTrail [Trail' Line V2 n]) -> (n, n)
forall {a} {b} {c}. (a, b, c) -> a
sel2 (((n, n), (n, n), ClosedTrail [Trail' Line V2 n]) -> (n, n))
-> ((n, n), (n, n), ClosedTrail [Trail' Line V2 n]) -> (n, n)
forall a b. (a -> b) -> a -> b
$ ((n, n), (n, n), ClosedTrail [Trail' Line V2 n])
-> PathCommand n
-> ((n, n), (n, n), ClosedTrail [Trail' Line V2 n])
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), [Trail' Line V2 n] -> ClosedTrail [Trail' Line V2 n]
forall a. a -> ClosedTrail a
O []) PathCommand n
c -- cs usually always starts with a M-command,
                                                       -- because we splitted the commands like that
  (n
x,n
y) = case [(Path V2 n, (n, n))] -> Maybe (NonEmpty (Path V2 n, (n, n)))
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [(Path V2 n, (n, n))]
paths of
    Maybe (NonEmpty (Path V2 n, (n, n)))
Nothing -> (n
0,n
0)
    Just NonEmpty (Path V2 n, (n, n))
nePaths -> (Path V2 n, (n, n)) -> (n, n)
forall a b. (a, b) -> b
snd (NonEmpty (Path V2 n, (n, n)) -> (Path V2 n, (n, n))
forall a. NonEmpty a -> a
NE.last NonEmpty (Path V2 n, (n, n))
nePaths)

  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, [Trail' Line V2 n] -> ClosedTrail [Trail' Line V2 n]
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, [Trail' Line V2 n] -> ClosedTrail [Trail' Line V2 n]
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
xn -> n -> n
forall a. Num a => a -> a -> a
+n
x0, n
yn -> n -> n
forall a. Num a => a -> a -> a
+n
y0), (n
xn -> n -> n
forall a. Num a => a -> a -> a
+n
x0, n
yn -> n -> n
forall a. Num a => a -> a -> a
+n
y0), [Trail' Line V2 n] -> ClosedTrail [Trail' Line V2 n]
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   ), [Trail' Line V2 n] -> ClosedTrail [Trail' Line V2 n]
forall a. a -> ClosedTrail a
O ([Trail' Line V2 n] -> ClosedTrail [Trail' Line V2 n])
-> [Trail' Line V2 n] -> ClosedTrail [Trail' Line V2 n]
forall a b. (a -> b) -> a -> b
$ [Trail' Line V2 n]
trail [Trail' Line V2 n] -> [Trail' Line V2 n] -> [Trail' Line V2 n]
forall a. [a] -> [a] -> [a]
++ [(n, n) -> Trail' Line V2 n
forall {n}. (Floating n, Ord n) => (n, n) -> Trail' Line V2 n
straight' (n
xn -> n -> n
forall a. Num a => a -> a -> a
-n
x0, n
yn -> n -> n
forall 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
xn -> n -> n
forall a. Num a => a -> a -> a
+n
x0, n
yn -> n -> n
forall a. Num a => a -> a -> a
+n
y0), (n
xn -> n -> n
forall a. Num a => a -> a -> a
+n
x0, n
yn -> n -> n
forall a. Num a => a -> a -> a
+n
y0), [Trail' Line V2 n] -> ClosedTrail [Trail' Line V2 n]
forall a. a -> ClosedTrail a
O ([Trail' Line V2 n] -> ClosedTrail [Trail' Line V2 n])
-> [Trail' Line V2 n] -> ClosedTrail [Trail' Line V2 n]
forall a b. (a -> b) -> a -> b
$ [Trail' Line V2 n]
trail [Trail' Line V2 n] -> [Trail' Line V2 n] -> [Trail' Line V2 n]
forall a. [a] -> [a] -> [a]
++ [(n, n) -> Trail' Line V2 n
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), [Trail' Line V2 n] -> ClosedTrail [Trail' Line V2 n]
forall a. a -> ClosedTrail a
O ([Trail' Line V2 n] -> ClosedTrail [Trail' Line V2 n])
-> [Trail' Line V2 n] -> ClosedTrail [Trail' Line V2 n]
forall a b. (a -> b) -> a -> b
$ [Trail' Line V2 n]
trail [Trail' Line V2 n] -> [Trail' Line V2 n] -> [Trail' Line V2 n]
forall a. [a] -> [a] -> [a]
++ [(n, n) -> Trail' Line V2 n
forall {n}. (Floating n, Ord n) => (n, n) -> Trail' Line V2 n
straight' (n
xn -> n -> n
forall 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
xn -> n -> n
forall a. Num a => a -> a -> a
+n
x0,   n
y0), (n
xn -> n -> n
forall a. Num a => a -> a -> a
+n
x0,   n
y0), [Trail' Line V2 n] -> ClosedTrail [Trail' Line V2 n]
forall a. a -> ClosedTrail a
O ([Trail' Line V2 n] -> ClosedTrail [Trail' Line V2 n])
-> [Trail' Line V2 n] -> ClosedTrail [Trail' Line V2 n]
forall a b. (a -> b) -> a -> b
$ [Trail' Line V2 n]
trail [Trail' Line V2 n] -> [Trail' Line V2 n] -> [Trail' Line V2 n]
forall a. [a] -> [a] -> [a]
++ [(n, n) -> Trail' Line V2 n
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   ), [Trail' Line V2 n] -> ClosedTrail [Trail' Line V2 n]
forall a. a -> ClosedTrail a
O ([Trail' Line V2 n] -> ClosedTrail [Trail' Line V2 n])
-> [Trail' Line V2 n] -> ClosedTrail [Trail' Line V2 n]
forall a b. (a -> b) -> a -> b
$ [Trail' Line V2 n]
trail [Trail' Line V2 n] -> [Trail' Line V2 n] -> [Trail' Line V2 n]
forall a. [a] -> [a] -> [a]
++ [(n, n) -> Trail' Line V2 n
forall {n}. (Floating n, Ord n) => (n, n) -> Trail' Line V2 n
straight' (n
0 ,   n
yn -> n -> n
forall 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
yn -> n -> n
forall a. Num a => a -> a -> a
+n
y0), (  n
x0, n
yn -> n -> n
forall a. Num a => a -> a -> a
+n
y0), [Trail' Line V2 n] -> ClosedTrail [Trail' Line V2 n]
forall a. a -> ClosedTrail a
O ([Trail' Line V2 n] -> ClosedTrail [Trail' Line V2 n])
-> [Trail' Line V2 n] -> ClosedTrail [Trail' Line V2 n]
forall a b. (a -> b) -> a -> b
$ [Trail' Line V2 n]
trail [Trail' Line V2 n] -> [Trail' Line V2 n] -> [Trail' Line V2 n]
forall a. [a] -> [a] -> [a]
++ [(n, n) -> Trail' Line V2 n
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), [Trail' Line V2 n] -> ClosedTrail [Trail' Line V2 n]
forall a. a -> ClosedTrail a
O ([Trail' Line V2 n] -> ClosedTrail [Trail' Line V2 n])
-> [Trail' Line V2 n] -> ClosedTrail [Trail' Line V2 n]
forall a b. (a -> b) -> a -> b
$ [Trail' Line V2 n]
trail [Trail' Line V2 n] -> [Trail' Line V2 n] -> [Trail' Line V2 n]
forall a. [a] -> [a] -> [a]
++ [(n, n) -> (n, n) -> (n, n) -> Trail' Line V2 n
forall {n}.
(Floating n, Ord n) =>
(n, n) -> (n, n) -> (n, n) -> Trail' Line V2 n
bez3 (n
x1n -> n -> n
forall a. Num a => a -> a -> a
-n
x0, n
y1n -> n -> n
forall a. Num a => a -> a -> a
-n
y0) (n
x2n -> n -> n
forall a. Num a => a -> a -> a
-n
x0, n
y2n -> n -> n
forall a. Num a => a -> a -> a
-n
y0) (n
xn -> n -> n
forall a. Num a => a -> a -> a
-n
x0,n
yn -> n -> n
forall 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
x2n -> n -> n
forall a. Num a => a -> a -> a
+n
x0, n
y2n -> n -> n
forall a. Num a => a -> a -> a
+n
y0), (n
xn -> n -> n
forall a. Num a => a -> a -> a
+n
x0, n
yn -> n -> n
forall a. Num a => a -> a -> a
+n
y0), [Trail' Line V2 n] -> ClosedTrail [Trail' Line V2 n]
forall a. a -> ClosedTrail a
O ([Trail' Line V2 n] -> ClosedTrail [Trail' Line V2 n])
-> [Trail' Line V2 n] -> ClosedTrail [Trail' Line V2 n]
forall a b. (a -> b) -> a -> b
$ [Trail' Line V2 n]
trail [Trail' Line V2 n] -> [Trail' Line V2 n] -> [Trail' Line V2 n]
forall a. [a] -> [a] -> [a]
++ [(n, n) -> (n, n) -> (n, n) -> Trail' Line V2 n
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), [Trail' Line V2 n] -> ClosedTrail [Trail' Line V2 n]
forall a. a -> ClosedTrail a
O ([Trail' Line V2 n] -> ClosedTrail [Trail' Line V2 n])
-> [Trail' Line V2 n] -> ClosedTrail [Trail' Line V2 n]
forall a b. (a -> b) -> a -> b
$ [Trail' Line V2 n]
trail [Trail' Line V2 n] -> [Trail' Line V2 n] -> [Trail' Line V2 n]
forall a. [a] -> [a] -> [a]
++ [(n, n) -> (n, n) -> (n, n) -> Trail' Line V2 n
forall {n}.
(Floating n, Ord n) =>
(n, n) -> (n, n) -> (n, n) -> Trail' Line V2 n
bez3 (n
x0n -> n -> n
forall a. Num a => a -> a -> a
-n
cx, n
y0n -> n -> n
forall a. Num a => a -> a -> a
-n
cy) (n
x2n -> n -> n
forall a. Num a => a -> a -> a
-n
x0, n
y2n -> n -> n
forall a. Num a => a -> a -> a
-n
y0) (n
xn -> n -> n
forall a. Num a => a -> a -> a
-n
x0, n
yn -> n -> n
forall 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
x2n -> n -> n
forall a. Num a => a -> a -> a
+n
x0, n
y2n -> n -> n
forall a. Num a => a -> a -> a
+n
y0), (n
xn -> n -> n
forall a. Num a => a -> a -> a
+n
x0, n
yn -> n -> n
forall a. Num a => a -> a -> a
+n
y0), [Trail' Line V2 n] -> ClosedTrail [Trail' Line V2 n]
forall a. a -> ClosedTrail a
O ([Trail' Line V2 n] -> ClosedTrail [Trail' Line V2 n])
-> [Trail' Line V2 n] -> ClosedTrail [Trail' Line V2 n]
forall a b. (a -> b) -> a -> b
$ [Trail' Line V2 n]
trail [Trail' Line V2 n] -> [Trail' Line V2 n] -> [Trail' Line V2 n]
forall a. [a] -> [a] -> [a]
++ [(n, n) -> (n, n) -> (n, n) -> Trail' Line V2 n
forall {n}.
(Floating n, Ord n) =>
(n, n) -> (n, n) -> (n, n) -> Trail' Line V2 n
bez3 (n
x0n -> n -> n
forall a. Num a => a -> a -> a
-n
cx, n
y0n -> n -> n
forall 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), [Trail' Line V2 n] -> ClosedTrail [Trail' Line V2 n]
forall a. a -> ClosedTrail a
O ([Trail' Line V2 n] -> ClosedTrail [Trail' Line V2 n])
-> [Trail' Line V2 n] -> ClosedTrail [Trail' Line V2 n]
forall a b. (a -> b) -> a -> b
$ [Trail' Line V2 n]
trail [Trail' Line V2 n] -> [Trail' Line V2 n] -> [Trail' Line V2 n]
forall a. [a] -> [a] -> [a]
++ [(n, n) -> (n, n) -> (n, n) -> Trail' Line V2 n
forall {n}.
(Floating n, Ord n) =>
(n, n) -> (n, n) -> (n, n) -> Trail' Line V2 n
bez3 (n
x1n -> n -> n
forall a. Num a => a -> a -> a
-n
x0, n
y1n -> n -> n
forall a. Num a => a -> a -> a
-n
y0) (n
xn -> n -> n
forall a. Num a => a -> a -> a
-n
x0, n
yn -> n -> n
forall a. Num a => a -> a -> a
-n
y0) (n
xn -> n -> n
forall a. Num a => a -> a -> a
-n
x0, n
yn -> n -> n
forall 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
x1n -> n -> n
forall a. Num a => a -> a -> a
+n
x0, n
y1n -> n -> n
forall a. Num a => a -> a -> a
+n
y0), (n
xn -> n -> n
forall a. Num a => a -> a -> a
+n
x0, n
yn -> n -> n
forall a. Num a => a -> a -> a
+n
y0), [Trail' Line V2 n] -> ClosedTrail [Trail' Line V2 n]
forall a. a -> ClosedTrail a
O ([Trail' Line V2 n] -> ClosedTrail [Trail' Line V2 n])
-> [Trail' Line V2 n] -> ClosedTrail [Trail' Line V2 n]
forall a b. (a -> b) -> a -> b
$ [Trail' Line V2 n]
trail [Trail' Line V2 n] -> [Trail' Line V2 n] -> [Trail' Line V2 n]
forall a. [a] -> [a] -> [a]
++ [(n, n) -> (n, n) -> (n, n) -> Trail' Line V2 n
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
2n -> n -> n
forall a. Num a => a -> a -> a
*n
x0n -> n -> n
forall a. Num a => a -> a -> a
-n
cx, n
2n -> n -> n
forall a. Num a => a -> a -> a
*n
y0n -> n -> n
forall a. Num a => a -> a -> a
-n
cy ), (n
x, n
y), [Trail' Line V2 n] -> ClosedTrail [Trail' Line V2 n]
forall a. a -> ClosedTrail a
O ([Trail' Line V2 n] -> ClosedTrail [Trail' Line V2 n])
-> [Trail' Line V2 n] -> ClosedTrail [Trail' Line V2 n]
forall a b. (a -> b) -> a -> b
$ [Trail' Line V2 n]
trail [Trail' Line V2 n] -> [Trail' Line V2 n] -> [Trail' Line V2 n]
forall a. [a] -> [a] -> [a]
++ [(n, n) -> (n, n) -> (n, n) -> Trail' Line V2 n
forall {n}.
(Floating n, Ord n) =>
(n, n) -> (n, n) -> (n, n) -> Trail' Line V2 n
bez3 (n
x0n -> n -> n
forall a. Num a => a -> a -> a
-n
cx, n
y0n -> n -> n
forall a. Num a => a -> a -> a
-n
cy) (n
xn -> n -> n
forall a. Num a => a -> a -> a
-n
x0, n
yn -> n -> n
forall a. Num a => a -> a -> a
-n
y0) (n
xn -> n -> n
forall a. Num a => a -> a -> a
-n
x0, n
yn -> n -> n
forall 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
2n -> n -> n
forall a. Num a => a -> a -> a
*n
x0n -> n -> n
forall a. Num a => a -> a -> a
-n
cx, n
2n -> n -> n
forall a. Num a => a -> a -> a
*n
y0n -> n -> n
forall a. Num a => a -> a -> a
-n
cy),  (n
x, n
y), [Trail' Line V2 n] -> ClosedTrail [Trail' Line V2 n]
forall a. a -> ClosedTrail a
O ([Trail' Line V2 n] -> ClosedTrail [Trail' Line V2 n])
-> [Trail' Line V2 n] -> ClosedTrail [Trail' Line V2 n]
forall a b. (a -> b) -> a -> b
$ [Trail' Line V2 n]
trail [Trail' Line V2 n] -> [Trail' Line V2 n] -> [Trail' Line V2 n]
forall a. [a] -> [a] -> [a]
++ [(n, n) -> (n, n) -> (n, n) -> Trail' Line V2 n
forall {n}.
(Floating n, Ord n) =>
(n, n) -> (n, n) -> (n, n) -> Trail' Line V2 n
bez3 (n
x0n -> n -> n
forall a. Num a => a -> a -> a
-n
cx, n
y0n -> n -> n
forall 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), [Trail' Line V2 n] -> ClosedTrail [Trail' Line V2 n]
forall a. a -> ClosedTrail a
O ([Trail' Line V2 n] -> ClosedTrail [Trail' Line V2 n])
-> [Trail' Line V2 n] -> ClosedTrail [Trail' Line V2 n]
forall a b. (a -> b) -> a -> b
$ [Trail' Line V2 n]
trail [Trail' Line V2 n] -> [Trail' Line V2 n] -> [Trail' Line V2 n]
forall a. [a] -> [a] -> [a]
++ [(n, n) -> n -> n -> n -> (n, n) -> Trail' Line V2 n
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
xn -> n -> n
forall a. Num a => a -> a -> a
-n
x0, n
yn -> n -> n
forall 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
xn -> n -> n
forall a. Num a => a -> a -> a
+n
x0, n
yn -> n -> n
forall a. Num a => a -> a -> a
+n
y0), (n
xn -> n -> n
forall a. Num a => a -> a -> a
+n
x0, n
yn -> n -> n
forall a. Num a => a -> a -> a
+n
y0), [Trail' Line V2 n] -> ClosedTrail [Trail' Line V2 n]
forall a. a -> ClosedTrail a
O ([Trail' Line V2 n] -> ClosedTrail [Trail' Line V2 n])
-> [Trail' Line V2 n] -> ClosedTrail [Trail' Line V2 n]
forall a b. (a -> b) -> a -> b
$ [Trail' Line V2 n]
trail [Trail' Line V2 n] -> [Trail' Line V2 n] -> [Trail' Line V2 n]
forall a. [a] -> [a] -> [a]
++ [(n, n) -> n -> n -> n -> (n, n) -> Trail' Line V2 n
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' = [Segment Closed V2 n] -> Trail' Line V2 n
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
[Segment Closed v n] -> Trail' Line v n
lineFromSegments ([Segment Closed V2 n] -> Trail' Line V2 n)
-> ((n, n) -> [Segment Closed V2 n]) -> (n, n) -> Trail' Line V2 n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Segment Closed V2 n
-> [Segment Closed V2 n] -> [Segment Closed V2 n]
forall a. a -> [a] -> [a]
:[]) (Segment Closed V2 n -> [Segment Closed V2 n])
-> ((n, n) -> Segment Closed V2 n)
-> (n, n)
-> [Segment Closed V2 n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. V2 n -> Segment Closed V2 n
forall (v :: * -> *) n. v n -> Segment Closed v n
straight (V2 n -> Segment Closed V2 n)
-> ((n, n) -> V2 n) -> (n, n) -> Segment Closed V2 n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (n, n) -> V2 n
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 = [Segment Closed V2 n] -> Trail' Line V2 n
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
[Segment Closed v n] -> Trail' Line v n
lineFromSegments [V2 n -> V2 n -> V2 n -> Segment Closed V2 n
forall (v :: * -> *) n. v n -> v n -> v n -> Segment Closed v n
bezier3 ((n, n) -> V2 n
forall n. (n, n) -> V2 n
r2 (n, n)
point1) ((n, n) -> V2 n
forall n. (n, n) -> V2 n
r2 (n, n)
point2) ((n, n) -> V2 n
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 n -> n -> Bool
forall a. Eq a => a -> a -> Bool
== n
0 Bool -> Bool -> Bool
&& n
y2 n -> n -> Bool
forall a. Eq a => a -> a -> Bool
== n
0 = Trail' Line V2 n
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Trail' Line v n
emptyLine -- spec F6.2
     | n
rx n -> n -> Bool
forall a. Eq a => a -> a -> Bool
== n
0 Bool -> Bool -> Bool
|| n
ry n -> n -> Bool
forall a. Eq a => a -> a -> Bool
== n
0 = (n, n) -> Trail' Line V2 n
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
                   Located (Trail' Line V2 n) -> Trail' Line V2 n
forall a. Located a -> a
unLoc (n -> Direction V2 n -> Angle n -> Located (Trail' Line V2 n)
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 n -> AReview (Angle n) n -> Angle n
forall b a. b -> AReview a b -> a
@@ AReview (Angle n) n
forall n (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p n (f n) -> p (Angle n) (f (Angle n))
rad) Located (Trail' Line V2 n)
-> (Located (Trail' Line V2 n) -> Located (Trail' Line V2 n))
-> Located (Trail' Line V2 n)
forall a b. a -> (a -> b) -> b
# n -> Located (Trail' Line V2 n) -> Located (Trail' Line V2 n)
forall (v :: * -> *) n t.
(InSpace v n t, R2 v, Fractional n, Transformable t) =>
n -> t -> t
scaleY n
ry Located (Trail' Line V2 n)
-> (Located (Trail' Line V2 n) -> Located (Trail' Line V2 n))
-> Located (Trail' Line V2 n)
forall a b. a -> (a -> b) -> b
# n -> Located (Trail' Line V2 n) -> Located (Trail' Line V2 n)
forall (v :: * -> *) n t.
(InSpace v n t, R2 v, Fractional n, Transformable t) =>
n -> t -> t
scaleX n
rx Located (Trail' Line V2 n)
-> (Located (Trail' Line V2 n) -> Located (Trail' Line V2 n))
-> Located (Trail' Line V2 n)
forall a b. a -> (a -> b) -> b
# Angle n -> Located (Trail' Line V2 n) -> Located (Trail' Line V2 n)
forall n t.
(InSpace V2 n t, Transformable t, Floating n) =>
Angle n -> t -> t
rotate (n
phi n -> AReview (Angle n) n -> Angle n
forall b a. b -> AReview a b -> a
@@ AReview (Angle n) n
forall n (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p n (f n) -> p (Angle n) (f (Angle n))
rad))
  where rx :: n
rx | n
rxx n -> n -> Bool
forall a. Ord a => a -> a -> Bool
< n
0   = -n
rxx  -- spec F6.2
           | Bool
otherwise =  n
rxx
        ry :: n
ry | n
ryy n -> n -> Bool
forall a. Ord a => a -> a -> Bool
< n
0   = -n
ryy  -- spec F6.2
           | Bool
otherwise =  n
ryy
        fa :: a
fa | n
largeArcFlag n -> n -> Bool
forall a. Eq a => a -> a -> Bool
== n
0 = a
0
           | Bool
otherwise         = a
1 -- spec F6.2
        fs :: a
fs | n
sweepFlag n -> n -> Bool
forall a. Eq a => a -> a -> Bool
== n
0 = a
0
           | Bool
otherwise      = a
1 -- spec F6.2
        phi :: n
phi = n
xAxisRot n -> n -> n
forall a. Num a => a -> a -> a
* n
forall a. Floating a => a
pi n -> n -> n
forall a. Fractional a => a -> a -> a
/ n
180
        (a
x1,b
y1) = (a
0,b
0)
        x1x2 :: n
x1x2 = (n
forall {b}. Num b => b
x1 n -> n -> n
forall a. Num a => a -> a -> a
- n
x2)n -> n -> n
forall a. Fractional a => a -> a -> a
/n
2
        y1y2 :: n
y1y2 = (n
forall {b}. Num b => b
y1 n -> n -> n
forall a. Num a => a -> a -> a
- n
y2)n -> n -> n
forall a. Fractional a => a -> a -> a
/n
2
        x1' :: n
x1' =  (n -> n
forall a. Floating a => a -> a
cos n
phi) n -> n -> n
forall a. Num a => a -> a -> a
* n
x1x2 n -> n -> n
forall a. Num a => a -> a -> a
+ (n -> n
forall a. Floating a => a -> a
sin n
phi) n -> n -> n
forall a. Num a => a -> a -> a
* n
y1y2
        y1' :: n
y1' = -(n -> n
forall a. Floating a => a -> a
sin n
phi) n -> n -> n
forall a. Num a => a -> a -> a
* n
x1x2 n -> n -> n
forall a. Num a => a -> a -> a
+ (n -> n
forall a. Floating a => a -> a
cos n
phi) n -> n -> n
forall a. Num a => a -> a -> a
* n
y1y2
        s :: n
s = (n
rxn -> n -> n
forall a. Num a => a -> a -> a
*n
rxn -> n -> n
forall a. Num a => a -> a -> a
*n
ryn -> n -> n
forall a. Num a => a -> a -> a
*n
ry n -> n -> n
forall a. Num a => a -> a -> a
- n
rxn -> n -> n
forall a. Num a => a -> a -> a
*n
rxn -> n -> n
forall a. Num a => a -> a -> a
*n
y1'n -> n -> n
forall a. Num a => a -> a -> a
*n
y1' n -> n -> n
forall a. Num a => a -> a -> a
- n
ryn -> n -> n
forall a. Num a => a -> a -> a
*n
ryn -> n -> n
forall a. Num a => a -> a -> a
*n
x1'n -> n -> n
forall a. Num a => a -> a -> a
*n
x1') n -> n -> n
forall a. Fractional a => a -> a -> a
/ (n
rxn -> n -> n
forall a. Num a => a -> a -> a
*n
rxn -> n -> n
forall a. Num a => a -> a -> a
*n
y1'n -> n -> n
forall a. Num a => a -> a -> a
*n
y1' n -> n -> n
forall a. Num a => a -> a -> a
+ n
ryn -> n -> n
forall a. Num a => a -> a -> a
*n
ryn -> n -> n
forall a. Num a => a -> a -> a
*n
x1'n -> n -> n
forall a. Num a => a -> a -> a
*n
x1' )
        root :: n
root | n
s n -> n -> Bool
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 = n -> n
forall a. Floating a => a -> a
sqrt n
s -- This bug happened: <https://ghc.haskell.org/trac/ghc/ticket/10010>
        cx' :: n
cx' | Integer
forall {b}. Num b => b
fa Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
forall {b}. Num b => b
fs  =   n
root n -> n -> n
forall a. Num a => a -> a -> a
* n
rx n -> n -> n
forall a. Num a => a -> a -> a
* n
y1' n -> n -> n
forall a. Fractional a => a -> a -> a
/ n
ry
            | Bool
otherwise = - n
root n -> n -> n
forall a. Num a => a -> a -> a
* n
rx n -> n -> n
forall a. Num a => a -> a -> a
* n
y1' n -> n -> n
forall a. Fractional a => a -> a -> a
/ n
ry
        cy' :: n
cy' | Integer
forall {b}. Num b => b
fa Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
forall {b}. Num b => b
fs  = - n
root n -> n -> n
forall a. Num a => a -> a -> a
* n
ry n -> n -> n
forall a. Num a => a -> a -> a
* n
x1' n -> n -> n
forall a. Fractional a => a -> a -> a
/ n
rx
            | Bool
otherwise =   n
root n -> n -> n
forall a. Num a => a -> a -> a
* n
ry n -> n -> n
forall a. Num a => a -> a -> a
* n
x1' n -> n -> n
forall a. Fractional a => a -> a -> a
/ n
rx
        cx :: n
cx = (n -> n
forall a. Floating a => a -> a
cos n
phi) n -> n -> n
forall a. Num a => a -> a -> a
* n
cx' n -> n -> n
forall a. Num a => a -> a -> a
- (n -> n
forall a. Floating a => a -> a
sin n
phi) n -> n -> n
forall a. Num a => a -> a -> a
* n
cy' n -> n -> n
forall a. Num a => a -> a -> a
+ ((n
forall {b}. Num b => b
x1n -> n -> n
forall a. Num a => a -> a -> a
+n
x2)n -> n -> n
forall a. Fractional a => a -> a -> a
/n
2)
        cy :: n
cy = (n -> n
forall a. Floating a => a -> a
sin n
phi) n -> n -> n
forall a. Num a => a -> a -> a
* n
cx' n -> n -> n
forall a. Num a => a -> a -> a
+ (n -> n
forall a. Floating a => a -> a
cos n
phi) n -> n -> n
forall a. Num a => a -> a -> a
* n
cy' n -> n -> n
forall a. Num a => a -> a -> a
+ ((n
forall {b}. Num b => b
y1n -> n -> n
forall a. Num a => a -> a -> a
+n
y2)n -> n -> n
forall a. Fractional a => a -> a -> a
/n
2)
        dir1 :: Direction V2 n
dir1 = Point V2 n -> Point V2 n -> Direction V2 n
forall (v :: * -> *) n.
(Additive v, Num n) =>
Point v n -> Point v n -> Direction v n
dirBetween Point V2 n
forall (f :: * -> *) a. (Additive f, Num a) => Point f a
origin ((n, n) -> Point V2 n
forall n. (n, n) -> P2 n
p2 ((n
x1'n -> n -> n
forall a. Num a => a -> a -> a
-n
cx')n -> n -> n
forall a. Fractional a => a -> a -> a
/n
rx, (n
y1'n -> n -> n
forall a. Num a => a -> a -> a
-n
cy')n -> n -> n
forall a. Fractional a => a -> a -> a
/n
ry))
        v1 :: V2 n
v1 = (n, n) -> V2 n
forall n. (n, n) -> V2 n
r2 (( n
x1'n -> n -> n
forall a. Num a => a -> a -> a
-n
cx')n -> n -> n
forall a. Fractional a => a -> a -> a
/n
rx,  (n
y1'n -> n -> n
forall a. Num a => a -> a -> a
-n
cy')n -> n -> n
forall a. Fractional a => a -> a -> a
/n
ry)
        v2 :: V2 n
v2 = (n, n) -> V2 n
forall n. (n, n) -> V2 n
r2 ((-n
x1'n -> n -> n
forall a. Num a => a -> a -> a
-n
cx')n -> n -> n
forall a. Fractional a => a -> a -> a
/n
rx, (-n
y1'n -> n -> n
forall a. Num a => a -> a -> a
-n
cy')n -> n -> n
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 | (V2 n -> V2 n
forall a. Floating a => V2 a -> V2 a
forall (f :: * -> *) a. (Metric f, Floating a) => f a -> f a
signorm V2 n
v1 V2 n -> V2 n -> n
forall a. Num a => V2 a -> V2 a -> a
forall (f :: * -> *) a. (Metric f, Num a) => f a -> f a -> a
`dot` V2 n -> V2 n
forall a. Floating a => V2 a -> V2 a
forall (f :: * -> *) a. (Metric f, Floating a) => f a -> f a
signorm V2 n
v2) n -> n -> Bool
forall a. Ord a => a -> a -> Bool
>=  n
1 = (n -> Angle n
forall n. Floating n => n -> Angle n
acosA   n
1 ) Angle n -> Getting n (Angle n) n -> n
forall s a. s -> Getting a s a -> a
^. Getting n (Angle n) n
forall n (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p n (f n) -> p (Angle n) (f (Angle n))
rad
                  | (V2 n -> V2 n
forall a. Floating a => V2 a -> V2 a
forall (f :: * -> *) a. (Metric f, Floating a) => f a -> f a
signorm V2 n
v1 V2 n -> V2 n -> n
forall a. Num a => V2 a -> V2 a -> a
forall (f :: * -> *) a. (Metric f, Num a) => f a -> f a -> a
`dot` V2 n -> V2 n
forall a. Floating a => V2 a -> V2 a
forall (f :: * -> *) a. (Metric f, Floating a) => f a -> f a
signorm V2 n
v2) n -> n -> Bool
forall a. Ord a => a -> a -> Bool
<= -n
1 = (n -> Angle n
forall n. Floating n => n -> Angle n
acosA (-n
1)) Angle n -> Getting n (Angle n) n -> n
forall s a. s -> Getting a s a -> a
^. Getting n (Angle n) n
forall n (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p n (f n) -> p (Angle n) (f (Angle n))
rad
                  | Bool
otherwise = (V2 n -> V2 n -> Angle n
forall n. RealFloat n => V2 n -> V2 n -> Angle n
signedAngleBetween V2 n
v2 V2 n
v1) Angle n -> Getting n (Angle n) n -> n
forall s a. s -> Getting a s a -> a
^. Getting n (Angle n) n
forall n (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p n (f n) -> p (Angle n) (f (Angle n))
rad
        dtheta :: n
dtheta | Integer
forall {b}. Num b => b
fs Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0   = if n
angleV1V2 n -> n -> Bool
forall a. Ord a => a -> a -> Bool
> n
0 then n
angleV1V2 n -> n -> n
forall a. Num a => a -> a -> a
- (n
2n -> n -> n
forall a. Num a => a -> a -> a
*n
forall a. Floating a => a
pi) else n
angleV1V2
               | Bool
otherwise = if n
angleV1V2 n -> n -> Bool
forall a. Ord a => a -> a -> Bool
< n
0 then n
angleV1V2 n -> n -> n
forall a. Num a => a -> a -> a
+ (n
2n -> n -> n
forall a. Num a => a -> a -> a
*n
forall a. Floating a => a
pi) else n
angleV1V2