{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NegativeLiterals #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RebindableSyntax #-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{-# OPTIONS_GHC -fno-warn-type-defaults #-}

-- | SVG path manipulation
module Data.Path
  ( -- * Path fundamental
    -- $path
    PathInfo (..),
    ArcInfo (..),
    ArcPosition (..),
    parsePath,
    toPathAbsolute,
    toPathCommand,
    toPathAbsolutes,
    toPathXYs,
    ArcCentroid (..),
    arcCentroid,
    arcPosition,
    arcBox,
    arcDerivs,
    ellipse,
    QuadPosition (..),
    QuadPolar (..),
    quadPosition,
    quadPolar,
    quadBox,
    quadBezier,
    quadDerivs,
    CubicPosition (..),
    CubicPolar (..),
    cubicPosition,
    cubicPolar,
    cubicBox,
    cubicBezier,
    cubicDerivs,
    singletonCubic,
    singletonQuad,
    singletonArc,
    singletonPie,
    singletonPie',
    toSingletonArc,
    pathBoxes,
    pathBox,
  )
where

import qualified Control.Foldl as L
import Control.Lens hiding ((...))
import qualified Data.Attoparsec.Text as A
import Data.FormatN
import Data.Generics.Labels ()
import qualified Data.Text as Text
import qualified Geom2D.CubicBezier as B
import Graphics.SvgTree (Origin (..), PathCommand (..))
import qualified Graphics.SvgTree as SvgTree
import Graphics.SvgTree.PathParser
import qualified Linear
import NumHask.Prelude hiding (rotate)
import NumHask.Space

-- $setup
-- >>> :set -XRebindableSyntax
-- >>> :set -XNegativeLiterals
-- >>> import NumHask.Prelude
-- >>> import Chart

-- $path
-- Every element of an svg path can be thought of as exactly two points in space, with instructions of how to draw a curve between them.  From this point of view, one which this library adopts, a path chart is thus very similar to a line chart.  There's just a lot more information about the style of this line to deal with.
--
-- References:
--
-- [SVG d](https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/d)
--
-- [SVG path](https://developer.mozilla.org/en-US/docs/Web/SVG/Tutorial/Paths)

-- | parse a raw path string
--
-- >>> let outerseg1 = "M-1.0,0.5 A0.5 0.5 0.0 1 1 0.0,-1.2320508075688774 1.0 1.0 0.0 0 0 -0.5,-0.3660254037844387 1.0 1.0 0.0 0 0 -1.0,0.5 Z"
-- >>> parsePath outerseg1
-- [MoveTo OriginAbsolute [V2 (-1.0) 0.5],EllipticalArc OriginAbsolute [(0.5,0.5,0.0,True,True,V2 0.0 (-1.2320508075688774)),(1.0,1.0,0.0,False,False,V2 (-0.5) (-0.3660254037844387)),(1.0,1.0,0.0,False,False,V2 (-1.0) 0.5)],EndPath]
--
-- https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/d
parsePath :: Text -> [PathCommand]
parsePath :: Text -> [PathCommand]
parsePath Text
t = (String -> [PathCommand])
-> ([PathCommand] -> [PathCommand])
-> Either String [PathCommand]
-> [PathCommand]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ([PathCommand] -> String -> [PathCommand]
forall a b. a -> b -> a
const []) [PathCommand] -> [PathCommand]
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id (Either String [PathCommand] -> [PathCommand])
-> Either String [PathCommand] -> [PathCommand]
forall a b. (a -> b) -> a -> b
$ Parser [PathCommand] -> Text -> Either String [PathCommand]
forall a. Parser a -> Text -> Either String a
A.parseOnly Parser [PathCommand]
pathParser Text
t

-- | To fit in with the requirements of the library design, specifically the separation of what a chart is into XY data Points from representation of these points, path instructions need to be decontructed into:
--
-- - define a single chart element as a line.
--
-- - split a single path element into the start and end points of the line, which become the 'Chart.Types.xys' of a 'Chart.Types.Chart', and the rest of the information, which is called 'PathInfo' and incorporated into the 'Chart.Types.Chart' 'Chart.Types.annotation'.
--
-- An arc path is variant to affine transformations of the 'Chart.Types.xys' points: angles are not presevred in the new reference frame.
data PathInfo a
  = StartI
  | LineI
  | CubicI (Point a) (Point a)
  | QuadI (Point a)
  | ArcI (ArcInfo a)
  deriving (Int -> PathInfo a -> ShowS
[PathInfo a] -> ShowS
PathInfo a -> String
(Int -> PathInfo a -> ShowS)
-> (PathInfo a -> String)
-> ([PathInfo a] -> ShowS)
-> Show (PathInfo a)
forall a. Show a => Int -> PathInfo a -> ShowS
forall a. Show a => [PathInfo a] -> ShowS
forall a. Show a => PathInfo a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PathInfo a] -> ShowS
$cshowList :: forall a. Show a => [PathInfo a] -> ShowS
show :: PathInfo a -> String
$cshow :: forall a. Show a => PathInfo a -> String
showsPrec :: Int -> PathInfo a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> PathInfo a -> ShowS
Show, PathInfo a -> PathInfo a -> Bool
(PathInfo a -> PathInfo a -> Bool)
-> (PathInfo a -> PathInfo a -> Bool) -> Eq (PathInfo a)
forall a. Eq a => PathInfo a -> PathInfo a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PathInfo a -> PathInfo a -> Bool
$c/= :: forall a. Eq a => PathInfo a -> PathInfo a -> Bool
== :: PathInfo a -> PathInfo a -> Bool
$c== :: forall a. Eq a => PathInfo a -> PathInfo a -> Bool
Eq, (forall x. PathInfo a -> Rep (PathInfo a) x)
-> (forall x. Rep (PathInfo a) x -> PathInfo a)
-> Generic (PathInfo a)
forall x. Rep (PathInfo a) x -> PathInfo a
forall x. PathInfo a -> Rep (PathInfo a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (PathInfo a) x -> PathInfo a
forall a x. PathInfo a -> Rep (PathInfo a) x
$cto :: forall a x. Rep (PathInfo a) x -> PathInfo a
$cfrom :: forall a x. PathInfo a -> Rep (PathInfo a) x
Generic)

-- | convert from a path info, start point, end point triple to a path text clause.
--
-- Note that morally,
--
-- > toPathsAbsolute . toInfos . 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 ::
  -- | (info, start, end)
  (PathInfo Double, Point Double) ->
  -- | path text
  Text
toPathAbsolute :: (PathInfo Double, Point Double) -> Text
toPathAbsolute (PathInfo Double
StartI, Point Double
p) = Text
"M " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Point Double -> Text
pp Point Double
p
toPathAbsolute (PathInfo Double
LineI, Point Double
p) = Text
"L " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Point Double -> Text
pp Point Double
p
toPathAbsolute (CubicI Point Double
c1 Point Double
c2, Point Double
next) =
  Text
"C "
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Point Double -> Text
pp Point Double
c1
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" "
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Point Double -> Text
pp Point Double
c2
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" "
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Point Double -> Text
pp Point Double
next
toPathAbsolute (QuadI Point Double
control, Point Double
next) =
  Text
"Q "
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Point Double -> Text
pp Point Double
control
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" "
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Point Double -> Text
pp Point Double
next
toPathAbsolute (ArcI (ArcInfo (Point Double
x Double
y) Double
phi' Bool
l Bool
sw), Point Double
x2) =
  Text
"A "
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Double -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show Double
x
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" "
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Double -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show Double
y
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" "
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Double -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show (- Double
phi' Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Double
180 Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ Double
forall a. TrigField a => a
pi)
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" "
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text -> Bool -> Text
forall a. a -> a -> Bool -> a
bool Text
"0" Text
"1" Bool
l
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" "
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text -> Bool -> Text
forall a. a -> a -> Bool -> a
bool Text
"0" Text
"1" Bool
sw
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" "
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Point Double -> Text
pp Point Double
x2

-- | render a point (including a flip of the y dimension).
pp :: Point Double -> Text
pp :: Point Double -> Text
pp (Point Double
x Double
y) =
  FormatN -> Double -> Text
showOr (Maybe Int -> FormatN
FormatFixed (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
4)) Double
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
","
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FormatN -> Double -> Text
showOr (Maybe Int -> FormatN
FormatFixed (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
4)) (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))

-- | convert an (info, point) list to an svg d path text.
toPathAbsolutes :: [(PathInfo Double, Point Double)] -> Text
toPathAbsolutes :: [(PathInfo Double, Point Double)] -> Text
toPathAbsolutes = Fold (PathInfo Double, Point Double) Text
-> [(PathInfo Double, Point Double)] -> Text
forall (f :: * -> *) a b. Foldable f => Fold a b -> f a -> b
L.fold (([Text] -> (PathInfo Double, Point Double) -> [Text])
-> [Text]
-> ([Text] -> Text)
-> Fold (PathInfo Double, Point Double) Text
forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
L.Fold [Text] -> (PathInfo Double, Point Double) -> [Text]
step [Text]
forall a. [a]
begin [Text] -> Text
done)
  where
    done :: [Text] -> Text
done = Text -> [Text] -> Text
Text.intercalate Text
" " ([Text] -> Text) -> ([Text] -> [Text]) -> [Text] -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [Text] -> [Text]
forall a. [a] -> [a]
reverse
    begin :: [a]
begin = []
    step :: [Text] -> (PathInfo Double, Point Double) -> [Text]
step [Text]
ts (PathInfo Double
info, Point Double
next) = (PathInfo Double, Point Double) -> Text
toPathAbsolute (PathInfo Double
info, Point Double
next) Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
ts

-- | Convert from PathInfo to PathCommand
toPathCommand ::
  (PathInfo Double, Point Double) ->
  -- | path text
  PathCommand
toPathCommand :: (PathInfo Double, Point Double) -> PathCommand
toPathCommand (PathInfo Double
StartI, Point Double
p) = Origin -> [RPoint] -> PathCommand
MoveTo Origin
OriginAbsolute [Point Double -> RPoint
forall a. Point a -> V2 a
toV2 Point Double
p]
toPathCommand (PathInfo Double
LineI, Point Double
p) = Origin -> [RPoint] -> PathCommand
LineTo Origin
OriginAbsolute [Point Double -> RPoint
forall a. Point a -> V2 a
toV2 Point Double
p]
toPathCommand (CubicI Point Double
c1 Point Double
c2, Point Double
p) = Origin -> [(RPoint, RPoint, RPoint)] -> PathCommand
CurveTo Origin
OriginAbsolute [(Point Double -> RPoint
forall a. Point a -> V2 a
toV2 Point Double
c1, Point Double -> RPoint
forall a. Point a -> V2 a
toV2 Point Double
c2, Point Double -> RPoint
forall a. Point a -> V2 a
toV2 Point Double
p)]
toPathCommand (QuadI Point Double
c, Point Double
p) = Origin -> [(RPoint, RPoint)] -> PathCommand
QuadraticBezier Origin
OriginAbsolute [(Point Double -> RPoint
forall a. Point a -> V2 a
toV2 Point Double
c, Point Double -> RPoint
forall a. Point a -> V2 a
toV2 Point Double
p)]
toPathCommand (ArcI (ArcInfo (Point Double
rx Double
ry) Double
phi' Bool
l Bool
sw), Point Double
p) =
  Origin
-> [(Double, Double, Double, Bool, Bool, RPoint)] -> PathCommand
EllipticalArc Origin
OriginAbsolute [(Double
rx, Double
ry, Double
phi', Bool
l, Bool
sw, Point Double -> RPoint
forall a. Point a -> V2 a
toV2 Point Double
p)]

toV2 :: Point a -> Linear.V2 a
toV2 :: Point a -> V2 a
toV2 (Point a
x a
y) = a -> a -> V2 a
forall a. a -> a -> V2 a
Linear.V2 a
x a
y

data StateInfo = StateInfo
  { -- | previous position
    StateInfo -> Point Double
cur :: Point Double,
    -- | start point (to close out the path)
    StateInfo -> Point Double
start :: Point Double,
    -- | last control point
    StateInfo -> Point Double
infoControl :: Point Double
  }
  deriving (StateInfo -> StateInfo -> Bool
(StateInfo -> StateInfo -> Bool)
-> (StateInfo -> StateInfo -> Bool) -> Eq StateInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StateInfo -> StateInfo -> Bool
$c/= :: StateInfo -> StateInfo -> Bool
== :: StateInfo -> StateInfo -> Bool
$c== :: StateInfo -> StateInfo -> Bool
Eq, Int -> StateInfo -> ShowS
[StateInfo] -> ShowS
StateInfo -> String
(Int -> StateInfo -> ShowS)
-> (StateInfo -> String)
-> ([StateInfo] -> ShowS)
-> Show StateInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StateInfo] -> ShowS
$cshowList :: [StateInfo] -> ShowS
show :: StateInfo -> String
$cshow :: StateInfo -> String
showsPrec :: Int -> StateInfo -> ShowS
$cshowsPrec :: Int -> StateInfo -> ShowS
Show, (forall x. StateInfo -> Rep StateInfo x)
-> (forall x. Rep StateInfo x -> StateInfo) -> Generic StateInfo
forall x. Rep StateInfo x -> StateInfo
forall x. StateInfo -> Rep StateInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StateInfo x -> StateInfo
$cfrom :: forall x. StateInfo -> Rep StateInfo x
Generic)

stateInfo0 :: StateInfo
stateInfo0 :: StateInfo
stateInfo0 = Point Double -> Point Double -> Point Double -> StateInfo
StateInfo Point Double
forall a. Additive a => a
zero Point Double
forall a. Additive a => a
zero Point Double
forall a. Additive a => a
zero

-- | Convert a path command fragment to an instruction + point.
--
-- flips the y-dimension of points.
toInfo :: StateInfo -> SvgTree.PathCommand -> (StateInfo, [(PathInfo Double, Point Double)])
toInfo :: StateInfo
-> PathCommand -> (StateInfo, [(PathInfo Double, Point Double)])
toInfo StateInfo
s (MoveTo Origin
_ []) = (StateInfo
s, [])
toInfo StateInfo
_ (MoveTo Origin
OriginAbsolute (RPoint
x : [RPoint]
xs)) = Fold (Point Double) (StateInfo, [(PathInfo Double, Point Double)])
-> [Point Double] -> (StateInfo, [(PathInfo Double, Point Double)])
forall (f :: * -> *) a b. Foldable f => Fold a b -> f a -> b
L.fold (((StateInfo, [(PathInfo Double, Point Double)])
 -> Point Double -> (StateInfo, [(PathInfo Double, Point Double)]))
-> (StateInfo, [(PathInfo Double, Point Double)])
-> ((StateInfo, [(PathInfo Double, Point Double)])
    -> (StateInfo, [(PathInfo Double, Point Double)]))
-> Fold
     (Point Double) (StateInfo, [(PathInfo Double, Point Double)])
forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
L.Fold (StateInfo, [(PathInfo Double, Point Double)])
-> Point Double -> (StateInfo, [(PathInfo Double, Point Double)])
forall s t a b a.
HasField "cur" s t a b =>
(s, [(PathInfo a, b)]) -> b -> (t, [(PathInfo a, b)])
step (StateInfo, [(PathInfo Double, Point Double)])
forall a. (StateInfo, [(PathInfo a, Point Double)])
begin (([(PathInfo Double, Point Double)]
 -> [(PathInfo Double, Point Double)])
-> (StateInfo, [(PathInfo Double, Point Double)])
-> (StateInfo, [(PathInfo Double, Point Double)])
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second [(PathInfo Double, Point Double)]
-> [(PathInfo Double, Point Double)]
forall a. [a] -> [a]
reverse)) (RPoint -> Point Double
forall a. Subtractive a => V2 a -> Point a
fromV2 (RPoint -> Point Double) -> [RPoint] -> [Point Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [RPoint]
xs)
  where
    x0 :: Point Double
x0 = RPoint -> Point Double
forall a. Subtractive a => V2 a -> Point a
fromV2 RPoint
x
    begin :: (StateInfo, [(PathInfo a, Point Double)])
begin = (Point Double -> Point Double -> Point Double -> StateInfo
StateInfo Point Double
x0 Point Double
x0 Point Double
forall a. Additive a => a
zero, [(PathInfo a
forall a. PathInfo a
StartI, Point Double
x0)])
    step :: (s, [(PathInfo a, b)]) -> b -> (t, [(PathInfo a, b)])
step (s
s, [(PathInfo a, b)]
p) b
a = (s
s s -> (s -> t) -> t
forall a b. a -> (a -> b) -> b
& (a -> Identity b) -> s -> Identity t
forall a. IsLabel "cur" a => a
forall (x :: Symbol) a. IsLabel x a => a
#cur ((a -> Identity b) -> s -> Identity t) -> b -> s -> t
forall s t a b. ASetter s t a b -> b -> s -> t
.~ b
a, (PathInfo a
forall a. PathInfo a
LineI, b
a) (PathInfo a, b) -> [(PathInfo a, b)] -> [(PathInfo a, b)]
forall a. a -> [a] -> [a]
: [(PathInfo a, b)]
p)
toInfo StateInfo
s (MoveTo Origin
OriginRelative (RPoint
x : [RPoint]
xs)) = Fold (Point Double) (StateInfo, [(PathInfo Double, Point Double)])
-> [Point Double] -> (StateInfo, [(PathInfo Double, Point Double)])
forall (f :: * -> *) a b. Foldable f => Fold a b -> f a -> b
L.fold (((StateInfo, [(PathInfo Double, Point Double)])
 -> Point Double -> (StateInfo, [(PathInfo Double, Point Double)]))
-> (StateInfo, [(PathInfo Double, Point Double)])
-> ((StateInfo, [(PathInfo Double, Point Double)])
    -> (StateInfo, [(PathInfo Double, Point Double)]))
-> Fold
     (Point Double) (StateInfo, [(PathInfo Double, Point Double)])
forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
L.Fold (StateInfo, [(PathInfo Double, Point Double)])
-> Point Double -> (StateInfo, [(PathInfo Double, Point Double)])
forall s t a b a.
(HasField "cur" s t a b, Additive b, HasField' "cur" s b) =>
(s, [(PathInfo a, b)]) -> b -> (t, [(PathInfo a, b)])
step (StateInfo, [(PathInfo Double, Point Double)])
forall a. (StateInfo, [(PathInfo a, Point Double)])
begin (([(PathInfo Double, Point Double)]
 -> [(PathInfo Double, Point Double)])
-> (StateInfo, [(PathInfo Double, Point Double)])
-> (StateInfo, [(PathInfo Double, Point Double)])
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second [(PathInfo Double, Point Double)]
-> [(PathInfo Double, Point Double)]
forall a. [a] -> [a]
reverse)) (RPoint -> Point Double
forall a. Subtractive a => V2 a -> Point a
fromV2 (RPoint -> Point Double) -> [RPoint] -> [Point Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [RPoint]
xs)
  where
    x0 :: Point Double
x0 = StateInfo
s StateInfo
-> Getting (Point Double) StateInfo (Point Double) -> Point Double
forall s a. s -> Getting a s a -> a
^. Getting (Point Double) StateInfo (Point Double)
forall a. IsLabel "cur" a => a
forall (x :: Symbol) a. IsLabel x a => a
#cur Point Double -> Point Double -> Point Double
forall a. Additive a => a -> a -> a
+ RPoint -> Point Double
forall a. Subtractive a => V2 a -> Point a
fromV2 RPoint
x
    begin :: (StateInfo, [(PathInfo a, Point Double)])
begin = (Point Double -> Point Double -> Point Double -> StateInfo
StateInfo Point Double
x0 Point Double
x0 Point Double
forall a. Additive a => a
zero, [(PathInfo a
forall a. PathInfo a
StartI, Point Double
x0)])
    step :: (s, [(PathInfo a, b)]) -> b -> (t, [(PathInfo a, b)])
step (s
s, [(PathInfo a, b)]
p) b
a = let a' :: b
a' = b
a b -> b -> b
forall a. Additive a => a -> a -> a
+ s
s s -> Getting b s b -> b
forall s a. s -> Getting a s a -> a
^. Getting b s b
forall a. IsLabel "cur" a => a
forall (x :: Symbol) a. IsLabel x a => a
#cur in (s
s s -> (s -> t) -> t
forall a b. a -> (a -> b) -> b
& (a -> Identity b) -> s -> Identity t
forall a. IsLabel "cur" a => a
forall (x :: Symbol) a. IsLabel x a => a
#cur ((a -> Identity b) -> s -> Identity t) -> b -> s -> t
forall s t a b. ASetter s t a b -> b -> s -> t
.~ b
a', (PathInfo a
forall a. PathInfo a
LineI, b
a') (PathInfo a, b) -> [(PathInfo a, b)] -> [(PathInfo a, b)]
forall a. a -> [a] -> [a]
: [(PathInfo a, b)]
p)
toInfo StateInfo
s PathCommand
EndPath = (StateInfo
s, [(PathInfo Double
forall a. PathInfo a
LineI, StateInfo
s StateInfo
-> Getting (Point Double) StateInfo (Point Double) -> Point Double
forall s a. s -> Getting a s a -> a
^. Getting (Point Double) StateInfo (Point Double)
forall a. IsLabel "start" a => a
forall (x :: Symbol) a. IsLabel x a => a
#start)])
toInfo StateInfo
s (LineTo Origin
OriginAbsolute [RPoint]
xs) = Fold (Point Double) (StateInfo, [(PathInfo Double, Point Double)])
-> [Point Double] -> (StateInfo, [(PathInfo Double, Point Double)])
forall (f :: * -> *) a b. Foldable f => Fold a b -> f a -> b
L.fold (((StateInfo, [(PathInfo Double, Point Double)])
 -> Point Double -> (StateInfo, [(PathInfo Double, Point Double)]))
-> (StateInfo, [(PathInfo Double, Point Double)])
-> ((StateInfo, [(PathInfo Double, Point Double)])
    -> (StateInfo, [(PathInfo Double, Point Double)]))
-> Fold
     (Point Double) (StateInfo, [(PathInfo Double, Point Double)])
forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
L.Fold (StateInfo, [(PathInfo Double, Point Double)])
-> Point Double -> (StateInfo, [(PathInfo Double, Point Double)])
forall s t a b a.
HasField "cur" s t a b =>
(s, [(PathInfo a, b)]) -> b -> (t, [(PathInfo a, b)])
step (StateInfo
s, []) (([(PathInfo Double, Point Double)]
 -> [(PathInfo Double, Point Double)])
-> (StateInfo, [(PathInfo Double, Point Double)])
-> (StateInfo, [(PathInfo Double, Point Double)])
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second [(PathInfo Double, Point Double)]
-> [(PathInfo Double, Point Double)]
forall a. [a] -> [a]
reverse)) (RPoint -> Point Double
forall a. Subtractive a => V2 a -> Point a
fromV2 (RPoint -> Point Double) -> [RPoint] -> [Point Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [RPoint]
xs)
  where
    step :: (s, [(PathInfo a, b)]) -> b -> (t, [(PathInfo a, b)])
step (s
s, [(PathInfo a, b)]
p) b
a = (s
s s -> (s -> t) -> t
forall a b. a -> (a -> b) -> b
& (a -> Identity b) -> s -> Identity t
forall a. IsLabel "cur" a => a
forall (x :: Symbol) a. IsLabel x a => a
#cur ((a -> Identity b) -> s -> Identity t) -> b -> s -> t
forall s t a b. ASetter s t a b -> b -> s -> t
.~ b
a, (PathInfo a
forall a. PathInfo a
LineI, b
a) (PathInfo a, b) -> [(PathInfo a, b)] -> [(PathInfo a, b)]
forall a. a -> [a] -> [a]
: [(PathInfo a, b)]
p)
toInfo StateInfo
s (LineTo Origin
OriginRelative [RPoint]
xs) = Fold (Point Double) (StateInfo, [(PathInfo Double, Point Double)])
-> [Point Double] -> (StateInfo, [(PathInfo Double, Point Double)])
forall (f :: * -> *) a b. Foldable f => Fold a b -> f a -> b
L.fold (((StateInfo, [(PathInfo Double, Point Double)])
 -> Point Double -> (StateInfo, [(PathInfo Double, Point Double)]))
-> (StateInfo, [(PathInfo Double, Point Double)])
-> ((StateInfo, [(PathInfo Double, Point Double)])
    -> (StateInfo, [(PathInfo Double, Point Double)]))
-> Fold
     (Point Double) (StateInfo, [(PathInfo Double, Point Double)])
forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
L.Fold (StateInfo, [(PathInfo Double, Point Double)])
-> Point Double -> (StateInfo, [(PathInfo Double, Point Double)])
forall s t a b a.
(HasField "cur" s t a b, Additive b, HasField' "cur" s b) =>
(s, [(PathInfo a, b)]) -> b -> (t, [(PathInfo a, b)])
step (StateInfo
s, []) (([(PathInfo Double, Point Double)]
 -> [(PathInfo Double, Point Double)])
-> (StateInfo, [(PathInfo Double, Point Double)])
-> (StateInfo, [(PathInfo Double, Point Double)])
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second [(PathInfo Double, Point Double)]
-> [(PathInfo Double, Point Double)]
forall a. [a] -> [a]
reverse)) (RPoint -> Point Double
forall a. Subtractive a => V2 a -> Point a
fromV2 (RPoint -> Point Double) -> [RPoint] -> [Point Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [RPoint]
xs)
  where
    step :: (s, [(PathInfo a, b)]) -> b -> (t, [(PathInfo a, b)])
step (s
s, [(PathInfo a, b)]
p) b
a = let a' :: b
a' = b
a b -> b -> b
forall a. Additive a => a -> a -> a
+ s
s s -> Getting b s b -> b
forall s a. s -> Getting a s a -> a
^. Getting b s b
forall a. IsLabel "cur" a => a
forall (x :: Symbol) a. IsLabel x a => a
#cur in (s
s s -> (s -> t) -> t
forall a b. a -> (a -> b) -> b
& (a -> Identity b) -> s -> Identity t
forall a. IsLabel "cur" a => a
forall (x :: Symbol) a. IsLabel x a => a
#cur ((a -> Identity b) -> s -> Identity t) -> b -> s -> t
forall s t a b. ASetter s t a b -> b -> s -> t
.~ b
a', (PathInfo a
forall a. PathInfo a
LineI, b
a') (PathInfo a, b) -> [(PathInfo a, b)] -> [(PathInfo a, b)]
forall a. a -> [a] -> [a]
: [(PathInfo a, b)]
p)
toInfo StateInfo
s (HorizontalTo Origin
OriginAbsolute [Double]
xs) = Fold Double (StateInfo, [(PathInfo Double, Point Double)])
-> [Double] -> (StateInfo, [(PathInfo Double, Point Double)])
forall (f :: * -> *) a b. Foldable f => Fold a b -> f a -> b
L.fold (((StateInfo, [(PathInfo Double, Point Double)])
 -> Double -> (StateInfo, [(PathInfo Double, Point Double)]))
-> (StateInfo, [(PathInfo Double, Point Double)])
-> ((StateInfo, [(PathInfo Double, Point Double)])
    -> (StateInfo, [(PathInfo Double, Point Double)]))
-> Fold Double (StateInfo, [(PathInfo Double, Point Double)])
forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
L.Fold (StateInfo, [(PathInfo Double, Point Double)])
-> Double -> (StateInfo, [(PathInfo Double, Point Double)])
forall a.
(StateInfo, [(PathInfo a, Point Double)])
-> Double -> (StateInfo, [(PathInfo a, Point Double)])
step (StateInfo
s, []) (([(PathInfo Double, Point Double)]
 -> [(PathInfo Double, Point Double)])
-> (StateInfo, [(PathInfo Double, Point Double)])
-> (StateInfo, [(PathInfo Double, Point Double)])
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second [(PathInfo Double, Point Double)]
-> [(PathInfo Double, Point Double)]
forall a. [a] -> [a]
reverse)) [Double]
xs
  where
    step :: (StateInfo, [(PathInfo a, Point Double)])
-> Double -> (StateInfo, [(PathInfo a, Point Double)])
step (s :: StateInfo
s@(StateInfo (Point Double
_ Double
cy) Point Double
_ Point Double
_), [(PathInfo a, Point Double)]
p) Double
a =
      let a' :: Point Double
a' = Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
a Double
cy in (StateInfo
s StateInfo -> (StateInfo -> StateInfo) -> StateInfo
forall a b. a -> (a -> b) -> b
& (Point Double -> Identity (Point Double))
-> StateInfo -> Identity StateInfo
forall a. IsLabel "cur" a => a
forall (x :: Symbol) a. IsLabel x a => a
#cur ((Point Double -> Identity (Point Double))
 -> StateInfo -> Identity StateInfo)
-> Point Double -> StateInfo -> StateInfo
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Point Double
a', (PathInfo a
forall a. PathInfo a
LineI, Point Double
a') (PathInfo a, Point Double)
-> [(PathInfo a, Point Double)] -> [(PathInfo a, Point Double)]
forall a. a -> [a] -> [a]
: [(PathInfo a, Point Double)]
p)
toInfo StateInfo
s (HorizontalTo Origin
OriginRelative [Double]
xs) = Fold Double (StateInfo, [(PathInfo Double, Point Double)])
-> [Double] -> (StateInfo, [(PathInfo Double, Point Double)])
forall (f :: * -> *) a b. Foldable f => Fold a b -> f a -> b
L.fold (((StateInfo, [(PathInfo Double, Point Double)])
 -> Double -> (StateInfo, [(PathInfo Double, Point Double)]))
-> (StateInfo, [(PathInfo Double, Point Double)])
-> ((StateInfo, [(PathInfo Double, Point Double)])
    -> (StateInfo, [(PathInfo Double, Point Double)]))
-> Fold Double (StateInfo, [(PathInfo Double, Point Double)])
forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
L.Fold (StateInfo, [(PathInfo Double, Point Double)])
-> Double -> (StateInfo, [(PathInfo Double, Point Double)])
forall a.
(StateInfo, [(PathInfo a, Point Double)])
-> Double -> (StateInfo, [(PathInfo a, Point Double)])
step (StateInfo
s, []) (([(PathInfo Double, Point Double)]
 -> [(PathInfo Double, Point Double)])
-> (StateInfo, [(PathInfo Double, Point Double)])
-> (StateInfo, [(PathInfo Double, Point Double)])
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second [(PathInfo Double, Point Double)]
-> [(PathInfo Double, Point Double)]
forall a. [a] -> [a]
reverse)) [Double]
xs
  where
    step :: (StateInfo, [(PathInfo a, Point Double)])
-> Double -> (StateInfo, [(PathInfo a, Point Double)])
step (s :: StateInfo
s@(StateInfo (Point Double
cx Double
cy) Point Double
_ Point Double
_), [(PathInfo a, Point Double)]
p) Double
a =
      let a' :: Point Double
a' = Double -> Double -> Point Double
forall a. a -> a -> Point a
Point (Double
a Double -> Double -> Double
forall a. Additive a => a -> a -> a
+ Double
cx) Double
cy in (StateInfo
s StateInfo -> (StateInfo -> StateInfo) -> StateInfo
forall a b. a -> (a -> b) -> b
& (Point Double -> Identity (Point Double))
-> StateInfo -> Identity StateInfo
forall a. IsLabel "cur" a => a
forall (x :: Symbol) a. IsLabel x a => a
#cur ((Point Double -> Identity (Point Double))
 -> StateInfo -> Identity StateInfo)
-> Point Double -> StateInfo -> StateInfo
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Point Double
a', (PathInfo a
forall a. PathInfo a
LineI, Point Double
a') (PathInfo a, Point Double)
-> [(PathInfo a, Point Double)] -> [(PathInfo a, Point Double)]
forall a. a -> [a] -> [a]
: [(PathInfo a, Point Double)]
p)
toInfo StateInfo
s (VerticalTo Origin
OriginAbsolute [Double]
xs) = Fold Double (StateInfo, [(PathInfo Double, Point Double)])
-> [Double] -> (StateInfo, [(PathInfo Double, Point Double)])
forall (f :: * -> *) a b. Foldable f => Fold a b -> f a -> b
L.fold (((StateInfo, [(PathInfo Double, Point Double)])
 -> Double -> (StateInfo, [(PathInfo Double, Point Double)]))
-> (StateInfo, [(PathInfo Double, Point Double)])
-> ((StateInfo, [(PathInfo Double, Point Double)])
    -> (StateInfo, [(PathInfo Double, Point Double)]))
-> Fold Double (StateInfo, [(PathInfo Double, Point Double)])
forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
L.Fold (StateInfo, [(PathInfo Double, Point Double)])
-> Double -> (StateInfo, [(PathInfo Double, Point Double)])
forall a.
(StateInfo, [(PathInfo a, Point Double)])
-> Double -> (StateInfo, [(PathInfo a, Point Double)])
step (StateInfo
s, []) (([(PathInfo Double, Point Double)]
 -> [(PathInfo Double, Point Double)])
-> (StateInfo, [(PathInfo Double, Point Double)])
-> (StateInfo, [(PathInfo Double, Point Double)])
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second [(PathInfo Double, Point Double)]
-> [(PathInfo Double, Point Double)]
forall a. [a] -> [a]
reverse)) [Double]
xs
  where
    step :: (StateInfo, [(PathInfo a, Point Double)])
-> Double -> (StateInfo, [(PathInfo a, Point Double)])
step (s :: StateInfo
s@(StateInfo (Point Double
cx Double
_) Point Double
_ Point Double
_), [(PathInfo a, Point Double)]
p) Double
a =
      let a' :: Point Double
a' = Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
cx Double
a in (StateInfo
s StateInfo -> (StateInfo -> StateInfo) -> StateInfo
forall a b. a -> (a -> b) -> b
& (Point Double -> Identity (Point Double))
-> StateInfo -> Identity StateInfo
forall a. IsLabel "cur" a => a
forall (x :: Symbol) a. IsLabel x a => a
#cur ((Point Double -> Identity (Point Double))
 -> StateInfo -> Identity StateInfo)
-> Point Double -> StateInfo -> StateInfo
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Point Double
a', (PathInfo a
forall a. PathInfo a
LineI, Point Double
a') (PathInfo a, Point Double)
-> [(PathInfo a, Point Double)] -> [(PathInfo a, Point Double)]
forall a. a -> [a] -> [a]
: [(PathInfo a, Point Double)]
p)
toInfo StateInfo
s (VerticalTo Origin
OriginRelative [Double]
xs) = Fold Double (StateInfo, [(PathInfo Double, Point Double)])
-> [Double] -> (StateInfo, [(PathInfo Double, Point Double)])
forall (f :: * -> *) a b. Foldable f => Fold a b -> f a -> b
L.fold (((StateInfo, [(PathInfo Double, Point Double)])
 -> Double -> (StateInfo, [(PathInfo Double, Point Double)]))
-> (StateInfo, [(PathInfo Double, Point Double)])
-> ((StateInfo, [(PathInfo Double, Point Double)])
    -> (StateInfo, [(PathInfo Double, Point Double)]))
-> Fold Double (StateInfo, [(PathInfo Double, Point Double)])
forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
L.Fold (StateInfo, [(PathInfo Double, Point Double)])
-> Double -> (StateInfo, [(PathInfo Double, Point Double)])
forall a.
(StateInfo, [(PathInfo a, Point Double)])
-> Double -> (StateInfo, [(PathInfo a, Point Double)])
step (StateInfo
s, []) (([(PathInfo Double, Point Double)]
 -> [(PathInfo Double, Point Double)])
-> (StateInfo, [(PathInfo Double, Point Double)])
-> (StateInfo, [(PathInfo Double, Point Double)])
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second [(PathInfo Double, Point Double)]
-> [(PathInfo Double, Point Double)]
forall a. [a] -> [a]
reverse)) [Double]
xs
  where
    step :: (StateInfo, [(PathInfo a, Point Double)])
-> Double -> (StateInfo, [(PathInfo a, Point Double)])
step (s :: StateInfo
s@(StateInfo (Point Double
cx Double
cy) Point Double
_ Point Double
_), [(PathInfo a, Point Double)]
p) Double
a =
      let a' :: Point Double
a' = Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
cx (Double
a Double -> Double -> Double
forall a. Additive a => a -> a -> a
+ Double
cy) in (StateInfo
s StateInfo -> (StateInfo -> StateInfo) -> StateInfo
forall a b. a -> (a -> b) -> b
& (Point Double -> Identity (Point Double))
-> StateInfo -> Identity StateInfo
forall a. IsLabel "cur" a => a
forall (x :: Symbol) a. IsLabel x a => a
#cur ((Point Double -> Identity (Point Double))
 -> StateInfo -> Identity StateInfo)
-> Point Double -> StateInfo -> StateInfo
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Point Double
a', (PathInfo a
forall a. PathInfo a
LineI, Point Double
a') (PathInfo a, Point Double)
-> [(PathInfo a, Point Double)] -> [(PathInfo a, Point Double)]
forall a. a -> [a] -> [a]
: [(PathInfo a, Point Double)]
p)
toInfo StateInfo
s (CurveTo Origin
OriginAbsolute [(RPoint, RPoint, RPoint)]
xs) =
  Fold
  (Point Double, Point Double, Point Double)
  (StateInfo, [(PathInfo Double, Point Double)])
-> [(Point Double, Point Double, Point Double)]
-> (StateInfo, [(PathInfo Double, Point Double)])
forall (f :: * -> *) a b. Foldable f => Fold a b -> f a -> b
L.fold (((StateInfo, [(PathInfo Double, Point Double)])
 -> (Point Double, Point Double, Point Double)
 -> (StateInfo, [(PathInfo Double, Point Double)]))
-> (StateInfo, [(PathInfo Double, Point Double)])
-> ((StateInfo, [(PathInfo Double, Point Double)])
    -> (StateInfo, [(PathInfo Double, Point Double)]))
-> Fold
     (Point Double, Point Double, Point Double)
     (StateInfo, [(PathInfo Double, Point Double)])
forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
L.Fold (StateInfo, [(PathInfo Double, Point Double)])
-> (Point Double, Point Double, Point Double)
-> (StateInfo, [(PathInfo Double, Point Double)])
forall s s a b t a a.
(HasField "cur" s s a b, HasField "infoControl" s t a (Point a)) =>
(s, [(PathInfo a, b)])
-> (Point a, Point a, b) -> (t, [(PathInfo a, b)])
step (StateInfo
s, []) (([(PathInfo Double, Point Double)]
 -> [(PathInfo Double, Point Double)])
-> (StateInfo, [(PathInfo Double, Point Double)])
-> (StateInfo, [(PathInfo Double, Point Double)])
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second [(PathInfo Double, Point Double)]
-> [(PathInfo Double, Point Double)]
forall a. [a] -> [a]
reverse)) [(Point Double, Point Double, Point Double)]
xs'
  where
    xs' :: [(Point Double, Point Double, Point Double)]
xs' = (\(RPoint
c1, RPoint
c2, RPoint
x2) -> (RPoint -> Point Double
forall a. Subtractive a => V2 a -> Point a
fromV2 RPoint
c1, RPoint -> Point Double
forall a. Subtractive a => V2 a -> Point a
fromV2 RPoint
c2, RPoint -> Point Double
forall a. Subtractive a => V2 a -> Point a
fromV2 RPoint
x2)) ((RPoint, RPoint, RPoint)
 -> (Point Double, Point Double, Point Double))
-> [(RPoint, RPoint, RPoint)]
-> [(Point Double, Point Double, Point Double)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(RPoint, RPoint, RPoint)]
xs
    step :: (s, [(PathInfo a, b)])
-> (Point a, Point a, b) -> (t, [(PathInfo a, b)])
step (s
s, [(PathInfo a, b)]
p) (Point a
c1, Point a
c2, b
x2) =
      (s
s s -> (s -> s) -> s
forall a b. a -> (a -> b) -> b
& (a -> Identity b) -> s -> Identity s
forall a. IsLabel "cur" a => a
forall (x :: Symbol) a. IsLabel x a => a
#cur ((a -> Identity b) -> s -> Identity s) -> b -> s -> s
forall s t a b. ASetter s t a b -> b -> s -> t
.~ b
x2 s -> (s -> t) -> t
forall a b. a -> (a -> b) -> b
& (a -> Identity (Point a)) -> s -> Identity t
forall a. IsLabel "infoControl" a => a
forall (x :: Symbol) a. IsLabel x a => a
#infoControl ((a -> Identity (Point a)) -> s -> Identity t) -> Point a -> s -> t
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Point a
c2, (Point a -> Point a -> PathInfo a
forall a. Point a -> Point a -> PathInfo a
CubicI Point a
c1 Point a
c2, b
x2) (PathInfo a, b) -> [(PathInfo a, b)] -> [(PathInfo a, b)]
forall a. a -> [a] -> [a]
: [(PathInfo a, b)]
p)
toInfo StateInfo
s (CurveTo Origin
OriginRelative [(RPoint, RPoint, RPoint)]
xs) =
  Fold
  (Point Double, Point Double, Point Double)
  (StateInfo, [(PathInfo Double, Point Double)])
-> [(Point Double, Point Double, Point Double)]
-> (StateInfo, [(PathInfo Double, Point Double)])
forall (f :: * -> *) a b. Foldable f => Fold a b -> f a -> b
L.fold (((StateInfo, [(PathInfo Double, Point Double)])
 -> (Point Double, Point Double, Point Double)
 -> (StateInfo, [(PathInfo Double, Point Double)]))
-> (StateInfo, [(PathInfo Double, Point Double)])
-> ((StateInfo, [(PathInfo Double, Point Double)])
    -> (StateInfo, [(PathInfo Double, Point Double)]))
-> Fold
     (Point Double, Point Double, Point Double)
     (StateInfo, [(PathInfo Double, Point Double)])
forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
L.Fold (StateInfo, [(PathInfo Double, Point Double)])
-> (Point Double, Point Double, Point Double)
-> (StateInfo, [(PathInfo Double, Point Double)])
forall a s s a t a.
(Additive a, HasField' "cur" s (Point a),
 HasField "cur" s s a (Point a),
 HasField "infoControl" s t a (Point a)) =>
(s, [(PathInfo a, Point a)])
-> (Point a, Point a, Point a) -> (t, [(PathInfo a, Point a)])
step (StateInfo
s, []) (([(PathInfo Double, Point Double)]
 -> [(PathInfo Double, Point Double)])
-> (StateInfo, [(PathInfo Double, Point Double)])
-> (StateInfo, [(PathInfo Double, Point Double)])
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second [(PathInfo Double, Point Double)]
-> [(PathInfo Double, Point Double)]
forall a. [a] -> [a]
reverse)) [(Point Double, Point Double, Point Double)]
xs'
  where
    xs' :: [(Point Double, Point Double, Point Double)]
xs' = (\(RPoint
c1, RPoint
c2, RPoint
x2) -> (RPoint -> Point Double
forall a. Subtractive a => V2 a -> Point a
fromV2 RPoint
c1, RPoint -> Point Double
forall a. Subtractive a => V2 a -> Point a
fromV2 RPoint
c2, RPoint -> Point Double
forall a. Subtractive a => V2 a -> Point a
fromV2 RPoint
x2)) ((RPoint, RPoint, RPoint)
 -> (Point Double, Point Double, Point Double))
-> [(RPoint, RPoint, RPoint)]
-> [(Point Double, Point Double, Point Double)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(RPoint, RPoint, RPoint)]
xs
    step :: (s, [(PathInfo a, Point a)])
-> (Point a, Point a, Point a) -> (t, [(PathInfo a, Point a)])
step (s
s, [(PathInfo a, Point a)]
p) (Point a
c1, Point a
c2, Point a
x2) =
      (s
s s -> (s -> s) -> s
forall a b. a -> (a -> b) -> b
& (a -> Identity (Point a)) -> s -> Identity s
forall a. IsLabel "cur" a => a
forall (x :: Symbol) a. IsLabel x a => a
#cur ((a -> Identity (Point a)) -> s -> Identity s) -> Point a -> s -> s
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Point a
x2 Point a -> Point a -> Point a
forall a. Additive a => a -> a -> a
+ s
s s -> Getting (Point a) s (Point a) -> Point a
forall s a. s -> Getting a s a -> a
^. Getting (Point a) s (Point a)
forall a. IsLabel "cur" a => a
forall (x :: Symbol) a. IsLabel x a => a
#cur) s -> (s -> t) -> t
forall a b. a -> (a -> b) -> b
& (a -> Identity (Point a)) -> s -> Identity t
forall a. IsLabel "infoControl" a => a
forall (x :: Symbol) a. IsLabel x a => a
#infoControl ((a -> Identity (Point a)) -> s -> Identity t) -> Point a -> s -> t
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Point a
c2 Point a -> Point a -> Point a
forall a. Additive a => a -> a -> a
+ s
s s -> Getting (Point a) s (Point a) -> Point a
forall s a. s -> Getting a s a -> a
^. Getting (Point a) s (Point a)
forall a. IsLabel "cur" a => a
forall (x :: Symbol) a. IsLabel x a => a
#cur), (Point a -> Point a -> PathInfo a
forall a. Point a -> Point a -> PathInfo a
CubicI (Point a
c1 Point a -> Point a -> Point a
forall a. Additive a => a -> a -> a
+ s
s s -> Getting (Point a) s (Point a) -> Point a
forall s a. s -> Getting a s a -> a
^. Getting (Point a) s (Point a)
forall a. IsLabel "cur" a => a
forall (x :: Symbol) a. IsLabel x a => a
#cur) (Point a
c2 Point a -> Point a -> Point a
forall a. Additive a => a -> a -> a
+ s
s s -> Getting (Point a) s (Point a) -> Point a
forall s a. s -> Getting a s a -> a
^. Getting (Point a) s (Point a)
forall a. IsLabel "cur" a => a
forall (x :: Symbol) a. IsLabel x a => a
#cur), Point a
x2 Point a -> Point a -> Point a
forall a. Additive a => a -> a -> a
+ s
s s -> Getting (Point a) s (Point a) -> Point a
forall s a. s -> Getting a s a -> a
^. Getting (Point a) s (Point a)
forall a. IsLabel "cur" a => a
forall (x :: Symbol) a. IsLabel x a => a
#cur) (PathInfo a, Point a)
-> [(PathInfo a, Point a)] -> [(PathInfo a, Point a)]
forall a. a -> [a] -> [a]
: [(PathInfo a, Point a)]
p)
toInfo StateInfo
s (SmoothCurveTo Origin
OriginAbsolute [(RPoint, RPoint)]
xs) =
  Fold
  (Point Double, Point Double)
  (StateInfo, [(PathInfo Double, Point Double)])
-> [(Point Double, Point Double)]
-> (StateInfo, [(PathInfo Double, Point Double)])
forall (f :: * -> *) a b. Foldable f => Fold a b -> f a -> b
L.fold (((StateInfo, [(PathInfo Double, Point Double)])
 -> (Point Double, Point Double)
 -> (StateInfo, [(PathInfo Double, Point Double)]))
-> (StateInfo, [(PathInfo Double, Point Double)])
-> ((StateInfo, [(PathInfo Double, Point Double)])
    -> (StateInfo, [(PathInfo Double, Point Double)]))
-> Fold
     (Point Double, Point Double)
     (StateInfo, [(PathInfo Double, Point Double)])
forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
L.Fold (StateInfo, [(PathInfo Double, Point Double)])
-> (Point Double, Point Double)
-> (StateInfo, [(PathInfo Double, Point Double)])
forall a s t a b.
(Subtractive a, HasField "cur" s t a b,
 HasField' "cur" s (Point a),
 HasField' "infoControl" s (Point a)) =>
(s, [(PathInfo a, b)]) -> (Point a, b) -> (t, [(PathInfo a, b)])
step (StateInfo
s, []) (([(PathInfo Double, Point Double)]
 -> [(PathInfo Double, Point Double)])
-> (StateInfo, [(PathInfo Double, Point Double)])
-> (StateInfo, [(PathInfo Double, Point Double)])
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second [(PathInfo Double, Point Double)]
-> [(PathInfo Double, Point Double)]
forall a. [a] -> [a]
reverse)) [(Point Double, Point Double)]
xs'
  where
    xs' :: [(Point Double, Point Double)]
xs' = (RPoint -> Point Double)
-> (RPoint -> Point Double)
-> (RPoint, RPoint)
-> (Point Double, Point Double)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap RPoint -> Point Double
forall a. Subtractive a => V2 a -> Point a
fromV2 RPoint -> Point Double
forall a. Subtractive a => V2 a -> Point a
fromV2 ((RPoint, RPoint) -> (Point Double, Point Double))
-> [(RPoint, RPoint)] -> [(Point Double, Point Double)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(RPoint, RPoint)]
xs
    step :: (s, [(PathInfo a, b)]) -> (Point a, b) -> (t, [(PathInfo a, b)])
step (s
s, [(PathInfo a, b)]
p) (Point a
c2, b
x2) =
      (s
s s -> (s -> t) -> t
forall a b. a -> (a -> b) -> b
& (a -> Identity b) -> s -> Identity t
forall a. IsLabel "cur" a => a
forall (x :: Symbol) a. IsLabel x a => a
#cur ((a -> Identity b) -> s -> Identity t) -> b -> s -> t
forall s t a b. ASetter s t a b -> b -> s -> t
.~ b
x2, (Point a -> Point a -> PathInfo a
forall a. Point a -> Point a -> PathInfo a
CubicI (s
s s -> Getting (Point a) s (Point a) -> Point a
forall s a. s -> Getting a s a -> a
^. Getting (Point a) s (Point a)
forall a. IsLabel "cur" a => a
forall (x :: Symbol) a. IsLabel x a => a
#cur Point a -> Point a -> Point a
forall a. Subtractive a => a -> a -> a
- (s
s s -> Getting (Point a) s (Point a) -> Point a
forall s a. s -> Getting a s a -> a
^. Getting (Point a) s (Point a)
forall a. IsLabel "infoControl" a => a
forall (x :: Symbol) a. IsLabel x a => a
#infoControl Point a -> Point a -> Point a
forall a. Subtractive a => a -> a -> a
- s
s s -> Getting (Point a) s (Point a) -> Point a
forall s a. s -> Getting a s a -> a
^. Getting (Point a) s (Point a)
forall a. IsLabel "cur" a => a
forall (x :: Symbol) a. IsLabel x a => a
#cur)) Point a
c2, b
x2) (PathInfo a, b) -> [(PathInfo a, b)] -> [(PathInfo a, b)]
forall a. a -> [a] -> [a]
: [(PathInfo a, b)]
p)
toInfo StateInfo
s (SmoothCurveTo Origin
OriginRelative [(RPoint, RPoint)]
xs) =
  Fold
  (Point Double, Point Double)
  (StateInfo, [(PathInfo Double, Point Double)])
-> [(Point Double, Point Double)]
-> (StateInfo, [(PathInfo Double, Point Double)])
forall (f :: * -> *) a b. Foldable f => Fold a b -> f a -> b
L.fold (((StateInfo, [(PathInfo Double, Point Double)])
 -> (Point Double, Point Double)
 -> (StateInfo, [(PathInfo Double, Point Double)]))
-> (StateInfo, [(PathInfo Double, Point Double)])
-> ((StateInfo, [(PathInfo Double, Point Double)])
    -> (StateInfo, [(PathInfo Double, Point Double)]))
-> Fold
     (Point Double, Point Double)
     (StateInfo, [(PathInfo Double, Point Double)])
forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
L.Fold (StateInfo, [(PathInfo Double, Point Double)])
-> (Point Double, Point Double)
-> (StateInfo, [(PathInfo Double, Point Double)])
forall a s s a t a.
(Subtractive a, HasField "cur" s s a (Point a),
 HasField "infoControl" s t a (Point a),
 HasField' "cur" s (Point a),
 HasField' "infoControl" s (Point a)) =>
(s, [(PathInfo a, Point a)])
-> (Point a, Point a) -> (t, [(PathInfo a, Point a)])
step (StateInfo
s, []) (([(PathInfo Double, Point Double)]
 -> [(PathInfo Double, Point Double)])
-> (StateInfo, [(PathInfo Double, Point Double)])
-> (StateInfo, [(PathInfo Double, Point Double)])
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second [(PathInfo Double, Point Double)]
-> [(PathInfo Double, Point Double)]
forall a. [a] -> [a]
reverse)) [(Point Double, Point Double)]
xs'
  where
    xs' :: [(Point Double, Point Double)]
xs' = (RPoint -> Point Double)
-> (RPoint -> Point Double)
-> (RPoint, RPoint)
-> (Point Double, Point Double)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap RPoint -> Point Double
forall a. Subtractive a => V2 a -> Point a
fromV2 RPoint -> Point Double
forall a. Subtractive a => V2 a -> Point a
fromV2 ((RPoint, RPoint) -> (Point Double, Point Double))
-> [(RPoint, RPoint)] -> [(Point Double, Point Double)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(RPoint, RPoint)]
xs
    step :: (s, [(PathInfo a, Point a)])
-> (Point a, Point a) -> (t, [(PathInfo a, Point a)])
step (s
s, [(PathInfo a, Point a)]
p) (Point a
c2, Point a
x2) =
      ( s
s
          s -> (s -> s) -> s
forall a b. a -> (a -> b) -> b
& (a -> Identity (Point a)) -> s -> Identity s
forall a. IsLabel "cur" a => a
forall (x :: Symbol) a. IsLabel x a => a
#cur ((a -> Identity (Point a)) -> s -> Identity s) -> Point a -> s -> s
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Point a
x2 Point a -> Point a -> Point a
forall a. Additive a => a -> a -> a
+ s
s s -> Getting (Point a) s (Point a) -> Point a
forall s a. s -> Getting a s a -> a
^. Getting (Point a) s (Point a)
forall a. IsLabel "cur" a => a
forall (x :: Symbol) a. IsLabel x a => a
#cur)
          s -> (s -> t) -> t
forall a b. a -> (a -> b) -> b
& (a -> Identity (Point a)) -> s -> Identity t
forall a. IsLabel "infoControl" a => a
forall (x :: Symbol) a. IsLabel x a => a
#infoControl ((a -> Identity (Point a)) -> s -> Identity t) -> Point a -> s -> t
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Point a
c2 Point a -> Point a -> Point a
forall a. Additive a => a -> a -> a
+ s
s s -> Getting (Point a) s (Point a) -> Point a
forall s a. s -> Getting a s a -> a
^. Getting (Point a) s (Point a)
forall a. IsLabel "cur" a => a
forall (x :: Symbol) a. IsLabel x a => a
#cur),
        (Point a -> Point a -> PathInfo a
forall a. Point a -> Point a -> PathInfo a
CubicI (s
s s -> Getting (Point a) s (Point a) -> Point a
forall s a. s -> Getting a s a -> a
^. Getting (Point a) s (Point a)
forall a. IsLabel "cur" a => a
forall (x :: Symbol) a. IsLabel x a => a
#cur Point a -> Point a -> Point a
forall a. Subtractive a => a -> a -> a
- (s
s s -> Getting (Point a) s (Point a) -> Point a
forall s a. s -> Getting a s a -> a
^. Getting (Point a) s (Point a)
forall a. IsLabel "infoControl" a => a
forall (x :: Symbol) a. IsLabel x a => a
#infoControl Point a -> Point a -> Point a
forall a. Subtractive a => a -> a -> a
- s
s s -> Getting (Point a) s (Point a) -> Point a
forall s a. s -> Getting a s a -> a
^. Getting (Point a) s (Point a)
forall a. IsLabel "cur" a => a
forall (x :: Symbol) a. IsLabel x a => a
#cur)) (Point a
c2 Point a -> Point a -> Point a
forall a. Additive a => a -> a -> a
+ s
s s -> Getting (Point a) s (Point a) -> Point a
forall s a. s -> Getting a s a -> a
^. Getting (Point a) s (Point a)
forall a. IsLabel "cur" a => a
forall (x :: Symbol) a. IsLabel x a => a
#cur), Point a
x2 Point a -> Point a -> Point a
forall a. Additive a => a -> a -> a
+ s
s s -> Getting (Point a) s (Point a) -> Point a
forall s a. s -> Getting a s a -> a
^. Getting (Point a) s (Point a)
forall a. IsLabel "cur" a => a
forall (x :: Symbol) a. IsLabel x a => a
#cur) (PathInfo a, Point a)
-> [(PathInfo a, Point a)] -> [(PathInfo a, Point a)]
forall a. a -> [a] -> [a]
: [(PathInfo a, Point a)]
p
      )
toInfo StateInfo
s (QuadraticBezier Origin
OriginAbsolute [(RPoint, RPoint)]
xs) =
  Fold
  (Point Double, Point Double)
  (StateInfo, [(PathInfo Double, Point Double)])
-> [(Point Double, Point Double)]
-> (StateInfo, [(PathInfo Double, Point Double)])
forall (f :: * -> *) a b. Foldable f => Fold a b -> f a -> b
L.fold (((StateInfo, [(PathInfo Double, Point Double)])
 -> (Point Double, Point Double)
 -> (StateInfo, [(PathInfo Double, Point Double)]))
-> (StateInfo, [(PathInfo Double, Point Double)])
-> ((StateInfo, [(PathInfo Double, Point Double)])
    -> (StateInfo, [(PathInfo Double, Point Double)]))
-> Fold
     (Point Double, Point Double)
     (StateInfo, [(PathInfo Double, Point Double)])
forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
L.Fold (StateInfo, [(PathInfo Double, Point Double)])
-> (Point Double, Point Double)
-> (StateInfo, [(PathInfo Double, Point Double)])
forall s s a b t a a.
(HasField "cur" s s a b, HasField "infoControl" s t a (Point a)) =>
(s, [(PathInfo a, b)]) -> (Point a, b) -> (t, [(PathInfo a, b)])
step (StateInfo
s, []) (([(PathInfo Double, Point Double)]
 -> [(PathInfo Double, Point Double)])
-> (StateInfo, [(PathInfo Double, Point Double)])
-> (StateInfo, [(PathInfo Double, Point Double)])
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second [(PathInfo Double, Point Double)]
-> [(PathInfo Double, Point Double)]
forall a. [a] -> [a]
reverse)) [(Point Double, Point Double)]
xs'
  where
    xs' :: [(Point Double, Point Double)]
xs' = (RPoint -> Point Double)
-> (RPoint -> Point Double)
-> (RPoint, RPoint)
-> (Point Double, Point Double)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap RPoint -> Point Double
forall a. Subtractive a => V2 a -> Point a
fromV2 RPoint -> Point Double
forall a. Subtractive a => V2 a -> Point a
fromV2 ((RPoint, RPoint) -> (Point Double, Point Double))
-> [(RPoint, RPoint)] -> [(Point Double, Point Double)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(RPoint, RPoint)]
xs
    step :: (s, [(PathInfo a, b)]) -> (Point a, b) -> (t, [(PathInfo a, b)])
step (s
s, [(PathInfo a, b)]
p) (Point a
c1, b
x2) =
      ( s
s
          s -> (s -> s) -> s
forall a b. a -> (a -> b) -> b
& (a -> Identity b) -> s -> Identity s
forall a. IsLabel "cur" a => a
forall (x :: Symbol) a. IsLabel x a => a
#cur ((a -> Identity b) -> s -> Identity s) -> b -> s -> s
forall s t a b. ASetter s t a b -> b -> s -> t
.~ b
x2
          s -> (s -> t) -> t
forall a b. a -> (a -> b) -> b
& (a -> Identity (Point a)) -> s -> Identity t
forall a. IsLabel "infoControl" a => a
forall (x :: Symbol) a. IsLabel x a => a
#infoControl ((a -> Identity (Point a)) -> s -> Identity t) -> Point a -> s -> t
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Point a
c1,
        (Point a -> PathInfo a
forall a. Point a -> PathInfo a
QuadI Point a
c1, b
x2) (PathInfo a, b) -> [(PathInfo a, b)] -> [(PathInfo a, b)]
forall a. a -> [a] -> [a]
: [(PathInfo a, b)]
p
      )
toInfo StateInfo
s (QuadraticBezier Origin
OriginRelative [(RPoint, RPoint)]
xs) =
  Fold
  (Point Double, Point Double)
  (StateInfo, [(PathInfo Double, Point Double)])
-> [(Point Double, Point Double)]
-> (StateInfo, [(PathInfo Double, Point Double)])
forall (f :: * -> *) a b. Foldable f => Fold a b -> f a -> b
L.fold (((StateInfo, [(PathInfo Double, Point Double)])
 -> (Point Double, Point Double)
 -> (StateInfo, [(PathInfo Double, Point Double)]))
-> (StateInfo, [(PathInfo Double, Point Double)])
-> ((StateInfo, [(PathInfo Double, Point Double)])
    -> (StateInfo, [(PathInfo Double, Point Double)]))
-> Fold
     (Point Double, Point Double)
     (StateInfo, [(PathInfo Double, Point Double)])
forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
L.Fold (StateInfo, [(PathInfo Double, Point Double)])
-> (Point Double, Point Double)
-> (StateInfo, [(PathInfo Double, Point Double)])
forall s a s a t a.
(HasField' "cur" s (Point a), Additive a,
 HasField "cur" s s a (Point a),
 HasField "infoControl" s t a (Point a)) =>
(s, [(PathInfo a, Point a)])
-> (Point a, Point a) -> (t, [(PathInfo a, Point a)])
step (StateInfo
s, []) (([(PathInfo Double, Point Double)]
 -> [(PathInfo Double, Point Double)])
-> (StateInfo, [(PathInfo Double, Point Double)])
-> (StateInfo, [(PathInfo Double, Point Double)])
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second [(PathInfo Double, Point Double)]
-> [(PathInfo Double, Point Double)]
forall a. [a] -> [a]
reverse)) [(Point Double, Point Double)]
xs'
  where
    xs' :: [(Point Double, Point Double)]
xs' = (RPoint -> Point Double)
-> (RPoint -> Point Double)
-> (RPoint, RPoint)
-> (Point Double, Point Double)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap RPoint -> Point Double
forall a. Subtractive a => V2 a -> Point a
fromV2 RPoint -> Point Double
forall a. Subtractive a => V2 a -> Point a
fromV2 ((RPoint, RPoint) -> (Point Double, Point Double))
-> [(RPoint, RPoint)] -> [(Point Double, Point Double)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(RPoint, RPoint)]
xs
    step :: (s, [(PathInfo a, Point a)])
-> (Point a, Point a) -> (t, [(PathInfo a, Point a)])
step (s
s, [(PathInfo a, Point a)]
p) (Point a
c1, Point a
x2) =
      (s
s s -> (s -> s) -> s
forall a b. a -> (a -> b) -> b
& (a -> Identity (Point a)) -> s -> Identity s
forall a. IsLabel "cur" a => a
forall (x :: Symbol) a. IsLabel x a => a
#cur ((a -> Identity (Point a)) -> s -> Identity s) -> Point a -> s -> s
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Point a
x2 s -> (s -> t) -> t
forall a b. a -> (a -> b) -> b
& (a -> Identity (Point a)) -> s -> Identity t
forall a. IsLabel "infoControl" a => a
forall (x :: Symbol) a. IsLabel x a => a
#infoControl ((a -> Identity (Point a)) -> s -> Identity t) -> Point a -> s -> t
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Point a
c1 Point a -> Point a -> Point a
forall a. Additive a => a -> a -> a
+ s
s s -> Getting (Point a) s (Point a) -> Point a
forall s a. s -> Getting a s a -> a
^. Getting (Point a) s (Point a)
forall a. IsLabel "cur" a => a
forall (x :: Symbol) a. IsLabel x a => a
#cur), (Point a -> PathInfo a
forall a. Point a -> PathInfo a
QuadI (Point a
c1 Point a -> Point a -> Point a
forall a. Additive a => a -> a -> a
+ s
s s -> Getting (Point a) s (Point a) -> Point a
forall s a. s -> Getting a s a -> a
^. Getting (Point a) s (Point a)
forall a. IsLabel "cur" a => a
forall (x :: Symbol) a. IsLabel x a => a
#cur), Point a
x2 Point a -> Point a -> Point a
forall a. Additive a => a -> a -> a
+ s
s s -> Getting (Point a) s (Point a) -> Point a
forall s a. s -> Getting a s a -> a
^. Getting (Point a) s (Point a)
forall a. IsLabel "cur" a => a
forall (x :: Symbol) a. IsLabel x a => a
#cur) (PathInfo a, Point a)
-> [(PathInfo a, Point a)] -> [(PathInfo a, Point a)]
forall a. a -> [a] -> [a]
: [(PathInfo a, Point a)]
p)
toInfo StateInfo
s (SmoothQuadraticBezierCurveTo Origin
OriginAbsolute [RPoint]
xs) =
  Fold (Point Double) (StateInfo, [(PathInfo Double, Point Double)])
-> [Point Double] -> (StateInfo, [(PathInfo Double, Point Double)])
forall (f :: * -> *) a b. Foldable f => Fold a b -> f a -> b
L.fold (((StateInfo, [(PathInfo Double, Point Double)])
 -> Point Double -> (StateInfo, [(PathInfo Double, Point Double)]))
-> (StateInfo, [(PathInfo Double, Point Double)])
-> ((StateInfo, [(PathInfo Double, Point Double)])
    -> (StateInfo, [(PathInfo Double, Point Double)]))
-> Fold
     (Point Double) (StateInfo, [(PathInfo Double, Point Double)])
forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
L.Fold (StateInfo, [(PathInfo Double, Point Double)])
-> Point Double -> (StateInfo, [(PathInfo Double, Point Double)])
forall a s s a b t a.
(Subtractive a, HasField "cur" s s a b,
 HasField "infoControl" s t a (Point a),
 HasField' "cur" s (Point a),
 HasField' "infoControl" s (Point a)) =>
(s, [(PathInfo a, b)]) -> b -> (t, [(PathInfo a, b)])
step (StateInfo
s, []) (([(PathInfo Double, Point Double)]
 -> [(PathInfo Double, Point Double)])
-> (StateInfo, [(PathInfo Double, Point Double)])
-> (StateInfo, [(PathInfo Double, Point Double)])
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second [(PathInfo Double, Point Double)]
-> [(PathInfo Double, Point Double)]
forall a. [a] -> [a]
reverse)) [Point Double]
xs'
  where
    xs' :: [Point Double]
xs' = RPoint -> Point Double
forall a. Subtractive a => V2 a -> Point a
fromV2 (RPoint -> Point Double) -> [RPoint] -> [Point Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [RPoint]
xs
    step :: (s, [(PathInfo a, b)]) -> b -> (t, [(PathInfo a, b)])
step (s
s, [(PathInfo a, b)]
p) b
x2 =
      ( s
s
          s -> (s -> s) -> s
forall a b. a -> (a -> b) -> b
& (a -> Identity b) -> s -> Identity s
forall a. IsLabel "cur" a => a
forall (x :: Symbol) a. IsLabel x a => a
#cur ((a -> Identity b) -> s -> Identity s) -> b -> s -> s
forall s t a b. ASetter s t a b -> b -> s -> t
.~ b
x2
          s -> (s -> t) -> t
forall a b. a -> (a -> b) -> b
& (a -> Identity (Point a)) -> s -> Identity t
forall a. IsLabel "infoControl" a => a
forall (x :: Symbol) a. IsLabel x a => a
#infoControl ((a -> Identity (Point a)) -> s -> Identity t) -> Point a -> s -> t
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (s
s s -> Getting (Point a) s (Point a) -> Point a
forall s a. s -> Getting a s a -> a
^. Getting (Point a) s (Point a)
forall a. IsLabel "cur" a => a
forall (x :: Symbol) a. IsLabel x a => a
#cur Point a -> Point a -> Point a
forall a. Subtractive a => a -> a -> a
- (s
s s -> Getting (Point a) s (Point a) -> Point a
forall s a. s -> Getting a s a -> a
^. Getting (Point a) s (Point a)
forall a. IsLabel "infoControl" a => a
forall (x :: Symbol) a. IsLabel x a => a
#infoControl Point a -> Point a -> Point a
forall a. Subtractive a => a -> a -> a
- s
s s -> Getting (Point a) s (Point a) -> Point a
forall s a. s -> Getting a s a -> a
^. Getting (Point a) s (Point a)
forall a. IsLabel "cur" a => a
forall (x :: Symbol) a. IsLabel x a => a
#cur)),
        (Point a -> PathInfo a
forall a. Point a -> PathInfo a
QuadI (s
s s -> Getting (Point a) s (Point a) -> Point a
forall s a. s -> Getting a s a -> a
^. Getting (Point a) s (Point a)
forall a. IsLabel "cur" a => a
forall (x :: Symbol) a. IsLabel x a => a
#cur Point a -> Point a -> Point a
forall a. Subtractive a => a -> a -> a
- (s
s s -> Getting (Point a) s (Point a) -> Point a
forall s a. s -> Getting a s a -> a
^. Getting (Point a) s (Point a)
forall a. IsLabel "infoControl" a => a
forall (x :: Symbol) a. IsLabel x a => a
#infoControl Point a -> Point a -> Point a
forall a. Subtractive a => a -> a -> a
- s
s s -> Getting (Point a) s (Point a) -> Point a
forall s a. s -> Getting a s a -> a
^. Getting (Point a) s (Point a)
forall a. IsLabel "cur" a => a
forall (x :: Symbol) a. IsLabel x a => a
#cur)), b
x2) (PathInfo a, b) -> [(PathInfo a, b)] -> [(PathInfo a, b)]
forall a. a -> [a] -> [a]
: [(PathInfo a, b)]
p
      )
toInfo StateInfo
s (SmoothQuadraticBezierCurveTo Origin
OriginRelative [RPoint]
xs) =
  Fold (Point Double) (StateInfo, [(PathInfo Double, Point Double)])
-> [Point Double] -> (StateInfo, [(PathInfo Double, Point Double)])
forall (f :: * -> *) a b. Foldable f => Fold a b -> f a -> b
L.fold (((StateInfo, [(PathInfo Double, Point Double)])
 -> Point Double -> (StateInfo, [(PathInfo Double, Point Double)]))
-> (StateInfo, [(PathInfo Double, Point Double)])
-> ((StateInfo, [(PathInfo Double, Point Double)])
    -> (StateInfo, [(PathInfo Double, Point Double)]))
-> Fold
     (Point Double) (StateInfo, [(PathInfo Double, Point Double)])
forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
L.Fold (StateInfo, [(PathInfo Double, Point Double)])
-> Point Double -> (StateInfo, [(PathInfo Double, Point Double)])
forall a s s a t a.
(Subtractive a, HasField "cur" s s a (Point a),
 HasField "infoControl" s t a (Point a),
 HasField' "cur" s (Point a),
 HasField' "infoControl" s (Point a)) =>
(s, [(PathInfo a, Point a)])
-> Point a -> (t, [(PathInfo a, Point a)])
step (StateInfo
s, []) (([(PathInfo Double, Point Double)]
 -> [(PathInfo Double, Point Double)])
-> (StateInfo, [(PathInfo Double, Point Double)])
-> (StateInfo, [(PathInfo Double, Point Double)])
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second [(PathInfo Double, Point Double)]
-> [(PathInfo Double, Point Double)]
forall a. [a] -> [a]
reverse)) [Point Double]
xs'
  where
    xs' :: [Point Double]
xs' = RPoint -> Point Double
forall a. Subtractive a => V2 a -> Point a
fromV2 (RPoint -> Point Double) -> [RPoint] -> [Point Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [RPoint]
xs
    step :: (s, [(PathInfo a, Point a)])
-> Point a -> (t, [(PathInfo a, Point a)])
step (s
s, [(PathInfo a, Point a)]
p) Point a
x2 =
      ( s
s
          s -> (s -> s) -> s
forall a b. a -> (a -> b) -> b
& (a -> Identity (Point a)) -> s -> Identity s
forall a. IsLabel "cur" a => a
forall (x :: Symbol) a. IsLabel x a => a
#cur ((a -> Identity (Point a)) -> s -> Identity s) -> Point a -> s -> s
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Point a
x2 Point a -> Point a -> Point a
forall a. Additive a => a -> a -> a
+ s
s s -> Getting (Point a) s (Point a) -> Point a
forall s a. s -> Getting a s a -> a
^. Getting (Point a) s (Point a)
forall a. IsLabel "cur" a => a
forall (x :: Symbol) a. IsLabel x a => a
#cur)
          s -> (s -> t) -> t
forall a b. a -> (a -> b) -> b
& (a -> Identity (Point a)) -> s -> Identity t
forall a. IsLabel "infoControl" a => a
forall (x :: Symbol) a. IsLabel x a => a
#infoControl ((a -> Identity (Point a)) -> s -> Identity t) -> Point a -> s -> t
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (s
s s -> Getting (Point a) s (Point a) -> Point a
forall s a. s -> Getting a s a -> a
^. Getting (Point a) s (Point a)
forall a. IsLabel "cur" a => a
forall (x :: Symbol) a. IsLabel x a => a
#cur Point a -> Point a -> Point a
forall a. Subtractive a => a -> a -> a
- (s
s s -> Getting (Point a) s (Point a) -> Point a
forall s a. s -> Getting a s a -> a
^. Getting (Point a) s (Point a)
forall a. IsLabel "infoControl" a => a
forall (x :: Symbol) a. IsLabel x a => a
#infoControl Point a -> Point a -> Point a
forall a. Subtractive a => a -> a -> a
- s
s s -> Getting (Point a) s (Point a) -> Point a
forall s a. s -> Getting a s a -> a
^. Getting (Point a) s (Point a)
forall a. IsLabel "cur" a => a
forall (x :: Symbol) a. IsLabel x a => a
#cur)),
        (Point a -> PathInfo a
forall a. Point a -> PathInfo a
QuadI (s
s s -> Getting (Point a) s (Point a) -> Point a
forall s a. s -> Getting a s a -> a
^. Getting (Point a) s (Point a)
forall a. IsLabel "cur" a => a
forall (x :: Symbol) a. IsLabel x a => a
#cur Point a -> Point a -> Point a
forall a. Subtractive a => a -> a -> a
- (s
s s -> Getting (Point a) s (Point a) -> Point a
forall s a. s -> Getting a s a -> a
^. Getting (Point a) s (Point a)
forall a. IsLabel "infoControl" a => a
forall (x :: Symbol) a. IsLabel x a => a
#infoControl Point a -> Point a -> Point a
forall a. Subtractive a => a -> a -> a
- s
s s -> Getting (Point a) s (Point a) -> Point a
forall s a. s -> Getting a s a -> a
^. Getting (Point a) s (Point a)
forall a. IsLabel "cur" a => a
forall (x :: Symbol) a. IsLabel x a => a
#cur)), Point a
x2 Point a -> Point a -> Point a
forall a. Additive a => a -> a -> a
+ s
s s -> Getting (Point a) s (Point a) -> Point a
forall s a. s -> Getting a s a -> a
^. Getting (Point a) s (Point a)
forall a. IsLabel "cur" a => a
forall (x :: Symbol) a. IsLabel x a => a
#cur) (PathInfo a, Point a)
-> [(PathInfo a, Point a)] -> [(PathInfo a, Point a)]
forall a. a -> [a] -> [a]
: [(PathInfo a, Point a)]
p
      )
toInfo StateInfo
s (EllipticalArc Origin
OriginAbsolute [(Double, Double, Double, Bool, Bool, RPoint)]
xs) =
  Fold
  (Double, Double, Double, Bool, Bool, Point Double)
  (StateInfo, [(PathInfo Double, Point Double)])
-> [(Double, Double, Double, Bool, Bool, Point Double)]
-> (StateInfo, [(PathInfo Double, Point Double)])
forall (f :: * -> *) a b. Foldable f => Fold a b -> f a -> b
L.fold (((StateInfo, [(PathInfo Double, Point Double)])
 -> (Double, Double, Double, Bool, Bool, Point Double)
 -> (StateInfo, [(PathInfo Double, Point Double)]))
-> (StateInfo, [(PathInfo Double, Point Double)])
-> ((StateInfo, [(PathInfo Double, Point Double)])
    -> (StateInfo, [(PathInfo Double, Point Double)]))
-> Fold
     (Double, Double, Double, Bool, Bool, Point Double)
     (StateInfo, [(PathInfo Double, Point Double)])
forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
L.Fold (StateInfo, [(PathInfo Double, Point Double)])
-> (Double, Double, Double, Bool, Bool, Point Double)
-> (StateInfo, [(PathInfo Double, Point Double)])
forall s t a a.
(HasField "cur" s t a (Point a), HasField' "cur" s (Point a)) =>
(s, [(PathInfo a, Point a)])
-> (a, a, a, Bool, Bool, Point a) -> (t, [(PathInfo a, Point a)])
step (StateInfo
s, []) (([(PathInfo Double, Point Double)]
 -> [(PathInfo Double, Point Double)])
-> (StateInfo, [(PathInfo Double, Point Double)])
-> (StateInfo, [(PathInfo Double, Point Double)])
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second [(PathInfo Double, Point Double)]
-> [(PathInfo Double, Point Double)]
forall a. [a] -> [a]
reverse)) [(Double, Double, Double, Bool, Bool, Point Double)]
xs'
  where
    xs' :: [(Double, Double, Double, Bool, Bool, Point Double)]
xs' = (\(Double
x, Double
y, Double
r, Bool
l, Bool
sw, RPoint
x2) -> (Double
x, Double
y, Double
r, Bool
l, Bool
sw, RPoint -> Point Double
forall a. Subtractive a => V2 a -> Point a
fromV2 RPoint
x2)) ((Double, Double, Double, Bool, Bool, RPoint)
 -> (Double, Double, Double, Bool, Bool, Point Double))
-> [(Double, Double, Double, Bool, Bool, RPoint)]
-> [(Double, Double, Double, Bool, Bool, Point Double)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Double, Double, Double, Bool, Bool, RPoint)]
xs
    step :: (s, [(PathInfo a, Point a)])
-> (a, a, a, Bool, Bool, Point a) -> (t, [(PathInfo a, Point a)])
step (s
s, [(PathInfo a, Point a)]
p) a :: (a, a, a, Bool, Bool, Point a)
a@(a
_, a
_, a
_, Bool
_, Bool
_, Point a
x2) =
      (s
s s -> (s -> t) -> t
forall a b. a -> (a -> b) -> b
& (a -> Identity (Point a)) -> s -> Identity t
forall a. IsLabel "cur" a => a
forall (x :: Symbol) a. IsLabel x a => a
#cur ((a -> Identity (Point a)) -> s -> Identity t) -> Point a -> s -> t
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Point a
x2, (Point a -> (a, a, a, Bool, Bool, Point a) -> PathInfo a
forall a. Point a -> (a, a, a, Bool, Bool, Point a) -> PathInfo a
fromPathEllipticalArc (s
s s -> Getting (Point a) s (Point a) -> Point a
forall s a. s -> Getting a s a -> a
^. Getting (Point a) s (Point a)
forall a. IsLabel "cur" a => a
forall (x :: Symbol) a. IsLabel x a => a
#cur) (a, a, a, Bool, Bool, Point a)
a, Point a
x2) (PathInfo a, Point a)
-> [(PathInfo a, Point a)] -> [(PathInfo a, Point a)]
forall a. a -> [a] -> [a]
: [(PathInfo a, Point a)]
p)
toInfo StateInfo
s (EllipticalArc Origin
OriginRelative [(Double, Double, Double, Bool, Bool, RPoint)]
xs) =
  Fold
  (Double, Double, Double, Bool, Bool, Point Double)
  (StateInfo, [(PathInfo Double, Point Double)])
-> [(Double, Double, Double, Bool, Bool, Point Double)]
-> (StateInfo, [(PathInfo Double, Point Double)])
forall (f :: * -> *) a b. Foldable f => Fold a b -> f a -> b
L.fold (((StateInfo, [(PathInfo Double, Point Double)])
 -> (Double, Double, Double, Bool, Bool, Point Double)
 -> (StateInfo, [(PathInfo Double, Point Double)]))
-> (StateInfo, [(PathInfo Double, Point Double)])
-> ((StateInfo, [(PathInfo Double, Point Double)])
    -> (StateInfo, [(PathInfo Double, Point Double)]))
-> Fold
     (Double, Double, Double, Bool, Bool, Point Double)
     (StateInfo, [(PathInfo Double, Point Double)])
forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
L.Fold (StateInfo, [(PathInfo Double, Point Double)])
-> (Double, Double, Double, Bool, Bool, Point Double)
-> (StateInfo, [(PathInfo Double, Point Double)])
forall s t a a.
(HasField "cur" s t a (Point a), Additive a,
 HasField' "cur" s (Point a)) =>
(s, [(PathInfo a, Point a)])
-> (a, a, a, Bool, Bool, Point a) -> (t, [(PathInfo a, Point a)])
step (StateInfo
s, []) (([(PathInfo Double, Point Double)]
 -> [(PathInfo Double, Point Double)])
-> (StateInfo, [(PathInfo Double, Point Double)])
-> (StateInfo, [(PathInfo Double, Point Double)])
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second [(PathInfo Double, Point Double)]
-> [(PathInfo Double, Point Double)]
forall a. [a] -> [a]
reverse)) [(Double, Double, Double, Bool, Bool, Point Double)]
xs'
  where
    xs' :: [(Double, Double, Double, Bool, Bool, Point Double)]
xs' = (\(Double
x, Double
y, Double
r, Bool
l, Bool
sw, RPoint
x2) -> (Double
x, Double
y, Double
r, Bool
l, Bool
sw, RPoint -> Point Double
forall a. Subtractive a => V2 a -> Point a
fromV2 RPoint
x2)) ((Double, Double, Double, Bool, Bool, RPoint)
 -> (Double, Double, Double, Bool, Bool, Point Double))
-> [(Double, Double, Double, Bool, Bool, RPoint)]
-> [(Double, Double, Double, Bool, Bool, Point Double)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Double, Double, Double, Bool, Bool, RPoint)]
xs
    step :: (s, [(PathInfo a, Point a)])
-> (a, a, a, Bool, Bool, Point a) -> (t, [(PathInfo a, Point a)])
step (s
s, [(PathInfo a, Point a)]
p) a :: (a, a, a, Bool, Bool, Point a)
a@(a
_, a
_, a
_, Bool
_, Bool
_, Point a
x2) =
      let x2' :: Point a
x2' = Point a
x2 Point a -> Point a -> Point a
forall a. Additive a => a -> a -> a
+ s
s s -> Getting (Point a) s (Point a) -> Point a
forall s a. s -> Getting a s a -> a
^. Getting (Point a) s (Point a)
forall a. IsLabel "cur" a => a
forall (x :: Symbol) a. IsLabel x a => a
#cur
       in (s
s s -> (s -> t) -> t
forall a b. a -> (a -> b) -> b
& (a -> Identity (Point a)) -> s -> Identity t
forall a. IsLabel "cur" a => a
forall (x :: Symbol) a. IsLabel x a => a
#cur ((a -> Identity (Point a)) -> s -> Identity t) -> Point a -> s -> t
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Point a
x2', (Point a -> (a, a, a, Bool, Bool, Point a) -> PathInfo a
forall a. Point a -> (a, a, a, Bool, Bool, Point a) -> PathInfo a
fromPathEllipticalArc (s
s s -> Getting (Point a) s (Point a) -> Point a
forall s a. s -> Getting a s a -> a
^. Getting (Point a) s (Point a)
forall a. IsLabel "cur" a => a
forall (x :: Symbol) a. IsLabel x a => a
#cur) (a, a, a, Bool, Bool, Point a)
a, Point a
x2') (PathInfo a, Point a)
-> [(PathInfo a, Point a)] -> [(PathInfo a, Point a)]
forall a. a -> [a] -> [a]
: [(PathInfo a, Point a)]
p)

fromPathEllipticalArc :: Point a -> (a, a, a, Bool, Bool, Point a) -> PathInfo a
fromPathEllipticalArc :: Point a -> (a, a, a, Bool, Bool, Point a) -> PathInfo a
fromPathEllipticalArc Point a
_ (a
x, a
y, a
r, Bool
l, Bool
s, Point a
_) = ArcInfo a -> PathInfo a
forall a. ArcInfo a -> PathInfo a
ArcI (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)

fromV2 :: (Subtractive a) => Linear.V2 a -> Point a
fromV2 :: V2 a -> Point a
fromV2 (Linear.V2 a
x a
y) = a -> a -> Point a
forall a. a -> a -> Point a
Point a
x (- a
y)

-- | Convert from a path command list to a PathA specification
toPathXYs :: [SvgTree.PathCommand] -> [(PathInfo Double, Point Double)]
toPathXYs :: [PathCommand] -> [(PathInfo Double, Point Double)]
toPathXYs [] = []
toPathXYs [PathCommand]
xs =
  (StateInfo, [(PathInfo Double, Point Double)])
-> [(PathInfo Double, Point Double)]
forall a b. (a, b) -> b
snd (((StateInfo, [(PathInfo Double, Point Double)])
 -> PathCommand -> (StateInfo, [(PathInfo Double, Point Double)]))
-> (StateInfo, [(PathInfo Double, Point Double)])
-> [PathCommand]
-> (StateInfo, [(PathInfo Double, Point Double)])
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\(StateInfo
x, [(PathInfo Double, Point Double)]
l) PathCommand
a -> ([(PathInfo Double, Point Double)]
 -> [(PathInfo Double, Point Double)])
-> (StateInfo, [(PathInfo Double, Point Double)])
-> (StateInfo, [(PathInfo Double, Point Double)])
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ([(PathInfo Double, Point Double)]
l [(PathInfo Double, Point Double)]
-> [(PathInfo Double, Point Double)]
-> [(PathInfo Double, Point Double)]
forall a. Semigroup a => a -> a -> a
<>) ((StateInfo, [(PathInfo Double, Point Double)])
 -> (StateInfo, [(PathInfo Double, Point Double)]))
-> (StateInfo, [(PathInfo Double, Point Double)])
-> (StateInfo, [(PathInfo Double, Point Double)])
forall a b. (a -> b) -> a -> b
$ StateInfo
-> PathCommand -> (StateInfo, [(PathInfo Double, Point Double)])
toInfo StateInfo
x PathCommand
a) (StateInfo
stateInfo0, []) [PathCommand]
xs)

-- | convert cubic position to path info.
singletonCubic :: CubicPosition Double -> [(PathInfo Double, Point Double)]
singletonCubic :: CubicPosition Double -> [(PathInfo Double, Point Double)]
singletonCubic (CubicPosition Point Double
s Point Double
e Point Double
c1 Point Double
c2) = [(PathInfo Double
forall a. PathInfo a
StartI, Point Double
s), (Point Double -> Point Double -> PathInfo Double
forall a. Point a -> Point a -> PathInfo a
CubicI Point Double
c1 Point Double
c2, Point Double
e)]

-- | convert quad position to path info.
singletonQuad :: QuadPosition Double -> [(PathInfo Double, Point Double)]
singletonQuad :: QuadPosition Double -> [(PathInfo Double, Point Double)]
singletonQuad (QuadPosition Point Double
s Point Double
e Point Double
c) = [(PathInfo Double
forall a. PathInfo a
StartI, Point Double
s), (Point Double -> PathInfo Double
forall a. Point a -> PathInfo a
QuadI Point Double
c, Point Double
e)]

-- | convert arc position to path info.
singletonArc :: ArcPosition Double -> [(PathInfo Double, Point Double)]
singletonArc :: ArcPosition Double -> [(PathInfo Double, Point Double)]
singletonArc (ArcPosition Point Double
s Point Double
e ArcInfo Double
i) = [(PathInfo Double
forall a. PathInfo a
StartI, Point Double
s), (ArcInfo Double -> PathInfo Double
forall a. ArcInfo a -> PathInfo a
ArcI ArcInfo Double
i, Point Double
e)]

-- | convert arc position to a pie slice.
singletonPie :: ArcPosition Double -> [(PathInfo Double, Point Double)]
singletonPie :: ArcPosition Double -> [(PathInfo Double, Point Double)]
singletonPie p :: ArcPosition Double
p@(ArcPosition Point Double
s Point Double
e ArcInfo Double
i) = [(PathInfo Double
forall a. PathInfo a
StartI, Point Double
c), (PathInfo Double
forall a. PathInfo a
LineI, Point Double
s), (ArcInfo Double -> PathInfo Double
forall a. ArcInfo a -> PathInfo a
ArcI ArcInfo Double
i, Point Double
e), (PathInfo Double
forall a. PathInfo a
LineI, Point Double
c)]
  where
    ac :: ArcCentroid Double
ac = ArcPosition Double -> ArcCentroid Double
forall a.
(FromInteger a, Ord a, TrigField a, ExpField a) =>
ArcPosition a -> ArcCentroid a
arcCentroid ArcPosition Double
p
    c :: Point Double
c = ArcCentroid Double
ac ArcCentroid Double
-> Getting (Point Double) (ArcCentroid Double) (Point Double)
-> Point Double
forall s a. s -> Getting a s a -> a
^. Getting (Point Double) (ArcCentroid Double) (Point Double)
forall a. IsLabel "centroid" a => a
forall (x :: Symbol) a. IsLabel x a => a
#centroid

-- | convert arc position to a pie slice, with a specific center.
singletonPie' :: Point Double -> ArcPosition Double -> [(PathInfo Double, Point Double)]
singletonPie' :: Point Double
-> ArcPosition Double -> [(PathInfo Double, Point Double)]
singletonPie' Point Double
c (ArcPosition Point Double
s Point Double
e ArcInfo Double
i) = [(PathInfo Double
forall a. PathInfo a
StartI, Point Double
c), (PathInfo Double
forall a. PathInfo a
LineI, Point Double
s), (ArcInfo Double -> PathInfo Double
forall a. ArcInfo a -> PathInfo a
ArcI ArcInfo Double
i, Point Double
e), (PathInfo Double
forall a. PathInfo a
LineI, Point Double
c)]

-- | convert path info to an ArcPosition.
toSingletonArc :: [(PathInfo Double, Point Double)] -> Maybe (ArcPosition Double)
toSingletonArc :: [(PathInfo Double, Point Double)] -> Maybe (ArcPosition Double)
toSingletonArc ((PathInfo Double
StartI, Point Double
s) : (ArcI ArcInfo Double
i, Point Double
e) : [(PathInfo Double, Point Double)]
_) = ArcPosition Double -> Maybe (ArcPosition Double)
forall a. a -> Maybe a
Just (ArcPosition Double -> Maybe (ArcPosition Double))
-> ArcPosition Double -> Maybe (ArcPosition Double)
forall a b. (a -> b) -> a -> b
$ Point Double
-> Point Double -> ArcInfo Double -> ArcPosition Double
forall a. Point a -> Point a -> ArcInfo a -> ArcPosition a
ArcPosition Point Double
s Point Double
e ArcInfo Double
i
toSingletonArc [(PathInfo Double, Point Double)]
_ = Maybe (ArcPosition Double)
forall a. Maybe a
Nothing

-- * Arc types

-- | Information about an individual arc path.
data ArcInfo a = ArcInfo
  { -- | ellipse radii
    ArcInfo a -> Point a
radii :: Point a,
    -- | rotation of the ellipse. positive means counter-clockwise (which is different to SVG).
    ArcInfo a -> a
phi :: a,
    ArcInfo a -> Bool
large :: Bool,
    -- | sweep means clockwise
    ArcInfo a -> Bool
clockwise :: Bool
  }
  deriving (ArcInfo a -> ArcInfo a -> Bool
(ArcInfo a -> ArcInfo a -> Bool)
-> (ArcInfo a -> ArcInfo a -> Bool) -> Eq (ArcInfo a)
forall a. Eq a => ArcInfo a -> ArcInfo a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ArcInfo a -> ArcInfo a -> Bool
$c/= :: forall a. Eq a => ArcInfo a -> ArcInfo a -> Bool
== :: ArcInfo a -> ArcInfo a -> Bool
$c== :: forall a. Eq a => ArcInfo a -> ArcInfo a -> Bool
Eq, Int -> ArcInfo a -> ShowS
[ArcInfo a] -> ShowS
ArcInfo a -> String
(Int -> ArcInfo a -> ShowS)
-> (ArcInfo a -> String)
-> ([ArcInfo a] -> ShowS)
-> Show (ArcInfo a)
forall a. Show a => Int -> ArcInfo a -> ShowS
forall a. Show a => [ArcInfo a] -> ShowS
forall a. Show a => ArcInfo a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ArcInfo a] -> ShowS
$cshowList :: forall a. Show a => [ArcInfo a] -> ShowS
show :: ArcInfo a -> String
$cshow :: forall a. Show a => ArcInfo a -> String
showsPrec :: Int -> ArcInfo a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> ArcInfo a -> ShowS
Show, (forall x. ArcInfo a -> Rep (ArcInfo a) x)
-> (forall x. Rep (ArcInfo a) x -> ArcInfo a)
-> Generic (ArcInfo a)
forall x. Rep (ArcInfo a) x -> ArcInfo a
forall x. ArcInfo a -> Rep (ArcInfo a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (ArcInfo a) x -> ArcInfo a
forall a x. ArcInfo a -> Rep (ArcInfo a) x
$cto :: forall a x. Rep (ArcInfo a) x -> ArcInfo a
$cfrom :: forall a x. ArcInfo a -> Rep (ArcInfo a) x
Generic)

-- | Specification of an Arc using positional referencing as per SVG standard.
data ArcPosition a = ArcPosition
  { ArcPosition a -> Point a
posStart :: Point a,
    ArcPosition a -> Point a
posEnd :: Point a,
    ArcPosition a -> ArcInfo a
posInfo :: ArcInfo a
  }
  deriving (ArcPosition a -> ArcPosition a -> Bool
(ArcPosition a -> ArcPosition a -> Bool)
-> (ArcPosition a -> ArcPosition a -> Bool) -> Eq (ArcPosition a)
forall a. Eq a => ArcPosition a -> ArcPosition a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ArcPosition a -> ArcPosition a -> Bool
$c/= :: forall a. Eq a => ArcPosition a -> ArcPosition a -> Bool
== :: ArcPosition a -> ArcPosition a -> Bool
$c== :: forall a. Eq a => ArcPosition a -> ArcPosition a -> Bool
Eq, Int -> ArcPosition a -> ShowS
[ArcPosition a] -> ShowS
ArcPosition a -> String
(Int -> ArcPosition a -> ShowS)
-> (ArcPosition a -> String)
-> ([ArcPosition a] -> ShowS)
-> Show (ArcPosition a)
forall a. Show a => Int -> ArcPosition a -> ShowS
forall a. Show a => [ArcPosition a] -> ShowS
forall a. Show a => ArcPosition a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ArcPosition a] -> ShowS
$cshowList :: forall a. Show a => [ArcPosition a] -> ShowS
show :: ArcPosition a -> String
$cshow :: forall a. Show a => ArcPosition a -> String
showsPrec :: Int -> ArcPosition a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> ArcPosition a -> ShowS
Show, (forall x. ArcPosition a -> Rep (ArcPosition a) x)
-> (forall x. Rep (ArcPosition a) x -> ArcPosition a)
-> Generic (ArcPosition a)
forall x. Rep (ArcPosition a) x -> ArcPosition a
forall x. ArcPosition a -> Rep (ArcPosition a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (ArcPosition a) x -> ArcPosition a
forall a x. ArcPosition a -> Rep (ArcPosition a) x
$cto :: forall a x. Rep (ArcPosition a) x -> ArcPosition a
$cfrom :: forall a x. ArcPosition a -> Rep (ArcPosition a) x
Generic)

-- | Arc specification based on centroidal interpretation.
--
-- See: https://www.w3.org/TR/SVG/implnote.html#ArcConversionEndpointToCenter
data ArcCentroid a = ArcCentroid
  { -- | ellipse center
    ArcCentroid a -> Point a
centroid :: Point a,
    -- | ellipse radii
    ArcCentroid a -> Point a
radius :: Point a,
    -- | ellipse rotation
    ArcCentroid a -> a
cphi :: a,
    -- | starting point angle to the x-axis
    ArcCentroid a -> a
ang0 :: a,
    -- | difference between ending point angle and starting point angle
    ArcCentroid a -> a
angdiff :: a
  }
  deriving (ArcCentroid a -> ArcCentroid a -> Bool
(ArcCentroid a -> ArcCentroid a -> Bool)
-> (ArcCentroid a -> ArcCentroid a -> Bool) -> Eq (ArcCentroid a)
forall a. Eq a => ArcCentroid a -> ArcCentroid a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ArcCentroid a -> ArcCentroid a -> Bool
$c/= :: forall a. Eq a => ArcCentroid a -> ArcCentroid a -> Bool
== :: ArcCentroid a -> ArcCentroid a -> Bool
$c== :: forall a. Eq a => ArcCentroid a -> ArcCentroid a -> Bool
Eq, Int -> ArcCentroid a -> ShowS
[ArcCentroid a] -> ShowS
ArcCentroid a -> String
(Int -> ArcCentroid a -> ShowS)
-> (ArcCentroid a -> String)
-> ([ArcCentroid a] -> ShowS)
-> Show (ArcCentroid a)
forall a. Show a => Int -> ArcCentroid a -> ShowS
forall a. Show a => [ArcCentroid a] -> ShowS
forall a. Show a => ArcCentroid a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ArcCentroid a] -> ShowS
$cshowList :: forall a. Show a => [ArcCentroid a] -> ShowS
show :: ArcCentroid a -> String
$cshow :: forall a. Show a => ArcCentroid a -> String
showsPrec :: Int -> ArcCentroid a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> ArcCentroid a -> ShowS
Show, (forall x. ArcCentroid a -> Rep (ArcCentroid a) x)
-> (forall x. Rep (ArcCentroid a) x -> ArcCentroid a)
-> Generic (ArcCentroid a)
forall x. Rep (ArcCentroid a) x -> ArcCentroid a
forall x. ArcCentroid a -> Rep (ArcCentroid a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (ArcCentroid a) x -> ArcCentroid a
forall a x. ArcCentroid a -> Rep (ArcCentroid a) x
$cto :: forall a x. Rep (ArcCentroid a) x -> ArcCentroid a
$cfrom :: forall a x. ArcCentroid a -> Rep (ArcCentroid a) x
Generic)

-- | convert from an ArcPosition spec to ArcCentroid spec.
--
-- See also [this](https://math.stackexchange.com/questions/55627/how-to-find-the-center-of-an-scaled-ellipse)
--
-- >>> let p = ArcPosition (Point 0 0) (Point 1 0) (ArcInfo (Point 1 0.5) (pi/4) False True)
-- >>> arcCentroid p
-- ArcCentroid {centroid = Point 0.20952624903444356 -0.48412291827592724, radius = Point 1.0 0.5, cphi = 0.7853981633974483, ang0 = 1.3753858999692936, angdiff = -1.823476581936975}
arcCentroid :: (FromInteger a, Ord a, TrigField a, ExpField a) => ArcPosition a -> ArcCentroid a
arcCentroid :: ArcPosition a -> ArcCentroid a
arcCentroid (ArcPosition p1 :: Point a
p1@(Point a
x1 a
y1) p2 :: Point a
p2@(Point a
x2 a
y2) (ArcInfo Point a
rad a
phi Bool
large Bool
clockwise)) = Point a -> Point a -> a -> a -> a -> ArcCentroid a
forall a. Point a -> Point a -> a -> a -> a -> ArcCentroid a
ArcCentroid Point a
c (a -> a -> Point a
forall a. a -> a -> Point a
Point a
rx a
ry) a
phi a
ang1 a
angd
  where
    (Point a
x1' a
y1') = a -> Point a -> Point a
forall a. TrigField a => a -> Point a -> Point a
rotateP (- a
phi) ((Point a
p1 Point a -> Point a -> Point a
forall a. Subtractive a => a -> a -> a
- Point a
p2) Point a -> a -> Point a
forall m a. DivisiveAction m a => m -> a -> m
/. a
forall a. (Multiplicative a, Additive a) => a
two)
    (Point a
rx' a
ry') = Point a
rad
    l :: a
l = a
x1' a -> a -> a
forall a. ExpField a => a -> a -> a
** a
2 a -> a -> a
forall a. Divisive a => a -> a -> a
/ a
rx' a -> a -> a
forall a. ExpField a => a -> a -> a
** a
2 a -> a -> a
forall a. Additive a => a -> a -> a
+ a
y1' a -> a -> a
forall a. ExpField a => a -> a -> a
** a
2 a -> a -> a
forall a. Divisive a => a -> a -> a
/ a
ry' a -> a -> a
forall a. ExpField a => a -> a -> a
** a
2
    (a
rx, a
ry) = (a, a) -> (a, a) -> Bool -> (a, a)
forall a. a -> a -> Bool -> a
bool (a
rx', a
ry') (a
rx' a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a -> a
forall a. ExpField a => a -> a
sqrt a
l, a
ry' a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a -> a
forall a. ExpField a => a -> a
sqrt a
l) (a
l a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
1)
    snumer :: a
snumer = a -> a -> a
forall a. Ord a => a -> a -> a
max a
0 (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ (a
rx a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
rx a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
ry a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
ry) a -> a -> a
forall a. Subtractive a => a -> a -> a
- (a
rx a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
rx a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
y1' a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
y1') a -> a -> a
forall a. Subtractive a => a -> a -> a
- (a
ry a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
ry a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
x1' a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
x1')
    s :: a
s =
      a -> a -> Bool -> a
forall a. a -> a -> Bool -> a
bool a
-1 a
1 (Bool
large Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
clockwise)
        a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a -> a
forall a. ExpField a => a -> a
sqrt
          (a
snumer a -> a -> a
forall a. Divisive a => a -> a -> a
/ (a
rx a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
rx a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
y1' a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
y1' a -> a -> a
forall a. Additive a => a -> a -> a
+ a
ry a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
ry a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
x1' a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
x1'))
    cx' :: a
cx' = a
s a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
rx a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
y1' a -> a -> a
forall a. Divisive a => a -> a -> a
/ a
ry
    cy' :: a
cy' = a
s a -> a -> a
forall a. Multiplicative a => a -> a -> a
* (- a
ry) a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
x1' a -> a -> a
forall a. Divisive a => a -> a -> a
/ a
rx
    cx :: a
cx = (a
x1 a -> a -> a
forall a. Additive a => a -> a -> a
+ a
x2) a -> a -> a
forall a. Divisive a => a -> a -> a
/ a
2 a -> a -> a
forall a. Additive a => a -> a -> a
+ a -> a
forall a. TrigField a => a -> a
cos a
phi a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
cx' a -> a -> a
forall a. Subtractive a => a -> a -> a
- a -> a
forall a. TrigField a => a -> a
sin a
phi a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
cy'
    cy :: a
cy = (a
y1 a -> a -> a
forall a. Additive a => a -> a -> a
+ a
y2) a -> a -> a
forall a. Divisive a => a -> a -> a
/ a
2 a -> a -> a
forall a. Additive a => a -> a -> a
+ a -> a
forall a. TrigField a => a -> a
sin a
phi a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
cx' a -> a -> a
forall a. Additive a => a -> a -> a
+ a -> a
forall a. TrigField a => a -> a
cos a
phi a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
cy'
    c :: Point a
c = a -> a -> Point a
forall a. a -> a -> Point a
Point a
cx a
cy
    ang1 :: a
ang1 = Point a -> a
forall coord dir. Direction coord dir => coord -> dir
angle (a -> a -> Point a
forall a. a -> a -> Point a
Point (- (a
cx' a -> a -> a
forall a. Subtractive a => a -> a -> a
- a
x1') a -> a -> a
forall a. Divisive a => a -> a -> a
/ a
rx) (- (a
cy' a -> a -> a
forall a. Subtractive a => a -> a -> a
- a
y1') a -> a -> a
forall a. Divisive a => a -> a -> a
/ a
ry))
    ang2 :: a
ang2 = Point a -> a
forall coord dir. Direction coord dir => coord -> dir
angle (a -> a -> Point a
forall a. a -> a -> Point a
Point (- (a
cx' a -> a -> a
forall a. Additive a => a -> a -> a
+ a
x1') a -> a -> a
forall a. Divisive a => a -> a -> a
/ a
rx) (- (a
cy' a -> a -> a
forall a. Additive a => a -> a -> a
+ a
y1') a -> a -> a
forall a. Divisive a => a -> a -> a
/ a
ry))
    angd' :: a
angd' = a
ang2 a -> a -> a
forall a. Subtractive a => a -> a -> a
- a
ang1
    angd :: a
angd =
      a -> a -> Bool -> a
forall a. a -> a -> Bool -> a
bool a
0 (a
2 a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
forall a. TrigField a => a
pi) (Bool -> Bool
not Bool
clockwise Bool -> Bool -> Bool
&& a
angd' a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0)
        a -> a -> a
forall a. Additive a => a -> a -> a
+ a -> a -> Bool -> a
forall a. a -> a -> Bool -> a
bool a
0 (a
-2 a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
forall a. TrigField a => a
pi) (Bool
clockwise Bool -> Bool -> Bool
&& a
angd' a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
0)
        a -> a -> a
forall a. Additive a => a -> a -> a
+ a
angd'

-- | convert from an ArcCentroid to an ArcPosition specification.
--
-- Morally,
-- > arcPosition . arcCentroid == id
--
-- Not isomorphic if:
--
-- - angle diff is pi and large is True
--
-- - radii are less than they should be and thus get scaled up.
arcPosition :: (Ord a, Signed a, TrigField a) => ArcCentroid a -> ArcPosition a
arcPosition :: ArcCentroid a -> ArcPosition a
arcPosition (ArcCentroid Point a
c Point a
r a
phi a
ang1 a
angd) =
  Point a -> Point a -> ArcInfo a -> ArcPosition a
forall a. Point a -> Point a -> ArcInfo a -> ArcPosition a
ArcPosition Point a
p1 Point a
p2 (Point a -> a -> Bool -> Bool -> ArcInfo a
forall a. Point a -> a -> Bool -> Bool -> ArcInfo a
ArcInfo Point a
r a
phi Bool
large Bool
clockwise)
  where
    p1 :: Point a
p1 = Point a -> Point a -> a -> a -> Point a
forall b a.
(Direction b a, Affinity b a, TrigField a) =>
b -> b -> a -> a -> b
ellipse Point a
c Point a
r a
phi a
ang1
    p2 :: Point a
p2 = Point a -> Point a -> a -> a -> Point a
forall b a.
(Direction b a, Affinity b a, TrigField a) =>
b -> b -> a -> a -> b
ellipse Point a
c Point a
r a
phi (a
ang1 a -> a -> a
forall a. Additive a => a -> a -> a
+ a
angd)
    large :: Bool
large = a -> a
forall a. Signed a => a -> a
abs a
angd a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
forall a. TrigField a => a
pi
    clockwise :: Bool
clockwise = a
angd a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
forall a. Additive a => a
zero

-- | ellipse formulae
--
-- >>> ellipse zero (Point 1 2) (pi/6) pi
-- Point -0.8660254037844388 -0.4999999999999997
--
-- Compare this "elegent" definition from [stackexchange](https://math.stackexchange.com/questions/426150/what-is-the-general-equation-of-the-ellipse-that-is-not-in-the-origin-and-rotate)
--
-- \[\dfrac{((x-h)\cos(A)+(y-k)\sin(A))^2}{a^2}+\dfrac{((x-h) \sin(A)-(y-k) \cos(A))^2}{b^2}=1\]
--
-- with the haskell code:
--
-- > c + (rotate phi |. (r * ray theta))
--
-- See also: [wolfram](https://mathworld.wolfram.com/Ellipse.html)
ellipse :: (Direction b a, Affinity b a, TrigField a) => b -> b -> a -> a -> b
ellipse :: b -> b -> a -> a -> b
ellipse b
c b
r a
phi a
theta = b
c b -> b -> b
forall a. Additive a => a -> a -> a
+ (a -> Transform a
forall a. TrigField a => a -> Transform a
rotate a
phi Transform a -> b -> b
forall a b. Affinity a b => Transform b -> a -> a
|. (b
r b -> b -> b
forall a. Multiplicative a => a -> a -> a
* a -> b
forall coord dir. Direction coord dir => dir -> coord
ray a
theta))

-- | compute the bounding box for an arcBox
--
-- > let p = ArcPosition (Point 0 0) (Point 1 0) (ArcInfo (Point 1 0.5) (pi/4) False True)
-- > arcBox p
-- Rect -8.326672684688674e-17 0.9999999999999998 -5.551115123125783e-17 0.30644649676616753
arcBox :: ArcPosition Double -> Rect Double
arcBox :: ArcPosition Double -> Rect Double
arcBox ArcPosition Double
p = [Element (Rect Double)] -> Rect Double
forall s (f :: * -> *).
(Space s, Traversable f) =>
f (Element s) -> s
space1 [Point Double]
[Element (Rect Double)]
pts
  where
    (ArcCentroid Point Double
c Point Double
r Double
phi Double
ang0 Double
angd) = ArcPosition Double -> ArcCentroid Double
forall a.
(FromInteger a, Ord a, TrigField a, ExpField a) =>
ArcPosition a -> ArcCentroid a
arcCentroid ArcPosition Double
p
    (Double
x', Double
y') = Point Double -> Double -> (Double, Double)
arcDerivs Point Double
r Double
phi
    angr :: Range Double
angr = Double
Element (Range Double)
ang0 Element (Range Double) -> Element (Range Double) -> Range Double
forall s. Space s => Element s -> Element s -> s
... (Double
ang0 Double -> Double -> Double
forall a. Additive a => a -> a -> a
+ Double
angd) :: Range Double
    angs :: [Double]
angs =
      (Double -> Bool) -> [Double] -> [Double]
forall a. (a -> Bool) -> [a] -> [a]
filter
        (Element (Range Double) -> Range Double -> Bool
forall s. Space s => Element s -> s -> Bool
|.| Range Double
angr)
        [ Double
x',
          Double
x' Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- Double
2 Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Double
forall a. TrigField a => a
pi,
          Double
x' Double -> Double -> Double
forall a. Additive a => a -> a -> a
+ Double
forall a. TrigField a => a
pi,
          Double
x' Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- Double
forall a. TrigField a => a
pi,
          Double
y',
          Double
y' Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- Double
2 Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Double
forall a. TrigField a => a
pi,
          Double
y' Double -> Double -> Double
forall a. Additive a => a -> a -> a
+ Double
forall a. TrigField a => a
pi,
          Double
y' Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- Double
forall a. TrigField a => a
pi,
          Double
ang0,
          Double
ang0 Double -> Double -> Double
forall a. Additive a => a -> a -> a
+ Double
angd
        ]
    pts :: [Point Double]
pts = Point Double -> Point Double -> Double -> Double -> Point Double
forall b a.
(Direction b a, Affinity b a, TrigField a) =>
b -> b -> a -> a -> b
ellipse Point Double
c Point Double
r Double
phi (Double -> Point Double) -> [Double] -> [Point Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Double]
angs

-- | potential arc turning points.
--
-- >>> arcDerivs (Point 1 0.5) (pi/4)
-- (-0.4636476090008061,0.4636476090008062)
arcDerivs :: Point Double -> Double -> (Double, Double)
arcDerivs :: Point Double -> Double -> (Double, Double)
arcDerivs (Point Double
rx Double
ry) Double
phi = (Double
thetax1, Double
thetay1)
  where
    thetax1 :: Double
thetax1 = Double -> Double -> Double
forall a. TrigField a => a -> a -> a
atan2 (- Double -> Double
forall a. TrigField a => a -> a
sin Double
phi Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Double
ry) (Double -> Double
forall a. TrigField a => a -> a
cos Double
phi Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Double
rx)
    thetay1 :: Double
thetay1 = Double -> Double -> Double
forall a. TrigField a => a -> a -> a
atan2 (Double -> Double
forall a. TrigField a => a -> a
cos Double
phi Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Double
ry) (Double -> Double
forall a. TrigField a => a -> a
sin Double
phi Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Double
rx)

-- * bezier

-- | Quadratic bezier curve expressed in positional terms.
data QuadPosition a = QuadPosition
  { -- | starting point
    QuadPosition a -> Point a
qposStart :: Point a,
    -- | ending point
    QuadPosition a -> Point a
qposEnd :: Point a,
    -- | control point
    QuadPosition a -> Point a
qposControl :: Point a
  }
  deriving (QuadPosition a -> QuadPosition a -> Bool
(QuadPosition a -> QuadPosition a -> Bool)
-> (QuadPosition a -> QuadPosition a -> Bool)
-> Eq (QuadPosition a)
forall a. Eq a => QuadPosition a -> QuadPosition a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: QuadPosition a -> QuadPosition a -> Bool
$c/= :: forall a. Eq a => QuadPosition a -> QuadPosition a -> Bool
== :: QuadPosition a -> QuadPosition a -> Bool
$c== :: forall a. Eq a => QuadPosition a -> QuadPosition a -> Bool
Eq, Int -> QuadPosition a -> ShowS
[QuadPosition a] -> ShowS
QuadPosition a -> String
(Int -> QuadPosition a -> ShowS)
-> (QuadPosition a -> String)
-> ([QuadPosition a] -> ShowS)
-> Show (QuadPosition a)
forall a. Show a => Int -> QuadPosition a -> ShowS
forall a. Show a => [QuadPosition a] -> ShowS
forall a. Show a => QuadPosition a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [QuadPosition a] -> ShowS
$cshowList :: forall a. Show a => [QuadPosition a] -> ShowS
show :: QuadPosition a -> String
$cshow :: forall a. Show a => QuadPosition a -> String
showsPrec :: Int -> QuadPosition a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> QuadPosition a -> ShowS
Show, (forall x. QuadPosition a -> Rep (QuadPosition a) x)
-> (forall x. Rep (QuadPosition a) x -> QuadPosition a)
-> Generic (QuadPosition a)
forall x. Rep (QuadPosition a) x -> QuadPosition a
forall x. QuadPosition a -> Rep (QuadPosition a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (QuadPosition a) x -> QuadPosition a
forall a x. QuadPosition a -> Rep (QuadPosition a) x
$cto :: forall a x. Rep (QuadPosition a) x -> QuadPosition a
$cfrom :: forall a x. QuadPosition a -> Rep (QuadPosition a) x
Generic)

-- | Quadratic bezier curve with control point expressed in polar terms normalised to the start - end line.
data QuadPolar a = QuadPolar
  { -- | starting point
    QuadPolar a -> Point a
qpolStart :: Point a,
    -- | ending point
    QuadPolar a -> Point a
qpolEnd :: Point a,
    -- | control point in terms of distance from and angle to the qp0 - qp2 line
    QuadPolar a -> Polar a a
qpolControl :: Polar a a
  }
  deriving (QuadPolar a -> QuadPolar a -> Bool
(QuadPolar a -> QuadPolar a -> Bool)
-> (QuadPolar a -> QuadPolar a -> Bool) -> Eq (QuadPolar a)
forall a. Eq a => QuadPolar a -> QuadPolar a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: QuadPolar a -> QuadPolar a -> Bool
$c/= :: forall a. Eq a => QuadPolar a -> QuadPolar a -> Bool
== :: QuadPolar a -> QuadPolar a -> Bool
$c== :: forall a. Eq a => QuadPolar a -> QuadPolar a -> Bool
Eq, Int -> QuadPolar a -> ShowS
[QuadPolar a] -> ShowS
QuadPolar a -> String
(Int -> QuadPolar a -> ShowS)
-> (QuadPolar a -> String)
-> ([QuadPolar a] -> ShowS)
-> Show (QuadPolar a)
forall a. Show a => Int -> QuadPolar a -> ShowS
forall a. Show a => [QuadPolar a] -> ShowS
forall a. Show a => QuadPolar a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [QuadPolar a] -> ShowS
$cshowList :: forall a. Show a => [QuadPolar a] -> ShowS
show :: QuadPolar a -> String
$cshow :: forall a. Show a => QuadPolar a -> String
showsPrec :: Int -> QuadPolar a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> QuadPolar a -> ShowS
Show, (forall x. QuadPolar a -> Rep (QuadPolar a) x)
-> (forall x. Rep (QuadPolar a) x -> QuadPolar a)
-> Generic (QuadPolar a)
forall x. Rep (QuadPolar a) x -> QuadPolar a
forall x. QuadPolar a -> Rep (QuadPolar a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (QuadPolar a) x -> QuadPolar a
forall a x. QuadPolar a -> Rep (QuadPolar a) x
$cto :: forall a x. Rep (QuadPolar a) x -> QuadPolar a
$cfrom :: forall a x. QuadPolar a -> Rep (QuadPolar a) x
Generic)

-- | Convert from a positional to a polar representation of a cubic bezier.
--
-- >>> quadPolar (QuadPosition (Point 0 0) (Point 1 1) (Point 2 -1))
-- QuadPolar {qpolStart = Point 0.0 0.0, qpolEnd = Point 1.0 1.0, qpolControl = Polar {magnitude = 2.1213203435596424, direction = -0.7853981633974483}}
quadPolar :: (ExpField a, TrigField a) => QuadPosition a -> QuadPolar a
quadPolar :: QuadPosition a -> QuadPolar a
quadPolar (QuadPosition Point a
start Point a
end Point a
control) = Point a -> Point a -> Polar a a -> QuadPolar a
forall a. Point a -> Point a -> Polar a a -> QuadPolar a
QuadPolar Point a
start Point a
end Polar a a
control'
  where
    mp :: Point a
mp = (Point a
start Point a -> Point a -> Point a
forall a. Additive a => a -> a -> a
+ Point a
end) Point a -> a -> Point a
forall m a. DivisiveAction m a => m -> a -> m
/. a
forall a. (Multiplicative a, Additive a) => a
two
    control' :: Polar a a
control' = Point a -> Polar a a
forall coord mag dir.
(Norm coord mag, Direction coord dir) =>
coord -> Polar mag dir
polar (Point a
control Point a -> Point a -> Point a
forall a. Subtractive a => a -> a -> a
- Point a
mp)

-- | Convert from a polar to a positional representation of a quadratic bezier.
--
-- > quadPosition . quadPolar == id
-- > quadPolar . quadPosition == id
--
-- >>> quadPosition $ quadPolar (QuadPosition (Point 0 0) (Point 1 1) (Point 2 -1))
-- QuadPosition {qposStart = Point 0.0 0.0, qposEnd = Point 1.0 1.0, qposControl = Point 2.0 -0.9999999999999998}
quadPosition :: (ExpField a, TrigField a) => QuadPolar a -> QuadPosition a
quadPosition :: QuadPolar a -> QuadPosition a
quadPosition (QuadPolar Point a
start Point a
end Polar a a
control) = Point a -> Point a -> Point a -> QuadPosition a
forall a. Point a -> Point a -> Point a -> QuadPosition a
QuadPosition Point a
start Point a
end Point a
control'
  where
    control' :: Point a
control' = Polar a a -> Point a
forall coord mag dir.
(MultiplicativeAction coord mag, Direction coord dir) =>
Polar mag dir -> coord
coord Polar a a
control Point a -> Point a -> Point a
forall a. Additive a => a -> a -> a
+ (Point a
start Point a -> Point a -> Point a
forall a. Additive a => a -> a -> a
+ Point a
end) Point a -> a -> Point a
forall m a. DivisiveAction m a => m -> a -> m
/. a
forall a. (Multiplicative a, Additive a) => a
two

-- | The quadratic bezier equation
--
-- >>> quadBezier (QuadPosition (Point 0 0) (Point 1 1) (Point 2 -1)) 0.33333333
-- Point 0.9999999933333332 -0.33333333333333326
quadBezier :: (ExpField a, FromInteger a) => QuadPosition a -> a -> Point a
quadBezier :: QuadPosition a -> a -> Point a
quadBezier (QuadPosition Point a
start Point a
end Point a
control) a
theta =
  (a
1 a -> a -> a
forall a. Subtractive a => a -> a -> a
- a
theta) a -> Int -> a
forall a. Divisive a => a -> Int -> a
^ Int
2 a -> Point a -> Point a
forall m a. MultiplicativeAction m a => a -> m -> m
.* Point a
start
    Point a -> Point a -> Point a
forall a. Additive a => a -> a -> a
+ a
2 a -> a -> a
forall a. Multiplicative a => a -> a -> a
* (a
1 a -> a -> a
forall a. Subtractive a => a -> a -> a
- a
theta) a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
theta a -> Point a -> Point a
forall m a. MultiplicativeAction m a => a -> m -> m
.* Point a
control
    Point a -> Point a -> Point a
forall a. Additive a => a -> a -> a
+ a
theta a -> Int -> a
forall a. Divisive a => a -> Int -> a
^ Int
2 a -> Point a -> Point a
forall m a. MultiplicativeAction m a => a -> m -> m
.* Point a
end

-- | QuadPosition turning points.
--
-- >>> quadDerivs (QuadPosition (Point 0 0) (Point 1 1) (Point 2 -1))
-- [0.6666666666666666,0.3333333333333333]
quadDerivs :: QuadPosition Double -> [Double]
quadDerivs :: QuadPosition Double -> [Double]
quadDerivs (QuadPosition Point Double
start Point Double
end Point Double
control) = [Double
x', Double
y']
  where
    (Point Double
detx Double
dety) = Point Double
start Point Double -> Point Double -> Point Double
forall a. Subtractive a => a -> a -> a
- Double
2 Double -> Point Double -> Point Double
forall m a. MultiplicativeAction m a => a -> m -> m
.* Point Double
control Point Double -> Point Double -> Point Double
forall a. Additive a => a -> a -> a
+ Point Double
end
    x' :: Double
x' = Double -> Double -> Bool -> Double
forall a. a -> a -> Bool -> a
bool ((Point Double -> Double
forall a. Point a -> a
_x Point Double
start Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- Point Double -> Double
forall a. Point a -> a
_x Point Double
control) Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ Double
detx) (Double
2 Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* (Point Double -> Double
forall a. Point a -> a
_x Point Double
control Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- Point Double -> Double
forall a. Point a -> a
_x Point Double
start)) (Double
detx Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
0)
    y' :: Double
y' = Double -> Double -> Bool -> Double
forall a. a -> a -> Bool -> a
bool ((Point Double -> Double
forall a. Point a -> a
_y Point Double
start Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- Point Double -> Double
forall a. Point a -> a
_y Point Double
control) Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ Double
dety) (Double
2 Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* (Point Double -> Double
forall a. Point a -> a
_y Point Double
control Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- Point Double -> Double
forall a. Point a -> a
_y Point Double
start)) (Double
dety Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
0)

-- | Bounding box for a QuadPosition
--
-- >>> quadBox (QuadPosition (Point 0 0) (Point 1 1) (Point 2 -1))
-- Rect 0.0 1.3333333333333335 -0.33333333333333337 1.0
quadBox :: QuadPosition Double -> Rect Double
quadBox :: QuadPosition Double -> Rect Double
quadBox QuadPosition Double
p = [Element (Rect Double)] -> Rect Double
forall s (f :: * -> *).
(Space s, Traversable f) =>
f (Element s) -> s
space1 [Point Double]
[Element (Rect Double)]
pts
  where
    ts :: [Double]
ts = QuadPosition Double -> [Double]
quadDerivs QuadPosition Double
p
    pts :: [Point Double]
pts = QuadPosition Double -> Double -> Point Double
forall a.
(ExpField a, FromInteger a) =>
QuadPosition a -> a -> Point a
quadBezier QuadPosition Double
p (Double -> Point Double) -> [Double] -> [Point Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Double
0, Double
1] [Double] -> [Double] -> [Double]
forall a. Semigroup a => a -> a -> a
<> [Double]
ts)

-- | cubic bezier curve
--
-- Note that the ordering is different to the svg standard.
data CubicPosition a = CubicPosition
  { -- | starting point
    CubicPosition a -> Point a
cposStart :: Point a,
    -- | ending point
    CubicPosition a -> Point a
cposEnd :: Point a,
    -- | control point 1
    CubicPosition a -> Point a
cposControl1 :: Point a,
    -- | control point 2
    CubicPosition a -> Point a
cposControl2 :: Point a
  }
  deriving (CubicPosition a -> CubicPosition a -> Bool
(CubicPosition a -> CubicPosition a -> Bool)
-> (CubicPosition a -> CubicPosition a -> Bool)
-> Eq (CubicPosition a)
forall a. Eq a => CubicPosition a -> CubicPosition a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CubicPosition a -> CubicPosition a -> Bool
$c/= :: forall a. Eq a => CubicPosition a -> CubicPosition a -> Bool
== :: CubicPosition a -> CubicPosition a -> Bool
$c== :: forall a. Eq a => CubicPosition a -> CubicPosition a -> Bool
Eq, Int -> CubicPosition a -> ShowS
[CubicPosition a] -> ShowS
CubicPosition a -> String
(Int -> CubicPosition a -> ShowS)
-> (CubicPosition a -> String)
-> ([CubicPosition a] -> ShowS)
-> Show (CubicPosition a)
forall a. Show a => Int -> CubicPosition a -> ShowS
forall a. Show a => [CubicPosition a] -> ShowS
forall a. Show a => CubicPosition a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CubicPosition a] -> ShowS
$cshowList :: forall a. Show a => [CubicPosition a] -> ShowS
show :: CubicPosition a -> String
$cshow :: forall a. Show a => CubicPosition a -> String
showsPrec :: Int -> CubicPosition a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> CubicPosition a -> ShowS
Show, (forall x. CubicPosition a -> Rep (CubicPosition a) x)
-> (forall x. Rep (CubicPosition a) x -> CubicPosition a)
-> Generic (CubicPosition a)
forall x. Rep (CubicPosition a) x -> CubicPosition a
forall x. CubicPosition a -> Rep (CubicPosition a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (CubicPosition a) x -> CubicPosition a
forall a x. CubicPosition a -> Rep (CubicPosition a) x
$cto :: forall a x. Rep (CubicPosition a) x -> CubicPosition a
$cfrom :: forall a x. CubicPosition a -> Rep (CubicPosition a) x
Generic)

-- | A polar representation of a cubic bezier with control points expressed as polar and normalised to the start - end line.
data CubicPolar a = CubicPolar
  { -- | starting point
    CubicPolar a -> Point a
cpolStart :: Point a,
    -- | ending point
    CubicPolar a -> Point a
cpolEnd :: Point a,
    -- | control point in terms of distance from and angle to the start end line
    CubicPolar a -> Polar a a
cpolControl1 :: Polar a a,
    -- | control point in terms of distance from and angle to the start end line
    CubicPolar a -> Polar a a
cpolControl2 :: Polar a a
  }
  deriving (CubicPolar a -> CubicPolar a -> Bool
(CubicPolar a -> CubicPolar a -> Bool)
-> (CubicPolar a -> CubicPolar a -> Bool) -> Eq (CubicPolar a)
forall a. Eq a => CubicPolar a -> CubicPolar a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CubicPolar a -> CubicPolar a -> Bool
$c/= :: forall a. Eq a => CubicPolar a -> CubicPolar a -> Bool
== :: CubicPolar a -> CubicPolar a -> Bool
$c== :: forall a. Eq a => CubicPolar a -> CubicPolar a -> Bool
Eq, Int -> CubicPolar a -> ShowS
[CubicPolar a] -> ShowS
CubicPolar a -> String
(Int -> CubicPolar a -> ShowS)
-> (CubicPolar a -> String)
-> ([CubicPolar a] -> ShowS)
-> Show (CubicPolar a)
forall a. Show a => Int -> CubicPolar a -> ShowS
forall a. Show a => [CubicPolar a] -> ShowS
forall a. Show a => CubicPolar a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CubicPolar a] -> ShowS
$cshowList :: forall a. Show a => [CubicPolar a] -> ShowS
show :: CubicPolar a -> String
$cshow :: forall a. Show a => CubicPolar a -> String
showsPrec :: Int -> CubicPolar a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> CubicPolar a -> ShowS
Show, (forall x. CubicPolar a -> Rep (CubicPolar a) x)
-> (forall x. Rep (CubicPolar a) x -> CubicPolar a)
-> Generic (CubicPolar a)
forall x. Rep (CubicPolar a) x -> CubicPolar a
forall x. CubicPolar a -> Rep (CubicPolar a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (CubicPolar a) x -> CubicPolar a
forall a x. CubicPolar a -> Rep (CubicPolar a) x
$cto :: forall a x. Rep (CubicPolar a) x -> CubicPolar a
$cfrom :: forall a x. CubicPolar a -> Rep (CubicPolar a) x
Generic)

-- | Convert from a positional to a polar representation of a cubic bezier.
--
-- > cubicPosition . cubicPolar == id
-- > cubicPolar . cubicPosition == id
--
-- >>> cubicPolar (CubicPosition (Point 0 0) (Point 1 1) (Point 1 -1) (Point 0 2))
-- CubicPolar {cpolStart = Point 0.0 0.0, cpolEnd = Point 1.0 1.0, cpolControl1 = Polar {magnitude = 1.1180339887498947, direction = -1.2490457723982544}, cpolControl2 = Polar {magnitude = 1.1180339887498947, direction = 1.8925468811915387}}
cubicPolar :: (ExpField a, TrigField a) => CubicPosition a -> CubicPolar a
cubicPolar :: CubicPosition a -> CubicPolar a
cubicPolar (CubicPosition Point a
start Point a
end Point a
control1 Point a
control2) = Point a -> Point a -> Polar a a -> Polar a a -> CubicPolar a
forall a.
Point a -> Point a -> Polar a a -> Polar a a -> CubicPolar a
CubicPolar Point a
start Point a
end Polar a a
control1' Polar a a
control2'
  where
    mp :: Point a
mp = (Point a
start Point a -> Point a -> Point a
forall a. Additive a => a -> a -> a
+ Point a
end) Point a -> a -> Point a
forall m a. DivisiveAction m a => m -> a -> m
/. a
forall a. (Multiplicative a, Additive a) => a
two
    control1' :: Polar a a
control1' = Point a -> Polar a a
forall coord mag dir.
(Norm coord mag, Direction coord dir) =>
coord -> Polar mag dir
polar (Point a -> Polar a a) -> Point a -> Polar a a
forall a b. (a -> b) -> a -> b
$ (Point a
control1 Point a -> Point a -> Point a
forall a. Subtractive a => a -> a -> a
- Point a
mp) Point a -> a -> Point a
forall m a. DivisiveAction m a => m -> a -> m
/. Point a -> a
forall a b. Norm a b => a -> b
norm (Point a
end Point a -> Point a -> Point a
forall a. Subtractive a => a -> a -> a
- Point a
start)
    control2' :: Polar a a
control2' = Point a -> Polar a a
forall coord mag dir.
(Norm coord mag, Direction coord dir) =>
coord -> Polar mag dir
polar (Point a -> Polar a a) -> Point a -> Polar a a
forall a b. (a -> b) -> a -> b
$ (Point a
control2 Point a -> Point a -> Point a
forall a. Subtractive a => a -> a -> a
- Point a
mp) Point a -> a -> Point a
forall m a. DivisiveAction m a => m -> a -> m
/. Point a -> a
forall a b. Norm a b => a -> b
norm (Point a
end Point a -> Point a -> Point a
forall a. Subtractive a => a -> a -> a
- Point a
start)

-- | Convert from a polar to a positional representation of a cubic bezier.
--
-- > cubicPosition . cubicPolar == id
-- > cubicPolar . cubicPosition == id
--
-- >>> cubicPosition $ cubicPolar (CubicPosition (Point 0 0) (Point 1 1) (Point 1 -1) (Point 0 2))
-- CubicPosition {cposStart = Point 0.0 0.0, cposEnd = Point 1.0 1.0, cposControl1 = Point 1.0 -1.0, cposControl2 = Point 1.6653345369377348e-16 2.0}
cubicPosition :: (ExpField a, TrigField a) => CubicPolar a -> CubicPosition a
cubicPosition :: CubicPolar a -> CubicPosition a
cubicPosition (CubicPolar Point a
start Point a
end Polar a a
control1 Polar a a
control2) = Point a -> Point a -> Point a -> Point a -> CubicPosition a
forall a.
Point a -> Point a -> Point a -> Point a -> CubicPosition a
CubicPosition Point a
start Point a
end Point a
control1' Point a
control2'
  where
    control1' :: Point a
control1' = Point a -> a
forall a b. Norm a b => a -> b
norm (Point a
end Point a -> Point a -> Point a
forall a. Subtractive a => a -> a -> a
- Point a
start) a -> Point a -> Point a
forall m a. MultiplicativeAction m a => a -> m -> m
.* Polar a a -> Point a
forall coord mag dir.
(MultiplicativeAction coord mag, Direction coord dir) =>
Polar mag dir -> coord
coord Polar a a
control1 Point a -> Point a -> Point a
forall a. Additive a => a -> a -> a
+ (Point a
start Point a -> Point a -> Point a
forall a. Additive a => a -> a -> a
+ Point a
end) Point a -> a -> Point a
forall m a. DivisiveAction m a => m -> a -> m
/. a
forall a. (Multiplicative a, Additive a) => a
two
    control2' :: Point a
control2' = Point a -> a
forall a b. Norm a b => a -> b
norm (Point a
end Point a -> Point a -> Point a
forall a. Subtractive a => a -> a -> a
- Point a
start) a -> Point a -> Point a
forall m a. MultiplicativeAction m a => a -> m -> m
.* Polar a a -> Point a
forall coord mag dir.
(MultiplicativeAction coord mag, Direction coord dir) =>
Polar mag dir -> coord
coord Polar a a
control2 Point a -> Point a -> Point a
forall a. Additive a => a -> a -> a
+ (Point a
start Point a -> Point a -> Point a
forall a. Additive a => a -> a -> a
+ Point a
end) Point a -> a -> Point a
forall m a. DivisiveAction m a => m -> a -> m
/. a
forall a. (Multiplicative a, Additive a) => a
two

-- | The cubic bezier equation
--
-- >>> cubicBezier (CubicPosition (Point 0 0) (Point 1 1) (Point 1 -1) (Point 0 2)) 0.8535533905932737
-- Point 0.6767766952966369 1.2071067811865475
cubicBezier :: (ExpField a, FromInteger a) => CubicPosition a -> a -> Point a
cubicBezier :: CubicPosition a -> a -> Point a
cubicBezier (CubicPosition Point a
start Point a
end Point a
control1 Point a
control2) a
theta =
  (a
1 a -> a -> a
forall a. Subtractive a => a -> a -> a
- a
theta) a -> Int -> a
forall a. Divisive a => a -> Int -> a
^ Int
3 a -> Point a -> Point a
forall m a. MultiplicativeAction m a => a -> m -> m
.* Point a
start
    Point a -> Point a -> Point a
forall a. Additive a => a -> a -> a
+ a
3 a -> a -> a
forall a. Multiplicative a => a -> a -> a
* (a
1 a -> a -> a
forall a. Subtractive a => a -> a -> a
- a
theta) a -> Int -> a
forall a. Divisive a => a -> Int -> a
^ Int
2 a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
theta a -> Point a -> Point a
forall m a. MultiplicativeAction m a => a -> m -> m
.* Point a
control1
    Point a -> Point a -> Point a
forall a. Additive a => a -> a -> a
+ a
3 a -> a -> a
forall a. Multiplicative a => a -> a -> a
* (a
1 a -> a -> a
forall a. Subtractive a => a -> a -> a
- a
theta) a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
theta a -> Int -> a
forall a. Divisive a => a -> Int -> a
^ Int
2 a -> Point a -> Point a
forall m a. MultiplicativeAction m a => a -> m -> m
.* Point a
control2
    Point a -> Point a -> Point a
forall a. Additive a => a -> a -> a
+ a
theta a -> Int -> a
forall a. Divisive a => a -> Int -> a
^ Int
3 a -> Point a -> Point a
forall m a. MultiplicativeAction m a => a -> m -> m
.* Point a
end

-- | Turning point positions for a CubicPosition (0,1 or 2)
--
-- >>> cubicDerivs (CubicPosition (Point 0 0) (Point 1 1) (Point 1 -1) (Point 0 2))
-- [0.8535533905932737,0.14644660940672624,0.5]
cubicDerivs :: CubicPosition Double -> [Double]
cubicDerivs :: CubicPosition Double -> [Double]
cubicDerivs
  ( CubicPosition
      (Point Double
c0x Double
c0y)
      (Point Double
c3x Double
c3y)
      (Point Double
c1x Double
c1y)
      (Point Double
c2x Double
c2y)
    ) =
    CubicBezier Double -> [Double]
B.bezierHoriz CubicBezier Double
b [Double] -> [Double] -> [Double]
forall a. Semigroup a => a -> a -> a
<> CubicBezier Double -> [Double]
B.bezierVert CubicBezier Double
b
    where
      b :: CubicBezier Double
b =
        Point Double
-> Point Double
-> Point Double
-> Point Double
-> CubicBezier Double
forall a. Point a -> Point a -> Point a -> Point a -> CubicBezier a
B.CubicBezier
          (Double -> Double -> Point Double
forall a. a -> a -> Point a
B.Point Double
c0x Double
c0y)
          (Double -> Double -> Point Double
forall a. a -> a -> Point a
B.Point Double
c1x Double
c1y)
          (Double -> Double -> Point Double
forall a. a -> a -> Point a
B.Point Double
c2x Double
c2y)
          (Double -> Double -> Point Double
forall a. a -> a -> Point a
B.Point Double
c3x Double
c3y)

-- | Bounding box for a CubicPosition
--
-- >>> cubicBox (CubicPosition (Point 0 0) (Point 1 1) (Point 1 -1) (Point 0 2))
-- Rect 0.0 1.0 -0.20710678118654752 1.2071067811865475
cubicBox :: CubicPosition Double -> Rect Double
cubicBox :: CubicPosition Double -> Rect Double
cubicBox CubicPosition Double
p = [Element (Rect Double)] -> Rect Double
forall s (f :: * -> *).
(Space s, Traversable f) =>
f (Element s) -> s
space1 [Point Double]
[Element (Rect Double)]
pts
  where
    ts :: [Double]
ts = CubicPosition Double -> [Double]
cubicDerivs CubicPosition Double
p
    pts :: [Point Double]
pts =
      CubicPosition Double -> Double -> Point Double
forall a.
(ExpField a, FromInteger a) =>
CubicPosition a -> a -> Point a
cubicBezier CubicPosition Double
p
        (Double -> Point Double) -> [Double] -> [Point Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Double -> Bool) -> [Double] -> [Double]
forall a. (a -> Bool) -> [a] -> [a]
filter
          (Element (Range Double) -> Range Double -> Bool
forall s. Space s => Element s -> s -> Bool
|.| Double -> Double -> Range Double
forall a. a -> a -> Range a
Range Double
0 Double
1)
          ([Double
0, Double
1] [Double] -> [Double] -> [Double]
forall a. Semigroup a => a -> a -> a
<> [Double]
ts)

-- | Bounding box for a list of path XYs.
pathBoxes :: [(PathInfo Double, Point Double)] -> Maybe (Rect Double)
pathBoxes :: [(PathInfo Double, Point Double)] -> Maybe (Rect Double)
pathBoxes [] = Maybe (Rect Double)
forall a. Maybe a
Nothing
pathBoxes ((PathInfo Double, Point Double)
x : [(PathInfo Double, Point Double)]
xs) =
  Fold (PathInfo Double, Point Double) (Maybe (Rect Double))
-> [(PathInfo Double, Point Double)] -> Maybe (Rect Double)
forall (f :: * -> *) a b. Foldable f => Fold a b -> f a -> b
L.fold (((Point Double, Rect Double)
 -> (PathInfo Double, Point Double) -> (Point Double, Rect Double))
-> (Point Double, Rect Double)
-> ((Point Double, Rect Double) -> Maybe (Rect Double))
-> Fold (PathInfo Double, Point Double) (Maybe (Rect Double))
forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
L.Fold (Point Double, Rect Double)
-> (PathInfo Double, Point Double) -> (Point Double, Rect Double)
step (Point Double, Rect Double)
begin (Rect Double -> Maybe (Rect Double)
forall a. a -> Maybe a
Just (Rect Double -> Maybe (Rect Double))
-> ((Point Double, Rect Double) -> Rect Double)
-> (Point Double, Rect Double)
-> Maybe (Rect Double)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Point Double, Rect Double) -> Rect Double
forall a b. (a, b) -> b
snd)) [(PathInfo Double, Point Double)]
xs
  where
    begin :: (Point Double, Rect Double)
    begin :: (Point Double, Rect Double)
begin = ((PathInfo Double, Point Double) -> Point Double
forall a b. (a, b) -> b
snd (PathInfo Double, Point Double)
x, Element (Rect Double) -> Rect Double
forall s. Space s => Element s -> s
singleton ((PathInfo Double, Point Double) -> Point Double
forall a b. (a, b) -> b
snd (PathInfo Double, Point Double)
x))
    step ::
      (Point Double, Rect Double) ->
      (PathInfo Double, Point Double) ->
      (Point Double, Rect Double)
    step :: (Point Double, Rect Double)
-> (PathInfo Double, Point Double) -> (Point Double, Rect Double)
step (Point Double
start, Rect Double
r) (PathInfo Double, Point Double)
a = ((PathInfo Double, Point Double) -> Point Double
forall a b. (a, b) -> b
snd (PathInfo Double, Point Double)
a, Point Double -> (PathInfo Double, Point Double) -> Rect Double
pathBox Point Double
start (PathInfo Double, Point Double)
a Rect Double -> Rect Double -> Rect Double
forall a. Semigroup a => a -> a -> a
<> Rect Double
r)

-- | Bounding box for a path info, start and end Points.
pathBox :: Point Double -> (PathInfo Double, Point Double) -> Rect Double
pathBox :: Point Double -> (PathInfo Double, Point Double) -> Rect Double
pathBox Point Double
start (PathInfo Double
info, Point Double
end) =
  case PathInfo Double
info of
    PathInfo Double
StartI -> Element (Rect Double) -> Rect Double
forall s. Space s => Element s -> s
singleton Point Double
Element (Rect Double)
end
    PathInfo Double
LineI -> [Element (Rect Double)] -> Rect Double
forall s (f :: * -> *).
(Space s, Traversable f) =>
f (Element s) -> s
space1 [Point Double
start, Point Double
end]
    CubicI Point Double
c1 Point Double
c2 -> CubicPosition Double -> Rect Double
cubicBox (Point Double
-> Point Double
-> Point Double
-> Point Double
-> CubicPosition Double
forall a.
Point a -> Point a -> Point a -> Point a -> CubicPosition a
CubicPosition Point Double
start Point Double
end Point Double
c1 Point Double
c2)
    QuadI Point Double
c -> QuadPosition Double -> Rect Double
quadBox (Point Double -> Point Double -> Point Double -> QuadPosition Double
forall a. Point a -> Point a -> Point a -> QuadPosition a
QuadPosition Point Double
start Point Double
end Point Double
c)
    ArcI ArcInfo Double
i -> ArcPosition Double -> Rect Double
arcBox (Point Double
-> Point Double -> ArcInfo Double -> ArcPosition Double
forall a. Point a -> Point a -> ArcInfo a -> ArcPosition a
ArcPosition Point Double
start Point Double
end ArcInfo Double
i)