{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RebindableSyntax #-}
{-# LANGUAGE TemplateHaskell #-}

-- | Conversions to and from an SVG path to a 'PathData'
module Data.Path.Parser
  ( -- * Parsing
    parsePath,
    pathParser,
    command,
    manyComma,
    svgToPathData,
    pathDataToSvg,
    PathCommand (..),
    Origin (..),
    toPathDatas,
  )
where

import Chart.Data
import Control.Applicative hiding (many, optional, some, (<|>))
import Control.Monad.State.Lazy
import Data.ByteString (ByteString, intercalate)
import Data.FormatN
import Data.Path (ArcInfo (ArcInfo), PathData (..))
import Data.Text.Encoding (encodeUtf8)
import FlatParse.Basic (char, optional, (<|>))
import GHC.Generics
import GHC.OverloadedLabels
import MarkupParse.FlatParse
import NumHask.Prelude hiding (optional, (<|>))
import Optics.Core hiding ((<|))

-- | Parse a raw path string.
--
-- > :set -XOverloadedStrings
-- > 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
-- Just [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 :: ByteString -> Maybe [PathCommand]
parsePath :: ByteString -> Maybe [PathCommand]
parsePath = Parser Any [PathCommand] -> ByteString -> Maybe [PathCommand]
forall e a. Parser e a -> ByteString -> Maybe a
runParserMaybe Parser Any [PathCommand]
forall e. Parser e [PathCommand]
pathParser

commaWsp :: Parser e (Maybe ())
commaWsp :: forall e. Parser e (Maybe ())
commaWsp = Parser e ()
forall e. Parser e ()
ws_ Parser e ()
-> ParserT PureMode e (Maybe ()) -> ParserT PureMode e (Maybe ())
forall a b.
ParserT PureMode e a
-> ParserT PureMode e b -> ParserT PureMode e b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser e () -> ParserT PureMode e (Maybe ())
forall (st :: ZeroBitType) e a.
ParserT st e a -> ParserT st e (Maybe a)
optional Parser e ()
forall e. Parser e ()
MarkupParse.FlatParse.comma ParserT PureMode e (Maybe ())
-> Parser e () -> ParserT PureMode e (Maybe ())
forall a b.
ParserT PureMode e a
-> ParserT PureMode e b -> ParserT PureMode e a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser e ()
forall e. Parser e ()
ws_

num :: Parser e Double
num :: forall e. Parser e Double
num = Parser e Double -> Parser e Double
forall b e. Num b => Parser e b -> Parser e b
signed Parser e Double
forall e. Parser e Double
double

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

numComma :: Parser e Double
numComma :: forall e. Parser e Double
numComma = Parser e Double
forall e. Parser e Double
num Parser e Double -> ParserT PureMode e (Maybe ()) -> Parser e Double
forall a b.
ParserT PureMode e a
-> ParserT PureMode e b -> ParserT PureMode e a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParserT PureMode e (Maybe ())
forall e. Parser e (Maybe ())
commaWsp

points :: Parser e [Point Double]
points :: forall e. Parser e [Point Double]
points = (:) (Point Double -> [Point Double] -> [Point Double])
-> ParserT PureMode e (Point Double)
-> ParserT PureMode e ([Point Double] -> [Point Double])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT PureMode e (Point Double)
forall e. Parser e (Point Double)
point ParserT PureMode e ([Point Double] -> [Point Double])
-> ParserT PureMode e [Point Double]
-> ParserT PureMode e [Point Double]
forall a b.
ParserT PureMode e (a -> b)
-> ParserT PureMode e a -> ParserT PureMode e b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParserT PureMode e (Point Double)
-> ParserT PureMode e [Point Double]
forall a. ParserT PureMode e a -> ParserT PureMode e [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser e (Maybe ())
forall e. Parser e (Maybe ())
commaWsp Parser e (Maybe ())
-> ParserT PureMode e (Point Double)
-> ParserT PureMode e (Point Double)
forall a b.
ParserT PureMode e a
-> ParserT PureMode e b -> ParserT PureMode e b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParserT PureMode e (Point Double)
forall e. Parser e (Point Double)
point) ParserT PureMode e [Point Double]
-> ParserT PureMode e [Point Double]
-> ParserT PureMode e [Point Double]
forall (st :: ZeroBitType) e a.
ParserT st e a -> ParserT st e a -> ParserT st e a
<|> [Point Double] -> ParserT PureMode e [Point Double]
forall a. a -> ParserT PureMode e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []

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

pointPairs :: Parser e [(Point Double, Point Double)]
pointPairs :: forall e. Parser e [(Point Double, Point Double)]
pointPairs = (:) ((Point Double, Point Double)
 -> [(Point Double, Point Double)]
 -> [(Point Double, Point Double)])
-> ParserT PureMode e (Point Double, Point Double)
-> ParserT
     PureMode
     e
     ([(Point Double, Point Double)] -> [(Point Double, Point Double)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT PureMode e (Point Double, Point Double)
forall e. Parser e (Point Double, Point Double)
pointPair ParserT
  PureMode
  e
  ([(Point Double, Point Double)] -> [(Point Double, Point Double)])
-> ParserT PureMode e [(Point Double, Point Double)]
-> ParserT PureMode e [(Point Double, Point Double)]
forall a b.
ParserT PureMode e (a -> b)
-> ParserT PureMode e a -> ParserT PureMode e b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParserT PureMode e (Point Double, Point Double)
-> ParserT PureMode e [(Point Double, Point Double)]
forall a. ParserT PureMode e a -> ParserT PureMode e [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser e (Maybe ())
forall e. Parser e (Maybe ())
commaWsp Parser e (Maybe ())
-> ParserT PureMode e (Point Double, Point Double)
-> ParserT PureMode e (Point Double, Point Double)
forall a b.
ParserT PureMode e a
-> ParserT PureMode e b -> ParserT PureMode e b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParserT PureMode e (Point Double, Point Double)
forall e. Parser e (Point Double, Point Double)
pointPair) ParserT PureMode e [(Point Double, Point Double)]
-> ParserT PureMode e [(Point Double, Point Double)]
-> ParserT PureMode e [(Point Double, Point Double)]
forall (st :: ZeroBitType) e a.
ParserT st e a -> ParserT st e a -> ParserT st e a
<|> [(Point Double, Point Double)]
-> ParserT PureMode e [(Point Double, Point Double)]
forall a. a -> ParserT PureMode e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []

nums :: Parser e [Double]
nums :: forall e. Parser e [Double]
nums = (:) (Double -> [Double] -> [Double])
-> ParserT PureMode e Double
-> ParserT PureMode e ([Double] -> [Double])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT PureMode e Double
forall e. Parser e Double
num ParserT PureMode e ([Double] -> [Double])
-> ParserT PureMode e [Double] -> ParserT PureMode e [Double]
forall a b.
ParserT PureMode e (a -> b)
-> ParserT PureMode e a -> ParserT PureMode e b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParserT PureMode e Double -> ParserT PureMode e [Double]
forall a. ParserT PureMode e a -> ParserT PureMode e [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser e (Maybe ())
forall e. Parser e (Maybe ())
commaWsp Parser e (Maybe ())
-> ParserT PureMode e Double -> ParserT PureMode e Double
forall a b.
ParserT PureMode e a
-> ParserT PureMode e b -> ParserT PureMode e b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParserT PureMode e Double
forall e. Parser e Double
num) ParserT PureMode e [Double]
-> ParserT PureMode e [Double] -> ParserT PureMode e [Double]
forall (st :: ZeroBitType) e a.
ParserT st e a -> ParserT st e a -> ParserT st e a
<|> [Double] -> ParserT PureMode e [Double]
forall a. a -> ParserT PureMode e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []

flag :: Parser e Bool
flag :: forall e. Parser e Bool
flag = (Int -> Bool) -> ParserT PureMode e Int -> ParserT PureMode e Bool
forall a b.
(a -> b) -> ParserT PureMode e a -> ParserT PureMode e b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0) ParserT PureMode e Int
forall e. Parser e Int
digit

-- | Items separated by a comma and one or more whitespace tokens either side.
manyComma :: Parser e a -> Parser e [a]
manyComma :: forall e a. Parser e a -> Parser e [a]
manyComma Parser e a
a = (:) (a -> [a] -> [a]) -> Parser e a -> ParserT PureMode e ([a] -> [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser e a
a ParserT PureMode e ([a] -> [a])
-> ParserT PureMode e [a] -> ParserT PureMode e [a]
forall a b.
ParserT PureMode e (a -> b)
-> ParserT PureMode e a -> ParserT PureMode e b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser e a -> ParserT PureMode e [a]
forall a. ParserT PureMode e a -> ParserT PureMode e [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser e (Maybe ())
forall e. Parser e (Maybe ())
commaWsp Parser e (Maybe ()) -> Parser e a -> Parser e a
forall a b.
ParserT PureMode e a
-> ParserT PureMode e b -> ParserT PureMode e b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser e a
a) ParserT PureMode e [a]
-> ParserT PureMode e [a] -> ParserT PureMode e [a]
forall (st :: ZeroBitType) e a.
ParserT st e a -> ParserT st e a -> ParserT st e a
<|> [a] -> ParserT PureMode e [a]
forall a. a -> ParserT PureMode e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []

flagComma :: Parser e Bool
flagComma :: forall e. Parser e Bool
flagComma = Parser e Bool
forall e. Parser e Bool
flag Parser e Bool -> ParserT PureMode e (Maybe ()) -> Parser e Bool
forall a b.
ParserT PureMode e a
-> ParserT PureMode e b -> ParserT PureMode e a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParserT PureMode e (Maybe ())
forall e. Parser e (Maybe ())
commaWsp

curveToArgs ::
  Parser
    e
    (Point Double, Point Double, Point Double)
curveToArgs :: forall e. Parser e (Point Double, Point Double, Point Double)
curveToArgs =
  (,,)
    (Point Double
 -> Point Double
 -> Point Double
 -> (Point Double, Point Double, Point Double))
-> ParserT PureMode e (Point Double)
-> ParserT
     PureMode
     e
     (Point Double
      -> Point Double -> (Point Double, Point Double, Point Double))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParserT PureMode e (Point Double)
forall e. Parser e (Point Double)
point ParserT PureMode e (Point Double)
-> ParserT PureMode e (Maybe ())
-> ParserT PureMode e (Point Double)
forall a b.
ParserT PureMode e a
-> ParserT PureMode e b -> ParserT PureMode e a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParserT PureMode e (Maybe ())
forall e. Parser e (Maybe ())
commaWsp)
    ParserT
  PureMode
  e
  (Point Double
   -> Point Double -> (Point Double, Point Double, Point Double))
-> ParserT PureMode e (Point Double)
-> ParserT
     PureMode
     e
     (Point Double -> (Point Double, Point Double, Point Double))
forall a b.
ParserT PureMode e (a -> b)
-> ParserT PureMode e a -> ParserT PureMode e b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ParserT PureMode e (Point Double)
forall e. Parser e (Point Double)
point ParserT PureMode e (Point Double)
-> ParserT PureMode e (Maybe ())
-> ParserT PureMode e (Point Double)
forall a b.
ParserT PureMode e a
-> ParserT PureMode e b -> ParserT PureMode e a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParserT PureMode e (Maybe ())
forall e. Parser e (Maybe ())
commaWsp)
    ParserT
  PureMode
  e
  (Point Double -> (Point Double, Point Double, Point Double))
-> ParserT PureMode e (Point Double)
-> ParserT PureMode e (Point Double, Point Double, Point Double)
forall a b.
ParserT PureMode e (a -> b)
-> ParserT PureMode e a -> ParserT PureMode e b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParserT PureMode e (Point Double)
forall e. Parser e (Point Double)
point

ellipticalArgs ::
  Parser
    e
    (Double, Double, Double, Bool, Bool, Point Double)
ellipticalArgs :: forall e.
Parser e (Double, Double, Double, Bool, Bool, Point Double)
ellipticalArgs =
  (,,,,,)
    (Double
 -> Double
 -> Double
 -> Bool
 -> Bool
 -> Point Double
 -> (Double, Double, Double, Bool, Bool, Point Double))
-> ParserT PureMode e Double
-> ParserT
     PureMode
     e
     (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
<$> ParserT PureMode e Double
forall e. Parser e Double
numComma
    ParserT
  PureMode
  e
  (Double
   -> Double
   -> Bool
   -> Bool
   -> Point Double
   -> (Double, Double, Double, Bool, Bool, Point Double))
-> ParserT PureMode e Double
-> ParserT
     PureMode
     e
     (Double
      -> Bool
      -> Bool
      -> Point Double
      -> (Double, Double, Double, Bool, Bool, Point Double))
forall a b.
ParserT PureMode e (a -> b)
-> ParserT PureMode e a -> ParserT PureMode e b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParserT PureMode e Double
forall e. Parser e Double
numComma
    ParserT
  PureMode
  e
  (Double
   -> Bool
   -> Bool
   -> Point Double
   -> (Double, Double, Double, Bool, Bool, Point Double))
-> ParserT PureMode e Double
-> ParserT
     PureMode
     e
     (Bool
      -> Bool
      -> Point Double
      -> (Double, Double, Double, Bool, Bool, Point Double))
forall a b.
ParserT PureMode e (a -> b)
-> ParserT PureMode e a -> ParserT PureMode e b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParserT PureMode e Double
forall e. Parser e Double
numComma
    ParserT
  PureMode
  e
  (Bool
   -> Bool
   -> Point Double
   -> (Double, Double, Double, Bool, Bool, Point Double))
-> ParserT PureMode e Bool
-> ParserT
     PureMode
     e
     (Bool
      -> Point Double
      -> (Double, Double, Double, Bool, Bool, Point Double))
forall a b.
ParserT PureMode e (a -> b)
-> ParserT PureMode e a -> ParserT PureMode e b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParserT PureMode e Bool
forall e. Parser e Bool
flagComma
    ParserT
  PureMode
  e
  (Bool
   -> Point Double
   -> (Double, Double, Double, Bool, Bool, Point Double))
-> ParserT PureMode e Bool
-> ParserT
     PureMode
     e
     (Point Double
      -> (Double, Double, Double, Bool, Bool, Point Double))
forall a b.
ParserT PureMode e (a -> b)
-> ParserT PureMode e a -> ParserT PureMode e b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParserT PureMode e Bool
forall e. Parser e Bool
flagComma
    ParserT
  PureMode
  e
  (Point Double
   -> (Double, Double, Double, Bool, Bool, Point Double))
-> ParserT PureMode e (Point Double)
-> ParserT
     PureMode e (Double, Double, Double, Bool, Bool, Point Double)
forall a b.
ParserT PureMode e (a -> b)
-> ParserT PureMode e a -> ParserT PureMode e b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParserT PureMode e (Point Double)
forall e. Parser e (Point Double)
point

-- | Parser for PathCommands
pathParser :: Parser e [PathCommand]
pathParser :: forall e. Parser e [PathCommand]
pathParser = Parser e ()
forall e. Parser e ()
ws_ Parser e ()
-> ParserT PureMode e [PathCommand]
-> ParserT PureMode e [PathCommand]
forall a b.
ParserT PureMode e a
-> ParserT PureMode e b -> ParserT PureMode e b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser e PathCommand -> ParserT PureMode e [PathCommand]
forall e a. Parser e a -> Parser e [a]
manyComma Parser e PathCommand
forall e. Parser e PathCommand
command

-- | Parser for a 'PathCommand'
command :: Parser e PathCommand
command :: forall e. Parser e PathCommand
command =
  (Origin -> [Point Double] -> PathCommand
MoveTo Origin
OriginAbsolute ([Point Double] -> PathCommand)
-> ParserT PureMode e ()
-> ParserT PureMode e ([Point Double] -> PathCommand)
forall a b. a -> ParserT PureMode e b -> ParserT PureMode e a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ $(char 'M') ParserT PureMode e ([Point Double] -> PathCommand)
-> ParserT PureMode e [Point Double]
-> ParserT PureMode e PathCommand
forall a b.
ParserT PureMode e (a -> b)
-> ParserT PureMode e a -> ParserT PureMode e b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ParserT PureMode e ()
forall e. Parser e ()
ws_ ParserT PureMode e ()
-> ParserT PureMode e [Point Double]
-> ParserT PureMode e [Point Double]
forall a b.
ParserT PureMode e a
-> ParserT PureMode e b -> ParserT PureMode e b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParserT PureMode e [Point Double]
forall e. Parser e [Point Double]
points))
    ParserT PureMode e PathCommand
-> ParserT PureMode e PathCommand -> ParserT PureMode e PathCommand
forall (st :: ZeroBitType) e a.
ParserT st e a -> ParserT st e a -> ParserT st e a
<|> (Origin -> [Point Double] -> PathCommand
MoveTo Origin
OriginRelative ([Point Double] -> PathCommand)
-> ParserT PureMode e ()
-> ParserT PureMode e ([Point Double] -> PathCommand)
forall a b. a -> ParserT PureMode e b -> ParserT PureMode e a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ $(char 'm') ParserT PureMode e ([Point Double] -> PathCommand)
-> ParserT PureMode e [Point Double]
-> ParserT PureMode e PathCommand
forall a b.
ParserT PureMode e (a -> b)
-> ParserT PureMode e a -> ParserT PureMode e b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ParserT PureMode e ()
forall e. Parser e ()
ws_ ParserT PureMode e ()
-> ParserT PureMode e [Point Double]
-> ParserT PureMode e [Point Double]
forall a b.
ParserT PureMode e a
-> ParserT PureMode e b -> ParserT PureMode e b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParserT PureMode e [Point Double]
forall e. Parser e [Point Double]
points))
    ParserT PureMode e PathCommand
-> ParserT PureMode e PathCommand -> ParserT PureMode e PathCommand
forall (st :: ZeroBitType) e a.
ParserT st e a -> ParserT st e a -> ParserT st e a
<|> (Origin -> [Point Double] -> PathCommand
LineTo Origin
OriginAbsolute ([Point Double] -> PathCommand)
-> ParserT PureMode e ()
-> ParserT PureMode e ([Point Double] -> PathCommand)
forall a b. a -> ParserT PureMode e b -> ParserT PureMode e a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ $(char 'L') ParserT PureMode e ([Point Double] -> PathCommand)
-> ParserT PureMode e [Point Double]
-> ParserT PureMode e PathCommand
forall a b.
ParserT PureMode e (a -> b)
-> ParserT PureMode e a -> ParserT PureMode e b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ParserT PureMode e ()
forall e. Parser e ()
ws_ ParserT PureMode e ()
-> ParserT PureMode e [Point Double]
-> ParserT PureMode e [Point Double]
forall a b.
ParserT PureMode e a
-> ParserT PureMode e b -> ParserT PureMode e b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParserT PureMode e [Point Double]
forall e. Parser e [Point Double]
points))
    ParserT PureMode e PathCommand
-> ParserT PureMode e PathCommand -> ParserT PureMode e PathCommand
forall (st :: ZeroBitType) e a.
ParserT st e a -> ParserT st e a -> ParserT st e a
<|> (Origin -> [Point Double] -> PathCommand
LineTo Origin
OriginRelative ([Point Double] -> PathCommand)
-> ParserT PureMode e ()
-> ParserT PureMode e ([Point Double] -> PathCommand)
forall a b. a -> ParserT PureMode e b -> ParserT PureMode e a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ $(char 'l') ParserT PureMode e ([Point Double] -> PathCommand)
-> ParserT PureMode e [Point Double]
-> ParserT PureMode e PathCommand
forall a b.
ParserT PureMode e (a -> b)
-> ParserT PureMode e a -> ParserT PureMode e b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ParserT PureMode e ()
forall e. Parser e ()
ws_ ParserT PureMode e ()
-> ParserT PureMode e [Point Double]
-> ParserT PureMode e [Point Double]
forall a b.
ParserT PureMode e a
-> ParserT PureMode e b -> ParserT PureMode e b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParserT PureMode e [Point Double]
forall e. Parser e [Point Double]
points))
    ParserT PureMode e PathCommand
-> ParserT PureMode e PathCommand -> ParserT PureMode e PathCommand
forall (st :: ZeroBitType) e a.
ParserT st e a -> ParserT st e a -> ParserT st e a
<|> (Origin -> [Double] -> PathCommand
HorizontalTo Origin
OriginAbsolute ([Double] -> PathCommand)
-> ParserT PureMode e ()
-> ParserT PureMode e ([Double] -> PathCommand)
forall a b. a -> ParserT PureMode e b -> ParserT PureMode e a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ $(char 'H') ParserT PureMode e ([Double] -> PathCommand)
-> ParserT PureMode e [Double] -> ParserT PureMode e PathCommand
forall a b.
ParserT PureMode e (a -> b)
-> ParserT PureMode e a -> ParserT PureMode e b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ParserT PureMode e ()
forall e. Parser e ()
ws_ ParserT PureMode e ()
-> ParserT PureMode e [Double] -> ParserT PureMode e [Double]
forall a b.
ParserT PureMode e a
-> ParserT PureMode e b -> ParserT PureMode e b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParserT PureMode e [Double]
forall e. Parser e [Double]
nums))
    ParserT PureMode e PathCommand
-> ParserT PureMode e PathCommand -> ParserT PureMode e PathCommand
forall (st :: ZeroBitType) e a.
ParserT st e a -> ParserT st e a -> ParserT st e a
<|> (Origin -> [Double] -> PathCommand
HorizontalTo Origin
OriginRelative ([Double] -> PathCommand)
-> ParserT PureMode e ()
-> ParserT PureMode e ([Double] -> PathCommand)
forall a b. a -> ParserT PureMode e b -> ParserT PureMode e a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ $(char 'h') ParserT PureMode e ([Double] -> PathCommand)
-> ParserT PureMode e [Double] -> ParserT PureMode e PathCommand
forall a b.
ParserT PureMode e (a -> b)
-> ParserT PureMode e a -> ParserT PureMode e b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ParserT PureMode e ()
forall e. Parser e ()
ws_ ParserT PureMode e ()
-> ParserT PureMode e [Double] -> ParserT PureMode e [Double]
forall a b.
ParserT PureMode e a
-> ParserT PureMode e b -> ParserT PureMode e b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParserT PureMode e [Double]
forall e. Parser e [Double]
nums))
    ParserT PureMode e PathCommand
-> ParserT PureMode e PathCommand -> ParserT PureMode e PathCommand
forall (st :: ZeroBitType) e a.
ParserT st e a -> ParserT st e a -> ParserT st e a
<|> (Origin -> [Double] -> PathCommand
VerticalTo Origin
OriginAbsolute ([Double] -> PathCommand)
-> ParserT PureMode e ()
-> ParserT PureMode e ([Double] -> PathCommand)
forall a b. a -> ParserT PureMode e b -> ParserT PureMode e a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ $(char 'V') ParserT PureMode e ([Double] -> PathCommand)
-> ParserT PureMode e [Double] -> ParserT PureMode e PathCommand
forall a b.
ParserT PureMode e (a -> b)
-> ParserT PureMode e a -> ParserT PureMode e b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ParserT PureMode e ()
forall e. Parser e ()
ws_ ParserT PureMode e ()
-> ParserT PureMode e [Double] -> ParserT PureMode e [Double]
forall a b.
ParserT PureMode e a
-> ParserT PureMode e b -> ParserT PureMode e b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParserT PureMode e [Double]
forall e. Parser e [Double]
nums))
    ParserT PureMode e PathCommand
-> ParserT PureMode e PathCommand -> ParserT PureMode e PathCommand
forall (st :: ZeroBitType) e a.
ParserT st e a -> ParserT st e a -> ParserT st e a
<|> (Origin -> [Double] -> PathCommand
VerticalTo Origin
OriginRelative ([Double] -> PathCommand)
-> ParserT PureMode e ()
-> ParserT PureMode e ([Double] -> PathCommand)
forall a b. a -> ParserT PureMode e b -> ParserT PureMode e a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ $(char 'v') ParserT PureMode e ([Double] -> PathCommand)
-> ParserT PureMode e [Double] -> ParserT PureMode e PathCommand
forall a b.
ParserT PureMode e (a -> b)
-> ParserT PureMode e a -> ParserT PureMode e b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ParserT PureMode e ()
forall e. Parser e ()
ws_ ParserT PureMode e ()
-> ParserT PureMode e [Double] -> ParserT PureMode e [Double]
forall a b.
ParserT PureMode e a
-> ParserT PureMode e b -> ParserT PureMode e b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParserT PureMode e [Double]
forall e. Parser e [Double]
nums))
    ParserT PureMode e PathCommand
-> ParserT PureMode e PathCommand -> ParserT PureMode e PathCommand
forall (st :: ZeroBitType) e a.
ParserT st e a -> ParserT st e a -> ParserT st e a
<|> (Origin
-> [(Point Double, Point Double, Point Double)] -> PathCommand
CurveTo Origin
OriginAbsolute ([(Point Double, Point Double, Point Double)] -> PathCommand)
-> ParserT PureMode e ()
-> ParserT
     PureMode
     e
     ([(Point Double, Point Double, Point Double)] -> PathCommand)
forall a b. a -> ParserT PureMode e b -> ParserT PureMode e a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ $(char 'C') ParserT
  PureMode
  e
  ([(Point Double, Point Double, Point Double)] -> PathCommand)
-> ParserT PureMode e [(Point Double, Point Double, Point Double)]
-> ParserT PureMode e PathCommand
forall a b.
ParserT PureMode e (a -> b)
-> ParserT PureMode e a -> ParserT PureMode e b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ParserT PureMode e ()
forall e. Parser e ()
ws_ ParserT PureMode e ()
-> ParserT PureMode e [(Point Double, Point Double, Point Double)]
-> ParserT PureMode e [(Point Double, Point Double, Point Double)]
forall a b.
ParserT PureMode e a
-> ParserT PureMode e b -> ParserT PureMode e b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser e (Point Double, Point Double, Point Double)
-> ParserT PureMode e [(Point Double, Point Double, Point Double)]
forall e a. Parser e a -> Parser e [a]
manyComma Parser e (Point Double, Point Double, Point Double)
forall e. Parser e (Point Double, Point Double, Point Double)
curveToArgs))
    ParserT PureMode e PathCommand
-> ParserT PureMode e PathCommand -> ParserT PureMode e PathCommand
forall (st :: ZeroBitType) e a.
ParserT st e a -> ParserT st e a -> ParserT st e a
<|> (Origin
-> [(Point Double, Point Double, Point Double)] -> PathCommand
CurveTo Origin
OriginRelative ([(Point Double, Point Double, Point Double)] -> PathCommand)
-> ParserT PureMode e ()
-> ParserT
     PureMode
     e
     ([(Point Double, Point Double, Point Double)] -> PathCommand)
forall a b. a -> ParserT PureMode e b -> ParserT PureMode e a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ $(char 'c') ParserT
  PureMode
  e
  ([(Point Double, Point Double, Point Double)] -> PathCommand)
-> ParserT PureMode e [(Point Double, Point Double, Point Double)]
-> ParserT PureMode e PathCommand
forall a b.
ParserT PureMode e (a -> b)
-> ParserT PureMode e a -> ParserT PureMode e b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ParserT PureMode e ()
forall e. Parser e ()
ws_ ParserT PureMode e ()
-> ParserT PureMode e [(Point Double, Point Double, Point Double)]
-> ParserT PureMode e [(Point Double, Point Double, Point Double)]
forall a b.
ParserT PureMode e a
-> ParserT PureMode e b -> ParserT PureMode e b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser e (Point Double, Point Double, Point Double)
-> ParserT PureMode e [(Point Double, Point Double, Point Double)]
forall e a. Parser e a -> Parser e [a]
manyComma Parser e (Point Double, Point Double, Point Double)
forall e. Parser e (Point Double, Point Double, Point Double)
curveToArgs))
    ParserT PureMode e PathCommand
-> ParserT PureMode e PathCommand -> ParserT PureMode e PathCommand
forall (st :: ZeroBitType) e a.
ParserT st e a -> ParserT st e a -> ParserT st e a
<|> (Origin -> [(Point Double, Point Double)] -> PathCommand
SmoothCurveTo Origin
OriginAbsolute ([(Point Double, Point Double)] -> PathCommand)
-> ParserT PureMode e ()
-> ParserT
     PureMode e ([(Point Double, Point Double)] -> PathCommand)
forall a b. a -> ParserT PureMode e b -> ParserT PureMode e a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ $(char 'S') ParserT PureMode e ([(Point Double, Point Double)] -> PathCommand)
-> ParserT PureMode e [(Point Double, Point Double)]
-> ParserT PureMode e PathCommand
forall a b.
ParserT PureMode e (a -> b)
-> ParserT PureMode e a -> ParserT PureMode e b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ParserT PureMode e ()
forall e. Parser e ()
ws_ ParserT PureMode e ()
-> ParserT PureMode e [(Point Double, Point Double)]
-> ParserT PureMode e [(Point Double, Point Double)]
forall a b.
ParserT PureMode e a
-> ParserT PureMode e b -> ParserT PureMode e b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParserT PureMode e [(Point Double, Point Double)]
forall e. Parser e [(Point Double, Point Double)]
pointPairs))
    ParserT PureMode e PathCommand
-> ParserT PureMode e PathCommand -> ParserT PureMode e PathCommand
forall (st :: ZeroBitType) e a.
ParserT st e a -> ParserT st e a -> ParserT st e a
<|> (Origin -> [(Point Double, Point Double)] -> PathCommand
SmoothCurveTo Origin
OriginRelative ([(Point Double, Point Double)] -> PathCommand)
-> ParserT PureMode e ()
-> ParserT
     PureMode e ([(Point Double, Point Double)] -> PathCommand)
forall a b. a -> ParserT PureMode e b -> ParserT PureMode e a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ $(char 's') ParserT PureMode e ([(Point Double, Point Double)] -> PathCommand)
-> ParserT PureMode e [(Point Double, Point Double)]
-> ParserT PureMode e PathCommand
forall a b.
ParserT PureMode e (a -> b)
-> ParserT PureMode e a -> ParserT PureMode e b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ParserT PureMode e ()
forall e. Parser e ()
ws_ ParserT PureMode e ()
-> ParserT PureMode e [(Point Double, Point Double)]
-> ParserT PureMode e [(Point Double, Point Double)]
forall a b.
ParserT PureMode e a
-> ParserT PureMode e b -> ParserT PureMode e b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParserT PureMode e [(Point Double, Point Double)]
forall e. Parser e [(Point Double, Point Double)]
pointPairs))
    ParserT PureMode e PathCommand
-> ParserT PureMode e PathCommand -> ParserT PureMode e PathCommand
forall (st :: ZeroBitType) e a.
ParserT st e a -> ParserT st e a -> ParserT st e a
<|> (Origin -> [(Point Double, Point Double)] -> PathCommand
QuadraticBezier Origin
OriginAbsolute ([(Point Double, Point Double)] -> PathCommand)
-> ParserT PureMode e ()
-> ParserT
     PureMode e ([(Point Double, Point Double)] -> PathCommand)
forall a b. a -> ParserT PureMode e b -> ParserT PureMode e a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ $(char 'Q') ParserT PureMode e ([(Point Double, Point Double)] -> PathCommand)
-> ParserT PureMode e [(Point Double, Point Double)]
-> ParserT PureMode e PathCommand
forall a b.
ParserT PureMode e (a -> b)
-> ParserT PureMode e a -> ParserT PureMode e b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ParserT PureMode e ()
forall e. Parser e ()
ws_ ParserT PureMode e ()
-> ParserT PureMode e [(Point Double, Point Double)]
-> ParserT PureMode e [(Point Double, Point Double)]
forall a b.
ParserT PureMode e a
-> ParserT PureMode e b -> ParserT PureMode e b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParserT PureMode e [(Point Double, Point Double)]
forall e. Parser e [(Point Double, Point Double)]
pointPairs))
    ParserT PureMode e PathCommand
-> ParserT PureMode e PathCommand -> ParserT PureMode e PathCommand
forall (st :: ZeroBitType) e a.
ParserT st e a -> ParserT st e a -> ParserT st e a
<|> (Origin -> [(Point Double, Point Double)] -> PathCommand
QuadraticBezier Origin
OriginRelative ([(Point Double, Point Double)] -> PathCommand)
-> ParserT PureMode e ()
-> ParserT
     PureMode e ([(Point Double, Point Double)] -> PathCommand)
forall a b. a -> ParserT PureMode e b -> ParserT PureMode e a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ $(char 'q') ParserT PureMode e ([(Point Double, Point Double)] -> PathCommand)
-> ParserT PureMode e [(Point Double, Point Double)]
-> ParserT PureMode e PathCommand
forall a b.
ParserT PureMode e (a -> b)
-> ParserT PureMode e a -> ParserT PureMode e b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ParserT PureMode e ()
forall e. Parser e ()
ws_ ParserT PureMode e ()
-> ParserT PureMode e [(Point Double, Point Double)]
-> ParserT PureMode e [(Point Double, Point Double)]
forall a b.
ParserT PureMode e a
-> ParserT PureMode e b -> ParserT PureMode e b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParserT PureMode e [(Point Double, Point Double)]
forall e. Parser e [(Point Double, Point Double)]
pointPairs))
    ParserT PureMode e PathCommand
-> ParserT PureMode e PathCommand -> ParserT PureMode e PathCommand
forall (st :: ZeroBitType) e a.
ParserT st e a -> ParserT st e a -> ParserT st e a
<|> (Origin -> [Point Double] -> PathCommand
SmoothQuadraticBezierCurveTo Origin
OriginAbsolute ([Point Double] -> PathCommand)
-> ParserT PureMode e ()
-> ParserT PureMode e ([Point Double] -> PathCommand)
forall a b. a -> ParserT PureMode e b -> ParserT PureMode e a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ $(char 'T') ParserT PureMode e ([Point Double] -> PathCommand)
-> ParserT PureMode e [Point Double]
-> ParserT PureMode e PathCommand
forall a b.
ParserT PureMode e (a -> b)
-> ParserT PureMode e a -> ParserT PureMode e b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ParserT PureMode e ()
forall e. Parser e ()
ws_ ParserT PureMode e ()
-> ParserT PureMode e [Point Double]
-> ParserT PureMode e [Point Double]
forall a b.
ParserT PureMode e a
-> ParserT PureMode e b -> ParserT PureMode e b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParserT PureMode e [Point Double]
forall e. Parser e [Point Double]
points))
    ParserT PureMode e PathCommand
-> ParserT PureMode e PathCommand -> ParserT PureMode e PathCommand
forall (st :: ZeroBitType) e a.
ParserT st e a -> ParserT st e a -> ParserT st e a
<|> (Origin -> [Point Double] -> PathCommand
SmoothQuadraticBezierCurveTo Origin
OriginRelative ([Point Double] -> PathCommand)
-> ParserT PureMode e ()
-> ParserT PureMode e ([Point Double] -> PathCommand)
forall a b. a -> ParserT PureMode e b -> ParserT PureMode e a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ $(char 't') ParserT PureMode e ([Point Double] -> PathCommand)
-> ParserT PureMode e [Point Double]
-> ParserT PureMode e PathCommand
forall a b.
ParserT PureMode e (a -> b)
-> ParserT PureMode e a -> ParserT PureMode e b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ParserT PureMode e ()
forall e. Parser e ()
ws_ ParserT PureMode e ()
-> ParserT PureMode e [Point Double]
-> ParserT PureMode e [Point Double]
forall a b.
ParserT PureMode e a
-> ParserT PureMode e b -> ParserT PureMode e b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParserT PureMode e [Point Double]
forall e. Parser e [Point Double]
points))
    ParserT PureMode e PathCommand
-> ParserT PureMode e PathCommand -> ParserT PureMode e PathCommand
forall (st :: ZeroBitType) e a.
ParserT st e a -> ParserT st e a -> ParserT st e a
<|> (Origin
-> [(Double, Double, Double, Bool, Bool, Point Double)]
-> PathCommand
EllipticalArc Origin
OriginAbsolute ([(Double, Double, Double, Bool, Bool, Point Double)]
 -> PathCommand)
-> ParserT PureMode e ()
-> ParserT
     PureMode
     e
     ([(Double, Double, Double, Bool, Bool, Point Double)]
      -> PathCommand)
forall a b. a -> ParserT PureMode e b -> ParserT PureMode e a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ $(char 'A') ParserT
  PureMode
  e
  ([(Double, Double, Double, Bool, Bool, Point Double)]
   -> PathCommand)
-> ParserT
     PureMode e [(Double, Double, Double, Bool, Bool, Point Double)]
-> ParserT PureMode e PathCommand
forall a b.
ParserT PureMode e (a -> b)
-> ParserT PureMode e a -> ParserT PureMode e b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ParserT PureMode e ()
forall e. Parser e ()
ws_ ParserT PureMode e ()
-> ParserT
     PureMode e [(Double, Double, Double, Bool, Bool, Point Double)]
-> ParserT
     PureMode e [(Double, Double, Double, Bool, Bool, Point Double)]
forall a b.
ParserT PureMode e a
-> ParserT PureMode e b -> ParserT PureMode e b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser e (Double, Double, Double, Bool, Bool, Point Double)
-> ParserT
     PureMode e [(Double, Double, Double, Bool, Bool, Point Double)]
forall e a. Parser e a -> Parser e [a]
manyComma Parser e (Double, Double, Double, Bool, Bool, Point Double)
forall e.
Parser e (Double, Double, Double, Bool, Bool, Point Double)
ellipticalArgs))
    ParserT PureMode e PathCommand
-> ParserT PureMode e PathCommand -> ParserT PureMode e PathCommand
forall (st :: ZeroBitType) e a.
ParserT st e a -> ParserT st e a -> ParserT st e a
<|> (Origin
-> [(Double, Double, Double, Bool, Bool, Point Double)]
-> PathCommand
EllipticalArc Origin
OriginRelative ([(Double, Double, Double, Bool, Bool, Point Double)]
 -> PathCommand)
-> ParserT PureMode e ()
-> ParserT
     PureMode
     e
     ([(Double, Double, Double, Bool, Bool, Point Double)]
      -> PathCommand)
forall a b. a -> ParserT PureMode e b -> ParserT PureMode e a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ $(char 'a') ParserT
  PureMode
  e
  ([(Double, Double, Double, Bool, Bool, Point Double)]
   -> PathCommand)
-> ParserT
     PureMode e [(Double, Double, Double, Bool, Bool, Point Double)]
-> ParserT PureMode e PathCommand
forall a b.
ParserT PureMode e (a -> b)
-> ParserT PureMode e a -> ParserT PureMode e b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ParserT PureMode e ()
forall e. Parser e ()
ws_ ParserT PureMode e ()
-> ParserT
     PureMode e [(Double, Double, Double, Bool, Bool, Point Double)]
-> ParserT
     PureMode e [(Double, Double, Double, Bool, Bool, Point Double)]
forall a b.
ParserT PureMode e a
-> ParserT PureMode e b -> ParserT PureMode e b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser e (Double, Double, Double, Bool, Bool, Point Double)
-> ParserT
     PureMode e [(Double, Double, Double, Bool, Bool, Point Double)]
forall e a. Parser e a -> Parser e [a]
manyComma Parser e (Double, Double, Double, Bool, Bool, Point Double)
forall e.
Parser e (Double, Double, Double, Bool, Bool, Point Double)
ellipticalArgs))
    ParserT PureMode e PathCommand
-> ParserT PureMode e PathCommand -> ParserT PureMode e PathCommand
forall (st :: ZeroBitType) e a.
ParserT st e a -> ParserT st e a -> ParserT st e a
<|> (PathCommand
EndPath PathCommand
-> ParserT PureMode e () -> ParserT PureMode e PathCommand
forall a b. a -> ParserT PureMode e b -> ParserT PureMode e a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ $(char 'Z') ParserT PureMode e PathCommand
-> ParserT PureMode e (Maybe ()) -> ParserT PureMode e PathCommand
forall a b.
ParserT PureMode e a
-> ParserT PureMode e b -> ParserT PureMode e a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParserT PureMode e (Maybe ())
forall e. Parser e (Maybe ())
commaWsp)
    ParserT PureMode e PathCommand
-> ParserT PureMode e PathCommand -> ParserT PureMode e PathCommand
forall (st :: ZeroBitType) e a.
ParserT st e a -> ParserT st e a -> ParserT st e a
<|> (PathCommand
EndPath PathCommand
-> ParserT PureMode e () -> ParserT PureMode e PathCommand
forall a b. a -> ParserT PureMode e b -> ParserT PureMode e a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ $(char 'z') ParserT PureMode e PathCommand
-> ParserT PureMode e (Maybe ()) -> ParserT PureMode e PathCommand
forall a b.
ParserT PureMode e a
-> ParserT PureMode e b -> ParserT PureMode e a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParserT PureMode e (Maybe ())
forall e. Parser e (Maybe ())
commaWsp)

-- | 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
(PathCommand -> PathCommand -> Bool)
-> (PathCommand -> PathCommand -> Bool) -> Eq PathCommand
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PathCommand -> PathCommand -> Bool
== :: PathCommand -> PathCommand -> Bool
$c/= :: PathCommand -> PathCommand -> Bool
/= :: PathCommand -> PathCommand -> Bool
Eq, Int -> PathCommand -> ShowS
[PathCommand] -> ShowS
PathCommand -> String
(Int -> PathCommand -> ShowS)
-> (PathCommand -> String)
-> ([PathCommand] -> ShowS)
-> Show PathCommand
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PathCommand -> ShowS
showsPrec :: Int -> PathCommand -> ShowS
$cshow :: PathCommand -> String
show :: PathCommand -> String
$cshowList :: [PathCommand] -> ShowS
showList :: [PathCommand] -> ShowS
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
$cfrom :: forall x. PathCommand -> Rep PathCommand x
from :: forall x. PathCommand -> Rep PathCommand x
$cto :: forall x. Rep PathCommand x -> PathCommand
to :: forall x. Rep PathCommand x -> PathCommand
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
(Origin -> Origin -> Bool)
-> (Origin -> Origin -> Bool) -> Eq Origin
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Origin -> Origin -> Bool
== :: Origin -> Origin -> Bool
$c/= :: Origin -> Origin -> Bool
/= :: Origin -> Origin -> Bool
Eq, Int -> Origin -> ShowS
[Origin] -> ShowS
Origin -> String
(Int -> Origin -> ShowS)
-> (Origin -> String) -> ([Origin] -> ShowS) -> Show Origin
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Origin -> ShowS
showsPrec :: Int -> Origin -> ShowS
$cshow :: Origin -> String
show :: Origin -> String
$cshowList :: [Origin] -> ShowS
showList :: [Origin] -> ShowS
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
$cfrom :: forall x. Origin -> Rep Origin x
from :: forall x. Origin -> Rep Origin x
$cto :: forall x. Rep Origin x -> Origin
to :: forall x. Rep Origin x -> Origin
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)

-- | 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
  ByteString
toPathAbsolute :: PathData Double -> ByteString
toPathAbsolute (StartP Point Double
p) = ByteString
"M " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Point Double -> ByteString
pp' Point Double
p
toPathAbsolute (LineP Point Double
p) = ByteString
"L " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Point Double -> ByteString
pp' Point Double
p
toPathAbsolute (CubicP Point Double
c1 Point Double
c2 Point Double
p) =
  ByteString
"C "
    ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Point Double -> ByteString
pp' Point Double
c1
    ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
" "
    ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Point Double -> ByteString
pp' Point Double
c2
    ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
" "
    ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Point Double -> ByteString
pp' Point Double
p
toPathAbsolute (QuadP Point Double
control Point Double
p) =
  ByteString
"Q "
    ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Point Double -> ByteString
pp' Point Double
control
    ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
" "
    ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Point Double -> ByteString
pp' Point Double
p
toPathAbsolute (ArcP (ArcInfo (Point Double
x Double
y) Double
phi' Bool
l Bool
sw) Point Double
x2) =
  ByteString
"A "
    ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Double -> ByteString
pv' Double
x
    ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
" "
    ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Double -> ByteString
pv' Double
y
    ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
" "
    ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Double -> ByteString
pv' (-(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))
    ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
" "
    ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString -> ByteString -> Bool -> ByteString
forall a. a -> a -> Bool -> a
bool ByteString
"0" ByteString
"1" Bool
l
    ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
" "
    ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString -> ByteString -> Bool -> ByteString
forall a. a -> a -> Bool -> a
bool ByteString
"0" ByteString
"1" Bool
sw
    ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
" "
    ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Point Double -> ByteString
pp' Point Double
x2

-- | Render a value to 4 SigFigs
pv' :: Double -> ByteString
pv' :: Double -> ByteString
pv' Double
x =
  Text -> ByteString
encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$
    FormatStyle -> Maybe Int -> Double -> Text
formatOrShow (Int -> FormatStyle
FixedStyle Int
4) Maybe Int
forall a. Maybe a
Nothing Double
x

-- | Render a point (including conversion to SVG Coordinates).
pp' :: Point Double -> ByteString
pp' :: Point Double -> ByteString
pp' (Point Double
x Double
y) =
  Text -> ByteString
encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$
    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
  { -- | 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
(PathCursor -> PathCursor -> Bool)
-> (PathCursor -> PathCursor -> Bool) -> Eq PathCursor
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PathCursor -> PathCursor -> Bool
== :: PathCursor -> PathCursor -> Bool
$c/= :: PathCursor -> PathCursor -> Bool
/= :: PathCursor -> PathCursor -> Bool
Eq, Int -> PathCursor -> ShowS
[PathCursor] -> ShowS
PathCursor -> String
(Int -> PathCursor -> ShowS)
-> (PathCursor -> String)
-> ([PathCursor] -> ShowS)
-> Show PathCursor
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PathCursor -> ShowS
showsPrec :: Int -> PathCursor -> ShowS
$cshow :: PathCursor -> String
show :: PathCursor -> String
$cshowList :: [PathCursor] -> ShowS
showList :: [PathCursor] -> ShowS
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
$cfrom :: forall x. PathCursor -> Rep PathCursor x
from :: forall x. PathCursor -> Rep PathCursor x
$cto :: forall x. Rep PathCursor x -> PathCursor
to :: forall x. Rep PathCursor x -> PathCursor
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

-- | Convert from an SVG d attribute text snippet to a [`PathData` `Double`]
svgToPathData :: ByteString -> [PathData Double]
svgToPathData :: ByteString -> [PathData Double]
svgToPathData = ([PathCommand] -> [PathData Double])
-> Maybe [PathCommand] -> [PathData Double]
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap [PathCommand] -> [PathData Double]
toPathDatas (Maybe [PathCommand] -> [PathData Double])
-> (ByteString -> Maybe [PathCommand])
-> ByteString
-> [PathData Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ByteString -> Maybe [PathCommand]
parsePath

-- | Convert from [`PathData` `Double`] to an SVG d path text snippet.
pathDataToSvg :: [PathData Double] -> ByteString
pathDataToSvg :: [PathData Double] -> ByteString
pathDataToSvg [PathData Double]
xs = ByteString -> [ByteString] -> ByteString
intercalate ByteString
" " ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ (PathData Double -> ByteString)
-> [PathData Double] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PathData Double -> ByteString
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 = (PathData Double -> PathData Double)
-> [PathData Double] -> [PathData Double]
forall a b. (a -> b) -> [a] -> [b]
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
$ (PathCommand -> StateT PathCursor Identity [PathData Double])
-> [PathCommand] -> State PathCursor [[PathData Double]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM PathCommand -> StateT PathCursor Identity [PathData Double]
toPathData [PathCommand]
xs

-- | Convert relative points to absolute points
relToAbs :: (Additive a) => a -> [a] -> [a]
relToAbs :: forall a. Additive a => a -> [a] -> [a]
relToAbs a
p [a]
xs = [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 [] = [PathData Double] -> StateT PathCursor Identity [PathData Double]
forall a. a -> StateT PathCursor Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
moveTo (Point Double
x : [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 -> Maybe (Point Double) -> Point Double
forall a. a -> Maybe a -> a
fromMaybe Point Double
x (Maybe (Point Double) -> Point Double)
-> Maybe (Point Double) -> Point Double
forall a b. (a -> b) -> a -> b
$ [Point Double] -> Maybe (Point Double)
forall a. [a] -> Maybe a
listToMaybe ([Point Double] -> Maybe (Point Double))
-> [Point Double] -> Maybe (Point Double)
forall a b. (a -> b) -> a -> b
$ [Point Double] -> [Point Double]
forall a. [a] -> [a]
reverse [Point Double]
xs) Point Double
x Maybe (Point Double)
forall a. Maybe a
Nothing)
  [PathData Double] -> StateT PathCursor Identity [PathData Double]
forall a. a -> StateT PathCursor Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Point Double -> PathData Double
forall a. Point a -> PathData a
StartP Point Double
x 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]
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)
-> 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
set Optic
  A_Lens NoIx PathCursor PathCursor (Point Double) (Point Double)
#curPrevious ([Point Double] -> Point Double
forall a. HasCallStack => [a] -> a
last [Point Double]
xs) (PathCursor -> PathCursor)
-> (PathCursor -> PathCursor) -> PathCursor -> PathCursor
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. 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
set Optic
  A_Lens
  NoIx
  PathCursor
  PathCursor
  (Maybe (Point Double))
  (Maybe (Point Double))
#curControl Maybe (Point Double)
forall a. Maybe a
Nothing)
  [PathData Double] -> StateT PathCursor Identity [PathData Double]
forall a. a -> StateT PathCursor Identity a
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 a b. (a -> b) -> [a] -> [b]
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 a b. (a -> b) -> [a] -> [b]
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)
-> 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
set Optic
  A_Lens NoIx PathCursor PathCursor (Point Double) (Point Double)
#curPrevious ((\(Point Double
_, Point Double
_, Point Double
p) -> Point Double
p) ([(Point Double, Point Double, Point Double)]
-> (Point Double, Point Double, Point Double)
forall a. HasCallStack => [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
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Optic
  A_Lens
  NoIx
  PathCursor
  PathCursor
  (Maybe (Point Double))
  (Maybe (Point Double))
#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. HasCallStack => [a] -> a
last [(Point Double, Point Double, Point Double)]
xs))
    )
  [PathData Double] -> StateT PathCursor Identity [PathData Double]
forall a. a -> StateT PathCursor Identity a
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

-- | 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) ((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 a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a
p +) ([a] -> [a]
forall a (f :: * -> *). (Additive a, Traversable f) => f a -> f a
accsum [a]
x1)
    x2' :: [a]
x2' = (a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a
p +) ([a] -> [a]
forall a (f :: * -> *). (Additive a, Traversable f) => f a -> f a
accsum [a]
x2)
    x3' :: [a]
x3' = (a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a
p +) ([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 a. a -> StateT PathCursor Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Point Double
p
    Just Point Double
c' -> Point Double -> State PathCursor (Point Double)
forall a. a -> StateT PathCursor Identity a
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))
#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
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. 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
set Optic
  A_Lens NoIx PathCursor PathCursor (Point Double) (Point Double)
#curPrevious Point Double
x2)
  PathData Double -> State PathCursor (PathData Double)
forall a. a -> StateT PathCursor Identity a
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)
 -> State PathCursor (PathData Double))
-> [(Point Double, Point Double)]
-> StateT PathCursor Identity [PathData Double]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Point Double, Point Double) -> State PathCursor (PathData Double)
smoothCurveToStep

-- | 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 = (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 a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a
p +) ([a] -> [a]
forall a (f :: * -> *). (Additive a, Traversable f) => f a -> f a
accsum [a]
x1)
    x2' :: [a]
x2' = (a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a
p +) ([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)
-> 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
set Optic
  A_Lens NoIx PathCursor PathCursor (Point Double) (Point Double)
#curPrevious ((Point Double, Point Double) -> Point Double
forall a b. (a, b) -> b
snd ([(Point Double, Point Double)] -> (Point Double, Point Double)
forall a. HasCallStack => [a] -> a
last [(Point Double, Point Double)]
xs))
        (PathCursor -> PathCursor)
-> (PathCursor -> PathCursor) -> PathCursor -> PathCursor
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. 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
set Optic
  A_Lens
  NoIx
  PathCursor
  PathCursor
  (Maybe (Point Double))
  (Maybe (Point Double))
#curControl (Point Double -> Maybe (Point Double)
forall a. a -> Maybe a
Just ((Point Double, Point Double) -> Point Double
forall a b. (a, b) -> a
fst ([(Point Double, Point Double)] -> (Point Double, Point Double)
forall a. HasCallStack => [a] -> a
last [(Point Double, Point Double)]
xs)))
    )
  [PathData Double] -> StateT PathCursor Identity [PathData Double]
forall a. a -> StateT PathCursor Identity a
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))
-> 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
set Optic
  A_Lens
  NoIx
  PathCursor
  PathCursor
  (Maybe (Point Double))
  (Maybe (Point Double))
#curControl (Point Double -> Maybe (Point Double)
forall a. a -> Maybe a
Just Point Double
c1) (PathCursor -> PathCursor)
-> (PathCursor -> PathCursor) -> PathCursor -> PathCursor
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. 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
set Optic
  A_Lens NoIx PathCursor PathCursor (Point Double) (Point Double)
#curPrevious Point Double
x2)
  PathData Double -> State PathCursor (PathData Double)
forall a. a -> StateT PathCursor Identity a
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 -> State PathCursor (PathData Double))
-> [Point Double] -> StateT PathCursor Identity [PathData Double]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Point Double -> State PathCursor (PathData Double)
smoothQuadStep

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)
-> 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
set Optic
  A_Lens NoIx PathCursor PathCursor (Point Double) (Point Double)
#curPrevious ((\(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. HasCallStack => [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
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. 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
set Optic
  A_Lens
  NoIx
  PathCursor
  PathCursor
  (Maybe (Point Double))
  (Maybe (Point Double))
#curControl Maybe (Point Double)
forall a. Maybe a
Nothing)
  [PathData Double] -> StateT PathCursor Identity [PathData Double]
forall a. a -> StateT PathCursor Identity a
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 :: 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) = 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

-- | 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) ((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 a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Point a
p +) ([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'

-- | 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)
_) <- 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)
toPathData 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 a. a -> StateT PathCursor Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Point Double -> PathData Double
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)
_) <- 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)
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)
_) <- 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)
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)
_) <- 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)
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)
_) <- 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)
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)
_) <- 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)
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)
_) <- 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)
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)
_) <- 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)
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)
_) <- 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)