{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RebindableSyntax #-}
{-# OPTIONS_GHC -Wall #-}
module Data.Path.Parser
(
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
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 ((<|))
parsePath :: Text -> Either String [PathCommand]
parsePath :: Text -> Either String [PathCommand]
parsePath = Parser [PathCommand] -> Text -> Either String [PathCommand]
forall a. Parser a -> Text -> Either String a
A.parseOnly Parser [PathCommand]
pathParser
commaWsp :: A.Parser ()
commaWsp :: Parser ()
commaWsp = Parser ()
A.skipSpace Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> () -> Parser () -> Parser ()
forall (f :: * -> *) a. Alternative f => a -> f a -> f a
A.option () (Text -> Parser Text
A.string Text
"," Parser Text -> () -> Parser ()
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ()) Parser () -> Parser () -> Parser ()
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 = Double -> Double -> Point Double
forall a. a -> a -> Point a
Point (Double -> Double -> Point Double)
-> Parser Text Double -> Parser Text (Double -> Point Double)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Double
num Parser Text (Double -> Point Double)
-> Parser () -> Parser Text (Double -> Point Double)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
commaWsp Parser Text (Double -> Point Double)
-> Parser Text Double -> Parser (Point Double)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text Double
num
points :: A.Parser [Point Double]
points :: Parser [Point Double]
points = [Point Double] -> [Point Double]
forall l. IsList l => [Item l] -> l
fromList ([Point Double] -> [Point Double])
-> Parser [Point Double] -> Parser [Point Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Point Double)
point Parser (Point Double) -> Parser () -> Parser [Point Double]
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 = (,) (Point Double -> Point Double -> (Point Double, Point Double))
-> Parser (Point Double)
-> Parser Text (Point Double -> (Point Double, Point Double))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Point Double)
point Parser Text (Point Double -> (Point Double, Point Double))
-> Parser ()
-> Parser Text (Point Double -> (Point Double, Point Double))
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
commaWsp Parser Text (Point Double -> (Point Double, Point Double))
-> Parser (Point Double) -> Parser (Point Double, Point Double)
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 = [(Point Double, Point Double)] -> [(Point Double, Point Double)]
forall l. IsList l => [Item l] -> l
fromList ([(Point Double, Point Double)] -> [(Point Double, Point Double)])
-> Parser [(Point Double, Point Double)]
-> Parser [(Point Double, Point Double)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Point Double, Point Double)
pointPair Parser (Point Double, Point Double)
-> Parser () -> Parser [(Point Double, Point Double)]
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
`A.sepBy1` Parser ()
commaWsp
pathParser :: A.Parser [PathCommand]
pathParser :: Parser [PathCommand]
pathParser = [PathCommand] -> [PathCommand]
forall l. IsList l => [Item l] -> l
fromList ([PathCommand] -> [PathCommand])
-> Parser [PathCommand] -> Parser [PathCommand]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser ()
A.skipSpace Parser () -> Parser [PathCommand] -> Parser [PathCommand]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text PathCommand -> Parser [PathCommand]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
A.many1 Parser Text PathCommand
command)
num :: A.Parser Double
num :: Parser Text Double
num = Double -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Double -> Double) -> Parser Text Double -> Parser Text Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser ()
A.skipSpace Parser () -> Parser Text Double -> Parser Text Double
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text Double
plusMinus Parser Text Double -> Parser () -> Parser Text Double
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
A.skipSpace)
where
doubleNumber :: A.Parser Double
doubleNumber :: Parser Text Double
doubleNumber = Scientific -> Double
forall a. RealFloat a => Scientific -> a
toRealFloat (Scientific -> Double)
-> Parser Text Scientific -> Parser Text Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Scientific
A.scientific Parser Text Double -> Parser Text Double -> Parser Text Double
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text Double
shorthand
plusMinus :: Parser Text Double
plusMinus =
Double -> Double
forall a. Subtractive a => a -> a
negate (Double -> Double) -> Parser Text -> Parser Text (Double -> Double)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
A.string Text
"-" Parser Text (Double -> Double)
-> Parser Text Double -> Parser Text Double
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text Double
doubleNumber
Parser Text Double -> Parser Text Double -> Parser Text Double
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Parser Text
A.string Text
"+" Parser Text -> Parser Text Double -> Parser Text Double
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text Double
doubleNumber
Parser Text Double -> Parser Text Double -> Parser Text Double
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text Double
doubleNumber
shorthand :: Parser Text Double
shorthand = String -> Double
process' (String -> Double) -> Parser Text String -> Parser Text Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Parser Text
A.string Text
"." Parser Text -> Parser Text String -> Parser Text String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text Char -> Parser Text String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
A.many1 Parser Text Char
A.digit)
process' :: String -> Double
process' = Double -> Either String Double -> Double
forall b a. b -> Either a b -> b
fromRight Double
0 (Either String Double -> Double)
-> (String -> Either String Double) -> String -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser Text Double -> Text -> Either String Double
forall a. Parser a -> Text -> Either String a
A.parseOnly Parser Text Double
doubleNumber (Text -> Either String Double)
-> (String -> Text) -> String -> Either String Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack (String -> Text) -> (String -> String) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
forall a. [a] -> [a] -> [a]
(++) String
"0."
nums :: A.Parser [Double]
nums :: Parser [Double]
nums = Parser Text Double
num Parser Text Double -> Parser () -> Parser [Double]
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
`A.sepBy1` Parser ()
commaWsp
flag :: A.Parser Bool
flag :: Parser Bool
flag = (Char -> Bool) -> Parser Text Char -> Parser Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'0') Parser Text Char
A.digit
command :: A.Parser PathCommand
command :: Parser Text PathCommand
command =
Origin -> [Point Double] -> PathCommand
MoveTo Origin
OriginAbsolute ([Point Double] -> PathCommand)
-> Parser Text -> Parser Text ([Point Double] -> PathCommand)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
A.string Text
"M" Parser Text ([Point Double] -> PathCommand)
-> Parser [Point Double] -> Parser Text PathCommand
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [Point Double]
points
Parser Text PathCommand
-> Parser Text PathCommand -> Parser Text PathCommand
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Origin -> [Point Double] -> PathCommand
MoveTo Origin
OriginRelative ([Point Double] -> PathCommand)
-> Parser Text -> Parser Text ([Point Double] -> PathCommand)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
A.string Text
"m" Parser Text ([Point Double] -> PathCommand)
-> Parser [Point Double] -> Parser Text PathCommand
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [Point Double]
points
Parser Text PathCommand
-> Parser Text PathCommand -> Parser Text PathCommand
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Origin -> [Point Double] -> PathCommand
LineTo Origin
OriginAbsolute ([Point Double] -> PathCommand)
-> Parser Text -> Parser Text ([Point Double] -> PathCommand)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
A.string Text
"L" Parser Text ([Point Double] -> PathCommand)
-> Parser [Point Double] -> Parser Text PathCommand
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [Point Double]
points
Parser Text PathCommand
-> Parser Text PathCommand -> Parser Text PathCommand
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Origin -> [Point Double] -> PathCommand
LineTo Origin
OriginRelative ([Point Double] -> PathCommand)
-> Parser Text -> Parser Text ([Point Double] -> PathCommand)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
A.string Text
"l" Parser Text ([Point Double] -> PathCommand)
-> Parser [Point Double] -> Parser Text PathCommand
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [Point Double]
points
Parser Text PathCommand
-> Parser Text PathCommand -> Parser Text PathCommand
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Origin -> [Double] -> PathCommand
HorizontalTo Origin
OriginAbsolute ([Double] -> PathCommand)
-> Parser Text -> Parser Text ([Double] -> PathCommand)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
A.string Text
"H" Parser Text ([Double] -> PathCommand)
-> Parser [Double] -> Parser Text PathCommand
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [Double]
nums
Parser Text PathCommand
-> Parser Text PathCommand -> Parser Text PathCommand
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Origin -> [Double] -> PathCommand
HorizontalTo Origin
OriginRelative ([Double] -> PathCommand)
-> Parser Text -> Parser Text ([Double] -> PathCommand)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
A.string Text
"h" Parser Text ([Double] -> PathCommand)
-> Parser [Double] -> Parser Text PathCommand
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [Double]
nums
Parser Text PathCommand
-> Parser Text PathCommand -> Parser Text PathCommand
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Origin -> [Double] -> PathCommand
VerticalTo Origin
OriginAbsolute ([Double] -> PathCommand)
-> Parser Text -> Parser Text ([Double] -> PathCommand)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
A.string Text
"V" Parser Text ([Double] -> PathCommand)
-> Parser [Double] -> Parser Text PathCommand
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [Double]
nums
Parser Text PathCommand
-> Parser Text PathCommand -> Parser Text PathCommand
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Origin -> [Double] -> PathCommand
VerticalTo Origin
OriginRelative ([Double] -> PathCommand)
-> Parser Text -> Parser Text ([Double] -> PathCommand)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
A.string Text
"v" Parser Text ([Double] -> PathCommand)
-> Parser [Double] -> Parser Text PathCommand
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [Double]
nums
Parser Text PathCommand
-> Parser Text PathCommand -> Parser Text PathCommand
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Origin
-> [(Point Double, Point Double, Point Double)] -> PathCommand
CurveTo Origin
OriginAbsolute ([(Point Double, Point Double, Point Double)] -> PathCommand)
-> Parser Text
-> Parser
Text ([(Point Double, Point Double, Point Double)] -> PathCommand)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
A.string Text
"C" Parser
Text ([(Point Double, Point Double, Point Double)] -> PathCommand)
-> Parser Text [(Point Double, Point Double, Point Double)]
-> Parser Text PathCommand
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([(Point Double, Point Double, Point Double)]
-> [(Point Double, Point Double, Point Double)])
-> Parser Text [(Point Double, Point Double, Point Double)]
-> Parser Text [(Point Double, Point Double, Point Double)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(Point Double, Point Double, Point Double)]
-> [(Point Double, Point Double, Point Double)]
forall l. IsList l => [Item l] -> l
fromList (Parser Text (Item [(Point Double, Point Double, Point Double)])
-> Parser Text [(Point Double, Point Double, Point Double)]
forall b. IsList b => Parser Text (Item b) -> Parser Text b
manyComma Parser Text (Point Double, Point Double, Point Double)
Parser Text (Item [(Point Double, Point Double, Point Double)])
curveToArgs)
Parser Text PathCommand
-> Parser Text PathCommand -> Parser Text PathCommand
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Origin
-> [(Point Double, Point Double, Point Double)] -> PathCommand
CurveTo Origin
OriginRelative ([(Point Double, Point Double, Point Double)] -> PathCommand)
-> Parser Text
-> Parser
Text ([(Point Double, Point Double, Point Double)] -> PathCommand)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
A.string Text
"c" Parser
Text ([(Point Double, Point Double, Point Double)] -> PathCommand)
-> Parser Text [(Point Double, Point Double, Point Double)]
-> Parser Text PathCommand
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([(Point Double, Point Double, Point Double)]
-> [(Point Double, Point Double, Point Double)])
-> Parser Text [(Point Double, Point Double, Point Double)]
-> Parser Text [(Point Double, Point Double, Point Double)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(Point Double, Point Double, Point Double)]
-> [(Point Double, Point Double, Point Double)]
forall l. IsList l => [Item l] -> l
fromList (Parser Text (Item [(Point Double, Point Double, Point Double)])
-> Parser Text [(Point Double, Point Double, Point Double)]
forall b. IsList b => Parser Text (Item b) -> Parser Text b
manyComma Parser Text (Point Double, Point Double, Point Double)
Parser Text (Item [(Point Double, Point Double, Point Double)])
curveToArgs)
Parser Text PathCommand
-> Parser Text PathCommand -> Parser Text PathCommand
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Origin -> [(Point Double, Point Double)] -> PathCommand
SmoothCurveTo Origin
OriginAbsolute ([(Point Double, Point Double)] -> PathCommand)
-> Parser Text
-> Parser Text ([(Point Double, Point Double)] -> PathCommand)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
A.string Text
"S" Parser Text ([(Point Double, Point Double)] -> PathCommand)
-> Parser [(Point Double, Point Double)] -> Parser Text PathCommand
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [(Point Double, Point Double)]
pointPairs
Parser Text PathCommand
-> Parser Text PathCommand -> Parser Text PathCommand
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Origin -> [(Point Double, Point Double)] -> PathCommand
SmoothCurveTo Origin
OriginRelative ([(Point Double, Point Double)] -> PathCommand)
-> Parser Text
-> Parser Text ([(Point Double, Point Double)] -> PathCommand)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
A.string Text
"s" Parser Text ([(Point Double, Point Double)] -> PathCommand)
-> Parser [(Point Double, Point Double)] -> Parser Text PathCommand
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [(Point Double, Point Double)]
pointPairs
Parser Text PathCommand
-> Parser Text PathCommand -> Parser Text PathCommand
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Origin -> [(Point Double, Point Double)] -> PathCommand
QuadraticBezier Origin
OriginAbsolute ([(Point Double, Point Double)] -> PathCommand)
-> Parser Text
-> Parser Text ([(Point Double, Point Double)] -> PathCommand)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
A.string Text
"Q" Parser Text ([(Point Double, Point Double)] -> PathCommand)
-> Parser [(Point Double, Point Double)] -> Parser Text PathCommand
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [(Point Double, Point Double)]
pointPairs
Parser Text PathCommand
-> Parser Text PathCommand -> Parser Text PathCommand
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Origin -> [(Point Double, Point Double)] -> PathCommand
QuadraticBezier Origin
OriginRelative ([(Point Double, Point Double)] -> PathCommand)
-> Parser Text
-> Parser Text ([(Point Double, Point Double)] -> PathCommand)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
A.string Text
"q" Parser Text ([(Point Double, Point Double)] -> PathCommand)
-> Parser [(Point Double, Point Double)] -> Parser Text PathCommand
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [(Point Double, Point Double)]
pointPairs
Parser Text PathCommand
-> Parser Text PathCommand -> Parser Text PathCommand
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Origin -> [Point Double] -> PathCommand
SmoothQuadraticBezierCurveTo Origin
OriginAbsolute ([Point Double] -> PathCommand)
-> Parser Text -> Parser Text ([Point Double] -> PathCommand)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
A.string Text
"T" Parser Text ([Point Double] -> PathCommand)
-> Parser [Point Double] -> Parser Text PathCommand
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [Point Double]
points
Parser Text PathCommand
-> Parser Text PathCommand -> Parser Text PathCommand
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Origin -> [Point Double] -> PathCommand
SmoothQuadraticBezierCurveTo Origin
OriginRelative ([Point Double] -> PathCommand)
-> Parser Text -> Parser Text ([Point Double] -> PathCommand)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
A.string Text
"t" Parser Text ([Point Double] -> PathCommand)
-> Parser [Point Double] -> Parser Text PathCommand
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [Point Double]
points
Parser Text PathCommand
-> Parser Text PathCommand -> Parser Text PathCommand
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Origin
-> [(Double, Double, Double, Bool, Bool, Point Double)]
-> PathCommand
EllipticalArc Origin
OriginAbsolute ([(Double, Double, Double, Bool, Bool, Point Double)]
-> PathCommand)
-> Parser Text
-> Parser
Text
([(Double, Double, Double, Bool, Bool, Point Double)]
-> PathCommand)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
A.string Text
"A" Parser
Text
([(Double, Double, Double, Bool, Bool, Point Double)]
-> PathCommand)
-> Parser Text [(Double, Double, Double, Bool, Bool, Point Double)]
-> Parser Text PathCommand
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser
Text (Item [(Double, Double, Double, Bool, Bool, Point Double)])
-> Parser Text [(Double, Double, Double, Bool, Bool, Point Double)]
forall b. IsList b => Parser Text (Item b) -> Parser Text b
manyComma Parser Text (Double, Double, Double, Bool, Bool, Point Double)
Parser
Text (Item [(Double, Double, Double, Bool, Bool, Point Double)])
ellipticalArgs
Parser Text PathCommand
-> Parser Text PathCommand -> Parser Text PathCommand
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Origin
-> [(Double, Double, Double, Bool, Bool, Point Double)]
-> PathCommand
EllipticalArc Origin
OriginRelative ([(Double, Double, Double, Bool, Bool, Point Double)]
-> PathCommand)
-> Parser Text
-> Parser
Text
([(Double, Double, Double, Bool, Bool, Point Double)]
-> PathCommand)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
A.string Text
"a" Parser
Text
([(Double, Double, Double, Bool, Bool, Point Double)]
-> PathCommand)
-> Parser Text [(Double, Double, Double, Bool, Bool, Point Double)]
-> Parser Text PathCommand
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser
Text (Item [(Double, Double, Double, Bool, Bool, Point Double)])
-> Parser Text [(Double, Double, Double, Bool, Bool, Point Double)]
forall b. IsList b => Parser Text (Item b) -> Parser Text b
manyComma Parser Text (Double, Double, Double, Bool, Bool, Point Double)
Parser
Text (Item [(Double, Double, Double, Bool, Bool, Point Double)])
ellipticalArgs
Parser Text PathCommand
-> Parser Text PathCommand -> Parser Text PathCommand
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> PathCommand
EndPath PathCommand -> Parser Text -> Parser Text PathCommand
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
A.string Text
"Z" Parser Text PathCommand -> Parser () -> Parser Text PathCommand
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
commaWsp
Parser Text PathCommand
-> Parser Text PathCommand -> Parser Text PathCommand
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> PathCommand
EndPath PathCommand -> Parser Text -> Parser Text PathCommand
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
A.string Text
"z" Parser Text PathCommand -> Parser () -> Parser Text PathCommand
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 =
(,,) (Point Double
-> Point Double
-> Point Double
-> (Point Double, Point Double, Point Double))
-> Parser (Point Double)
-> Parser
Text
(Point Double
-> Point Double -> (Point Double, Point Double, Point Double))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser (Point Double)
point Parser (Point Double) -> Parser () -> Parser (Point Double)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
commaWsp)
Parser
Text
(Point Double
-> Point Double -> (Point Double, Point Double, Point Double))
-> Parser (Point Double)
-> Parser
Text (Point Double -> (Point Double, Point Double, Point Double))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser (Point Double)
point Parser (Point Double) -> Parser () -> Parser (Point Double)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
commaWsp)
Parser
Text (Point Double -> (Point Double, Point Double, Point Double))
-> Parser (Point Double)
-> Parser Text (Point Double, Point Double, Point Double)
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 = [Item b] -> b
forall l. IsList l => [Item l] -> l
fromList ([Item b] -> b) -> Parser Text [Item b] -> Parser Text b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text (Item b)
a Parser Text (Item b) -> Parser () -> Parser Text [Item b]
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
`A.sepBy1` Parser ()
commaWsp
numComma :: Parser Text Double
numComma = Parser Text Double
num Parser Text Double -> Parser () -> Parser Text Double
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
commaWsp
flagComma :: Parser Bool
flagComma = Parser Bool
flag Parser Bool -> Parser () -> Parser Bool
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 =
(,,,,,) (Double
-> Double
-> Double
-> Bool
-> Bool
-> Point Double
-> (Double, Double, Double, Bool, Bool, Point Double))
-> Parser Text Double
-> Parser
Text
(Double
-> Double
-> Bool
-> Bool
-> Point Double
-> (Double, Double, Double, Bool, Bool, Point Double))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Double
numComma
Parser
Text
(Double
-> Double
-> Bool
-> Bool
-> Point Double
-> (Double, Double, Double, Bool, Bool, Point Double))
-> Parser Text Double
-> Parser
Text
(Double
-> Bool
-> Bool
-> Point Double
-> (Double, Double, Double, Bool, Bool, Point Double))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text Double
numComma
Parser
Text
(Double
-> Bool
-> Bool
-> Point Double
-> (Double, Double, Double, Bool, Bool, Point Double))
-> Parser Text Double
-> Parser
Text
(Bool
-> Bool
-> Point Double
-> (Double, Double, Double, Bool, Bool, Point Double))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text Double
numComma
Parser
Text
(Bool
-> Bool
-> Point Double
-> (Double, Double, Double, Bool, Bool, Point Double))
-> Parser Bool
-> Parser
Text
(Bool
-> Point Double
-> (Double, Double, Double, Bool, Bool, Point Double))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Bool
flagComma
Parser
Text
(Bool
-> Point Double
-> (Double, Double, Double, Bool, Bool, Point Double))
-> Parser Bool
-> Parser
Text
(Point Double
-> (Double, Double, Double, Bool, Bool, Point Double))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Bool
flagComma
Parser
Text
(Point Double
-> (Double, Double, Double, Bool, Bool, Point Double))
-> Parser (Point Double)
-> Parser Text (Double, Double, Double, Bool, Bool, Point Double)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Point Double)
point
data PathCommand
=
MoveTo !Origin ![Point Double]
|
LineTo !Origin ![Point Double]
|
HorizontalTo !Origin ![Double]
|
VerticalTo !Origin ![Double]
|
CurveTo !Origin ![(Point Double, Point Double, Point Double)]
|
SmoothCurveTo !Origin ![(Point Double, Point Double)]
|
QuadraticBezier !Origin ![(Point Double, Point Double)]
|
SmoothQuadraticBezierCurveTo !Origin ![Point Double]
|
EllipticalArc !Origin ![(Double, Double, Double, Bool, Bool, Point Double)]
|
EndPath
deriving (PathCommand -> PathCommand -> Bool
(PathCommand -> PathCommand -> Bool)
-> (PathCommand -> PathCommand -> Bool) -> Eq PathCommand
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 -> String -> String
[PathCommand] -> String -> String
PathCommand -> String
(Int -> PathCommand -> String -> String)
-> (PathCommand -> String)
-> ([PathCommand] -> String -> String)
-> Show PathCommand
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PathCommand] -> String -> String
$cshowList :: [PathCommand] -> String -> String
show :: PathCommand -> String
$cshow :: PathCommand -> String
showsPrec :: Int -> PathCommand -> String -> String
$cshowsPrec :: Int -> PathCommand -> String -> String
Show, (forall x. PathCommand -> Rep PathCommand x)
-> (forall x. Rep PathCommand x -> PathCommand)
-> Generic PathCommand
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)
data Origin
=
OriginAbsolute
|
OriginRelative
deriving (Origin -> Origin -> Bool
(Origin -> Origin -> Bool)
-> (Origin -> Origin -> Bool) -> Eq Origin
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 -> String -> String
[Origin] -> String -> String
Origin -> String
(Int -> Origin -> String -> String)
-> (Origin -> String)
-> ([Origin] -> String -> String)
-> Show Origin
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Origin] -> String -> String
$cshowList :: [Origin] -> String -> String
show :: Origin -> String
$cshow :: Origin -> String
showsPrec :: Int -> Origin -> String -> String
$cshowsPrec :: Int -> Origin -> String -> String
Show, (forall x. Origin -> Rep Origin x)
-> (forall x. Rep Origin x -> Origin) -> Generic Origin
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)
data PathInfo a
= StartI
| LineI
| CubicI (Point a) (Point a)
| QuadI (Point a)
| ArcI (ArcInfo a)
deriving (Int -> PathInfo a -> String -> String
[PathInfo a] -> String -> String
PathInfo a -> String
(Int -> PathInfo a -> String -> String)
-> (PathInfo a -> String)
-> ([PathInfo a] -> String -> String)
-> Show (PathInfo a)
forall a. Show a => Int -> PathInfo a -> String -> String
forall a. Show a => [PathInfo a] -> String -> String
forall a. Show a => PathInfo a -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PathInfo a] -> String -> String
$cshowList :: forall a. Show a => [PathInfo a] -> String -> String
show :: PathInfo a -> String
$cshow :: forall a. Show a => PathInfo a -> String
showsPrec :: Int -> PathInfo a -> String -> String
$cshowsPrec :: forall a. Show a => Int -> PathInfo a -> String -> String
Show, PathInfo a -> PathInfo a -> Bool
(PathInfo a -> PathInfo a -> Bool)
-> (PathInfo a -> PathInfo a -> Bool) -> Eq (PathInfo a)
forall a. Eq a => PathInfo a -> PathInfo a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PathInfo a -> PathInfo a -> Bool
$c/= :: forall a. Eq a => PathInfo a -> PathInfo a -> Bool
== :: PathInfo a -> PathInfo a -> Bool
$c== :: forall a. Eq a => PathInfo a -> PathInfo a -> Bool
Eq, (forall x. PathInfo a -> Rep (PathInfo a) x)
-> (forall x. Rep (PathInfo a) x -> PathInfo a)
-> Generic (PathInfo a)
forall x. Rep (PathInfo a) x -> PathInfo a
forall x. PathInfo a -> Rep (PathInfo a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (PathInfo a) x -> PathInfo a
forall a x. PathInfo a -> Rep (PathInfo a) x
$cto :: forall a x. Rep (PathInfo a) x -> PathInfo a
$cfrom :: forall a x. PathInfo a -> Rep (PathInfo a) x
Generic)
pointToSvgCoords :: Point Double -> Point Double
pointToSvgCoords :: Point Double -> Point Double
pointToSvgCoords (Point Double
x Double
y) = Double -> Double -> Point Double
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) = Point Double -> Point Double -> Point Double -> PathData Double
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) = Point Double -> Point Double -> PathData Double
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) = Point Double -> PathData Double
forall a. Point a -> PathData a
StartP (Point Double -> Point Double
pointToSvgCoords Point Double
p)
svgCoords (LineP Point Double
p) = Point Double -> PathData Double
forall a. Point a -> PathData a
LineP (Point Double -> Point Double
pointToSvgCoords Point Double
p)
svgCoords (ArcP ArcInfo Double
i Point Double
p) = ArcInfo Double -> Point Double -> PathData Double
forall a. ArcInfo a -> Point a -> PathData a
ArcP ArcInfo Double
i (Point Double -> Point Double
pointToSvgCoords Point Double
p)
toPathAbsolute ::
PathData Double ->
Text
toPathAbsolute :: PathData Double -> Text
toPathAbsolute (StartP Point Double
p) = Text
"M " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Point Double -> Text
pp Point Double
p
toPathAbsolute (LineP Point Double
p) = Text
"L " Text -> Text -> Text
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 "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Point Double -> Text
pp Point Double
c1
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Point Double -> Text
pp Point Double
c2
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" "
Text -> Text -> 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 "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Point Double -> Text
pp Point Double
control
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" "
Text -> Text -> 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 "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (String -> Text
pack (String -> Text) -> (Double -> String) -> Double -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> String
forall a. Show a => a -> String
show) Double
x
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (String -> Text
pack (String -> Text) -> (Double -> String) -> Double -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> String
forall a. Show a => a -> String
show) Double
y
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (String -> Text
pack (String -> Text) -> (Double -> String) -> Double -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> String
forall a. Show a => a -> String
show) (-Double
phi' Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Double
180 Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ Double
forall a. TrigField a => a
pi)
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text -> Bool -> Text
forall a. a -> a -> Bool -> a
bool Text
"0" Text
"1" Bool
l
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text -> Bool -> Text
forall a. a -> a -> Bool -> a
bool Text
"0" Text
"1" Bool
sw
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Point Double -> Text
pp Point Double
x2
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) Maybe Int
forall a. Maybe a
Nothing Double
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
","
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FormatStyle -> Maybe Int -> Double -> Text
formatOrShow (Int -> FormatStyle
FixedStyle Int
4) Maybe Int
forall a. Maybe a
Nothing (Double -> Double -> Bool -> Double
forall a. a -> a -> Bool -> a
bool (-Double
y) Double
y (Double
y Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
forall a. Additive a => a
zero))
data PathCursor = PathCursor
{
PathCursor -> Point Double
curPrevious :: Point Double,
PathCursor -> Point Double
curStart :: Point Double,
PathCursor -> Maybe (Point Double)
curControl :: Maybe (Point Double)
}
deriving (PathCursor -> PathCursor -> Bool
(PathCursor -> PathCursor -> Bool)
-> (PathCursor -> PathCursor -> Bool) -> Eq PathCursor
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 -> String -> String
[PathCursor] -> String -> String
PathCursor -> String
(Int -> PathCursor -> String -> String)
-> (PathCursor -> String)
-> ([PathCursor] -> String -> String)
-> Show PathCursor
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PathCursor] -> String -> String
$cshowList :: [PathCursor] -> String -> String
show :: PathCursor -> String
$cshow :: PathCursor -> String
showsPrec :: Int -> PathCursor -> String -> String
$cshowsPrec :: Int -> PathCursor -> String -> String
Show, (forall x. PathCursor -> Rep PathCursor x)
-> (forall x. Rep PathCursor x -> PathCursor) -> Generic PathCursor
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 Point Double
forall a. Additive a => a
zero Point Double
forall a. Additive a => a
zero Maybe (Point Double)
forall a. Maybe a
Nothing
svgToPathData :: Text -> [PathData Double]
svgToPathData :: Text -> [PathData Double]
svgToPathData = [PathCommand] -> [PathData Double]
toPathDatas ([PathCommand] -> [PathData Double])
-> (Text -> [PathCommand]) -> Text -> [PathData Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> [PathCommand])
-> ([PathCommand] -> [PathCommand])
-> Either String [PathCommand]
-> [PathCommand]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> [PathCommand]
forall a. HasCallStack => String -> a
error [PathCommand] -> [PathCommand]
forall a. a -> a
id (Either String [PathCommand] -> [PathCommand])
-> (Text -> Either String [PathCommand]) -> Text -> [PathCommand]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either String [PathCommand]
parsePath
pathDataToSvg :: [PathData Double] -> Text
pathDataToSvg :: [PathData Double] -> Text
pathDataToSvg [PathData Double]
xs = Text -> [Text] -> Text
Text.intercalate Text
" " ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (PathData Double -> Text) -> [PathData Double] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PathData Double -> Text
toPathAbsolute [PathData Double]
xs
toPathDatas :: [PathCommand] -> [PathData Double]
toPathDatas :: [PathCommand] -> [PathData Double]
toPathDatas [PathCommand]
xs = (PathData Double -> PathData Double)
-> [PathData Double] -> [PathData Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PathData Double -> PathData Double
svgCoords ([PathData Double] -> [PathData Double])
-> [PathData Double] -> [PathData Double]
forall a b. (a -> b) -> a -> b
$ [[PathData Double]] -> [PathData Double]
forall a. Monoid a => [a] -> a
mconcat ([[PathData Double]] -> [PathData Double])
-> [[PathData Double]] -> [PathData Double]
forall a b. (a -> b) -> a -> b
$ (State PathCursor [[PathData Double]]
-> PathCursor -> [[PathData Double]])
-> PathCursor
-> State PathCursor [[PathData Double]]
-> [[PathData Double]]
forall a b c. (a -> b -> c) -> b -> a -> c
flip State PathCursor [[PathData Double]]
-> PathCursor -> [[PathData Double]]
forall s a. State s a -> s -> a
evalState PathCursor
stateCur0 (State PathCursor [[PathData Double]] -> [[PathData Double]])
-> State PathCursor [[PathData Double]] -> [[PathData Double]]
forall a b. (a -> b) -> a -> b
$ [StateT PathCursor Identity [PathData Double]]
-> State PathCursor [[PathData Double]]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([StateT PathCursor Identity [PathData Double]]
-> State PathCursor [[PathData Double]])
-> [StateT PathCursor Identity [PathData Double]]
-> State PathCursor [[PathData Double]]
forall a b. (a -> b) -> a -> b
$ PathCommand -> StateT PathCursor Identity [PathData Double]
toInfo (PathCommand -> StateT PathCursor Identity [PathData Double])
-> [PathCommand] -> [StateT PathCursor Identity [PathData Double]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PathCommand]
xs
relToAbs :: (Additive a) => a -> [a] -> [a]
relToAbs :: a -> [a] -> [a]
relToAbs a
p [a]
xs = [a] -> [a]
forall a (f :: * -> *). (Additive a, Traversable f) => f a -> f a
accsum (a
p a -> [a] -> [a]
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
PathCursor -> StateT PathCursor Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Point Double -> Point Double -> Maybe (Point Double) -> PathCursor
PathCursor ([Point Double] -> Point Double
forall a. [a] -> a
last [Point Double]
xs) ([Point Double] -> Point Double
forall a. [a] -> a
head [Point Double]
xs) Maybe (Point Double)
forall a. Maybe a
Nothing)
[PathData Double] -> StateT PathCursor Identity [PathData Double]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Point Double -> PathData Double
forall a. Point a -> PathData a
StartP ([Point Double] -> Point Double
forall a. [a] -> a
head [Point Double]
xs) PathData Double -> [PathData Double] -> [PathData Double]
forall a. a -> [a] -> [a]
: (Point Double -> PathData Double
forall a. Point a -> PathData a
LineP (Point Double -> PathData Double)
-> [Point Double] -> [PathData Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Point Double] -> [Point Double]
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
(PathCursor -> PathCursor) -> StateT PathCursor Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((Optic
A_Lens NoIx PathCursor PathCursor (Point Double) (Point Double)
forall a. IsLabel "curPrevious" a => a
forall (x :: Symbol) a. IsLabel x a => a
#curPrevious Optic
A_Lens NoIx PathCursor PathCursor (Point Double) (Point Double)
-> Point Double -> PathCursor -> PathCursor
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
forall a. [a] -> a
last [Point Double]
xs) (PathCursor -> PathCursor)
-> (PathCursor -> PathCursor) -> PathCursor -> PathCursor
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Optic
A_Lens
NoIx
PathCursor
PathCursor
(Maybe (Point Double))
(Maybe (Point Double))
forall a. IsLabel "curControl" a => a
forall (x :: Symbol) a. IsLabel x a => a
#curControl Optic
A_Lens
NoIx
PathCursor
PathCursor
(Maybe (Point Double))
(Maybe (Point Double))
-> Maybe (Point Double) -> PathCursor -> PathCursor
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Maybe (Point Double)
forall a. Maybe a
Nothing))
[PathData Double] -> StateT PathCursor Identity [PathData Double]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([PathData Double] -> StateT PathCursor Identity [PathData Double])
-> [PathData Double]
-> StateT PathCursor Identity [PathData Double]
forall a b. (a -> b) -> a -> b
$ Point Double -> PathData Double
forall a. Point a -> PathData a
LineP (Point Double -> PathData Double)
-> [Point Double] -> [PathData Double]
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)
_) <- StateT PathCursor Identity PathCursor
forall s (m :: * -> *). MonadState s m => m s
get
[Point Double] -> StateT PathCursor Identity [PathData Double]
lineTo ((Double -> Point Double) -> [Double] -> [Point Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Double -> Double -> Point Double
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)
_) <- StateT PathCursor Identity PathCursor
forall s (m :: * -> *). MonadState s m => m s
get
[Point Double] -> StateT PathCursor Identity [PathData Double]
lineTo ((Double -> Point Double) -> [Double] -> [Point Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Double -> Double -> Point Double
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
(PathCursor -> PathCursor) -> StateT PathCursor Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify
( (Optic
A_Lens NoIx PathCursor PathCursor (Point Double) (Point Double)
forall a. IsLabel "curPrevious" a => a
forall (x :: Symbol) a. IsLabel x a => a
#curPrevious Optic
A_Lens NoIx PathCursor PathCursor (Point Double) (Point Double)
-> Point Double -> PathCursor -> PathCursor
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) ([(Point Double, Point Double, Point Double)]
-> (Point Double, Point Double, Point Double)
forall a. [a] -> a
last [(Point Double, Point Double, Point Double)]
xs))
(PathCursor -> PathCursor)
-> (PathCursor -> PathCursor) -> PathCursor -> PathCursor
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Optic
A_Lens
NoIx
PathCursor
PathCursor
(Maybe (Point Double))
(Maybe (Point Double))
forall a. IsLabel "curControl" a => a
forall (x :: Symbol) a. IsLabel x a => a
#curControl Optic
A_Lens
NoIx
PathCursor
PathCursor
(Maybe (Point Double))
(Maybe (Point Double))
-> Point Double -> PathCursor -> PathCursor
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) ([(Point Double, Point Double, Point Double)]
-> (Point Double, Point Double, Point Double)
forall a. [a] -> a
last [(Point Double, Point Double, Point Double)]
xs))
)
[PathData Double] -> StateT PathCursor Identity [PathData Double]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([PathData Double] -> StateT PathCursor Identity [PathData Double])
-> [PathData Double]
-> StateT PathCursor Identity [PathData Double]
forall a b. (a -> b) -> a -> b
$ (\(Point Double
c1, Point Double
c2, Point Double
x2) -> Point Double -> Point Double -> Point Double -> PathData Double
forall a. Point a -> Point a -> Point a -> PathData a
CubicP Point Double
c1 Point Double
c2 Point Double
x2) ((Point Double, Point Double, Point Double) -> PathData Double)
-> [(Point Double, Point Double, Point Double)]
-> [PathData Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Point Double, Point Double, Point Double)]
xs
relToAbs3 :: Additive a => a -> [(a, a, a)] -> [(a, a, a)]
relToAbs3 :: 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) ((a, a, a) -> a) -> [(a, a, a)] -> [a]
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) ((a, a, a) -> a) -> [(a, a, a)] -> [a]
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) ((a, a, a) -> a) -> [(a, a, a)] -> [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(a, a, a)]
xs
x1' :: [a]
x1' = (a -> a) -> [a] -> [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a
p a -> a -> a
forall a. Additive a => a -> a -> a
+) ([a] -> [a]
forall a (f :: * -> *). (Additive a, Traversable f) => f a -> f a
accsum [a]
x1)
x2' :: [a]
x2' = (a -> a) -> [a] -> [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a
p a -> a -> a
forall a. Additive a => a -> a -> a
+) ([a] -> [a]
forall a (f :: * -> *). (Additive a, Traversable f) => f a -> f a
accsum [a]
x2)
x3' :: [a]
x3' = (a -> a) -> [a] -> [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a
p a -> a -> a
forall a. Additive a => a -> a -> a
+) ([a] -> [a]
forall a (f :: * -> *). (Additive a, Traversable f) => f a -> f a
accsum [a]
x3)
xs' :: [(a, a, a)]
xs' = [a] -> [a] -> [a] -> [(a, a, a)]
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) <- StateT PathCursor Identity PathCursor
forall s (m :: * -> *). MonadState s m => m s
get
case Maybe (Point Double)
c of
Maybe (Point Double)
Nothing -> Point Double -> State PathCursor (Point Double)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Point Double
p
Just Point Double
c' -> Point Double -> State PathCursor (Point Double)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Point Double
p Point Double -> Point Double -> Point Double
forall a. Subtractive a => a -> a -> a
- (Point Double
c' Point Double -> Point Double -> Point Double
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
(PathCursor -> PathCursor) -> StateT PathCursor Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((Optic
A_Lens
NoIx
PathCursor
PathCursor
(Maybe (Point Double))
(Maybe (Point Double))
forall a. IsLabel "curControl" a => a
forall (x :: Symbol) a. IsLabel x a => a
#curControl Optic
A_Lens
NoIx
PathCursor
PathCursor
(Maybe (Point Double))
(Maybe (Point Double))
-> Point Double -> PathCursor -> PathCursor
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) (PathCursor -> PathCursor)
-> (PathCursor -> PathCursor) -> PathCursor -> PathCursor
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Optic
A_Lens NoIx PathCursor PathCursor (Point Double) (Point Double)
forall a. IsLabel "curPrevious" a => a
forall (x :: Symbol) a. IsLabel x a => a
#curPrevious Optic
A_Lens NoIx PathCursor PathCursor (Point Double) (Point Double)
-> Point Double -> PathCursor -> PathCursor
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))
PathData Double -> State PathCursor (PathData Double)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Point Double -> Point Double -> Point Double -> PathData Double
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 =
[State PathCursor (PathData Double)]
-> StateT PathCursor Identity [PathData Double]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ((Point Double, Point Double) -> State PathCursor (PathData Double)
smoothCurveToStep ((Point Double, Point Double)
-> State PathCursor (PathData Double))
-> [(Point Double, Point Double)]
-> [State PathCursor (PathData Double)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Point Double, Point Double)]
xs)
relToAbs2 :: Additive a => a -> [(a, a)] -> [(a, a)]
relToAbs2 :: a -> [(a, a)] -> [(a, a)]
relToAbs2 a
p [(a, a)]
xs = [(a, a)]
xs'
where
x1 :: [a]
x1 = (a, a) -> a
forall a b. (a, b) -> a
fst ((a, a) -> a) -> [(a, a)] -> [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(a, a)]
xs
x2 :: [a]
x2 = (a, a) -> a
forall a b. (a, b) -> b
snd ((a, a) -> a) -> [(a, a)] -> [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(a, a)]
xs
x1' :: [a]
x1' = (a -> a) -> [a] -> [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a
p a -> a -> a
forall a. Additive a => a -> a -> a
+) ([a] -> [a]
forall a (f :: * -> *). (Additive a, Traversable f) => f a -> f a
accsum [a]
x1)
x2' :: [a]
x2' = (a -> a) -> [a] -> [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a
p a -> a -> a
forall a. Additive a => a -> a -> a
+) ([a] -> [a]
forall a (f :: * -> *). (Additive a, Traversable f) => f a -> f a
accsum [a]
x2)
xs' :: [(a, a)]
xs' = [a] -> [a] -> [(a, a)]
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
(PathCursor -> PathCursor) -> StateT PathCursor Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify
( (Optic
A_Lens NoIx PathCursor PathCursor (Point Double) (Point Double)
forall a. IsLabel "curPrevious" a => a
forall (x :: Symbol) a. IsLabel x a => a
#curPrevious Optic
A_Lens NoIx PathCursor PathCursor (Point Double) (Point Double)
-> Point Double -> PathCursor -> PathCursor
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
forall a b. (a, b) -> b
snd ([(Point Double, Point Double)] -> (Point Double, Point Double)
forall a. [a] -> a
last [(Point Double, Point Double)]
xs))
(PathCursor -> PathCursor)
-> (PathCursor -> PathCursor) -> PathCursor -> PathCursor
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Optic
A_Lens
NoIx
PathCursor
PathCursor
(Maybe (Point Double))
(Maybe (Point Double))
forall a. IsLabel "curControl" a => a
forall (x :: Symbol) a. IsLabel x a => a
#curControl Optic
A_Lens
NoIx
PathCursor
PathCursor
(Maybe (Point Double))
(Maybe (Point Double))
-> Point Double -> PathCursor -> PathCursor
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) -> Point Double
forall a b. (a, b) -> a
fst ([(Point Double, Point Double)] -> (Point Double, Point Double)
forall a. [a] -> a
last [(Point Double, Point Double)]
xs))
)
[PathData Double] -> StateT PathCursor Identity [PathData Double]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([PathData Double] -> StateT PathCursor Identity [PathData Double])
-> [PathData Double]
-> StateT PathCursor Identity [PathData Double]
forall a b. (a -> b) -> a -> b
$ (Point Double -> Point Double -> PathData Double)
-> (Point Double, Point Double) -> PathData Double
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Point Double -> Point Double -> PathData Double
forall a. Point a -> Point a -> PathData a
QuadP ((Point Double, Point Double) -> PathData Double)
-> [(Point Double, Point Double)] -> [PathData Double]
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
(PathCursor -> PathCursor) -> StateT PathCursor Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((Optic
A_Lens
NoIx
PathCursor
PathCursor
(Maybe (Point Double))
(Maybe (Point Double))
forall a. IsLabel "curControl" a => a
forall (x :: Symbol) a. IsLabel x a => a
#curControl Optic
A_Lens
NoIx
PathCursor
PathCursor
(Maybe (Point Double))
(Maybe (Point Double))
-> Point Double -> PathCursor -> PathCursor
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) (PathCursor -> PathCursor)
-> (PathCursor -> PathCursor) -> PathCursor -> PathCursor
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Optic
A_Lens NoIx PathCursor PathCursor (Point Double) (Point Double)
forall a. IsLabel "curPrevious" a => a
forall (x :: Symbol) a. IsLabel x a => a
#curPrevious Optic
A_Lens NoIx PathCursor PathCursor (Point Double) (Point Double)
-> Point Double -> PathCursor -> PathCursor
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))
PathData Double -> State PathCursor (PathData Double)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Point Double -> Point Double -> PathData Double
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 =
[State PathCursor (PathData Double)]
-> StateT PathCursor Identity [PathData Double]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence (Point Double -> State PathCursor (PathData Double)
smoothQuadStep (Point Double -> State PathCursor (PathData Double))
-> [Point Double] -> [State PathCursor (PathData Double)]
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
(PathCursor -> PathCursor) -> StateT PathCursor Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((Optic
A_Lens NoIx PathCursor PathCursor (Point Double) (Point Double)
forall a. IsLabel "curPrevious" a => a
forall (x :: Symbol) a. IsLabel x a => a
#curPrevious Optic
A_Lens NoIx PathCursor PathCursor (Point Double) (Point Double)
-> Point Double -> PathCursor -> PathCursor
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) ([(Double, Double, Double, Bool, Bool, Point Double)]
-> (Double, Double, Double, Bool, Bool, Point Double)
forall a. [a] -> a
last [(Double, Double, Double, Bool, Bool, Point Double)]
xs)) (PathCursor -> PathCursor)
-> (PathCursor -> PathCursor) -> PathCursor -> PathCursor
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Optic
A_Lens
NoIx
PathCursor
PathCursor
(Maybe (Point Double))
(Maybe (Point Double))
forall a. IsLabel "curControl" a => a
forall (x :: Symbol) a. IsLabel x a => a
#curControl Optic
A_Lens
NoIx
PathCursor
PathCursor
(Maybe (Point Double))
(Maybe (Point Double))
-> Maybe (Point Double) -> PathCursor -> PathCursor
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Maybe (Point Double)
forall a. Maybe a
Nothing))
[PathData Double] -> StateT PathCursor Identity [PathData Double]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([PathData Double] -> StateT PathCursor Identity [PathData Double])
-> [PathData Double]
-> StateT PathCursor Identity [PathData Double]
forall a b. (a -> b) -> a -> b
$ (Double, Double, Double, Bool, Bool, Point Double)
-> PathData Double
forall a. (a, a, a, Bool, Bool, Point a) -> PathData a
fromPathEllipticalArc ((Double, Double, Double, Bool, Bool, Point Double)
-> PathData Double)
-> [(Double, Double, Double, Bool, Bool, Point Double)]
-> [PathData Double]
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 :: (a, a, a, Bool, Bool, Point a) -> PathData a
fromPathEllipticalArc (a
x, a
y, a
r, Bool
l, Bool
s, Point a
p) = ArcInfo a -> Point a -> PathData a
forall a. ArcInfo a -> Point a -> PathData a
ArcP (Point a -> a -> Bool -> Bool -> ArcInfo a
forall a. Point a -> a -> Bool -> Bool -> ArcInfo a
ArcInfo (a -> a -> Point a
forall a. a -> a -> Point a
Point a
x a
y) a
r Bool
l Bool
s) Point a
p
relToAbsArc :: Additive a => Point a -> [(a, a, a, Bool, Bool, Point a)] -> [(a, a, a, Bool, Bool, Point a)]
relToAbsArc :: 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) ((a, a, a, Bool, Bool, Point a) -> Point a)
-> [(a, a, a, Bool, Bool, Point a)] -> [Point a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(a, a, a, Bool, Bool, Point a)]
xs
ps' :: [Point a]
ps' = (Point a -> Point a) -> [Point a] -> [Point a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Point a
p Point a -> Point a -> Point a
forall a. Additive a => a -> a -> a
+) ([Point a] -> [Point 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' = ((a, a, a, Bool, Bool, Point a)
-> Point a -> (a, a, a, Bool, Bool, Point a))
-> [(a, a, a, Bool, Bool, Point a)]
-> [Point a]
-> [(a, a, a, Bool, Bool, Point a)]
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'
toInfo :: PathCommand -> State PathCursor [PathData Double]
toInfo :: PathCommand -> StateT PathCursor Identity [PathData Double]
toInfo (MoveTo Origin
OriginAbsolute [Point Double]
xs) = [Point Double] -> StateT PathCursor Identity [PathData Double]
moveTo [Point Double]
xs
toInfo (MoveTo Origin
OriginRelative [Point Double]
xs) = do
(PathCursor Point Double
p Point Double
_ Maybe (Point Double)
_) <- StateT PathCursor Identity PathCursor
forall s (m :: * -> *). MonadState s m => m s
get
[Point Double] -> StateT PathCursor Identity [PathData Double]
moveTo (Point Double -> [Point Double] -> [Point Double]
forall a. Additive a => a -> [a] -> [a]
relToAbs Point Double
p [Point Double]
xs)
toInfo PathCommand
EndPath = do
(PathCursor Point Double
_ Point Double
s Maybe (Point Double)
_) <- StateT PathCursor Identity PathCursor
forall s (m :: * -> *). MonadState s m => m s
get
[PathData Double] -> StateT PathCursor Identity [PathData Double]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Point Double -> PathData Double
forall a. Point a -> PathData a
LineP Point Double
s]
toInfo (LineTo Origin
OriginAbsolute [Point Double]
xs) = [Point Double] -> StateT PathCursor Identity [PathData Double]
lineTo [Point Double]
xs
toInfo (LineTo Origin
OriginRelative [Point Double]
xs) = do
(PathCursor Point Double
p Point Double
_ Maybe (Point Double)
_) <- StateT PathCursor Identity PathCursor
forall s (m :: * -> *). MonadState s m => m s
get
[Point Double] -> StateT PathCursor Identity [PathData Double]
lineTo (Point Double -> [Point Double] -> [Point Double]
forall a. Additive a => a -> [a] -> [a]
relToAbs Point Double
p [Point Double]
xs)
toInfo (HorizontalTo Origin
OriginAbsolute [Double]
xs) = [Double] -> StateT PathCursor Identity [PathData Double]
horTo [Double]
xs
toInfo (HorizontalTo Origin
OriginRelative [Double]
xs) = do
(PathCursor (Point Double
x Double
_) Point Double
_ Maybe (Point Double)
_) <- StateT PathCursor Identity PathCursor
forall s (m :: * -> *). MonadState s m => m s
get
[Double] -> StateT PathCursor Identity [PathData Double]
horTo (Double -> [Double] -> [Double]
forall a. Additive a => a -> [a] -> [a]
relToAbs Double
x [Double]
xs)
toInfo (VerticalTo Origin
OriginAbsolute [Double]
xs) = [Double] -> StateT PathCursor Identity [PathData Double]
verTo [Double]
xs
toInfo (VerticalTo Origin
OriginRelative [Double]
ys) = do
(PathCursor (Point Double
_ Double
y) Point Double
_ Maybe (Point Double)
_) <- StateT PathCursor Identity PathCursor
forall s (m :: * -> *). MonadState s m => m s
get
[Double] -> StateT PathCursor Identity [PathData Double]
verTo (Double -> [Double] -> [Double]
forall a. Additive a => a -> [a] -> [a]
relToAbs Double
y [Double]
ys)
toInfo (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
toInfo (CurveTo Origin
OriginRelative [(Point Double, Point Double, Point Double)]
xs) = do
(PathCursor Point Double
p Point Double
_ Maybe (Point Double)
_) <- StateT PathCursor Identity PathCursor
forall s (m :: * -> *). MonadState s m => m s
get
[(Point Double, Point Double, Point Double)]
-> StateT PathCursor Identity [PathData Double]
curveTo (Point Double
-> [(Point Double, Point Double, Point Double)]
-> [(Point Double, Point Double, Point Double)]
forall a. Additive a => a -> [(a, a, a)] -> [(a, a, a)]
relToAbs3 Point Double
p [(Point Double, Point Double, Point Double)]
xs)
toInfo (SmoothCurveTo Origin
OriginAbsolute [(Point Double, Point Double)]
xs) = [(Point Double, Point Double)]
-> StateT PathCursor Identity [PathData Double]
smoothCurveTo [(Point Double, Point Double)]
xs
toInfo (SmoothCurveTo Origin
OriginRelative [(Point Double, Point Double)]
xs) = do
(PathCursor Point Double
p Point Double
_ Maybe (Point Double)
_) <- StateT PathCursor Identity PathCursor
forall s (m :: * -> *). MonadState s m => m s
get
[(Point Double, Point Double)]
-> StateT PathCursor Identity [PathData Double]
smoothCurveTo (Point Double
-> [(Point Double, Point Double)] -> [(Point Double, Point Double)]
forall a. Additive a => a -> [(a, a)] -> [(a, a)]
relToAbs2 Point Double
p [(Point Double, Point Double)]
xs)
toInfo (QuadraticBezier Origin
OriginAbsolute [(Point Double, Point Double)]
xs) = [(Point Double, Point Double)]
-> StateT PathCursor Identity [PathData Double]
quad [(Point Double, Point Double)]
xs
toInfo (QuadraticBezier Origin
OriginRelative [(Point Double, Point Double)]
xs) = do
(PathCursor Point Double
p Point Double
_ Maybe (Point Double)
_) <- StateT PathCursor Identity PathCursor
forall s (m :: * -> *). MonadState s m => m s
get
[(Point Double, Point Double)]
-> StateT PathCursor Identity [PathData Double]
quad (Point Double
-> [(Point Double, Point Double)] -> [(Point Double, Point Double)]
forall a. Additive a => a -> [(a, a)] -> [(a, a)]
relToAbs2 Point Double
p [(Point Double, Point Double)]
xs)
toInfo (SmoothQuadraticBezierCurveTo Origin
OriginAbsolute [Point Double]
xs) = [Point Double] -> StateT PathCursor Identity [PathData Double]
smoothQuad [Point Double]
xs
toInfo (SmoothQuadraticBezierCurveTo Origin
OriginRelative [Point Double]
xs) = do
(PathCursor Point Double
p Point Double
_ Maybe (Point Double)
_) <- StateT PathCursor Identity PathCursor
forall s (m :: * -> *). MonadState s m => m s
get
[Point Double] -> StateT PathCursor Identity [PathData Double]
smoothQuad (Point Double -> [Point Double] -> [Point Double]
forall a. Additive a => a -> [a] -> [a]
relToAbs Point Double
p [Point Double]
xs)
toInfo (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
toInfo (EllipticalArc Origin
OriginRelative [(Double, Double, Double, Bool, Bool, Point Double)]
xs) = do
(PathCursor Point Double
p Point Double
_ Maybe (Point Double)
_) <- StateT PathCursor Identity PathCursor
forall s (m :: * -> *). MonadState s m => m s
get
[(Double, Double, Double, Bool, Bool, Point Double)]
-> StateT PathCursor Identity [PathData Double]
arcTo (Point Double
-> [(Double, Double, Double, Bool, Bool, Point Double)]
-> [(Double, Double, Double, Bool, Bool, Point Double)]
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)