{-# 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,
    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.Char hiding (isDigit)
import Data.Data
import Data.FormatN
import Data.Path (ArcInfo (ArcInfo), PathData (..))
import Data.Text.Encoding (encodeUtf8)
import FlatParse.Basic
import GHC.Generics
import GHC.OverloadedLabels
import NumHask.Prelude hiding (optional, (<|>))
import Optics.Core hiding ((<|))

-- * parsing helpers

runParserMaybe :: Parser e a -> ByteString -> Maybe a
runParserMaybe :: forall e a. Parser e a -> ByteString -> Maybe a
runParserMaybe Parser e a
p ByteString
b = case Parser e a -> ByteString -> Result e a
forall e a. Parser e a -> ByteString -> Result e a
runParser Parser e a
p ByteString
b of
  OK a
r ByteString
_ -> a -> Maybe a
forall a. a -> Maybe a
Just a
r
  Result e a
Fail -> Maybe a
forall a. Maybe a
Nothing
  Err e
_ -> Maybe a
forall a. Maybe a
Nothing

comma_ :: Parser e ()
comma_ :: forall e. Parser e ()
comma_ = $(char ',')

ws_ :: Parser e ()
ws_ :: forall e. Parser e ()
ws_ =
  $( switch
       [|
         case _ of
           " " -> ws_
           "\n" -> ws_
           "\t" -> ws_
           "\r" -> ws_
           "\f" -> ws_
           _ -> pure ()
         |]
   )

-- | 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 ()
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_

minus :: Parser e ()
minus :: forall e. Parser e ()
minus = $(char '-') ParserT PureMode e ()
-> ParserT PureMode e () -> ParserT PureMode e ()
forall (st :: ZeroBitType) e a.
ParserT st e a -> ParserT st e a -> ParserT st e a
<|> ByteString -> ParserT PureMode e ()
forall (st :: ZeroBitType) e. ByteString -> ParserT st e ()
byteString ByteString
"¯"

digit :: Parser e Int
digit :: forall e. Parser e Int
digit = (\Char
c -> Char -> Int
ord Char
c Int -> Int -> Int
forall a. Subtractive a => a -> a -> a
- Char -> Int
ord Char
'0') (Char -> Int) -> ParserT PureMode e Char -> ParserT PureMode e Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> ParserT PureMode e Char
forall (st :: ZeroBitType) e. (Char -> Bool) -> ParserT st e Char
satisfyAscii Char -> Bool
isDigit

digits :: Parser e (Int, Int)
digits :: forall e. Parser e (Int, Int)
digits = do
  (Int
place, Int
n) <- (Int -> (Int, Int) -> (Int, Int))
-> ParserT PureMode e Int
-> Parser e (Int, Int)
-> Parser e (Int, Int)
forall a b (st :: ZeroBitType) e.
(a -> b -> b) -> ParserT st e a -> ParserT st e b -> ParserT st e b
chainr (\Int
n (Int
place, Int
acc) -> (Int
place Int -> Int -> Int
forall a. Multiplicative a => a -> a -> a
* Int
10, Int
acc Int -> Int -> Int
forall a. Additive a => a -> a -> a
+ Int
place Int -> Int -> Int
forall a. Multiplicative a => a -> a -> a
* Int
n)) ParserT PureMode e Int
forall e. Parser e Int
digit ((Int, Int) -> Parser e (Int, Int)
forall a. a -> ParserT PureMode e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
1, Int
0))
  case Int
place of
    Int
1 -> Parser e (Int, Int)
forall a. ParserT PureMode e a
forall (f :: * -> *) a. Alternative f => f a
empty
    Int
_ -> (Int, Int) -> Parser e (Int, Int)
forall a. a -> ParserT PureMode e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
place, Int
n)

-- A 'Double' parser. does not parse .1 as a double.
double :: Parser e Double
double :: forall e. Parser e Double
double = do
  (Int
placel, Int
nl) <- Parser e (Int, Int)
forall e. Parser e (Int, Int)
digits
  Parser e (Int, Int)
-> ((Int, Int) -> Parser e Double)
-> Parser e Double
-> Parser e Double
forall (st :: ZeroBitType) e a r.
ParserT st e a
-> (a -> ParserT st e r) -> ParserT st e r -> ParserT st e r
withOption
    ($(char '.') ParserT PureMode e () -> Parser e (Int, Int) -> Parser e (Int, Int)
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 (Int, Int)
forall e. Parser e (Int, Int)
digits)
    ( \(Int
placer, Int
nr) ->
        case Int
placel of
          Int
1 -> Parser e Double
forall a. ParserT PureMode e a
forall (f :: * -> *) a. Alternative f => f a
empty
          Int
_ -> Double -> Parser e Double
forall a. a -> ParserT PureMode e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Double -> Parser e Double) -> Double -> Parser e Double
forall a b. (a -> b) -> a -> b
$ Int -> Double
forall a b. FromIntegral a b => b -> a
fromIntegral Int
nl Double -> Double -> Double
forall a. Additive a => a -> a -> a
+ Int -> Double
forall a b. FromIntegral a b => b -> a
fromIntegral Int
nr Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ Int -> Double
forall a b. FromIntegral a b => b -> a
fromIntegral Int
placer
    )
    ( case Int
placel of
        Int
1 -> Parser e Double
forall a. ParserT PureMode e a
forall (f :: * -> *) a. Alternative f => f a
empty
        Int
_ -> Double -> Parser e Double
forall a. a -> ParserT PureMode e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Double -> Parser e Double) -> Double -> Parser e Double
forall a b. (a -> b) -> a -> b
$ Int -> Double
forall a b. FromIntegral a b => b -> a
fromIntegral Int
nl
    )

-- Parser for a signed prefix to a number. Unlike uiua, this parses '-' as a negative number prefix.
signed :: (Subtractive b) => Parser e b -> Parser e b
signed :: forall b e. Subtractive b => Parser e b -> Parser e b
signed Parser e b
p = do
  Maybe ()
m <- ParserT PureMode e () -> ParserT PureMode e (Maybe ())
forall (st :: ZeroBitType) e a.
ParserT st e a -> ParserT st e (Maybe a)
optional ParserT PureMode e ()
forall e. Parser e ()
minus
  case Maybe ()
m of
    Maybe ()
Nothing -> Parser e b
p
    Just () -> b -> b
forall a. Subtractive a => a -> a
negate (b -> b) -> Parser e b -> Parser e b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser e b
p

num :: Parser e Double
num :: forall e. Parser e Double
num = Parser e Double -> Parser e Double
forall b e. Subtractive 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, Typeable PathCommand
Typeable PathCommand =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> PathCommand -> c PathCommand)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c PathCommand)
-> (PathCommand -> Constr)
-> (PathCommand -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c PathCommand))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c PathCommand))
-> ((forall b. Data b => b -> b) -> PathCommand -> PathCommand)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> PathCommand -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> PathCommand -> r)
-> (forall u. (forall d. Data d => d -> u) -> PathCommand -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> PathCommand -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> PathCommand -> m PathCommand)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> PathCommand -> m PathCommand)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> PathCommand -> m PathCommand)
-> Data PathCommand
PathCommand -> Constr
PathCommand -> DataType
(forall b. Data b => b -> b) -> PathCommand -> PathCommand
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> PathCommand -> u
forall u. (forall d. Data d => d -> u) -> PathCommand -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PathCommand -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PathCommand -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PathCommand -> m PathCommand
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PathCommand -> m PathCommand
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PathCommand
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PathCommand -> c PathCommand
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PathCommand)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PathCommand)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PathCommand -> c PathCommand
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PathCommand -> c PathCommand
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PathCommand
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PathCommand
$ctoConstr :: PathCommand -> Constr
toConstr :: PathCommand -> Constr
$cdataTypeOf :: PathCommand -> DataType
dataTypeOf :: PathCommand -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PathCommand)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PathCommand)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PathCommand)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PathCommand)
$cgmapT :: (forall b. Data b => b -> b) -> PathCommand -> PathCommand
gmapT :: (forall b. Data b => b -> b) -> PathCommand -> PathCommand
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PathCommand -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PathCommand -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PathCommand -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PathCommand -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> PathCommand -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> PathCommand -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> PathCommand -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> PathCommand -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PathCommand -> m PathCommand
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PathCommand -> m PathCommand
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PathCommand -> m PathCommand
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PathCommand -> m PathCommand
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PathCommand -> m PathCommand
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PathCommand -> m PathCommand
Data)

-- | 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, Typeable Origin
Typeable Origin =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Origin -> c Origin)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Origin)
-> (Origin -> Constr)
-> (Origin -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Origin))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Origin))
-> ((forall b. Data b => b -> b) -> Origin -> Origin)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Origin -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Origin -> r)
-> (forall u. (forall d. Data d => d -> u) -> Origin -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Origin -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Origin -> m Origin)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Origin -> m Origin)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Origin -> m Origin)
-> Data Origin
Origin -> Constr
Origin -> DataType
(forall b. Data b => b -> b) -> Origin -> Origin
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Origin -> u
forall u. (forall d. Data d => d -> u) -> Origin -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Origin -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Origin -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Origin -> m Origin
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Origin -> m Origin
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Origin
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Origin -> c Origin
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Origin)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Origin)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Origin -> c Origin
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Origin -> c Origin
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Origin
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Origin
$ctoConstr :: Origin -> Constr
toConstr :: Origin -> Constr
$cdataTypeOf :: Origin -> DataType
dataTypeOf :: Origin -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Origin)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Origin)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Origin)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Origin)
$cgmapT :: (forall b. Data b => b -> b) -> Origin -> Origin
gmapT :: (forall b. Data b => b -> b) -> Origin -> Origin
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Origin -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Origin -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Origin -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Origin -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Origin -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Origin -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Origin -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Origin -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Origin -> m Origin
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Origin -> m Origin
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Origin -> m Origin
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Origin -> m Origin
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Origin -> m Origin
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Origin -> m Origin
Data)

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, Typeable PathCursor
Typeable PathCursor =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> PathCursor -> c PathCursor)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c PathCursor)
-> (PathCursor -> Constr)
-> (PathCursor -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c PathCursor))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c PathCursor))
-> ((forall b. Data b => b -> b) -> PathCursor -> PathCursor)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> PathCursor -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> PathCursor -> r)
-> (forall u. (forall d. Data d => d -> u) -> PathCursor -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> PathCursor -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> PathCursor -> m PathCursor)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> PathCursor -> m PathCursor)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> PathCursor -> m PathCursor)
-> Data PathCursor
PathCursor -> Constr
PathCursor -> DataType
(forall b. Data b => b -> b) -> PathCursor -> PathCursor
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> PathCursor -> u
forall u. (forall d. Data d => d -> u) -> PathCursor -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PathCursor -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PathCursor -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PathCursor -> m PathCursor
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PathCursor -> m PathCursor
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PathCursor
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PathCursor -> c PathCursor
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PathCursor)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PathCursor)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PathCursor -> c PathCursor
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PathCursor -> c PathCursor
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PathCursor
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PathCursor
$ctoConstr :: PathCursor -> Constr
toConstr :: PathCursor -> Constr
$cdataTypeOf :: PathCursor -> DataType
dataTypeOf :: PathCursor -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PathCursor)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PathCursor)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PathCursor)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PathCursor)
$cgmapT :: (forall b. Data b => b -> b) -> PathCursor -> PathCursor
gmapT :: (forall b. Data b => b -> b) -> PathCursor -> PathCursor
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PathCursor -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PathCursor -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PathCursor -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PathCursor -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> PathCursor -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> PathCursor -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> PathCursor -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> PathCursor -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PathCursor -> m PathCursor
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PathCursor -> m PathCursor
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PathCursor -> m PathCursor
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PathCursor -> m PathCursor
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PathCursor -> m PathCursor
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PathCursor -> m PathCursor
Data)

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)