{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RebindableSyntax #-}
{-# OPTIONS_GHC -Wall #-}

-- | SVG path manipulation
module Data.Path.Parser
  ( -- * Parsing
    -- $parsing
    parsePath,
    svgToPathData,
    pathDataToSvg,
    PathCommand (..),
    Origin (..),
  )
where

import Chart.Data
import Control.Applicative
import Control.Monad.State.Lazy
import qualified Data.Attoparsec.Text as A
import Data.Either
import Data.FormatN
import Data.Functor
import Data.Path (ArcInfo (ArcInfo), PathData (..))
import Data.Scientific (toRealFloat)
import Data.Text (Text, pack)
import qualified Data.Text as Text
import GHC.Generics
import GHC.OverloadedLabels
import NumHask.Prelude
import Optics.Core hiding ((<|))

-- import qualified Data.List as List

-- $parsing
-- Every element of an svg path can be thought of as exactly two points in space, with instructions of how to draw a curve between them.  From this point of view, one which this library adopts, a path chart is thus very similar to a line chart.  There's just a lot more information about the style of this line to deal with.
--
-- References:
--
-- [SVG d attribute](https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/d)
--
-- [SVG Paths](https://developer.mozilla.org/en-US/docs/Web/SVG/Tutorial/Paths)

-- | Parse a raw path string.
--
-- >>> let outerseg1 = "M-1.0,0.5 A0.5 0.5 0.0 1 1 0.0,-1.2320508075688774 1.0 1.0 0.0 0 0 -0.5,-0.3660254037844387 1.0 1.0 0.0 0 0 -1.0,0.5 Z"
-- >>> parsePath outerseg1
-- Right [MoveTo OriginAbsolute [Point -1.0 0.5],EllipticalArc OriginAbsolute [(0.5,0.5,0.0,True,True,Point 0.0 -1.2320508075688774),(1.0,1.0,0.0,False,False,Point -0.5 -0.3660254037844387),(1.0,1.0,0.0,False,False,Point -1.0 0.5)],EndPath]
parsePath :: Text -> Either String [PathCommand]
parsePath :: Text -> Either String [PathCommand]
parsePath = forall a. Parser a -> Text -> Either String a
A.parseOnly Parser [PathCommand]
pathParser

commaWsp :: A.Parser ()
commaWsp :: Parser ()
commaWsp = Parser ()
A.skipSpace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a. Alternative f => a -> f a -> f a
A.option () (Text -> Parser Text
A.string Text
"," forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ()) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
A.skipSpace

point :: A.Parser (Point Double)
point :: Parser (Point Double)
point = forall a. a -> a -> Point a
Point forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Double
num forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
commaWsp forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Double
num

points :: A.Parser [Point Double]
points :: Parser [Point Double]
points = forall l. IsList l => [Item l] -> l
fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Point Double)
point forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
`A.sepBy1` Parser ()
commaWsp

pointPair :: A.Parser (Point Double, Point Double)
pointPair :: Parser (Point Double, Point Double)
pointPair = (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Point Double)
point forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
commaWsp forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Point Double)
point

pointPairs :: A.Parser [(Point Double, Point Double)]
pointPairs :: Parser [(Point Double, Point Double)]
pointPairs = forall l. IsList l => [Item l] -> l
fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Point Double, Point Double)
pointPair forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
`A.sepBy1` Parser ()
commaWsp

pathParser :: A.Parser [PathCommand]
pathParser :: Parser [PathCommand]
pathParser = forall l. IsList l => [Item l] -> l
fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser ()
A.skipSpace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a. Alternative f => f a -> f [a]
A.many1 Parser PathCommand
command)

num :: A.Parser Double
num :: Parser Double
num = forall a b. (Real a, Fractional b) => a -> b
realToFrac forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser ()
A.skipSpace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Double
plusMinus forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
A.skipSpace)
  where
    doubleNumber :: A.Parser Double
    doubleNumber :: Parser Double
doubleNumber = forall a. RealFloat a => Scientific -> a
toRealFloat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Scientific
A.scientific forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Double
shorthand

    plusMinus :: Parser Double
plusMinus =
      forall a. Subtractive a => a -> a
negate forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
A.string Text
"-" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Double
doubleNumber
        forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Parser Text
A.string Text
"+" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Double
doubleNumber
        forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Double
doubleNumber

    shorthand :: Parser Double
shorthand = String -> Double
process' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Parser Text
A.string Text
"." forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a. Alternative f => f a -> f [a]
A.many1 Parser Char
A.digit)
    process' :: String -> Double
process' = forall b a. b -> Either a b -> b
fromRight Double
0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Parser a -> Text -> Either String a
A.parseOnly Parser Double
doubleNumber forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a] -> [a]
(++) String
"0."

nums :: A.Parser [Double]
nums :: Parser [Double]
nums = Parser Double
num forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
`A.sepBy1` Parser ()
commaWsp

flag :: A.Parser Bool
flag :: Parser Bool
flag = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Eq a => a -> a -> Bool
/= Char
'0') Parser Char
A.digit

command :: A.Parser PathCommand
command :: Parser PathCommand
command =
  Origin -> [Point Double] -> PathCommand
MoveTo Origin
OriginAbsolute forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
A.string Text
"M" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [Point Double]
points
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Origin -> [Point Double] -> PathCommand
MoveTo Origin
OriginRelative forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
A.string Text
"m" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [Point Double]
points
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Origin -> [Point Double] -> PathCommand
LineTo Origin
OriginAbsolute forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
A.string Text
"L" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [Point Double]
points
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Origin -> [Point Double] -> PathCommand
LineTo Origin
OriginRelative forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
A.string Text
"l" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [Point Double]
points
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Origin -> [Double] -> PathCommand
HorizontalTo Origin
OriginAbsolute forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
A.string Text
"H" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [Double]
nums
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Origin -> [Double] -> PathCommand
HorizontalTo Origin
OriginRelative forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
A.string Text
"h" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [Double]
nums
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Origin -> [Double] -> PathCommand
VerticalTo Origin
OriginAbsolute forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
A.string Text
"V" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [Double]
nums
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Origin -> [Double] -> PathCommand
VerticalTo Origin
OriginRelative forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
A.string Text
"v" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [Double]
nums
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Origin
-> [(Point Double, Point Double, Point Double)] -> PathCommand
CurveTo Origin
OriginAbsolute forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
A.string Text
"C" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall l. IsList l => [Item l] -> l
fromList (forall {b}. IsList b => Parser Text (Item b) -> Parser Text b
manyComma Parser Text (Point Double, Point Double, Point Double)
curveToArgs)
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Origin
-> [(Point Double, Point Double, Point Double)] -> PathCommand
CurveTo Origin
OriginRelative forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
A.string Text
"c" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall l. IsList l => [Item l] -> l
fromList (forall {b}. IsList b => Parser Text (Item b) -> Parser Text b
manyComma Parser Text (Point Double, Point Double, Point Double)
curveToArgs)
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Origin -> [(Point Double, Point Double)] -> PathCommand
SmoothCurveTo Origin
OriginAbsolute forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
A.string Text
"S" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [(Point Double, Point Double)]
pointPairs
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Origin -> [(Point Double, Point Double)] -> PathCommand
SmoothCurveTo Origin
OriginRelative forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
A.string Text
"s" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [(Point Double, Point Double)]
pointPairs
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Origin -> [(Point Double, Point Double)] -> PathCommand
QuadraticBezier Origin
OriginAbsolute forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
A.string Text
"Q" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [(Point Double, Point Double)]
pointPairs
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Origin -> [(Point Double, Point Double)] -> PathCommand
QuadraticBezier Origin
OriginRelative forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
A.string Text
"q" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [(Point Double, Point Double)]
pointPairs
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Origin -> [Point Double] -> PathCommand
SmoothQuadraticBezierCurveTo Origin
OriginAbsolute forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
A.string Text
"T" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [Point Double]
points
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Origin -> [Point Double] -> PathCommand
SmoothQuadraticBezierCurveTo Origin
OriginRelative forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
A.string Text
"t" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [Point Double]
points
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Origin
-> [(Double, Double, Double, Bool, Bool, Point Double)]
-> PathCommand
EllipticalArc Origin
OriginAbsolute forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
A.string Text
"A" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall {b}. IsList b => Parser Text (Item b) -> Parser Text b
manyComma Parser Text (Double, Double, Double, Bool, Bool, Point Double)
ellipticalArgs
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Origin
-> [(Double, Double, Double, Bool, Bool, Point Double)]
-> PathCommand
EllipticalArc Origin
OriginRelative forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
A.string Text
"a" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall {b}. IsList b => Parser Text (Item b) -> Parser Text b
manyComma Parser Text (Double, Double, Double, Bool, Bool, Point Double)
ellipticalArgs
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> PathCommand
EndPath forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
A.string Text
"Z" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
commaWsp
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> PathCommand
EndPath forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
A.string Text
"z" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
commaWsp
  where
    curveToArgs :: Parser Text (Point Double, Point Double, Point Double)
curveToArgs =
      (,,)
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser (Point Double)
point forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
commaWsp)
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser (Point Double)
point forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
commaWsp)
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Point Double)
point
    manyComma :: Parser Text (Item b) -> Parser Text b
manyComma Parser Text (Item b)
a = forall l. IsList l => [Item l] -> l
fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text (Item b)
a forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
`A.sepBy1` Parser ()
commaWsp

    numComma :: Parser Double
numComma = Parser Double
num forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
commaWsp
    flagComma :: Parser Bool
flagComma = Parser Bool
flag forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
commaWsp
    ellipticalArgs :: Parser Text (Double, Double, Double, Bool, Bool, Point Double)
ellipticalArgs =
      (,,,,,)
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Double
numComma
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Double
numComma
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Double
numComma
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Bool
flagComma
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Bool
flagComma
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Point Double)
point

-- | Path command definition (ripped from reanimate-svg).
data PathCommand
  = -- | M or m command
    MoveTo !Origin ![Point Double]
  | -- | Line to, L or l Svg path command.
    LineTo !Origin ![Point Double]
  | -- | Equivalent to the H or h svg path command.
    HorizontalTo !Origin ![Double]
  | -- | Equivalent to the V or v svg path command.
    VerticalTo !Origin ![Double]
  | -- | Cubic bezier, C or c command
    CurveTo !Origin ![(Point Double, Point Double, Point Double)]
  | -- | Smooth cubic bezier, equivalent to S or s command
    SmoothCurveTo !Origin ![(Point Double, Point Double)]
  | -- | Quadratic bezier, Q or q command
    QuadraticBezier !Origin ![(Point Double, Point Double)]
  | -- | Quadratic bezier, T or t command
    SmoothQuadraticBezierCurveTo !Origin ![Point Double]
  | -- | Elliptical arc, A or a command.
    EllipticalArc !Origin ![(Double, Double, Double, Bool, Bool, Point Double)]
  | -- | Close the path, Z or z svg path command.
    EndPath
  deriving (PathCommand -> PathCommand -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PathCommand -> PathCommand -> Bool
$c/= :: PathCommand -> PathCommand -> Bool
== :: PathCommand -> PathCommand -> Bool
$c== :: PathCommand -> PathCommand -> Bool
Eq, Int -> PathCommand -> ShowS
[PathCommand] -> ShowS
PathCommand -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PathCommand] -> ShowS
$cshowList :: [PathCommand] -> ShowS
show :: PathCommand -> String
$cshow :: PathCommand -> String
showsPrec :: Int -> PathCommand -> ShowS
$cshowsPrec :: Int -> PathCommand -> ShowS
Show, forall x. Rep PathCommand x -> PathCommand
forall x. PathCommand -> Rep PathCommand x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PathCommand x -> PathCommand
$cfrom :: forall x. PathCommand -> Rep PathCommand x
Generic)

-- | Tell if a path command is absolute (in the current
-- user coordiante) or relative to the previous point.
data Origin
  = -- | Next point in absolute coordinate
    OriginAbsolute
  | -- | Next point relative to the previous
    OriginRelative
  deriving (Origin -> Origin -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Origin -> Origin -> Bool
$c/= :: Origin -> Origin -> Bool
== :: Origin -> Origin -> Bool
$c== :: Origin -> Origin -> Bool
Eq, Int -> Origin -> ShowS
[Origin] -> ShowS
Origin -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Origin] -> ShowS
$cshowList :: [Origin] -> ShowS
show :: Origin -> String
$cshow :: Origin -> String
showsPrec :: Int -> Origin -> ShowS
$cshowsPrec :: Int -> Origin -> ShowS
Show, forall x. Rep Origin x -> Origin
forall x. Origin -> Rep Origin x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Origin x -> Origin
$cfrom :: forall x. Origin -> Rep Origin x
Generic)

pointToSvgCoords :: Point Double -> Point Double
pointToSvgCoords :: Point Double -> Point Double
pointToSvgCoords (Point Double
x Double
y) = forall a. a -> a -> Point a
Point Double
x (-Double
y)

svgCoords :: PathData Double -> PathData Double
svgCoords :: PathData Double -> PathData Double
svgCoords (CubicP Point Double
a Point Double
b Point Double
p) = forall a. Point a -> Point a -> Point a -> PathData a
CubicP (Point Double -> Point Double
pointToSvgCoords Point Double
a) (Point Double -> Point Double
pointToSvgCoords Point Double
b) (Point Double -> Point Double
pointToSvgCoords Point Double
p)
svgCoords (QuadP Point Double
a Point Double
p) = forall a. Point a -> Point a -> PathData a
QuadP (Point Double -> Point Double
pointToSvgCoords Point Double
a) (Point Double -> Point Double
pointToSvgCoords Point Double
p)
svgCoords (StartP Point Double
p) = forall a. Point a -> PathData a
StartP (Point Double -> Point Double
pointToSvgCoords Point Double
p)
svgCoords (LineP Point Double
p) = forall a. Point a -> PathData a
LineP (Point Double -> Point Double
pointToSvgCoords Point Double
p)
svgCoords (ArcP ArcInfo Double
i Point Double
p) = forall a. ArcInfo a -> Point a -> PathData a
ArcP ArcInfo Double
i (Point Double -> Point Double
pointToSvgCoords Point Double
p)

-- | Convert from a path info, start point, end point triple to a path text clause.
--
-- Note that morally,
--
-- > toPathsAbsolute . toPathDatas . parsePath == id
--
-- but the round trip destroys much information, including:
--
-- - path text spacing
--
-- - "Z", which is replaced by a LineI instruction from the end point back to the original start of the path.
--
-- - Sequences of the same instruction type are uncompressed
--
-- - As the name suggests, relative paths are translated to absolute ones.
--
-- - implicit L's in multiple M instructions are separated.
--
-- In converting between chart-svg and SVG there are two changes in reference:
--
-- - arc rotation is expressed as positive degrees for a clockwise rotation in SVG, and counter-clockwise in radians for chart-svg
--
-- - A positive y-direction is down for SVG and up for chart-svg
toPathAbsolute ::
  PathData Double ->
  -- | path text
  Text
toPathAbsolute :: PathData Double -> Text
toPathAbsolute (StartP Point Double
p) = Text
"M " forall a. Semigroup a => a -> a -> a
<> Point Double -> Text
pp Point Double
p
toPathAbsolute (LineP Point Double
p) = Text
"L " forall a. Semigroup a => a -> a -> a
<> Point Double -> Text
pp Point Double
p
toPathAbsolute (CubicP Point Double
c1 Point Double
c2 Point Double
p) =
  Text
"C "
    forall a. Semigroup a => a -> a -> a
<> Point Double -> Text
pp Point Double
c1
    forall a. Semigroup a => a -> a -> a
<> Text
" "
    forall a. Semigroup a => a -> a -> a
<> Point Double -> Text
pp Point Double
c2
    forall a. Semigroup a => a -> a -> a
<> Text
" "
    forall a. Semigroup a => a -> a -> a
<> Point Double -> Text
pp Point Double
p
toPathAbsolute (QuadP Point Double
control Point Double
p) =
  Text
"Q "
    forall a. Semigroup a => a -> a -> a
<> Point Double -> Text
pp Point Double
control
    forall a. Semigroup a => a -> a -> a
<> Text
" "
    forall a. Semigroup a => a -> a -> a
<> Point Double -> Text
pp Point Double
p
toPathAbsolute (ArcP (ArcInfo (Point Double
x Double
y) Double
phi' Bool
l Bool
sw) Point Double
x2) =
  Text
"A "
    forall a. Semigroup a => a -> a -> a
<> (String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) Double
x
    forall a. Semigroup a => a -> a -> a
<> Text
" "
    forall a. Semigroup a => a -> a -> a
<> (String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) Double
y
    forall a. Semigroup a => a -> a -> a
<> Text
" "
    forall a. Semigroup a => a -> a -> a
<> (String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) (-Double
phi' forall a. Multiplicative a => a -> a -> a
* Double
180 forall a. Divisive a => a -> a -> a
/ forall a. TrigField a => a
pi)
    forall a. Semigroup a => a -> a -> a
<> Text
" "
    forall a. Semigroup a => a -> a -> a
<> forall a. a -> a -> Bool -> a
bool Text
"0" Text
"1" Bool
l
    forall a. Semigroup a => a -> a -> a
<> Text
" "
    forall a. Semigroup a => a -> a -> a
<> forall a. a -> a -> Bool -> a
bool Text
"0" Text
"1" Bool
sw
    forall a. Semigroup a => a -> a -> a
<> Text
" "
    forall a. Semigroup a => a -> a -> a
<> Point Double -> Text
pp Point Double
x2

-- | Render a point (including conversion to SVG Coordinates).
pp :: Point Double -> Text
pp :: Point Double -> Text
pp (Point Double
x Double
y) =
  FormatStyle -> Maybe Int -> Double -> Text
formatOrShow (Int -> FormatStyle
FixedStyle Int
4) forall a. Maybe a
Nothing Double
x
    forall a. Semigroup a => a -> a -> a
<> Text
","
    forall a. Semigroup a => a -> a -> a
<> FormatStyle -> Maybe Int -> Double -> Text
formatOrShow (Int -> FormatStyle
FixedStyle Int
4) forall a. Maybe a
Nothing (forall a. a -> a -> Bool -> a
bool (-Double
y) Double
y (Double
y forall a. Eq a => a -> a -> Bool
== forall a. Additive a => a
zero))

data PathCursor = PathCursor
  { -- | previous position
    PathCursor -> Point Double
curPrevious :: Point Double,
    -- | start point (to close out the path)
    PathCursor -> Point Double
curStart :: Point Double,
    -- | last control point
    PathCursor -> Maybe (Point Double)
curControl :: Maybe (Point Double)
  }
  deriving (PathCursor -> PathCursor -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PathCursor -> PathCursor -> Bool
$c/= :: PathCursor -> PathCursor -> Bool
== :: PathCursor -> PathCursor -> Bool
$c== :: PathCursor -> PathCursor -> Bool
Eq, Int -> PathCursor -> ShowS
[PathCursor] -> ShowS
PathCursor -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PathCursor] -> ShowS
$cshowList :: [PathCursor] -> ShowS
show :: PathCursor -> String
$cshow :: PathCursor -> String
showsPrec :: Int -> PathCursor -> ShowS
$cshowsPrec :: Int -> PathCursor -> ShowS
Show, forall x. Rep PathCursor x -> PathCursor
forall x. PathCursor -> Rep PathCursor x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PathCursor x -> PathCursor
$cfrom :: forall x. PathCursor -> Rep PathCursor x
Generic)

stateCur0 :: PathCursor
stateCur0 :: PathCursor
stateCur0 = Point Double -> Point Double -> Maybe (Point Double) -> PathCursor
PathCursor forall a. Additive a => a
zero forall a. Additive a => a
zero forall a. Maybe a
Nothing

-- | Convert from an SVG d attribute text snippet to a [`PathData` `Double`]
svgToPathData :: Text -> [PathData Double]
svgToPathData :: Text -> [PathData Double]
svgToPathData = [PathCommand] -> [PathData Double]
toPathDatas 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. HasCallStack => String -> a
error forall a. a -> a
id forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either String [PathCommand]
parsePath

-- | Convert from [`PathData` `Double`] to an SVG d path text snippet.
pathDataToSvg :: [PathData Double] -> Text
pathDataToSvg :: [PathData Double] -> Text
pathDataToSvg [PathData Double]
xs = Text -> [Text] -> Text
Text.intercalate Text
" " forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PathData Double -> Text
toPathAbsolute [PathData Double]
xs

-- | Convert from a path command list to a PathA specification
toPathDatas :: [PathCommand] -> [PathData Double]
toPathDatas :: [PathCommand] -> [PathData Double]
toPathDatas [PathCommand]
xs = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PathData Double -> PathData Double
svgCoords forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip forall s a. State s a -> s -> a
evalState PathCursor
stateCur0 forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM PathCommand -> State PathCursor [PathData Double]
toPathData [PathCommand]
xs

-- | Convert relative points to absolute points
relToAbs :: (Additive a) => a -> [a] -> [a]
relToAbs :: forall a. Additive a => a -> [a] -> [a]
relToAbs a
p [a]
xs = forall a (f :: * -> *). (Additive a, Traversable f) => f a -> f a
accsum (a
p forall a. a -> [a] -> [a]
: [a]
xs)

moveTo :: [Point Double] -> State PathCursor [PathData Double]
moveTo :: [Point Double] -> State PathCursor [PathData Double]
moveTo [Point Double]
xs = do
  forall s (m :: * -> *). MonadState s m => s -> m ()
put (Point Double -> Point Double -> Maybe (Point Double) -> PathCursor
PathCursor (forall a. [a] -> a
last [Point Double]
xs) (forall a. [a] -> a
head [Point Double]
xs) forall a. Maybe a
Nothing)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. Point a -> PathData a
StartP (forall a. [a] -> a
head [Point Double]
xs) forall a. a -> [a] -> [a]
: (forall a. Point a -> PathData a
LineP forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. [a] -> [a]
tail [Point Double]
xs))

lineTo :: [Point Double] -> State PathCursor [PathData Double]
lineTo :: [Point Double] -> State PathCursor [PathData Double]
lineTo [Point Double]
xs = do
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((forall a. IsLabel "curPrevious" a => a
#curPrevious forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ forall a. [a] -> a
last [Point Double]
xs) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. IsLabel "curControl" a => a
#curControl forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ forall a. Maybe a
Nothing))
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. Point a -> PathData a
LineP forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Point Double]
xs

horTo :: [Double] -> State PathCursor [PathData Double]
horTo :: [Double] -> State PathCursor [PathData Double]
horTo [Double]
xs = do
  (PathCursor (Point Double
_ Double
y) Point Double
_ Maybe (Point Double)
_) <- forall s (m :: * -> *). MonadState s m => m s
get
  [Point Double] -> State PathCursor [PathData Double]
lineTo (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. a -> a -> Point a
`Point` Double
y) [Double]
xs)

verTo :: [Double] -> State PathCursor [PathData Double]
verTo :: [Double] -> State PathCursor [PathData Double]
verTo [Double]
ys = do
  (PathCursor (Point Double
x Double
_) Point Double
_ Maybe (Point Double)
_) <- forall s (m :: * -> *). MonadState s m => m s
get
  [Point Double] -> State PathCursor [PathData Double]
lineTo (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. a -> a -> Point a
Point Double
x) [Double]
ys)

curveTo :: [(Point Double, Point Double, Point Double)] -> State PathCursor [PathData Double]
curveTo :: [(Point Double, Point Double, Point Double)]
-> State PathCursor [PathData Double]
curveTo [(Point Double, Point Double, Point Double)]
xs = do
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify
    ( (forall a. IsLabel "curPrevious" a => a
#curPrevious forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ (\(Point Double
_, Point Double
_, Point Double
p) -> Point Double
p) (forall a. [a] -> a
last [(Point Double, Point Double, Point Double)]
xs))
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. IsLabel "curControl" a => a
#curControl forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a (Maybe b) -> b -> s -> t
?~ (\(Point Double
_, Point Double
c2, Point Double
_) -> Point Double
c2) (forall a. [a] -> a
last [(Point Double, Point Double, Point Double)]
xs))
    )
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (\(Point Double
c1, Point Double
c2, Point Double
x2) -> forall a. Point a -> Point a -> Point a -> PathData a
CubicP Point Double
c1 Point Double
c2 Point Double
x2) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Point Double, Point Double, Point Double)]
xs

-- | Convert relative points to absolute points
relToAbs3 :: (Additive a) => a -> [(a, a, a)] -> [(a, a, a)]
relToAbs3 :: forall a. Additive a => a -> [(a, a, a)] -> [(a, a, a)]
relToAbs3 a
p [(a, a, a)]
xs = [(a, a, a)]
xs'
  where
    x1 :: [a]
x1 = (\(a
x, a
_, a
_) -> a
x) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(a, a, a)]
xs
    x2 :: [a]
x2 = (\(a
_, a
x, a
_) -> a
x) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(a, a, a)]
xs
    x3 :: [a]
x3 = (\(a
_, a
_, a
x) -> a
x) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(a, a, a)]
xs
    x1' :: [a]
x1' = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a
p forall a. Additive a => a -> a -> a
+) (forall a (f :: * -> *). (Additive a, Traversable f) => f a -> f a
accsum [a]
x1)
    x2' :: [a]
x2' = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a
p forall a. Additive a => a -> a -> a
+) (forall a (f :: * -> *). (Additive a, Traversable f) => f a -> f a
accsum [a]
x2)
    x3' :: [a]
x3' = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a
p forall a. Additive a => a -> a -> a
+) (forall a (f :: * -> *). (Additive a, Traversable f) => f a -> f a
accsum [a]
x3)
    xs' :: [(a, a, a)]
xs' = forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [a]
x1' [a]
x2' [a]
x3'

reflControlPoint :: State PathCursor (Point Double)
reflControlPoint :: State PathCursor (Point Double)
reflControlPoint = do
  (PathCursor Point Double
p Point Double
_ Maybe (Point Double)
c) <- forall s (m :: * -> *). MonadState s m => m s
get
  case Maybe (Point Double)
c of
    Maybe (Point Double)
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Point Double
p
    Just Point Double
c' -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Point Double
p forall a. Subtractive a => a -> a -> a
- (Point Double
c' forall a. Subtractive a => a -> a -> a
- Point Double
p))

smoothCurveToStep :: (Point Double, Point Double) -> State PathCursor (PathData Double)
smoothCurveToStep :: (Point Double, Point Double) -> State PathCursor (PathData Double)
smoothCurveToStep (Point Double
c2, Point Double
x2) = do
  Point Double
c1 <- State PathCursor (Point Double)
reflControlPoint
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((forall a. IsLabel "curControl" a => a
#curControl forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a (Maybe b) -> b -> s -> t
?~ Point Double
c2) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. IsLabel "curPrevious" a => a
#curPrevious forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Point Double
x2))
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. Point a -> Point a -> Point a -> PathData a
CubicP Point Double
c1 Point Double
c2 Point Double
x2)

smoothCurveTo :: [(Point Double, Point Double)] -> State PathCursor [PathData Double]
smoothCurveTo :: [(Point Double, Point Double)]
-> State PathCursor [PathData Double]
smoothCurveTo [(Point Double, Point Double)]
xs =
  forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Point Double, Point Double) -> State PathCursor (PathData Double)
smoothCurveToStep [(Point Double, Point Double)]
xs

-- | Convert relative points to absolute points
relToAbs2 :: (Additive a) => a -> [(a, a)] -> [(a, a)]
relToAbs2 :: forall a. Additive a => a -> [(a, a)] -> [(a, a)]
relToAbs2 a
p [(a, a)]
xs = [(a, a)]
xs'
  where
    x1 :: [a]
x1 = forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(a, a)]
xs
    x2 :: [a]
x2 = forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(a, a)]
xs
    x1' :: [a]
x1' = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a
p forall a. Additive a => a -> a -> a
+) (forall a (f :: * -> *). (Additive a, Traversable f) => f a -> f a
accsum [a]
x1)
    x2' :: [a]
x2' = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a
p forall a. Additive a => a -> a -> a
+) (forall a (f :: * -> *). (Additive a, Traversable f) => f a -> f a
accsum [a]
x2)
    xs' :: [(a, a)]
xs' = forall a b. [a] -> [b] -> [(a, b)]
zip [a]
x1' [a]
x2'

quad :: [(Point Double, Point Double)] -> State PathCursor [PathData Double]
quad :: [(Point Double, Point Double)]
-> State PathCursor [PathData Double]
quad [(Point Double, Point Double)]
xs = do
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify
    ( (forall a. IsLabel "curPrevious" a => a
#curPrevious forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ forall a b. (a, b) -> b
snd (forall a. [a] -> a
last [(Point Double, Point Double)]
xs))
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. IsLabel "curControl" a => a
#curControl forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a (Maybe b) -> b -> s -> t
?~ forall a b. (a, b) -> a
fst (forall a. [a] -> a
last [(Point Double, Point Double)]
xs))
    )
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Point a -> Point a -> PathData a
QuadP forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Point Double, Point Double)]
xs

smoothQuadStep :: Point Double -> State PathCursor (PathData Double)
smoothQuadStep :: Point Double -> State PathCursor (PathData Double)
smoothQuadStep Point Double
x2 = do
  Point Double
c1 <- State PathCursor (Point Double)
reflControlPoint
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((forall a. IsLabel "curControl" a => a
#curControl forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a (Maybe b) -> b -> s -> t
?~ Point Double
c1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. IsLabel "curPrevious" a => a
#curPrevious forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Point Double
x2))
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. Point a -> Point a -> PathData a
QuadP Point Double
c1 Point Double
x2)

smoothQuad :: [Point Double] -> State PathCursor [PathData Double]
smoothQuad :: [Point Double] -> State PathCursor [PathData Double]
smoothQuad [Point Double]
xs =
  forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Point Double -> State PathCursor (PathData Double)
smoothQuadStep [Point Double]
xs

arcTo :: [(Double, Double, Double, Bool, Bool, Point Double)] -> State PathCursor [PathData Double]
arcTo :: [(Double, Double, Double, Bool, Bool, Point Double)]
-> State PathCursor [PathData Double]
arcTo [(Double, Double, Double, Bool, Bool, Point Double)]
xs = do
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((forall a. IsLabel "curPrevious" a => a
#curPrevious forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ (\(Double
_, Double
_, Double
_, Bool
_, Bool
_, Point Double
p) -> Point Double
p) (forall a. [a] -> a
last [(Double, Double, Double, Bool, Bool, Point Double)]
xs)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. IsLabel "curControl" a => a
#curControl forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ forall a. Maybe a
Nothing))
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. (a, a, a, Bool, Bool, Point a) -> PathData a
fromPathEllipticalArc forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Double, Double, Double, Bool, Bool, Point Double)]
xs

fromPathEllipticalArc :: (a, a, a, Bool, Bool, Point a) -> PathData a
fromPathEllipticalArc :: forall a. (a, a, a, Bool, Bool, Point a) -> PathData a
fromPathEllipticalArc (a
x, a
y, a
r, Bool
l, Bool
s, Point a
p) = forall a. ArcInfo a -> Point a -> PathData a
ArcP (forall a. Point a -> a -> Bool -> Bool -> ArcInfo a
ArcInfo (forall a. a -> a -> Point a
Point a
x a
y) a
r Bool
l Bool
s) Point a
p

-- | Convert relative points to absolute points
relToAbsArc :: (Additive a) => Point a -> [(a, a, a, Bool, Bool, Point a)] -> [(a, a, a, Bool, Bool, Point a)]
relToAbsArc :: forall a.
Additive a =>
Point a
-> [(a, a, a, Bool, Bool, Point a)]
-> [(a, a, a, Bool, Bool, Point a)]
relToAbsArc Point a
p [(a, a, a, Bool, Bool, Point a)]
xs = [(a, a, a, Bool, Bool, Point a)]
xs'
  where
    ps :: [Point a]
ps = (\(a
_, a
_, a
_, Bool
_, Bool
_, Point a
pt) -> Point a
pt) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(a, a, a, Bool, Bool, Point a)]
xs
    ps' :: [Point a]
ps' = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Point a
p forall a. Additive a => a -> a -> a
+) (forall a (f :: * -> *). (Additive a, Traversable f) => f a -> f a
accsum [Point a]
ps)
    xs' :: [(a, a, a, Bool, Bool, Point a)]
xs' = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\(a
x0, a
x1, a
x2, Bool
x3, Bool
x4, Point a
_) Point a
pt -> (a
x0, a
x1, a
x2, Bool
x3, Bool
x4, Point a
pt)) [(a, a, a, Bool, Bool, Point a)]
xs [Point a]
ps'

-- | Convert a path command fragment to PathData
--
-- flips the y-dimension of points.
toPathData :: PathCommand -> State PathCursor [PathData Double]
toPathData :: PathCommand -> State PathCursor [PathData Double]
toPathData (MoveTo Origin
OriginAbsolute [Point Double]
xs) = [Point Double] -> State PathCursor [PathData Double]
moveTo [Point Double]
xs
toPathData (MoveTo Origin
OriginRelative [Point Double]
xs) = do
  (PathCursor Point Double
p Point Double
_ Maybe (Point Double)
_) <- forall s (m :: * -> *). MonadState s m => m s
get
  [Point Double] -> State PathCursor [PathData Double]
moveTo (forall a. Additive a => a -> [a] -> [a]
relToAbs Point Double
p [Point Double]
xs)
toPathData PathCommand
EndPath = do
  (PathCursor Point Double
_ Point Double
s Maybe (Point Double)
_) <- forall s (m :: * -> *). MonadState s m => m s
get
  forall (f :: * -> *) a. Applicative f => a -> f a
pure [forall a. Point a -> PathData a
LineP Point Double
s]
toPathData (LineTo Origin
OriginAbsolute [Point Double]
xs) = [Point Double] -> State PathCursor [PathData Double]
lineTo [Point Double]
xs
toPathData (LineTo Origin
OriginRelative [Point Double]
xs) = do
  (PathCursor Point Double
p Point Double
_ Maybe (Point Double)
_) <- forall s (m :: * -> *). MonadState s m => m s
get
  [Point Double] -> State PathCursor [PathData Double]
lineTo (forall a. Additive a => a -> [a] -> [a]
relToAbs Point Double
p [Point Double]
xs)
toPathData (HorizontalTo Origin
OriginAbsolute [Double]
xs) = [Double] -> State PathCursor [PathData Double]
horTo [Double]
xs
toPathData (HorizontalTo Origin
OriginRelative [Double]
xs) = do
  (PathCursor (Point Double
x Double
_) Point Double
_ Maybe (Point Double)
_) <- forall s (m :: * -> *). MonadState s m => m s
get
  [Double] -> State PathCursor [PathData Double]
horTo (forall a. Additive a => a -> [a] -> [a]
relToAbs Double
x [Double]
xs)
toPathData (VerticalTo Origin
OriginAbsolute [Double]
xs) = [Double] -> State PathCursor [PathData Double]
verTo [Double]
xs
toPathData (VerticalTo Origin
OriginRelative [Double]
ys) = do
  (PathCursor (Point Double
_ Double
y) Point Double
_ Maybe (Point Double)
_) <- forall s (m :: * -> *). MonadState s m => m s
get
  [Double] -> State PathCursor [PathData Double]
verTo (forall a. Additive a => a -> [a] -> [a]
relToAbs Double
y [Double]
ys)
toPathData (CurveTo Origin
OriginAbsolute [(Point Double, Point Double, Point Double)]
xs) = [(Point Double, Point Double, Point Double)]
-> State PathCursor [PathData Double]
curveTo [(Point Double, Point Double, Point Double)]
xs
toPathData (CurveTo Origin
OriginRelative [(Point Double, Point Double, Point Double)]
xs) = do
  (PathCursor Point Double
p Point Double
_ Maybe (Point Double)
_) <- forall s (m :: * -> *). MonadState s m => m s
get
  [(Point Double, Point Double, Point Double)]
-> State PathCursor [PathData Double]
curveTo (forall a. Additive a => a -> [(a, a, a)] -> [(a, a, a)]
relToAbs3 Point Double
p [(Point Double, Point Double, Point Double)]
xs)
toPathData (SmoothCurveTo Origin
OriginAbsolute [(Point Double, Point Double)]
xs) = [(Point Double, Point Double)]
-> State PathCursor [PathData Double]
smoothCurveTo [(Point Double, Point Double)]
xs
toPathData (SmoothCurveTo Origin
OriginRelative [(Point Double, Point Double)]
xs) = do
  (PathCursor Point Double
p Point Double
_ Maybe (Point Double)
_) <- forall s (m :: * -> *). MonadState s m => m s
get
  [(Point Double, Point Double)]
-> State PathCursor [PathData Double]
smoothCurveTo (forall a. Additive a => a -> [(a, a)] -> [(a, a)]
relToAbs2 Point Double
p [(Point Double, Point Double)]
xs)
toPathData (QuadraticBezier Origin
OriginAbsolute [(Point Double, Point Double)]
xs) = [(Point Double, Point Double)]
-> State PathCursor [PathData Double]
quad [(Point Double, Point Double)]
xs
toPathData (QuadraticBezier Origin
OriginRelative [(Point Double, Point Double)]
xs) = do
  (PathCursor Point Double
p Point Double
_ Maybe (Point Double)
_) <- forall s (m :: * -> *). MonadState s m => m s
get
  [(Point Double, Point Double)]
-> State PathCursor [PathData Double]
quad (forall a. Additive a => a -> [(a, a)] -> [(a, a)]
relToAbs2 Point Double
p [(Point Double, Point Double)]
xs)
toPathData (SmoothQuadraticBezierCurveTo Origin
OriginAbsolute [Point Double]
xs) = [Point Double] -> State PathCursor [PathData Double]
smoothQuad [Point Double]
xs
toPathData (SmoothQuadraticBezierCurveTo Origin
OriginRelative [Point Double]
xs) = do
  (PathCursor Point Double
p Point Double
_ Maybe (Point Double)
_) <- forall s (m :: * -> *). MonadState s m => m s
get
  [Point Double] -> State PathCursor [PathData Double]
smoothQuad (forall a. Additive a => a -> [a] -> [a]
relToAbs Point Double
p [Point Double]
xs)
toPathData (EllipticalArc Origin
OriginAbsolute [(Double, Double, Double, Bool, Bool, Point Double)]
xs) = [(Double, Double, Double, Bool, Bool, Point Double)]
-> State PathCursor [PathData Double]
arcTo [(Double, Double, Double, Bool, Bool, Point Double)]
xs
toPathData (EllipticalArc Origin
OriginRelative [(Double, Double, Double, Bool, Bool, Point Double)]
xs) = do
  (PathCursor Point Double
p Point Double
_ Maybe (Point Double)
_) <- forall s (m :: * -> *). MonadState s m => m s
get
  [(Double, Double, Double, Bool, Bool, Point Double)]
-> State PathCursor [PathData Double]
arcTo (forall a.
Additive a =>
Point a
-> [(a, a, a, Bool, Bool, Point a)]
-> [(a, a, a, Bool, Bool, Point a)]
relToAbsArc Point Double
p [(Double, Double, Double, Bool, Bool, Point Double)]
xs)