{-# 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 ( PathData(..), ArcInfo(ArcInfo) )
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.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence forall a b. (a -> b) -> a -> b
$ PathCommand -> StateT PathCursor Identity [PathData Double]
toPathData forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [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] -> StateT PathCursor Identity [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] -> StateT PathCursor Identity [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] -> StateT PathCursor Identity [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] -> StateT PathCursor Identity [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] -> StateT PathCursor Identity [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] -> StateT PathCursor Identity [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)]
-> StateT PathCursor Identity [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)]
-> StateT PathCursor Identity [PathData Double]
smoothCurveTo [(Point Double, Point Double)]
xs =
  forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ((Point Double, Point Double) -> State PathCursor (PathData Double)
smoothCurveToStep forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(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)]
-> StateT PathCursor Identity [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] -> StateT PathCursor Identity [PathData Double]
smoothQuad [Point Double]
xs =
  forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence (Point Double -> State PathCursor (PathData Double)
smoothQuadStep forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Point Double]
xs)

arcTo :: [(Double, Double, Double, Bool, Bool, Point Double)] -> State PathCursor [PathData Double]
arcTo :: [(Double, Double, Double, Bool, Bool, Point Double)]
-> StateT PathCursor Identity [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 -> StateT PathCursor Identity [PathData Double]
toPathData (MoveTo Origin
OriginAbsolute [Point Double]
xs) = [Point Double] -> StateT PathCursor Identity [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] -> StateT PathCursor Identity [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] -> StateT PathCursor Identity [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] -> StateT PathCursor Identity [PathData Double]
lineTo (forall a. Additive a => a -> [a] -> [a]
relToAbs Point Double
p [Point Double]
xs)
toPathData (HorizontalTo Origin
OriginAbsolute [Double]
xs) = [Double] -> StateT PathCursor Identity [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] -> StateT PathCursor Identity [PathData Double]
horTo (forall a. Additive a => a -> [a] -> [a]
relToAbs Double
x [Double]
xs)
toPathData (VerticalTo Origin
OriginAbsolute [Double]
xs) = [Double] -> StateT PathCursor Identity [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] -> StateT PathCursor Identity [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)]
-> StateT PathCursor Identity [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)]
-> StateT PathCursor Identity [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)]
-> StateT PathCursor Identity [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)]
-> StateT PathCursor Identity [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)]
-> StateT PathCursor Identity [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)]
-> StateT PathCursor Identity [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] -> StateT PathCursor Identity [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] -> StateT PathCursor Identity [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)]
-> StateT PathCursor Identity [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)]
-> StateT PathCursor Identity [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)