{-# LANGUAGE OverloadedStrings #-}

module Geometry.SvgParser.PathParser (parse) where



import           Control.Applicative
import           Control.Monad.Trans.State
import           Data.Maybe
import           Data.Text                 (Text)
import qualified Data.Text                 as T
import           Data.Traversable
import qualified Text.Megaparsec           as MP
import qualified Text.Megaparsec.Char      as MPC

import Geometry.Bezier
import Geometry.Core
import Geometry.SvgParser.Common



vec2 :: Ord err => MP.Parsec err Text Vec2
vec2 :: forall err. Ord err => Parsec err Text Vec2
vec2 = String
-> ParsecT err Text Identity Vec2 -> ParsecT err Text Identity Vec2
forall a.
String
-> ParsecT err Text Identity a -> ParsecT err Text Identity a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
MP.label String
"position (x,y)" (ParsecT err Text Identity Vec2 -> ParsecT err Text Identity Vec2)
-> ParsecT err Text Identity Vec2 -> ParsecT err Text Identity Vec2
forall a b. (a -> b) -> a -> b
$ do
    Double
x <- Parsec err Text Double
forall err. Ord err => Parsec err Text Double
double
    () -> ParsecT err Text Identity () -> ParsecT err Text Identity ()
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
MP.option () (Char -> ParsecT err Text Identity ()
forall err. Ord err => Char -> Parsec err Text ()
char_ Char
',')
    Double
y <- Parsec err Text Double
forall err. Ord err => Parsec err Text Double
double
    Vec2 -> ParsecT err Text Identity Vec2
forall a. a -> ParsecT err Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Double -> Double -> Vec2
Vec2 Double
x Double
y)

data AbsRel = Absolute | Relative
    deriving (AbsRel -> AbsRel -> Bool
(AbsRel -> AbsRel -> Bool)
-> (AbsRel -> AbsRel -> Bool) -> Eq AbsRel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AbsRel -> AbsRel -> Bool
== :: AbsRel -> AbsRel -> Bool
$c/= :: AbsRel -> AbsRel -> Bool
/= :: AbsRel -> AbsRel -> Bool
Eq, Eq AbsRel
Eq AbsRel
-> (AbsRel -> AbsRel -> Ordering)
-> (AbsRel -> AbsRel -> Bool)
-> (AbsRel -> AbsRel -> Bool)
-> (AbsRel -> AbsRel -> Bool)
-> (AbsRel -> AbsRel -> Bool)
-> (AbsRel -> AbsRel -> AbsRel)
-> (AbsRel -> AbsRel -> AbsRel)
-> Ord AbsRel
AbsRel -> AbsRel -> Bool
AbsRel -> AbsRel -> Ordering
AbsRel -> AbsRel -> AbsRel
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: AbsRel -> AbsRel -> Ordering
compare :: AbsRel -> AbsRel -> Ordering
$c< :: AbsRel -> AbsRel -> Bool
< :: AbsRel -> AbsRel -> Bool
$c<= :: AbsRel -> AbsRel -> Bool
<= :: AbsRel -> AbsRel -> Bool
$c> :: AbsRel -> AbsRel -> Bool
> :: AbsRel -> AbsRel -> Bool
$c>= :: AbsRel -> AbsRel -> Bool
>= :: AbsRel -> AbsRel -> Bool
$cmax :: AbsRel -> AbsRel -> AbsRel
max :: AbsRel -> AbsRel -> AbsRel
$cmin :: AbsRel -> AbsRel -> AbsRel
min :: AbsRel -> AbsRel -> AbsRel
Ord, Int -> AbsRel -> ShowS
[AbsRel] -> ShowS
AbsRel -> String
(Int -> AbsRel -> ShowS)
-> (AbsRel -> String) -> ([AbsRel] -> ShowS) -> Show AbsRel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AbsRel -> ShowS
showsPrec :: Int -> AbsRel -> ShowS
$cshow :: AbsRel -> String
show :: AbsRel -> String
$cshowList :: [AbsRel] -> ShowS
showList :: [AbsRel] -> ShowS
Show)

move :: Ord err => MP.Parsec err Text (State DrawState [Line])
move :: forall err. Ord err => Parsec err Text (State DrawState [Line])
move = String
-> ParsecT err Text Identity (State DrawState [Line])
-> ParsecT err Text Identity (State DrawState [Line])
forall a.
String
-> ParsecT err Text Identity a -> ParsecT err Text Identity a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
MP.label String
"move (mM)" (ParsecT err Text Identity (State DrawState [Line])
 -> ParsecT err Text Identity (State DrawState [Line]))
-> ParsecT err Text Identity (State DrawState [Line])
-> ParsecT err Text Identity (State DrawState [Line])
forall a b. (a -> b) -> a -> b
$ do
    AbsRel
absRel <- AbsRel
Absolute AbsRel
-> ParsecT err Text Identity () -> ParsecT err Text Identity AbsRel
forall a b.
a -> ParsecT err Text Identity b -> ParsecT err Text Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ParsecT err Text Identity ()
forall err. Ord err => Char -> Parsec err Text ()
char_ Char
'M' ParsecT err Text Identity AbsRel
-> ParsecT err Text Identity AbsRel
-> ParsecT err Text Identity AbsRel
forall a.
ParsecT err Text Identity a
-> ParsecT err Text Identity a -> ParsecT err Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> AbsRel
Relative AbsRel
-> ParsecT err Text Identity () -> ParsecT err Text Identity AbsRel
forall a b.
a -> ParsecT err Text Identity b -> ParsecT err Text Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ParsecT err Text Identity ()
forall err. Ord err => Char -> Parsec err Text ()
char_ Char
'm'
    Vec2
mM:[Vec2]
vs <- Parsec err Text Vec2 -> Parsec err Text [Vec2]
forall err a. Ord err => Parsec err Text a -> Parsec err Text [a]
someMaybeCommaSep Parsec err Text Vec2
forall err. Ord err => Parsec err Text Vec2
vec2
    State DrawState [Line]
-> ParsecT err Text Identity (State DrawState [Line])
forall a. a -> ParsecT err Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (State DrawState [Line]
 -> ParsecT err Text Identity (State DrawState [Line]))
-> State DrawState [Line]
-> ParsecT err Text Identity (State DrawState [Line])
forall a b. (a -> b) -> a -> b
$ do
        Current Vec2
oldCurrent <- (DrawState -> Current Vec2)
-> StateT DrawState Identity (Current Vec2)
forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
gets DrawState -> Current Vec2
_currentPoint
        let newStart :: Vec2
newStart = case AbsRel
absRel of
                AbsRel
Absolute -> Vec2
mM
                AbsRel
Relative -> Vec2
oldCurrent Vec2 -> Vec2 -> Vec2
forall v. VectorSpace v => v -> v -> v
+. Vec2
mM
        (DrawState -> DrawState) -> StateT DrawState Identity ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify' ((DrawState -> DrawState) -> StateT DrawState Identity ())
-> (DrawState -> DrawState) -> StateT DrawState Identity ()
forall a b. (a -> b) -> a -> b
$ \DrawState
s -> DrawState
s
            { _startOfTrajectory :: Start Vec2
_startOfTrajectory = Vec2 -> Start Vec2
forall a. a -> Start a
Start Vec2
newStart
            , _currentPoint :: Current Vec2
_currentPoint = Vec2 -> Current Vec2
forall a. a -> Current a
Current Vec2
newStart
            , _bezierReflectionQuadratic :: Maybe Vec2
_bezierReflectionQuadratic = Maybe Vec2
forall a. Maybe a
Nothing
            , _bezierReflectionCubic :: Maybe Vec2
_bezierReflectionCubic = Maybe Vec2
forall a. Maybe a
Nothing }
        [Vec2]
-> (Vec2 -> StateT DrawState Identity Line)
-> State DrawState [Line]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Vec2]
vs (AbsRel -> Vec2 -> StateT DrawState Identity Line
makeLine AbsRel
absRel)

data DrawState = DrawState
    { DrawState -> Start Vec2
_startOfTrajectory :: Start Vec2
    , DrawState -> Current Vec2
_currentPoint :: Current Vec2
    , DrawState -> Maybe Vec2
_bezierReflectionQuadratic :: Maybe Vec2
    , DrawState -> Maybe Vec2
_bezierReflectionCubic :: Maybe Vec2
    } deriving (DrawState -> DrawState -> Bool
(DrawState -> DrawState -> Bool)
-> (DrawState -> DrawState -> Bool) -> Eq DrawState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DrawState -> DrawState -> Bool
== :: DrawState -> DrawState -> Bool
$c/= :: DrawState -> DrawState -> Bool
/= :: DrawState -> DrawState -> Bool
Eq, Eq DrawState
Eq DrawState
-> (DrawState -> DrawState -> Ordering)
-> (DrawState -> DrawState -> Bool)
-> (DrawState -> DrawState -> Bool)
-> (DrawState -> DrawState -> Bool)
-> (DrawState -> DrawState -> Bool)
-> (DrawState -> DrawState -> DrawState)
-> (DrawState -> DrawState -> DrawState)
-> Ord DrawState
DrawState -> DrawState -> Bool
DrawState -> DrawState -> Ordering
DrawState -> DrawState -> DrawState
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: DrawState -> DrawState -> Ordering
compare :: DrawState -> DrawState -> Ordering
$c< :: DrawState -> DrawState -> Bool
< :: DrawState -> DrawState -> Bool
$c<= :: DrawState -> DrawState -> Bool
<= :: DrawState -> DrawState -> Bool
$c> :: DrawState -> DrawState -> Bool
> :: DrawState -> DrawState -> Bool
$c>= :: DrawState -> DrawState -> Bool
>= :: DrawState -> DrawState -> Bool
$cmax :: DrawState -> DrawState -> DrawState
max :: DrawState -> DrawState -> DrawState
$cmin :: DrawState -> DrawState -> DrawState
min :: DrawState -> DrawState -> DrawState
Ord, Int -> DrawState -> ShowS
[DrawState] -> ShowS
DrawState -> String
(Int -> DrawState -> ShowS)
-> (DrawState -> String)
-> ([DrawState] -> ShowS)
-> Show DrawState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DrawState -> ShowS
showsPrec :: Int -> DrawState -> ShowS
$cshow :: DrawState -> String
show :: DrawState -> String
$cshowList :: [DrawState] -> ShowS
showList :: [DrawState] -> ShowS
Show)

-- Safety wrappers so I don’t mix them up
newtype Start a = Start a deriving (Start a -> Start a -> Bool
(Start a -> Start a -> Bool)
-> (Start a -> Start a -> Bool) -> Eq (Start a)
forall a. Eq a => Start a -> Start a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Start a -> Start a -> Bool
== :: Start a -> Start a -> Bool
$c/= :: forall a. Eq a => Start a -> Start a -> Bool
/= :: Start a -> Start a -> Bool
Eq, Eq (Start a)
Eq (Start a)
-> (Start a -> Start a -> Ordering)
-> (Start a -> Start a -> Bool)
-> (Start a -> Start a -> Bool)
-> (Start a -> Start a -> Bool)
-> (Start a -> Start a -> Bool)
-> (Start a -> Start a -> Start a)
-> (Start a -> Start a -> Start a)
-> Ord (Start a)
Start a -> Start a -> Bool
Start a -> Start a -> Ordering
Start a -> Start a -> Start a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a}. Ord a => Eq (Start a)
forall a. Ord a => Start a -> Start a -> Bool
forall a. Ord a => Start a -> Start a -> Ordering
forall a. Ord a => Start a -> Start a -> Start a
$ccompare :: forall a. Ord a => Start a -> Start a -> Ordering
compare :: Start a -> Start a -> Ordering
$c< :: forall a. Ord a => Start a -> Start a -> Bool
< :: Start a -> Start a -> Bool
$c<= :: forall a. Ord a => Start a -> Start a -> Bool
<= :: Start a -> Start a -> Bool
$c> :: forall a. Ord a => Start a -> Start a -> Bool
> :: Start a -> Start a -> Bool
$c>= :: forall a. Ord a => Start a -> Start a -> Bool
>= :: Start a -> Start a -> Bool
$cmax :: forall a. Ord a => Start a -> Start a -> Start a
max :: Start a -> Start a -> Start a
$cmin :: forall a. Ord a => Start a -> Start a -> Start a
min :: Start a -> Start a -> Start a
Ord, Int -> Start a -> ShowS
[Start a] -> ShowS
Start a -> String
(Int -> Start a -> ShowS)
-> (Start a -> String) -> ([Start a] -> ShowS) -> Show (Start a)
forall a. Show a => Int -> Start a -> ShowS
forall a. Show a => [Start a] -> ShowS
forall a. Show a => Start a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Start a -> ShowS
showsPrec :: Int -> Start a -> ShowS
$cshow :: forall a. Show a => Start a -> String
show :: Start a -> String
$cshowList :: forall a. Show a => [Start a] -> ShowS
showList :: [Start a] -> ShowS
Show)
newtype Current a = Current a deriving (Current a -> Current a -> Bool
(Current a -> Current a -> Bool)
-> (Current a -> Current a -> Bool) -> Eq (Current a)
forall a. Eq a => Current a -> Current a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Current a -> Current a -> Bool
== :: Current a -> Current a -> Bool
$c/= :: forall a. Eq a => Current a -> Current a -> Bool
/= :: Current a -> Current a -> Bool
Eq, Eq (Current a)
Eq (Current a)
-> (Current a -> Current a -> Ordering)
-> (Current a -> Current a -> Bool)
-> (Current a -> Current a -> Bool)
-> (Current a -> Current a -> Bool)
-> (Current a -> Current a -> Bool)
-> (Current a -> Current a -> Current a)
-> (Current a -> Current a -> Current a)
-> Ord (Current a)
Current a -> Current a -> Bool
Current a -> Current a -> Ordering
Current a -> Current a -> Current a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a}. Ord a => Eq (Current a)
forall a. Ord a => Current a -> Current a -> Bool
forall a. Ord a => Current a -> Current a -> Ordering
forall a. Ord a => Current a -> Current a -> Current a
$ccompare :: forall a. Ord a => Current a -> Current a -> Ordering
compare :: Current a -> Current a -> Ordering
$c< :: forall a. Ord a => Current a -> Current a -> Bool
< :: Current a -> Current a -> Bool
$c<= :: forall a. Ord a => Current a -> Current a -> Bool
<= :: Current a -> Current a -> Bool
$c> :: forall a. Ord a => Current a -> Current a -> Bool
> :: Current a -> Current a -> Bool
$c>= :: forall a. Ord a => Current a -> Current a -> Bool
>= :: Current a -> Current a -> Bool
$cmax :: forall a. Ord a => Current a -> Current a -> Current a
max :: Current a -> Current a -> Current a
$cmin :: forall a. Ord a => Current a -> Current a -> Current a
min :: Current a -> Current a -> Current a
Ord, Int -> Current a -> ShowS
[Current a] -> ShowS
Current a -> String
(Int -> Current a -> ShowS)
-> (Current a -> String)
-> ([Current a] -> ShowS)
-> Show (Current a)
forall a. Show a => Int -> Current a -> ShowS
forall a. Show a => [Current a] -> ShowS
forall a. Show a => Current a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Current a -> ShowS
showsPrec :: Int -> Current a -> ShowS
$cshow :: forall a. Show a => Current a -> String
show :: Current a -> String
$cshowList :: forall a. Show a => [Current a] -> ShowS
showList :: [Current a] -> ShowS
Show)

lineXY :: Ord err => MP.Parsec err Text (State DrawState [Line])
lineXY :: forall err. Ord err => Parsec err Text (State DrawState [Line])
lineXY = do
    AbsRel
absRel <- AbsRel
Absolute AbsRel
-> ParsecT err Text Identity () -> ParsecT err Text Identity AbsRel
forall a b.
a -> ParsecT err Text Identity b -> ParsecT err Text Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ParsecT err Text Identity ()
forall err. Ord err => Char -> Parsec err Text ()
char_ Char
'L' ParsecT err Text Identity AbsRel
-> ParsecT err Text Identity AbsRel
-> ParsecT err Text Identity AbsRel
forall a.
ParsecT err Text Identity a
-> ParsecT err Text Identity a -> ParsecT err Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> AbsRel
Relative AbsRel
-> ParsecT err Text Identity () -> ParsecT err Text Identity AbsRel
forall a b.
a -> ParsecT err Text Identity b -> ParsecT err Text Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ParsecT err Text Identity ()
forall err. Ord err => Char -> Parsec err Text ()
char_ Char
'l'
    [Vec2]
ps <- Parsec err Text Vec2 -> Parsec err Text [Vec2]
forall err a. Ord err => Parsec err Text a -> Parsec err Text [a]
someMaybeCommaSep Parsec err Text Vec2
forall err. Ord err => Parsec err Text Vec2
vec2
    State DrawState [Line] -> Parsec err Text (State DrawState [Line])
forall a. a -> ParsecT err Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (State DrawState [Line]
 -> Parsec err Text (State DrawState [Line]))
-> State DrawState [Line]
-> Parsec err Text (State DrawState [Line])
forall a b. (a -> b) -> a -> b
$ (Vec2 -> StateT DrawState Identity Line)
-> [Vec2] -> State DrawState [Line]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (AbsRel -> Vec2 -> StateT DrawState Identity Line
makeLine AbsRel
absRel) [Vec2]
ps

makeLine :: AbsRel -> Vec2 -> State DrawState Line
makeLine :: AbsRel -> Vec2 -> StateT DrawState Identity Line
makeLine AbsRel
absRel Vec2
p = do
    Current Vec2
current <- (DrawState -> Current Vec2)
-> StateT DrawState Identity (Current Vec2)
forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
gets DrawState -> Current Vec2
_currentPoint
    let new :: Vec2
new = case AbsRel
absRel of
            AbsRel
Absolute -> Vec2
p
            AbsRel
Relative -> Vec2
current Vec2 -> Vec2 -> Vec2
forall v. VectorSpace v => v -> v -> v
+. Vec2
p
    (DrawState -> DrawState) -> StateT DrawState Identity ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify' ((DrawState -> DrawState) -> StateT DrawState Identity ())
-> (DrawState -> DrawState) -> StateT DrawState Identity ()
forall a b. (a -> b) -> a -> b
$ \DrawState
s -> DrawState
s
        { _currentPoint :: Current Vec2
_currentPoint = Vec2 -> Current Vec2
forall a. a -> Current a
Current Vec2
new
        , _bezierReflectionQuadratic :: Maybe Vec2
_bezierReflectionQuadratic = Maybe Vec2
forall a. Maybe a
Nothing
        , _bezierReflectionCubic :: Maybe Vec2
_bezierReflectionCubic = Maybe Vec2
forall a. Maybe a
Nothing }
    Line -> StateT DrawState Identity Line
forall a. a -> StateT DrawState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Vec2 -> Vec2 -> Line
Line Vec2
current Vec2
new)

lineH :: Ord err => MP.Parsec err Text (State DrawState [Line])
lineH :: forall err. Ord err => Parsec err Text (State DrawState [Line])
lineH = do
    AbsRel
absRel <- AbsRel
Absolute AbsRel
-> ParsecT err Text Identity () -> ParsecT err Text Identity AbsRel
forall a b.
a -> ParsecT err Text Identity b -> ParsecT err Text Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ParsecT err Text Identity ()
forall err. Ord err => Char -> Parsec err Text ()
char_ Char
'H' ParsecT err Text Identity AbsRel
-> ParsecT err Text Identity AbsRel
-> ParsecT err Text Identity AbsRel
forall a.
ParsecT err Text Identity a
-> ParsecT err Text Identity a -> ParsecT err Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> AbsRel
Relative AbsRel
-> ParsecT err Text Identity () -> ParsecT err Text Identity AbsRel
forall a b.
a -> ParsecT err Text Identity b -> ParsecT err Text Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ParsecT err Text Identity ()
forall err. Ord err => Char -> Parsec err Text ()
char_ Char
'h'
    [Double]
xs <- Parsec err Text Double -> Parsec err Text [Double]
forall err a. Ord err => Parsec err Text a -> Parsec err Text [a]
someMaybeCommaSep Parsec err Text Double
forall err. Ord err => Parsec err Text Double
double
    State DrawState [Line] -> Parsec err Text (State DrawState [Line])
forall a. a -> ParsecT err Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (State DrawState [Line]
 -> Parsec err Text (State DrawState [Line]))
-> State DrawState [Line]
-> Parsec err Text (State DrawState [Line])
forall a b. (a -> b) -> a -> b
$ [Double]
-> (Double -> StateT DrawState Identity Line)
-> State DrawState [Line]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Double]
xs ((Double -> StateT DrawState Identity Line)
 -> State DrawState [Line])
-> (Double -> StateT DrawState Identity Line)
-> State DrawState [Line]
forall a b. (a -> b) -> a -> b
$ \Double
x' -> do
        Current current :: Vec2
current@(Vec2 Double
x Double
y) <- (DrawState -> Current Vec2)
-> StateT DrawState Identity (Current Vec2)
forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
gets DrawState -> Current Vec2
_currentPoint
        let new :: Vec2
new = case AbsRel
absRel of
                AbsRel
Absolute -> Double -> Double -> Vec2
Vec2 Double
x' Double
y
                AbsRel
Relative -> Double -> Double -> Vec2
Vec2 (Double
xDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
x') Double
y
        (DrawState -> DrawState) -> StateT DrawState Identity ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify' ((DrawState -> DrawState) -> StateT DrawState Identity ())
-> (DrawState -> DrawState) -> StateT DrawState Identity ()
forall a b. (a -> b) -> a -> b
$ \DrawState
s -> DrawState
s
            { _currentPoint :: Current Vec2
_currentPoint = Vec2 -> Current Vec2
forall a. a -> Current a
Current Vec2
new
            , _bezierReflectionQuadratic :: Maybe Vec2
_bezierReflectionQuadratic = Maybe Vec2
forall a. Maybe a
Nothing
            , _bezierReflectionCubic :: Maybe Vec2
_bezierReflectionCubic = Maybe Vec2
forall a. Maybe a
Nothing }
        Line -> StateT DrawState Identity Line
forall a. a -> StateT DrawState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Vec2 -> Vec2 -> Line
Line Vec2
current Vec2
new)

lineV :: Ord err => MP.Parsec err Text (State DrawState [Line])
lineV :: forall err. Ord err => Parsec err Text (State DrawState [Line])
lineV = do
    AbsRel
absRel <- AbsRel
Absolute AbsRel
-> ParsecT err Text Identity () -> ParsecT err Text Identity AbsRel
forall a b.
a -> ParsecT err Text Identity b -> ParsecT err Text Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ParsecT err Text Identity ()
forall err. Ord err => Char -> Parsec err Text ()
char_ Char
'V' ParsecT err Text Identity AbsRel
-> ParsecT err Text Identity AbsRel
-> ParsecT err Text Identity AbsRel
forall a.
ParsecT err Text Identity a
-> ParsecT err Text Identity a -> ParsecT err Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> AbsRel
Relative AbsRel
-> ParsecT err Text Identity () -> ParsecT err Text Identity AbsRel
forall a b.
a -> ParsecT err Text Identity b -> ParsecT err Text Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ParsecT err Text Identity ()
forall err. Ord err => Char -> Parsec err Text ()
char_ Char
'v'
    [Double]
ys <- Parsec err Text Double -> Parsec err Text [Double]
forall err a. Ord err => Parsec err Text a -> Parsec err Text [a]
someMaybeCommaSep Parsec err Text Double
forall err. Ord err => Parsec err Text Double
double
    State DrawState [Line] -> Parsec err Text (State DrawState [Line])
forall a. a -> ParsecT err Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (State DrawState [Line]
 -> Parsec err Text (State DrawState [Line]))
-> State DrawState [Line]
-> Parsec err Text (State DrawState [Line])
forall a b. (a -> b) -> a -> b
$ [Double]
-> (Double -> StateT DrawState Identity Line)
-> State DrawState [Line]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Double]
ys ((Double -> StateT DrawState Identity Line)
 -> State DrawState [Line])
-> (Double -> StateT DrawState Identity Line)
-> State DrawState [Line]
forall a b. (a -> b) -> a -> b
$ \Double
y' -> do
        Current current :: Vec2
current@(Vec2 Double
x Double
y) <- (DrawState -> Current Vec2)
-> StateT DrawState Identity (Current Vec2)
forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
gets DrawState -> Current Vec2
_currentPoint
        let new :: Vec2
new = case AbsRel
absRel of
                AbsRel
Absolute -> Double -> Double -> Vec2
Vec2 Double
x Double
y'
                AbsRel
Relative -> Double -> Double -> Vec2
Vec2 Double
x (Double
yDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
y')
        (DrawState -> DrawState) -> StateT DrawState Identity ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify' ((DrawState -> DrawState) -> StateT DrawState Identity ())
-> (DrawState -> DrawState) -> StateT DrawState Identity ()
forall a b. (a -> b) -> a -> b
$ \DrawState
s -> DrawState
s
            { _currentPoint :: Current Vec2
_currentPoint = Vec2 -> Current Vec2
forall a. a -> Current a
Current Vec2
new
            , _bezierReflectionQuadratic :: Maybe Vec2
_bezierReflectionQuadratic = Maybe Vec2
forall a. Maybe a
Nothing
            , _bezierReflectionCubic :: Maybe Vec2
_bezierReflectionCubic = Maybe Vec2
forall a. Maybe a
Nothing }
        Line -> StateT DrawState Identity Line
forall a. a -> StateT DrawState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Vec2 -> Vec2 -> Line
Line Vec2
current Vec2
new)

line :: Ord err => MP.Parsec err Text (State DrawState [Line])
line :: forall err. Ord err => Parsec err Text (State DrawState [Line])
line = String
-> ParsecT err Text Identity (State DrawState [Line])
-> ParsecT err Text Identity (State DrawState [Line])
forall a.
String
-> ParsecT err Text Identity a -> ParsecT err Text Identity a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
MP.label String
"line (lLhHvV)" (ParsecT err Text Identity (State DrawState [Line])
 -> ParsecT err Text Identity (State DrawState [Line]))
-> ParsecT err Text Identity (State DrawState [Line])
-> ParsecT err Text Identity (State DrawState [Line])
forall a b. (a -> b) -> a -> b
$ ParsecT err Text Identity (State DrawState [Line])
forall err. Ord err => Parsec err Text (State DrawState [Line])
lineXY ParsecT err Text Identity (State DrawState [Line])
-> ParsecT err Text Identity (State DrawState [Line])
-> ParsecT err Text Identity (State DrawState [Line])
forall a.
ParsecT err Text Identity a
-> ParsecT err Text Identity a -> ParsecT err Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT err Text Identity (State DrawState [Line])
forall err. Ord err => Parsec err Text (State DrawState [Line])
lineH ParsecT err Text Identity (State DrawState [Line])
-> ParsecT err Text Identity (State DrawState [Line])
-> ParsecT err Text Identity (State DrawState [Line])
forall a.
ParsecT err Text Identity a
-> ParsecT err Text Identity a -> ParsecT err Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT err Text Identity (State DrawState [Line])
forall err. Ord err => Parsec err Text (State DrawState [Line])
lineV

bezierCubic :: Ord err => MP.Parsec err Text (State DrawState [Bezier])
bezierCubic :: forall err. Ord err => Parsec err Text (State DrawState [Bezier])
bezierCubic = String
-> ParsecT err Text Identity (State DrawState [Bezier])
-> ParsecT err Text Identity (State DrawState [Bezier])
forall a.
String
-> ParsecT err Text Identity a -> ParsecT err Text Identity a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
MP.label String
"cubical bezier (cCsS)" (ParsecT err Text Identity (State DrawState [Bezier])
 -> ParsecT err Text Identity (State DrawState [Bezier]))
-> ParsecT err Text Identity (State DrawState [Bezier])
-> ParsecT err Text Identity (State DrawState [Bezier])
forall a b. (a -> b) -> a -> b
$ do
    (AbsRel
absRel, Bool
mirrorPreviousControlPoint) <- [ParsecT err Text Identity (AbsRel, Bool)]
-> ParsecT err Text Identity (AbsRel, Bool)
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
        [ (AbsRel
Absolute, Bool
False) (AbsRel, Bool)
-> ParsecT err Text Identity ()
-> ParsecT err Text Identity (AbsRel, Bool)
forall a b.
a -> ParsecT err Text Identity b -> ParsecT err Text Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ParsecT err Text Identity ()
forall err. Ord err => Char -> Parsec err Text ()
char_ Char
'C'
        , (AbsRel
Relative, Bool
False) (AbsRel, Bool)
-> ParsecT err Text Identity ()
-> ParsecT err Text Identity (AbsRel, Bool)
forall a b.
a -> ParsecT err Text Identity b -> ParsecT err Text Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ParsecT err Text Identity ()
forall err. Ord err => Char -> Parsec err Text ()
char_ Char
'c'
        , (AbsRel
Absolute, Bool
True) (AbsRel, Bool)
-> ParsecT err Text Identity ()
-> ParsecT err Text Identity (AbsRel, Bool)
forall a b.
a -> ParsecT err Text Identity b -> ParsecT err Text Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ParsecT err Text Identity ()
forall err. Ord err => Char -> Parsec err Text ()
char_ Char
'S'
        , (AbsRel
Relative, Bool
True) (AbsRel, Bool)
-> ParsecT err Text Identity ()
-> ParsecT err Text Identity (AbsRel, Bool)
forall a b.
a -> ParsecT err Text Identity b -> ParsecT err Text Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ParsecT err Text Identity ()
forall err. Ord err => Char -> Parsec err Text ()
char_ Char
's'
        ]
    [Either (Vec2, Vec2, Vec2) (Vec2, Vec2)]
controlPoints <- Parsec err Text (Either (Vec2, Vec2, Vec2) (Vec2, Vec2))
-> Parsec err Text [Either (Vec2, Vec2, Vec2) (Vec2, Vec2)]
forall err a. Ord err => Parsec err Text a -> Parsec err Text [a]
someMaybeCommaSep (Parsec err Text (Either (Vec2, Vec2, Vec2) (Vec2, Vec2))
 -> Parsec err Text [Either (Vec2, Vec2, Vec2) (Vec2, Vec2)])
-> Parsec err Text (Either (Vec2, Vec2, Vec2) (Vec2, Vec2))
-> Parsec err Text [Either (Vec2, Vec2, Vec2) (Vec2, Vec2)]
forall a b. (a -> b) -> a -> b
$ case Bool
mirrorPreviousControlPoint of
        Bool
False -> (Vec2, Vec2, Vec2) -> Either (Vec2, Vec2, Vec2) (Vec2, Vec2)
forall a b. a -> Either a b
Left ((Vec2, Vec2, Vec2) -> Either (Vec2, Vec2, Vec2) (Vec2, Vec2))
-> ParsecT err Text Identity (Vec2, Vec2, Vec2)
-> Parsec err Text (Either (Vec2, Vec2, Vec2) (Vec2, Vec2))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((,,) (Vec2 -> Vec2 -> Vec2 -> (Vec2, Vec2, Vec2))
-> ParsecT err Text Identity Vec2
-> ParsecT err Text Identity (Vec2 -> Vec2 -> (Vec2, Vec2, Vec2))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT err Text Identity Vec2
forall err. Ord err => Parsec err Text Vec2
vec2 ParsecT err Text Identity (Vec2 -> Vec2 -> (Vec2, Vec2, Vec2))
-> ParsecT err Text Identity Vec2
-> ParsecT err Text Identity (Vec2 -> (Vec2, Vec2, Vec2))
forall a b.
ParsecT err Text Identity (a -> b)
-> ParsecT err Text Identity a -> ParsecT err Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT err Text Identity Vec2
forall err. Ord err => Parsec err Text Vec2
vec2 ParsecT err Text Identity (Vec2 -> (Vec2, Vec2, Vec2))
-> ParsecT err Text Identity Vec2
-> ParsecT err Text Identity (Vec2, Vec2, Vec2)
forall a b.
ParsecT err Text Identity (a -> b)
-> ParsecT err Text Identity a -> ParsecT err Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT err Text Identity Vec2
forall err. Ord err => Parsec err Text Vec2
vec2)
        Bool
True -> (Vec2, Vec2) -> Either (Vec2, Vec2, Vec2) (Vec2, Vec2)
forall a b. b -> Either a b
Right ((Vec2, Vec2) -> Either (Vec2, Vec2, Vec2) (Vec2, Vec2))
-> ParsecT err Text Identity (Vec2, Vec2)
-> Parsec err Text (Either (Vec2, Vec2, Vec2) (Vec2, Vec2))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((,) (Vec2 -> Vec2 -> (Vec2, Vec2))
-> ParsecT err Text Identity Vec2
-> ParsecT err Text Identity (Vec2 -> (Vec2, Vec2))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT err Text Identity Vec2
forall err. Ord err => Parsec err Text Vec2
vec2 ParsecT err Text Identity (Vec2 -> (Vec2, Vec2))
-> ParsecT err Text Identity Vec2
-> ParsecT err Text Identity (Vec2, Vec2)
forall a b.
ParsecT err Text Identity (a -> b)
-> ParsecT err Text Identity a -> ParsecT err Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT err Text Identity Vec2
forall err. Ord err => Parsec err Text Vec2
vec2)
    State DrawState [Bezier]
-> ParsecT err Text Identity (State DrawState [Bezier])
forall a. a -> ParsecT err Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (State DrawState [Bezier]
 -> ParsecT err Text Identity (State DrawState [Bezier]))
-> State DrawState [Bezier]
-> ParsecT err Text Identity (State DrawState [Bezier])
forall a b. (a -> b) -> a -> b
$ [Either (Vec2, Vec2, Vec2) (Vec2, Vec2)]
-> (Either (Vec2, Vec2, Vec2) (Vec2, Vec2)
    -> StateT DrawState Identity Bezier)
-> State DrawState [Bezier]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Either (Vec2, Vec2, Vec2) (Vec2, Vec2)]
controlPoints ((Either (Vec2, Vec2, Vec2) (Vec2, Vec2)
  -> StateT DrawState Identity Bezier)
 -> State DrawState [Bezier])
-> (Either (Vec2, Vec2, Vec2) (Vec2, Vec2)
    -> StateT DrawState Identity Bezier)
-> State DrawState [Bezier]
forall a b. (a -> b) -> a -> b
$ \Either (Vec2, Vec2, Vec2) (Vec2, Vec2)
cps -> do
        DrawState{_currentPoint :: DrawState -> Current Vec2
_currentPoint = Current Vec2
current, _bezierReflectionCubic :: DrawState -> Maybe Vec2
_bezierReflectionCubic = Maybe Vec2
reflectMe} <- StateT DrawState Identity DrawState
forall (m :: * -> *) s. Monad m => StateT s m s
get
        curve :: Bezier
curve@(Bezier Vec2
_ Vec2
_ Vec2
helper2 Vec2
end) <- case Either (Vec2, Vec2, Vec2) (Vec2, Vec2)
cps of
            Left (Vec2
helper1Raw, Vec2
helper2Raw, Vec2
endRaw) -> do
                let (Vec2
helper1, Vec2
helper2, Vec2
end) = case AbsRel
absRel of
                        AbsRel
Absolute -> (Vec2
helper1Raw, Vec2
helper2Raw, Vec2
endRaw)
                        AbsRel
Relative -> (Vec2
helper1Raw Vec2 -> Vec2 -> Vec2
forall v. VectorSpace v => v -> v -> v
+. Vec2
current, Vec2
helper2Raw Vec2 -> Vec2 -> Vec2
forall v. VectorSpace v => v -> v -> v
+. Vec2
current, Vec2
endRaw Vec2 -> Vec2 -> Vec2
forall v. VectorSpace v => v -> v -> v
+. Vec2
current)
                Bezier -> StateT DrawState Identity Bezier
forall a. a -> StateT DrawState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Vec2 -> Vec2 -> Vec2 -> Vec2 -> Bezier
Bezier Vec2
current Vec2
helper1 Vec2
helper2 Vec2
end)
            Right (Vec2
helper2Raw, Vec2
endRaw) -> do
                let helper1 :: Vec2
helper1 = Vec2
current Vec2 -> Vec2 -> Vec2
forall v. VectorSpace v => v -> v -> v
-. Vec2 -> Maybe Vec2 -> Vec2
forall a. a -> Maybe a -> a
fromMaybe Vec2
current Maybe Vec2
reflectMe
                    (Vec2
helper2, Vec2
end) = case AbsRel
absRel of
                        AbsRel
Absolute -> (Vec2
helper2Raw, Vec2
endRaw)
                        AbsRel
Relative -> (Vec2
helper2Raw Vec2 -> Vec2 -> Vec2
forall v. VectorSpace v => v -> v -> v
+. Vec2
current, Vec2
endRaw Vec2 -> Vec2 -> Vec2
forall v. VectorSpace v => v -> v -> v
+. Vec2
current)
                Bezier -> StateT DrawState Identity Bezier
forall a. a -> StateT DrawState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Vec2 -> Vec2 -> Vec2 -> Vec2 -> Bezier
Bezier Vec2
current Vec2
helper1 Vec2
helper2 Vec2
end)
        (DrawState -> DrawState) -> StateT DrawState Identity ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify' ((DrawState -> DrawState) -> StateT DrawState Identity ())
-> (DrawState -> DrawState) -> StateT DrawState Identity ()
forall a b. (a -> b) -> a -> b
$ \DrawState
s -> DrawState
s
            { _currentPoint :: Current Vec2
_currentPoint = Vec2 -> Current Vec2
forall a. a -> Current a
Current Vec2
end
            , _bezierReflectionCubic :: Maybe Vec2
_bezierReflectionCubic = Vec2 -> Maybe Vec2
forall a. a -> Maybe a
Just Vec2
helper2
            , _bezierReflectionQuadratic :: Maybe Vec2
_bezierReflectionQuadratic = Maybe Vec2
forall a. Maybe a
Nothing }
        Bezier -> StateT DrawState Identity Bezier
forall a. a -> StateT DrawState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bezier
curve

bezierQuadratic :: Ord err => MP.Parsec err Text (State DrawState [Bezier])
bezierQuadratic :: forall err. Ord err => Parsec err Text (State DrawState [Bezier])
bezierQuadratic = String
-> ParsecT err Text Identity (State DrawState [Bezier])
-> ParsecT err Text Identity (State DrawState [Bezier])
forall a.
String
-> ParsecT err Text Identity a -> ParsecT err Text Identity a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
MP.label String
"quadratic bezier (qQtT)" (ParsecT err Text Identity (State DrawState [Bezier])
 -> ParsecT err Text Identity (State DrawState [Bezier]))
-> ParsecT err Text Identity (State DrawState [Bezier])
-> ParsecT err Text Identity (State DrawState [Bezier])
forall a b. (a -> b) -> a -> b
$ do
    (AbsRel
absRel, Bool
mirrorPreviousControlPoint) <- [ParsecT err Text Identity (AbsRel, Bool)]
-> ParsecT err Text Identity (AbsRel, Bool)
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
        [ (AbsRel
Absolute, Bool
False) (AbsRel, Bool)
-> ParsecT err Text Identity ()
-> ParsecT err Text Identity (AbsRel, Bool)
forall a b.
a -> ParsecT err Text Identity b -> ParsecT err Text Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ParsecT err Text Identity ()
forall err. Ord err => Char -> Parsec err Text ()
char_ Char
'Q'
        , (AbsRel
Relative, Bool
False) (AbsRel, Bool)
-> ParsecT err Text Identity ()
-> ParsecT err Text Identity (AbsRel, Bool)
forall a b.
a -> ParsecT err Text Identity b -> ParsecT err Text Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ParsecT err Text Identity ()
forall err. Ord err => Char -> Parsec err Text ()
char_ Char
'q'
        , (AbsRel
Absolute, Bool
True) (AbsRel, Bool)
-> ParsecT err Text Identity ()
-> ParsecT err Text Identity (AbsRel, Bool)
forall a b.
a -> ParsecT err Text Identity b -> ParsecT err Text Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ParsecT err Text Identity ()
forall err. Ord err => Char -> Parsec err Text ()
char_ Char
'T'
        , (AbsRel
Relative, Bool
True) (AbsRel, Bool)
-> ParsecT err Text Identity ()
-> ParsecT err Text Identity (AbsRel, Bool)
forall a b.
a -> ParsecT err Text Identity b -> ParsecT err Text Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ParsecT err Text Identity ()
forall err. Ord err => Char -> Parsec err Text ()
char_ Char
't'
        ]
    [Either (Vec2, Vec2) Vec2]
controlPoints <- Parsec err Text (Either (Vec2, Vec2) Vec2)
-> Parsec err Text [Either (Vec2, Vec2) Vec2]
forall err a. Ord err => Parsec err Text a -> Parsec err Text [a]
someMaybeCommaSep (Parsec err Text (Either (Vec2, Vec2) Vec2)
 -> Parsec err Text [Either (Vec2, Vec2) Vec2])
-> Parsec err Text (Either (Vec2, Vec2) Vec2)
-> Parsec err Text [Either (Vec2, Vec2) Vec2]
forall a b. (a -> b) -> a -> b
$ case Bool
mirrorPreviousControlPoint of
        Bool
False -> (Vec2, Vec2) -> Either (Vec2, Vec2) Vec2
forall a b. a -> Either a b
Left ((Vec2, Vec2) -> Either (Vec2, Vec2) Vec2)
-> ParsecT err Text Identity (Vec2, Vec2)
-> Parsec err Text (Either (Vec2, Vec2) Vec2)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((,) (Vec2 -> Vec2 -> (Vec2, Vec2))
-> ParsecT err Text Identity Vec2
-> ParsecT err Text Identity (Vec2 -> (Vec2, Vec2))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT err Text Identity Vec2
forall err. Ord err => Parsec err Text Vec2
vec2 ParsecT err Text Identity (Vec2 -> (Vec2, Vec2))
-> ParsecT err Text Identity Vec2
-> ParsecT err Text Identity (Vec2, Vec2)
forall a b.
ParsecT err Text Identity (a -> b)
-> ParsecT err Text Identity a -> ParsecT err Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT err Text Identity Vec2
forall err. Ord err => Parsec err Text Vec2
vec2)
        Bool
True -> Vec2 -> Either (Vec2, Vec2) Vec2
forall a b. b -> Either a b
Right (Vec2 -> Either (Vec2, Vec2) Vec2)
-> ParsecT err Text Identity Vec2
-> Parsec err Text (Either (Vec2, Vec2) Vec2)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT err Text Identity Vec2
forall err. Ord err => Parsec err Text Vec2
vec2
    State DrawState [Bezier]
-> ParsecT err Text Identity (State DrawState [Bezier])
forall a. a -> ParsecT err Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (State DrawState [Bezier]
 -> ParsecT err Text Identity (State DrawState [Bezier]))
-> State DrawState [Bezier]
-> ParsecT err Text Identity (State DrawState [Bezier])
forall a b. (a -> b) -> a -> b
$ [Either (Vec2, Vec2) Vec2]
-> (Either (Vec2, Vec2) Vec2 -> StateT DrawState Identity Bezier)
-> State DrawState [Bezier]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Either (Vec2, Vec2) Vec2]
controlPoints ((Either (Vec2, Vec2) Vec2 -> StateT DrawState Identity Bezier)
 -> State DrawState [Bezier])
-> (Either (Vec2, Vec2) Vec2 -> StateT DrawState Identity Bezier)
-> State DrawState [Bezier]
forall a b. (a -> b) -> a -> b
$ \Either (Vec2, Vec2) Vec2
cps -> do
        DrawState{_currentPoint :: DrawState -> Current Vec2
_currentPoint = Current Vec2
current, _bezierReflectionQuadratic :: DrawState -> Maybe Vec2
_bezierReflectionQuadratic = Maybe Vec2
reflectMe} <- StateT DrawState Identity DrawState
forall (m :: * -> *) s. Monad m => StateT s m s
get
        curve :: QuadraticBezier
curve@(QuadraticBezier Vec2
_ Vec2
helper Vec2
end) <- case Either (Vec2, Vec2) Vec2
cps of
            Left (Vec2
helperRaw, Vec2
endRaw) -> do
                let (Vec2
helper, Vec2
end) = case AbsRel
absRel of
                        AbsRel
Absolute -> (Vec2
helperRaw, Vec2
endRaw)
                        AbsRel
Relative -> (Vec2
helperRaw Vec2 -> Vec2 -> Vec2
forall v. VectorSpace v => v -> v -> v
+. Vec2
current, Vec2
endRaw Vec2 -> Vec2 -> Vec2
forall v. VectorSpace v => v -> v -> v
+. Vec2
current)
                QuadraticBezier -> StateT DrawState Identity QuadraticBezier
forall a. a -> StateT DrawState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Vec2 -> Vec2 -> Vec2 -> QuadraticBezier
QuadraticBezier Vec2
current Vec2
helper Vec2
end)
            Right Vec2
endRaw -> do
                let helper :: Vec2
helper = Vec2
current Vec2 -> Vec2 -> Vec2
forall v. VectorSpace v => v -> v -> v
-. Vec2 -> Maybe Vec2 -> Vec2
forall a. a -> Maybe a -> a
fromMaybe Vec2
current Maybe Vec2
reflectMe
                    end :: Vec2
end = case AbsRel
absRel of
                        AbsRel
Absolute -> Vec2
endRaw
                        AbsRel
Relative -> Vec2
endRaw Vec2 -> Vec2 -> Vec2
forall v. VectorSpace v => v -> v -> v
+. Vec2
current
                QuadraticBezier -> StateT DrawState Identity QuadraticBezier
forall a. a -> StateT DrawState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Vec2 -> Vec2 -> Vec2 -> QuadraticBezier
QuadraticBezier Vec2
current Vec2
helper Vec2
end)
        (DrawState -> DrawState) -> StateT DrawState Identity ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify' ((DrawState -> DrawState) -> StateT DrawState Identity ())
-> (DrawState -> DrawState) -> StateT DrawState Identity ()
forall a b. (a -> b) -> a -> b
$ \DrawState
s -> DrawState
s
            { _currentPoint :: Current Vec2
_currentPoint = Vec2 -> Current Vec2
forall a. a -> Current a
Current Vec2
end
            , _bezierReflectionQuadratic :: Maybe Vec2
_bezierReflectionQuadratic = Vec2 -> Maybe Vec2
forall a. a -> Maybe a
Just Vec2
helper
            , _bezierReflectionCubic :: Maybe Vec2
_bezierReflectionCubic = Maybe Vec2
forall a. Maybe a
Nothing }
        Bezier -> StateT DrawState Identity Bezier
forall a. a -> StateT DrawState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (QuadraticBezier -> Bezier
quadraticToCubical QuadraticBezier
curve)

data QuadraticBezier = QuadraticBezier Vec2 Vec2 Vec2 deriving (QuadraticBezier -> QuadraticBezier -> Bool
(QuadraticBezier -> QuadraticBezier -> Bool)
-> (QuadraticBezier -> QuadraticBezier -> Bool)
-> Eq QuadraticBezier
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: QuadraticBezier -> QuadraticBezier -> Bool
== :: QuadraticBezier -> QuadraticBezier -> Bool
$c/= :: QuadraticBezier -> QuadraticBezier -> Bool
/= :: QuadraticBezier -> QuadraticBezier -> Bool
Eq, Eq QuadraticBezier
Eq QuadraticBezier
-> (QuadraticBezier -> QuadraticBezier -> Ordering)
-> (QuadraticBezier -> QuadraticBezier -> Bool)
-> (QuadraticBezier -> QuadraticBezier -> Bool)
-> (QuadraticBezier -> QuadraticBezier -> Bool)
-> (QuadraticBezier -> QuadraticBezier -> Bool)
-> (QuadraticBezier -> QuadraticBezier -> QuadraticBezier)
-> (QuadraticBezier -> QuadraticBezier -> QuadraticBezier)
-> Ord QuadraticBezier
QuadraticBezier -> QuadraticBezier -> Bool
QuadraticBezier -> QuadraticBezier -> Ordering
QuadraticBezier -> QuadraticBezier -> QuadraticBezier
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: QuadraticBezier -> QuadraticBezier -> Ordering
compare :: QuadraticBezier -> QuadraticBezier -> Ordering
$c< :: QuadraticBezier -> QuadraticBezier -> Bool
< :: QuadraticBezier -> QuadraticBezier -> Bool
$c<= :: QuadraticBezier -> QuadraticBezier -> Bool
<= :: QuadraticBezier -> QuadraticBezier -> Bool
$c> :: QuadraticBezier -> QuadraticBezier -> Bool
> :: QuadraticBezier -> QuadraticBezier -> Bool
$c>= :: QuadraticBezier -> QuadraticBezier -> Bool
>= :: QuadraticBezier -> QuadraticBezier -> Bool
$cmax :: QuadraticBezier -> QuadraticBezier -> QuadraticBezier
max :: QuadraticBezier -> QuadraticBezier -> QuadraticBezier
$cmin :: QuadraticBezier -> QuadraticBezier -> QuadraticBezier
min :: QuadraticBezier -> QuadraticBezier -> QuadraticBezier
Ord, Int -> QuadraticBezier -> ShowS
[QuadraticBezier] -> ShowS
QuadraticBezier -> String
(Int -> QuadraticBezier -> ShowS)
-> (QuadraticBezier -> String)
-> ([QuadraticBezier] -> ShowS)
-> Show QuadraticBezier
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> QuadraticBezier -> ShowS
showsPrec :: Int -> QuadraticBezier -> ShowS
$cshow :: QuadraticBezier -> String
show :: QuadraticBezier -> String
$cshowList :: [QuadraticBezier] -> ShowS
showList :: [QuadraticBezier] -> ShowS
Show)

quadraticToCubical :: QuadraticBezier -> Bezier
quadraticToCubical :: QuadraticBezier -> Bezier
quadraticToCubical (QuadraticBezier Vec2
qStart Vec2
qHelper Vec2
qEnd) =
    let cStart :: Vec2
cStart = Vec2
qStart
        cHelper1 :: Vec2
cHelper1 = Vec2
qStart Vec2 -> Vec2 -> Vec2
forall v. VectorSpace v => v -> v -> v
+. Double
2Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
3 Double -> Vec2 -> Vec2
forall v. VectorSpace v => Double -> v -> v
*. (Vec2
qHelper Vec2 -> Vec2 -> Vec2
forall v. VectorSpace v => v -> v -> v
-.Vec2
qStart)
        cHelper2 :: Vec2
cHelper2 = Vec2
qEnd   Vec2 -> Vec2 -> Vec2
forall v. VectorSpace v => v -> v -> v
+. Double
2Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
3 Double -> Vec2 -> Vec2
forall v. VectorSpace v => Double -> v -> v
*. (Vec2
qHelper Vec2 -> Vec2 -> Vec2
forall v. VectorSpace v => v -> v -> v
-.Vec2
qEnd)
        cEnd :: Vec2
cEnd = Vec2
qEnd
    in Vec2 -> Vec2 -> Vec2 -> Vec2 -> Bezier
Bezier Vec2
cStart Vec2
cHelper1 Vec2
cHelper2 Vec2
cEnd

bezier :: Ord err => MP.Parsec err Text (State DrawState [Bezier])
bezier :: forall err. Ord err => Parsec err Text (State DrawState [Bezier])
bezier = Parsec err Text (State DrawState [Bezier])
forall err. Ord err => Parsec err Text (State DrawState [Bezier])
bezierQuadratic Parsec err Text (State DrawState [Bezier])
-> Parsec err Text (State DrawState [Bezier])
-> Parsec err Text (State DrawState [Bezier])
forall a.
ParsecT err Text Identity a
-> ParsecT err Text Identity a -> ParsecT err Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parsec err Text (State DrawState [Bezier])
forall err. Ord err => Parsec err Text (State DrawState [Bezier])
bezierCubic

ellipticalArc :: MP.Parsec Text Text a
ellipticalArc :: forall a. Parsec Text Text a
ellipticalArc = String
-> ParsecT Text Text Identity a -> ParsecT Text Text Identity a
forall a.
String
-> ParsecT Text Text Identity a -> ParsecT Text Text Identity a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
MP.label String
"" (ParsecT Text Text Identity a -> ParsecT Text Text Identity a)
-> ParsecT Text Text Identity a -> ParsecT Text Text Identity a
forall a b. (a -> b) -> a -> b
$ do
    ()
_cubicChar <- [ParsecT Text Text Identity ()] -> ParsecT Text Text Identity ()
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum ((Char -> ParsecT Text Text Identity ())
-> String -> [ParsecT Text Text Identity ()]
forall a b. (a -> b) -> [a] -> [b]
map Char -> ParsecT Text Text Identity ()
forall err. Ord err => Char -> Parsec err Text ()
char_ String
"aA")
    Text -> ParsecT Text Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
MP.customFailure Text
"Elliptical arc curves are not supported by the parser"

closePath :: Ord err => MP.Parsec err Text (State DrawState Line)
closePath :: forall err.
Ord err =>
Parsec err Text (StateT DrawState Identity Line)
closePath = String
-> ParsecT err Text Identity (StateT DrawState Identity Line)
-> ParsecT err Text Identity (StateT DrawState Identity Line)
forall a.
String
-> ParsecT err Text Identity a -> ParsecT err Text Identity a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
MP.label String
"close path (zZ)" (ParsecT err Text Identity (StateT DrawState Identity Line)
 -> ParsecT err Text Identity (StateT DrawState Identity Line))
-> ParsecT err Text Identity (StateT DrawState Identity Line)
-> ParsecT err Text Identity (StateT DrawState Identity Line)
forall a b. (a -> b) -> a -> b
$ do
    Char -> Parsec err Text ()
forall err. Ord err => Char -> Parsec err Text ()
char_ Char
'Z' Parsec err Text () -> Parsec err Text () -> Parsec err Text ()
forall a.
ParsecT err Text Identity a
-> ParsecT err Text Identity a -> ParsecT err Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> Parsec err Text ()
forall err. Ord err => Char -> Parsec err Text ()
char_ Char
'z'
    StateT DrawState Identity Line
-> ParsecT err Text Identity (StateT DrawState Identity Line)
forall a. a -> ParsecT err Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StateT DrawState Identity Line
 -> ParsecT err Text Identity (StateT DrawState Identity Line))
-> StateT DrawState Identity Line
-> ParsecT err Text Identity (StateT DrawState Identity Line)
forall a b. (a -> b) -> a -> b
$ do
        DrawState {_startOfTrajectory :: DrawState -> Start Vec2
_startOfTrajectory = Start Vec2
start, _currentPoint :: DrawState -> Current Vec2
_currentPoint = Current Vec2
current} <- StateT DrawState Identity DrawState
forall (m :: * -> *) s. Monad m => StateT s m s
get
        (DrawState -> DrawState) -> StateT DrawState Identity ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify' ((DrawState -> DrawState) -> StateT DrawState Identity ())
-> (DrawState -> DrawState) -> StateT DrawState Identity ()
forall a b. (a -> b) -> a -> b
$ \DrawState
s -> DrawState
s {_currentPoint :: Current Vec2
_currentPoint = Vec2 -> Current Vec2
forall a. a -> Current a
Current Vec2
start, _bezierReflectionQuadratic :: Maybe Vec2
_bezierReflectionQuadratic = Maybe Vec2
forall a. Maybe a
Nothing, _bezierReflectionCubic :: Maybe Vec2
_bezierReflectionCubic = Maybe Vec2
forall a. Maybe a
Nothing }
        Line -> StateT DrawState Identity Line
forall a. a -> StateT DrawState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Vec2 -> Vec2 -> Line
Line Vec2
current Vec2
start)

parse :: Text -> Either Text [[Either Line Bezier]]
parse :: Text -> Either Text [[Either Line Bezier]]
parse Text
input = case Parsec Text Text [[State DrawState (Either [Line] [Bezier])]]
-> String
-> Text
-> Either
     (ParseErrorBundle Text Text)
     [[State DrawState (Either [Line] [Bezier])]]
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
MP.parse (ParsecT Text Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
MPC.space ParsecT Text Text Identity ()
-> Parsec Text Text [[State DrawState (Either [Line] [Bezier])]]
-> Parsec Text Text [[State DrawState (Either [Line] [Bezier])]]
forall a b.
ParsecT Text Text Identity a
-> ParsecT Text Text Identity b -> ParsecT Text Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT
  Text Text Identity [State DrawState (Either [Line] [Bezier])]
-> Parsec Text Text [[State DrawState (Either [Line] [Bezier])]]
forall a.
ParsecT Text Text Identity a -> ParsecT Text Text Identity [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ParsecT
  Text Text Identity [State DrawState (Either [Line] [Bezier])]
parseSinglePathInstruction Parsec Text Text [[State DrawState (Either [Line] [Bezier])]]
-> ParsecT Text Text Identity ()
-> Parsec Text Text [[State DrawState (Either [Line] [Bezier])]]
forall a b.
ParsecT Text Text Identity a
-> ParsecT Text Text Identity b -> ParsecT Text Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text Text Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
MP.eof) String
sourceFile Text
input of
    Left ParseErrorBundle Text Text
errBundle -> Text -> Either Text [[Either Line Bezier]]
forall a b. a -> Either a b
Left (String -> Text
T.pack (ParseErrorBundle Text Text -> String
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
MP.errorBundlePretty ParseErrorBundle Text Text
errBundle))
    Right [[State DrawState (Either [Line] [Bezier])]]
pathInstructions -> [[Either Line Bezier]] -> Either Text [[Either Line Bezier]]
forall a b. b -> Either a b
Right ([[State DrawState (Either [Line] [Bezier])]]
-> [[Either Line Bezier]]
interpretAllDrawingInstructions [[State DrawState (Either [Line] [Bezier])]]
pathInstructions)
  where
    sourceFile :: String
sourceFile = String
""

parseSinglePathInstruction :: MP.Parsec Text Text [State DrawState (Either [Line] [Bezier])]
parseSinglePathInstruction :: ParsecT
  Text Text Identity [State DrawState (Either [Line] [Bezier])]
parseSinglePathInstruction = do
    State DrawState (Either [Line] [Bezier])
moveLines <- ((State DrawState [Line]
 -> State DrawState (Either [Line] [Bezier]))
-> ParsecT Text Text Identity (State DrawState [Line])
-> ParsecT
     Text Text Identity (State DrawState (Either [Line] [Bezier]))
forall a b.
(a -> b)
-> ParsecT Text Text Identity a -> ParsecT Text Text Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap((State DrawState [Line]
  -> State DrawState (Either [Line] [Bezier]))
 -> ParsecT Text Text Identity (State DrawState [Line])
 -> ParsecT
      Text Text Identity (State DrawState (Either [Line] [Bezier])))
-> (([Line] -> Either [Line] [Bezier])
    -> State DrawState [Line]
    -> State DrawState (Either [Line] [Bezier]))
-> ([Line] -> Either [Line] [Bezier])
-> ParsecT Text Text Identity (State DrawState [Line])
-> ParsecT
     Text Text Identity (State DrawState (Either [Line] [Bezier]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.([Line] -> Either [Line] [Bezier])
-> State DrawState [Line]
-> State DrawState (Either [Line] [Bezier])
forall a b.
(a -> b)
-> StateT DrawState Identity a -> StateT DrawState Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) [Line] -> Either [Line] [Bezier]
forall a b. a -> Either a b
Left ParsecT Text Text Identity (State DrawState [Line])
forall err. Ord err => Parsec err Text (State DrawState [Line])
move
    [State DrawState (Either [Line] [Bezier])]
states <- ParsecT
  Text Text Identity (State DrawState (Either [Line] [Bezier]))
-> ParsecT
     Text Text Identity [State DrawState (Either [Line] [Bezier])]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
MP.many (ParsecT
   Text Text Identity (State DrawState (Either [Line] [Bezier]))
 -> ParsecT
      Text Text Identity [State DrawState (Either [Line] [Bezier])])
-> ParsecT
     Text Text Identity (State DrawState (Either [Line] [Bezier]))
-> ParsecT
     Text Text Identity [State DrawState (Either [Line] [Bezier])]
forall a b. (a -> b) -> a -> b
$ [ParsecT
   Text Text Identity (State DrawState (Either [Line] [Bezier]))]
-> ParsecT
     Text Text Identity (State DrawState (Either [Line] [Bezier]))
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
        [ ((State DrawState [Line]
 -> State DrawState (Either [Line] [Bezier]))
-> ParsecT Text Text Identity (State DrawState [Line])
-> ParsecT
     Text Text Identity (State DrawState (Either [Line] [Bezier]))
forall a b.
(a -> b)
-> ParsecT Text Text Identity a -> ParsecT Text Text Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap((State DrawState [Line]
  -> State DrawState (Either [Line] [Bezier]))
 -> ParsecT Text Text Identity (State DrawState [Line])
 -> ParsecT
      Text Text Identity (State DrawState (Either [Line] [Bezier])))
-> (([Line] -> Either [Line] [Bezier])
    -> State DrawState [Line]
    -> State DrawState (Either [Line] [Bezier]))
-> ([Line] -> Either [Line] [Bezier])
-> ParsecT Text Text Identity (State DrawState [Line])
-> ParsecT
     Text Text Identity (State DrawState (Either [Line] [Bezier]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.([Line] -> Either [Line] [Bezier])
-> State DrawState [Line]
-> State DrawState (Either [Line] [Bezier])
forall a b.
(a -> b)
-> StateT DrawState Identity a -> StateT DrawState Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) [Line] -> Either [Line] [Bezier]
forall a b. a -> Either a b
Left ParsecT Text Text Identity (State DrawState [Line])
forall err. Ord err => Parsec err Text (State DrawState [Line])
line
        , ((State DrawState [Bezier]
 -> State DrawState (Either [Line] [Bezier]))
-> ParsecT Text Text Identity (State DrawState [Bezier])
-> ParsecT
     Text Text Identity (State DrawState (Either [Line] [Bezier]))
forall a b.
(a -> b)
-> ParsecT Text Text Identity a -> ParsecT Text Text Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap((State DrawState [Bezier]
  -> State DrawState (Either [Line] [Bezier]))
 -> ParsecT Text Text Identity (State DrawState [Bezier])
 -> ParsecT
      Text Text Identity (State DrawState (Either [Line] [Bezier])))
-> (([Bezier] -> Either [Line] [Bezier])
    -> State DrawState [Bezier]
    -> State DrawState (Either [Line] [Bezier]))
-> ([Bezier] -> Either [Line] [Bezier])
-> ParsecT Text Text Identity (State DrawState [Bezier])
-> ParsecT
     Text Text Identity (State DrawState (Either [Line] [Bezier]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.([Bezier] -> Either [Line] [Bezier])
-> State DrawState [Bezier]
-> State DrawState (Either [Line] [Bezier])
forall a b.
(a -> b)
-> StateT DrawState Identity a -> StateT DrawState Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) [Bezier] -> Either [Line] [Bezier]
forall a b. b -> Either a b
Right ParsecT Text Text Identity (State DrawState [Bezier])
forall err. Ord err => Parsec err Text (State DrawState [Bezier])
bezier
        , ParsecT
  Text Text Identity (State DrawState (Either [Line] [Bezier]))
forall a. Parsec Text Text a
ellipticalArc
        ]
    [State DrawState (Either [Line] [Bezier])]
closePathLine <- ParsecT Text Text Identity (StateT DrawState Identity Line)
-> ParsecT
     Text Text Identity (Maybe (StateT DrawState Identity Line))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT Text Text Identity (StateT DrawState Identity Line)
forall err.
Ord err =>
Parsec err Text (StateT DrawState Identity Line)
closePath ParsecT Text Text Identity (Maybe (StateT DrawState Identity Line))
-> (Maybe (StateT DrawState Identity Line)
    -> ParsecT
         Text Text Identity [State DrawState (Either [Line] [Bezier])])
-> ParsecT
     Text Text Identity [State DrawState (Either [Line] [Bezier])]
forall a b.
ParsecT Text Text Identity a
-> (a -> ParsecT Text Text Identity b)
-> ParsecT Text Text Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Maybe (StateT DrawState Identity Line)
Nothing -> [State DrawState (Either [Line] [Bezier])]
-> ParsecT
     Text Text Identity [State DrawState (Either [Line] [Bezier])]
forall a. a -> ParsecT Text Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
        Just StateT DrawState Identity Line
close -> [State DrawState (Either [Line] [Bezier])]
-> ParsecT
     Text Text Identity [State DrawState (Either [Line] [Bezier])]
forall a. a -> ParsecT Text Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [(Line -> Either [Line] [Bezier])
-> StateT DrawState Identity Line
-> State DrawState (Either [Line] [Bezier])
forall a b.
(a -> b)
-> StateT DrawState Identity a -> StateT DrawState Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Line
x -> [Line] -> Either [Line] [Bezier]
forall a b. a -> Either a b
Left [Line
x]) StateT DrawState Identity Line
close]

    [State DrawState (Either [Line] [Bezier])]
-> ParsecT
     Text Text Identity [State DrawState (Either [Line] [Bezier])]
forall a. a -> ParsecT Text Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (State DrawState (Either [Line] [Bezier])
moveLines State DrawState (Either [Line] [Bezier])
-> [State DrawState (Either [Line] [Bezier])]
-> [State DrawState (Either [Line] [Bezier])]
forall a. a -> [a] -> [a]
: [State DrawState (Either [Line] [Bezier])]
states [State DrawState (Either [Line] [Bezier])]
-> [State DrawState (Either [Line] [Bezier])]
-> [State DrawState (Either [Line] [Bezier])]
forall a. [a] -> [a] -> [a]
++ [State DrawState (Either [Line] [Bezier])]
closePathLine)

interpretAllDrawingInstructions :: [[State DrawState (Either [Line] [Bezier])]] -> [[Either Line Bezier]]
interpretAllDrawingInstructions :: [[State DrawState (Either [Line] [Bezier])]]
-> [[Either Line Bezier]]
interpretAllDrawingInstructions [[State DrawState (Either [Line] [Bezier])]]
instructions = State DrawState [[Either Line Bezier]]
-> DrawState -> [[Either Line Bezier]]
forall s a. State s a -> s -> a
evalState ([[State DrawState (Either [Line] [Bezier])]]
-> State DrawState [[Either Line Bezier]]
go [[State DrawState (Either [Line] [Bezier])]]
instructions) DrawState
initialState
  where
    initialState :: DrawState
initialState = DrawState
        { _startOfTrajectory :: Start Vec2
_startOfTrajectory = Vec2 -> Start Vec2
forall a. a -> Start a
Start Vec2
forall v. VectorSpace v => v
zero
        , _currentPoint :: Current Vec2
_currentPoint = Vec2 -> Current Vec2
forall a. a -> Current a
Current Vec2
forall v. VectorSpace v => v
zero
        , _bezierReflectionQuadratic :: Maybe Vec2
_bezierReflectionQuadratic = Maybe Vec2
forall a. Maybe a
Nothing
        , _bezierReflectionCubic :: Maybe Vec2
_bezierReflectionCubic = Maybe Vec2
forall a. Maybe a
Nothing
        }

    go :: [[State DrawState (Either [Line] [Bezier])]] -> State DrawState [[Either Line Bezier]]
    go :: [[State DrawState (Either [Line] [Bezier])]]
-> State DrawState [[Either Line Bezier]]
go [] = [[Either Line Bezier]] -> State DrawState [[Either Line Bezier]]
forall a. a -> StateT DrawState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    go ([State DrawState (Either [Line] [Bezier])]
is:[[State DrawState (Either [Line] [Bezier])]]
iss) = do
        [Either Line Bezier]
paths <- ([Either [Line] [Bezier]] -> [Either Line Bezier])
-> StateT DrawState Identity [Either [Line] [Bezier]]
-> StateT DrawState Identity [Either Line Bezier]
forall a b.
(a -> b)
-> StateT DrawState Identity a -> StateT DrawState Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Either [Line] [Bezier]] -> [Either Line Bezier]
flatten ([State DrawState (Either [Line] [Bezier])]
-> StateT DrawState Identity [Either [Line] [Bezier]]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [State DrawState (Either [Line] [Bezier])]
is)
        [[Either Line Bezier]]
rest <- [[State DrawState (Either [Line] [Bezier])]]
-> State DrawState [[Either Line Bezier]]
go [[State DrawState (Either [Line] [Bezier])]]
iss
        [[Either Line Bezier]] -> State DrawState [[Either Line Bezier]]
forall a. a -> StateT DrawState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Either Line Bezier]
paths [Either Line Bezier]
-> [[Either Line Bezier]] -> [[Either Line Bezier]]
forall a. a -> [a] -> [a]
: [[Either Line Bezier]]
rest)

    flatten :: [Either [Line] [Bezier]] -> [Either Line Bezier]
    flatten :: [Either [Line] [Bezier]] -> [Either Line Bezier]
flatten [] = []
    flatten (Left [Line]
ls : [Either [Line] [Bezier]]
xs) = (Line -> Either Line Bezier) -> [Line] -> [Either Line Bezier]
forall a b. (a -> b) -> [a] -> [b]
map Line -> Either Line Bezier
forall a b. a -> Either a b
Left [Line]
ls [Either Line Bezier]
-> [Either Line Bezier] -> [Either Line Bezier]
forall a. [a] -> [a] -> [a]
++ [Either [Line] [Bezier]] -> [Either Line Bezier]
flatten [Either [Line] [Bezier]]
xs
    flatten (Right [Bezier]
bs : [Either [Line] [Bezier]]
xs) = (Bezier -> Either Line Bezier) -> [Bezier] -> [Either Line Bezier]
forall a b. (a -> b) -> [a] -> [b]
map Bezier -> Either Line Bezier
forall a b. b -> Either a b
Right [Bezier]
bs [Either Line Bezier]
-> [Either Line Bezier] -> [Either Line Bezier]
forall a. [a] -> [a] -> [a]
++ [Either [Line] [Bezier]] -> [Either Line Bezier]
flatten [Either [Line] [Bezier]]
xs