{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RebindableSyntax #-}
{-# OPTIONS_GHC -Wno-incomplete-patterns #-}

-- | SVG path manipulation
module Data.Path
  ( -- * Svg Paths
    -- $path
    PathData (..),
    pointPath,
    movePath,
    scalePath,
    projectPaths,
    pathBoxes,
    pathBox,

    -- * Path maths
    ArcInfo (..),
    ArcPosition (..),
    ArcCentroid (..),
    arcCentroid,
    arcPosition,
    arcBox,
    arcDerivs,
    ellipse,
    QuadPosition (..),
    QuadPolar (..),
    quadPosition,
    quadPolar,
    quadBox,
    quadBezier,
    quadDerivs,
    CubicPosition (..),
    CubicPolar (..),
    cubicPosition,
    cubicPolar,
    cubicBox,
    cubicBezier,
    cubicDerivs,
    singletonCubic,
    singletonQuad,
    singletonArc,
    singletonPie,
  )
where

import Chart.Data
import qualified Control.Foldl as L
import Control.Monad.State.Lazy
import GHC.Generics
import qualified Geom2D.CubicBezier as B
import NumHask.Prelude

-- $setup
--
-- >>> :set -XOverloadedLabels
-- >>> :set -XOverloadedStrings
-- >>> import Chart
-- >>> import Optics.Core

-- $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 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)

-- | Representation of a single SVG path data point
data PathData a
  = -- | Starting position
    StartP (Point a)
  | -- | line (from previous position)
    LineP (Point a)
  | -- | cubic bezier curve
    CubicP (Point a) (Point a) (Point a)
  | -- | quad bezier curve
    QuadP (Point a) (Point a)
  | -- arc
    ArcP (ArcInfo a) (Point a)
  deriving (Int -> PathData a -> ShowS
forall a. Show a => Int -> PathData a -> ShowS
forall a. Show a => [PathData a] -> ShowS
forall a. Show a => PathData a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PathData a] -> ShowS
$cshowList :: forall a. Show a => [PathData a] -> ShowS
show :: PathData a -> String
$cshow :: forall a. Show a => PathData a -> String
showsPrec :: Int -> PathData a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> PathData a -> ShowS
Show, PathData a -> PathData a -> Bool
forall a. Eq a => PathData a -> PathData a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PathData a -> PathData a -> Bool
$c/= :: forall a. Eq a => PathData a -> PathData a -> Bool
== :: PathData a -> PathData a -> Bool
$c== :: forall a. Eq a => PathData a -> PathData a -> Bool
Eq, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (PathData a) x -> PathData a
forall a x. PathData a -> Rep (PathData a) x
$cto :: forall a x. Rep (PathData a) x -> PathData a
$cfrom :: forall a x. PathData a -> Rep (PathData a) x
Generic)

-- | View the Point part of a PathData
pointPath :: PathData a -> Point a
pointPath :: forall a. PathData a -> Point a
pointPath (StartP Point a
p) = Point a
p
pointPath (LineP Point a
p) = Point a
p
pointPath (CubicP Point a
_ Point a
_ Point a
p) = Point a
p
pointPath (QuadP Point a
_ Point a
p) = Point a
p
pointPath (ArcP ArcInfo a
_ Point a
p) = Point a
p

-- | Move the Point part of a PathData
movePath :: (Additive a) => Point a -> PathData a -> PathData a
movePath :: forall a. Additive a => Point a -> PathData a -> PathData a
movePath Point a
x (StartP Point a
p) = forall a. Point a -> PathData a
StartP (Point a
p forall a. Additive a => a -> a -> a
+ Point a
x)
movePath Point a
x (LineP Point a
p) = forall a. Point a -> PathData a
LineP (Point a
p forall a. Additive a => a -> a -> a
+ Point a
x)
movePath Point a
x (CubicP Point a
c1 Point a
c2 Point a
p) = forall a. Point a -> Point a -> Point a -> PathData a
CubicP (Point a
c1 forall a. Additive a => a -> a -> a
+ Point a
x) (Point a
c2 forall a. Additive a => a -> a -> a
+ Point a
x) (Point a
p forall a. Additive a => a -> a -> a
+ Point a
x)
movePath Point a
x (QuadP Point a
c Point a
p) = forall a. Point a -> Point a -> PathData a
QuadP (Point a
c forall a. Additive a => a -> a -> a
+ Point a
x) (Point a
p forall a. Additive a => a -> a -> a
+ Point a
x)
movePath Point a
x (ArcP ArcInfo a
i Point a
p) = forall a. ArcInfo a -> Point a -> PathData a
ArcP ArcInfo a
i (Point a
p forall a. Additive a => a -> a -> a
+ Point a
x)

-- | Multiplicatively scale a PathData
scalePath :: (Multiplicative a) => a -> PathData a -> PathData a
scalePath :: forall a. Multiplicative a => a -> PathData a -> PathData a
scalePath a
x (StartP Point a
p) = forall a. Point a -> PathData a
StartP (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a
x forall a. Multiplicative a => a -> a -> a
*) Point a
p)
scalePath a
x (LineP Point a
p) = forall a. Point a -> PathData a
LineP (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a
x forall a. Multiplicative a => a -> a -> a
*) Point a
p)
scalePath a
x (CubicP Point a
c1 Point a
c2 Point a
p) = forall a. Point a -> Point a -> Point a -> PathData a
CubicP (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a
x forall a. Multiplicative a => a -> a -> a
*) Point a
c1) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a
x forall a. Multiplicative a => a -> a -> a
*) Point a
c2) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a
x forall a. Multiplicative a => a -> a -> a
*) Point a
p)
scalePath a
x (QuadP Point a
c Point a
p) = forall a. Point a -> Point a -> PathData a
QuadP (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a
x forall a. Multiplicative a => a -> a -> a
*) Point a
c) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a
x forall a. Multiplicative a => a -> a -> a
*) Point a
p)
scalePath a
x (ArcP ArcInfo a
i Point a
p) = forall a. ArcInfo a -> Point a -> PathData a
ArcP ArcInfo a
i (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a
x forall a. Multiplicative a => a -> a -> a
*) Point a
p)

-- | Project a list of connected PathDatas from one Rect (XY plave) to a new one.
projectPaths :: Rect Double -> Rect Double -> [PathData Double] -> [PathData Double]
projectPaths :: Rect Double
-> Rect Double -> [PathData Double] -> [PathData Double]
projectPaths Rect Double
new Rect Double
old [PathData Double]
ps =
  forall a b c. (a -> b -> c) -> b -> a -> c
flip forall s a. State s a -> s -> a
evalState forall a. Additive a => a
zero forall a b. (a -> b) -> a -> b
$
    forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM
      ( \PathData Double
p -> do
          Point Double
x <- forall s (m :: * -> *). MonadState s m => m s
get
          let d :: PathData Double
d = Rect Double
-> Rect Double
-> Point Double
-> PathData Double
-> PathData Double
projectPath Rect Double
new Rect Double
old Point Double
x PathData Double
p
          forall s (m :: * -> *). MonadState s m => s -> m ()
put (forall a. PathData a -> Point a
pointPath PathData Double
d)
          forall (f :: * -> *) a. Applicative f => a -> f a
pure PathData Double
d
      )
      [PathData Double]
ps

-- | Project a PathData from one Rect (XY plave) to a new one.
projectPath ::
  Rect Double ->
  Rect Double ->
  Point Double ->
  PathData Double ->
  PathData Double
projectPath :: Rect Double
-> Rect Double
-> Point Double
-> PathData Double
-> PathData Double
projectPath Rect Double
new Rect Double
old Point Double
_ (CubicP Point Double
c1 Point Double
c2 Point Double
p) =
  forall a. Point a -> Point a -> Point a -> PathData a
CubicP (Rect Double -> Rect Double -> Point Double -> Point Double
projectOnP Rect Double
new Rect Double
old Point Double
c1) (Rect Double -> Rect Double -> Point Double -> Point Double
projectOnP Rect Double
new Rect Double
old Point Double
c2) (Rect Double -> Rect Double -> Point Double -> Point Double
projectOnP Rect Double
new Rect Double
old Point Double
p)
projectPath Rect Double
new Rect Double
old Point Double
_ (QuadP Point Double
c Point Double
p) =
  forall a. Point a -> Point a -> PathData a
QuadP (Rect Double -> Rect Double -> Point Double -> Point Double
projectOnP Rect Double
new Rect Double
old Point Double
c) (Rect Double -> Rect Double -> Point Double -> Point Double
projectOnP Rect Double
new Rect Double
old Point Double
p)
projectPath Rect Double
new Rect Double
old Point Double
p1 (ArcP ArcInfo Double
ai Point Double
p2) = forall a. ArcInfo a -> Point a -> PathData a
ArcP (Rect Double -> Rect Double -> ArcPosition Double -> ArcInfo Double
projectArcPosition Rect Double
new Rect Double
old (forall a. Point a -> Point a -> ArcInfo a -> ArcPosition a
ArcPosition Point Double
p1 Point Double
p2 ArcInfo Double
ai)) (Rect Double -> Rect Double -> Point Double -> Point Double
projectOnP Rect Double
new Rect Double
old Point Double
p2)
projectPath Rect Double
new Rect Double
old Point Double
_ (LineP Point Double
p) = forall a. Point a -> PathData a
LineP (Rect Double -> Rect Double -> Point Double -> Point Double
projectOnP Rect Double
new Rect Double
old Point Double
p)
projectPath Rect Double
new Rect Double
old Point Double
_ (StartP Point Double
p) = forall a. Point a -> PathData a
StartP (Rect Double -> Rect Double -> Point Double -> Point Double
projectOnP Rect Double
new Rect Double
old Point Double
p)

-- | Convert cubic position to path data.
singletonCubic :: CubicPosition Double -> [PathData Double]
singletonCubic :: CubicPosition Double -> [PathData Double]
singletonCubic (CubicPosition Point Double
s Point Double
e Point Double
c1 Point Double
c2) = [forall a. Point a -> PathData a
StartP Point Double
s, forall a. Point a -> Point a -> Point a -> PathData a
CubicP Point Double
c1 Point Double
c2 Point Double
e]

-- | Convert quad position to path data.
singletonQuad :: QuadPosition Double -> [PathData Double]
singletonQuad :: QuadPosition Double -> [PathData Double]
singletonQuad (QuadPosition Point Double
s Point Double
e Point Double
c) = [forall a. Point a -> PathData a
StartP Point Double
s, forall a. Point a -> Point a -> PathData a
QuadP Point Double
c Point Double
e]

-- | Convert arc position to path data.
singletonArc :: ArcPosition Double -> [PathData Double]
singletonArc :: ArcPosition Double -> [PathData Double]
singletonArc (ArcPosition Point Double
s Point Double
e ArcInfo Double
i) = [forall a. Point a -> PathData a
StartP Point Double
s, forall a. ArcInfo a -> Point a -> PathData a
ArcP ArcInfo Double
i Point Double
e]

-- | Convert arc position to a pie slice, with a specific center.
singletonPie :: Point Double -> ArcPosition Double -> [PathData Double]
singletonPie :: Point Double -> ArcPosition Double -> [PathData Double]
singletonPie Point Double
c (ArcPosition Point Double
s Point Double
e ArcInfo Double
i) = [forall a. Point a -> PathData a
StartP Point Double
c, forall a. Point a -> PathData a
LineP Point Double
s, forall a. ArcInfo a -> Point a -> PathData a
ArcP ArcInfo Double
i Point Double
e, forall a. Point a -> PathData a
LineP Point Double
c]

-- * Arc types

-- | Information about an individual arc path.
data ArcInfo a = ArcInfo
  { -- | ellipse radii
    forall a. ArcInfo a -> Point a
radii :: Point a,
    -- | rotation of the ellipse. positive means counter-clockwise (which is different to SVG).
    forall a. ArcInfo a -> a
phi :: a,
    forall a. ArcInfo a -> Bool
large :: Bool,
    -- | sweep means clockwise
    forall a. ArcInfo a -> Bool
clockwise :: Bool
  }
  deriving (ArcInfo a -> ArcInfo a -> Bool
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
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 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
  { forall a. ArcPosition a -> Point a
posStart :: Point a,
    forall a. ArcPosition a -> Point a
posEnd :: Point a,
    forall a. ArcPosition a -> ArcInfo a
posInfo :: ArcInfo a
  }
  deriving (ArcPosition a -> ArcPosition a -> Bool
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
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 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
    forall a. ArcCentroid a -> Point a
centroid :: Point a,
    -- | ellipse radii
    forall a. ArcCentroid a -> Point a
radius :: Point a,
    -- | ellipse rotation
    forall a. ArcCentroid a -> a
cphi :: a,
    -- | starting point angle to the x-axis
    forall a. ArcCentroid a -> a
ang0 :: a,
    -- | difference between ending point angle and starting point angle
    forall a. ArcCentroid a -> a
angdiff :: a
  }
  deriving (ArcCentroid a -> ArcCentroid a -> Bool
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
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 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 :: (Ord a, FromInteger a, TrigField a, ExpField a) => ArcPosition a -> ArcCentroid a
arcCentroid :: forall a.
(Ord a, FromInteger a, TrigField a, ExpField a) =>
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')) = forall a. Point a -> Point a -> a -> a -> a -> ArcCentroid a
ArcCentroid Point a
c (forall a. a -> a -> Point a
Point a
rx a
ry) a
phi' a
ang1 a
angd
  where
    (Point a
x1' a
y1') = forall a. TrigField a => a -> Point a -> Point a
rotateP (-a
phi') ((Point a
p1 forall a. Subtractive a => a -> a -> a
- Point a
p2) forall m a. (MultiplicativeAction m a, Divisive a) => m -> a -> m
/. forall a. (Multiplicative a, Additive a) => a
two)
    (Point a
rx' a
ry') = Point a
rad
    l :: a
l = a
x1' forall a. ExpField a => a -> a -> a
** a
2 forall a. Divisive a => a -> a -> a
/ a
rx' forall a. ExpField a => a -> a -> a
** a
2 forall a. Additive a => a -> a -> a
+ a
y1' forall a. ExpField a => a -> a -> a
** a
2 forall a. Divisive a => a -> a -> a
/ a
ry' forall a. ExpField a => a -> a -> a
** a
2
    (a
rx, a
ry) = forall a. a -> a -> Bool -> a
bool (a
rx', a
ry') (a
rx' forall a. Multiplicative a => a -> a -> a
* forall a. ExpField a => a -> a
sqrt a
l, a
ry' forall a. Multiplicative a => a -> a -> a
* forall a. ExpField a => a -> a
sqrt a
l) (a
l forall a. Ord a => a -> a -> Bool
> a
1)
    snumer :: a
snumer = forall a. Ord a => a -> a -> a
max a
0 forall a b. (a -> b) -> a -> b
$ (a
rx forall a. Multiplicative a => a -> a -> a
* a
rx forall a. Multiplicative a => a -> a -> a
* a
ry forall a. Multiplicative a => a -> a -> a
* a
ry) forall a. Subtractive a => a -> a -> a
- (a
rx forall a. Multiplicative a => a -> a -> a
* a
rx forall a. Multiplicative a => a -> a -> a
* a
y1' forall a. Multiplicative a => a -> a -> a
* a
y1') forall a. Subtractive a => a -> a -> a
- (a
ry forall a. Multiplicative a => a -> a -> a
* a
ry forall a. Multiplicative a => a -> a -> a
* a
x1' forall a. Multiplicative a => a -> a -> a
* a
x1')
    s :: a
s =
      forall a. a -> a -> Bool -> a
bool (-a
1) a
1 (Bool
large' forall a. Eq a => a -> a -> Bool
== Bool
clockwise')
        forall a. Multiplicative a => a -> a -> a
* forall a. ExpField a => a -> a
sqrt
          (a
snumer forall a. Divisive a => a -> a -> a
/ (a
rx forall a. Multiplicative a => a -> a -> a
* a
rx forall a. Multiplicative a => a -> a -> a
* a
y1' forall a. Multiplicative a => a -> a -> a
* a
y1' forall a. Additive a => a -> a -> a
+ a
ry forall a. Multiplicative a => a -> a -> a
* a
ry forall a. Multiplicative a => a -> a -> a
* a
x1' forall a. Multiplicative a => a -> a -> a
* a
x1'))
    cx' :: a
cx' = a
s forall a. Multiplicative a => a -> a -> a
* a
rx forall a. Multiplicative a => a -> a -> a
* a
y1' forall a. Divisive a => a -> a -> a
/ a
ry
    cy' :: a
cy' = a
s forall a. Multiplicative a => a -> a -> a
* (-a
ry) forall a. Multiplicative a => a -> a -> a
* a
x1' forall a. Divisive a => a -> a -> a
/ a
rx
    cx :: a
cx = (a
x1 forall a. Additive a => a -> a -> a
+ a
x2) forall a. Divisive a => a -> a -> a
/ a
2 forall a. Additive a => a -> a -> a
+ forall a. TrigField a => a -> a
cos a
phi' forall a. Multiplicative a => a -> a -> a
* a
cx' forall a. Subtractive a => a -> a -> a
- forall a. TrigField a => a -> a
sin a
phi' forall a. Multiplicative a => a -> a -> a
* a
cy'
    cy :: a
cy = (a
y1 forall a. Additive a => a -> a -> a
+ a
y2) forall a. Divisive a => a -> a -> a
/ a
2 forall a. Additive a => a -> a -> a
+ forall a. TrigField a => a -> a
sin a
phi' forall a. Multiplicative a => a -> a -> a
* a
cx' forall a. Additive a => a -> a -> a
+ forall a. TrigField a => a -> a
cos a
phi' forall a. Multiplicative a => a -> a -> a
* a
cy'
    c :: Point a
c = forall a. a -> a -> Point a
Point a
cx a
cy
    ang1 :: a
ang1 = forall coord dir. Direction coord dir => coord -> dir
angle (forall a. a -> a -> Point a
Point (-(a
cx' forall a. Subtractive a => a -> a -> a
- a
x1') forall a. Divisive a => a -> a -> a
/ a
rx) (-(a
cy' forall a. Subtractive a => a -> a -> a
- a
y1') forall a. Divisive a => a -> a -> a
/ a
ry))
    ang2 :: a
ang2 = forall coord dir. Direction coord dir => coord -> dir
angle (forall a. a -> a -> Point a
Point (-(a
cx' forall a. Additive a => a -> a -> a
+ a
x1') forall a. Divisive a => a -> a -> a
/ a
rx) (-(a
cy' forall a. Additive a => a -> a -> a
+ a
y1') forall a. Divisive a => a -> a -> a
/ a
ry))
    angd' :: a
angd' = a
ang2 forall a. Subtractive a => a -> a -> a
- a
ang1
    angd :: a
angd =
      forall a. a -> a -> Bool -> a
bool a
0 (a
2 forall a. Multiplicative a => a -> a -> a
* forall a. TrigField a => a
pi) (Bool -> Bool
not Bool
clockwise' Bool -> Bool -> Bool
&& a
angd' forall a. Ord a => a -> a -> Bool
< a
0)
        forall a. Additive a => a -> a -> a
+ forall a. a -> a -> Bool -> a
bool a
0 (-a
2 forall a. Multiplicative a => a -> a -> a
* forall a. TrigField a => a
pi) (Bool
clockwise' Bool -> Bool -> Bool
&& a
angd' forall a. Ord a => a -> a -> Bool
> a
0)
        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 :: forall a.
(Ord a, Signed a, TrigField a) =>
ArcCentroid a -> ArcPosition a
arcPosition (ArcCentroid Point a
c Point a
r a
phi' a
ang1 a
angd) =
  forall a. Point a -> Point a -> ArcInfo a -> ArcPosition a
ArcPosition Point a
p1 Point a
p2 (forall a. Point a -> a -> Bool -> Bool -> ArcInfo a
ArcInfo Point a
r a
phi' Bool
large' Bool
clockwise')
  where
    p1 :: Point a
p1 = 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 = 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 forall a. Additive a => a -> a -> a
+ a
angd)
    large' :: Bool
large' = forall a. Signed a => a -> a
abs a
angd forall a. Ord a => a -> a -> Bool
> forall a. TrigField a => a
pi
    clockwise' :: Bool
clockwise' = a
angd forall a. Ord a => a -> a -> Bool
< 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 :: forall b a.
(Direction b a, Affinity b a, TrigField a) =>
b -> b -> a -> a -> b
ellipse b
c b
r a
phi' a
theta = b
c forall a. Additive a => a -> a -> a
+ (forall a. TrigField a => a -> Transform a
rotate a
phi' forall a b. Affinity a b => Transform b -> a -> a
|. (b
r forall a. Multiplicative a => a -> a -> a
* 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)
-- >>> import Data.FormatN
-- >>> fmap (fixed (Just 3)) (arcBox p)
-- Rect "-0.000" "1.000" "-0.000" "0.306"
arcBox :: ArcPosition Double -> Rect Double
arcBox :: ArcPosition Double -> Rect Double
arcBox ArcPosition Double
p = forall s (f :: * -> *).
(Space s, Traversable f) =>
f (Element s) -> s
unsafeSpace1 [Point Double]
pts
  where
    (ArcCentroid Point Double
c Point Double
r Double
phi' Double
ang0' Double
angd) = forall a.
(Ord a, FromInteger 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
ang0' forall s. Space s => Element s -> Element s -> s
... (Double
ang0' forall a. Additive a => a -> a -> a
+ Double
angd) :: Range Double
    angs :: [Double]
angs =
      forall a. (a -> Bool) -> [a] -> [a]
filter
        (forall s. Space s => Element s -> s -> Bool
|.| Range Double
angr)
        [ Double
x',
          Double
x' forall a. Subtractive a => a -> a -> a
- Double
2 forall a. Multiplicative a => a -> a -> a
* forall a. TrigField a => a
pi,
          Double
x' forall a. Additive a => a -> a -> a
+ forall a. TrigField a => a
pi,
          Double
x' forall a. Subtractive a => a -> a -> a
- forall a. TrigField a => a
pi,
          Double
y',
          Double
y' forall a. Subtractive a => a -> a -> a
- Double
2 forall a. Multiplicative a => a -> a -> a
* forall a. TrigField a => a
pi,
          Double
y' forall a. Additive a => a -> a -> a
+ forall a. TrigField a => a
pi,
          Double
y' forall a. Subtractive a => a -> a -> a
- forall a. TrigField a => a
pi,
          Double
ang0',
          Double
ang0' forall a. Additive a => a -> a -> a
+ Double
angd
        ]
    pts :: [Point Double]
pts = 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' 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 = forall a. TrigField a => a -> a -> a
atan2 (-forall a. TrigField a => a -> a
sin Double
phi' forall a. Multiplicative a => a -> a -> a
* Double
ry) (forall a. TrigField a => a -> a
cos Double
phi' forall a. Multiplicative a => a -> a -> a
* Double
rx)
    thetay1 :: Double
thetay1 = forall a. TrigField a => a -> a -> a
atan2 (forall a. TrigField a => a -> a
cos Double
phi' forall a. Multiplicative a => a -> a -> a
* Double
ry) (forall a. TrigField a => a -> a
sin Double
phi' forall a. Multiplicative a => a -> a -> a
* Double
rx)

-- | Quadratic bezier curve expressed in positional terms.
data QuadPosition a = QuadPosition
  { -- | starting point
    forall a. QuadPosition a -> Point a
qposStart :: Point a,
    -- | ending point
    forall a. QuadPosition a -> Point a
qposEnd :: Point a,
    -- | control point
    forall a. QuadPosition a -> Point a
qposControl :: Point a
  }
  deriving (QuadPosition a -> QuadPosition a -> Bool
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
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 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
    forall a. QuadPolar a -> Point a
qpolStart :: Point a,
    -- | ending point
    forall a. QuadPolar a -> Point a
qpolEnd :: Point a,
    -- | control point in terms of distance from and angle to the qp0 - qp2 line
    forall a. QuadPolar a -> Polar a a
qpolControl :: Polar a a
  }
  deriving (QuadPolar a -> QuadPolar a -> Bool
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
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 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 :: (Eq a, TrigField a, ExpField a) => QuadPosition a -> QuadPolar a
quadPolar :: forall a.
(Eq a, TrigField a, ExpField a) =>
QuadPosition a -> QuadPolar a
quadPolar (QuadPosition Point a
start' Point a
end Point a
control) = 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' forall a. Additive a => a -> a -> a
+ Point a
end) forall m a. (MultiplicativeAction m a, Divisive a) => m -> a -> m
/. forall a. (Multiplicative a, Additive a) => a
two
    control' :: Polar a a
control' = forall coord mag dir.
(Norm coord mag, Direction coord dir) =>
coord -> Polar mag dir
polar (Point a
control 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 :: (TrigField a) => QuadPolar a -> QuadPosition a
quadPosition :: forall a. TrigField a => QuadPolar a -> QuadPosition a
quadPosition (QuadPolar Point a
start' Point a
end Polar a a
control) = 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' = forall coord mag dir.
(MultiplicativeAction coord mag, Direction coord dir) =>
Polar mag dir -> coord
coord Polar a a
control forall a. Additive a => a -> a -> a
+ (Point a
start' forall a. Additive a => a -> a -> a
+ Point a
end) forall m a. (MultiplicativeAction m a, Divisive a) => m -> a -> m
/. 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 :: (FromInteger a, ExpField a) => QuadPosition a -> a -> Point a
quadBezier :: forall a.
(FromInteger a, ExpField a) =>
QuadPosition a -> a -> Point a
quadBezier (QuadPosition Point a
start' Point a
end Point a
control) a
theta =
  (a
1 forall a. Subtractive a => a -> a -> a
- a
theta) forall a. Divisive a => a -> Int -> a
^ Int
2 forall m a. MultiplicativeAction m a => a -> m -> m
.* Point a
start'
    forall a. Additive a => a -> a -> a
+ a
2 forall a. Multiplicative a => a -> a -> a
* (a
1 forall a. Subtractive a => a -> a -> a
- a
theta) forall a. Multiplicative a => a -> a -> a
* a
theta forall m a. MultiplicativeAction m a => a -> m -> m
.* Point a
control
    forall a. Additive a => a -> a -> a
+ a
theta forall a. Divisive a => a -> Int -> a
^ Int
2 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' forall a. Subtractive a => a -> a -> a
- Double
2 forall m a. MultiplicativeAction m a => a -> m -> m
.* Point Double
control forall a. Additive a => a -> a -> a
+ Point Double
end
    x' :: Double
x' = forall a. a -> a -> Bool -> a
bool ((forall a. Point a -> a
_x Point Double
start' forall a. Subtractive a => a -> a -> a
- forall a. Point a -> a
_x Point Double
control) forall a. Divisive a => a -> a -> a
/ Double
detx) (Double
2 forall a. Multiplicative a => a -> a -> a
* (forall a. Point a -> a
_x Point Double
control forall a. Subtractive a => a -> a -> a
- forall a. Point a -> a
_x Point Double
start')) (Double
detx forall a. Eq a => a -> a -> Bool
== Double
0)
    y' :: Double
y' = forall a. a -> a -> Bool -> a
bool ((forall a. Point a -> a
_y Point Double
start' forall a. Subtractive a => a -> a -> a
- forall a. Point a -> a
_y Point Double
control) forall a. Divisive a => a -> a -> a
/ Double
dety) (Double
2 forall a. Multiplicative a => a -> a -> a
* (forall a. Point a -> a
_y Point Double
control forall a. Subtractive a => a -> a -> a
- forall a. Point a -> a
_y Point Double
start')) (Double
dety 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 = forall s (f :: * -> *).
(Space s, Traversable f) =>
f (Element s) -> s
unsafeSpace1 [Point Double]
pts
  where
    ts :: [Double]
ts = QuadPosition Double -> [Double]
quadDerivs QuadPosition Double
p
    pts :: [Point Double]
pts = forall a.
(FromInteger a, ExpField a) =>
QuadPosition a -> a -> Point a
quadBezier QuadPosition Double
p forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Double
0, Double
1] 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
    forall a. CubicPosition a -> Point a
cposStart :: Point a,
    -- | ending point
    forall a. CubicPosition a -> Point a
cposEnd :: Point a,
    -- | control point 1
    forall a. CubicPosition a -> Point a
cposControl1 :: Point a,
    -- | control point 2
    forall a. CubicPosition a -> Point a
cposControl2 :: Point a
  }
  deriving (CubicPosition a -> CubicPosition a -> Bool
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
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 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
    forall a. CubicPolar a -> Point a
cpolStart :: Point a,
    -- | ending point
    forall a. CubicPolar a -> Point a
cpolEnd :: Point a,
    -- | control point in terms of distance from and angle to the start end line
    forall a. CubicPolar a -> Polar a a
cpolControl1 :: Polar a a,
    -- | control point in terms of distance from and angle to the start end line
    forall a. CubicPolar a -> Polar a a
cpolControl2 :: Polar a a
  }
  deriving (CubicPolar a -> CubicPolar a -> Bool
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
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 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 :: (Eq a, ExpField a, TrigField a) => CubicPosition a -> CubicPolar a
cubicPolar :: forall a.
(Eq a, ExpField a, TrigField a) =>
CubicPosition a -> CubicPolar a
cubicPolar (CubicPosition Point a
start' Point a
end Point a
control1 Point a
control2) = 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' forall a. Additive a => a -> a -> a
+ Point a
end) forall m a. (MultiplicativeAction m a, Divisive a) => m -> a -> m
/. forall a. (Multiplicative a, Additive a) => a
two
    control1' :: Polar a a
control1' = forall coord mag dir.
(Norm coord mag, Direction coord dir) =>
coord -> Polar mag dir
polar forall a b. (a -> b) -> a -> b
$ (Point a
control1 forall a. Subtractive a => a -> a -> a
- Point a
mp) forall m a. (MultiplicativeAction m a, Divisive a) => m -> a -> m
/. forall a b. Norm a b => a -> b
norm (Point a
end forall a. Subtractive a => a -> a -> a
- Point a
start')
    control2' :: Polar a a
control2' = forall coord mag dir.
(Norm coord mag, Direction coord dir) =>
coord -> Polar mag dir
polar forall a b. (a -> b) -> a -> b
$ (Point a
control2 forall a. Subtractive a => a -> a -> a
- Point a
mp) forall m a. (MultiplicativeAction m a, Divisive a) => m -> a -> m
/. forall a b. Norm a b => a -> b
norm (Point a
end 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 :: (Eq a, TrigField a, ExpField a) => CubicPolar a -> CubicPosition a
cubicPosition :: forall a.
(Eq a, TrigField a, ExpField a) =>
CubicPolar a -> CubicPosition a
cubicPosition (CubicPolar Point a
start' Point a
end Polar a a
control1 Polar a a
control2) = 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' = forall a b. Norm a b => a -> b
norm (Point a
end forall a. Subtractive a => a -> a -> a
- Point a
start') forall m a. MultiplicativeAction m a => a -> m -> m
.* forall coord mag dir.
(MultiplicativeAction coord mag, Direction coord dir) =>
Polar mag dir -> coord
coord Polar a a
control1 forall a. Additive a => a -> a -> a
+ (Point a
start' forall a. Additive a => a -> a -> a
+ Point a
end) forall m a. (MultiplicativeAction m a, Divisive a) => m -> a -> m
/. forall a. (Multiplicative a, Additive a) => a
two
    control2' :: Point a
control2' = forall a b. Norm a b => a -> b
norm (Point a
end forall a. Subtractive a => a -> a -> a
- Point a
start') forall m a. MultiplicativeAction m a => a -> m -> m
.* forall coord mag dir.
(MultiplicativeAction coord mag, Direction coord dir) =>
Polar mag dir -> coord
coord Polar a a
control2 forall a. Additive a => a -> a -> a
+ (Point a
start' forall a. Additive a => a -> a -> a
+ Point a
end) forall m a. (MultiplicativeAction m a, Divisive a) => m -> a -> m
/. 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 :: (FromInteger a, TrigField a) => CubicPosition a -> a -> Point a
cubicBezier :: forall a.
(FromInteger a, TrigField a) =>
CubicPosition a -> a -> Point a
cubicBezier (CubicPosition Point a
start' Point a
end Point a
control1 Point a
control2) a
theta =
  (a
1 forall a. Subtractive a => a -> a -> a
- a
theta) forall a. Divisive a => a -> Int -> a
^ Int
3 forall m a. MultiplicativeAction m a => a -> m -> m
.* Point a
start'
    forall a. Additive a => a -> a -> a
+ a
3 forall a. Multiplicative a => a -> a -> a
* (a
1 forall a. Subtractive a => a -> a -> a
- a
theta) forall a. Divisive a => a -> Int -> a
^ Int
2 forall a. Multiplicative a => a -> a -> a
* a
theta forall m a. MultiplicativeAction m a => a -> m -> m
.* Point a
control1
    forall a. Additive a => a -> a -> a
+ a
3 forall a. Multiplicative a => a -> a -> a
* (a
1 forall a. Subtractive a => a -> a -> a
- a
theta) forall a. Multiplicative a => a -> a -> a
* a
theta forall a. Divisive a => a -> Int -> a
^ Int
2 forall m a. MultiplicativeAction m a => a -> m -> m
.* Point a
control2
    forall a. Additive a => a -> a -> a
+ a
theta forall a. Divisive a => a -> Int -> a
^ Int
3 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 forall a. Semigroup a => a -> a -> a
<> CubicBezier Double -> [Double]
B.bezierVert CubicBezier Double
b
    where
      b :: CubicBezier Double
b =
        forall a. Point a -> Point a -> Point a -> Point a -> CubicBezier a
B.CubicBezier
          (forall a. a -> a -> Point a
B.Point Double
c0x Double
c0y)
          (forall a. a -> a -> Point a
B.Point Double
c1x Double
c1y)
          (forall a. a -> a -> Point a
B.Point Double
c2x Double
c2y)
          (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 = forall s (f :: * -> *).
(Space s, Traversable f) =>
f (Element s) -> s
unsafeSpace1 [Point Double]
pts
  where
    ts :: [Double]
ts = CubicPosition Double -> [Double]
cubicDerivs CubicPosition Double
p
    pts :: [Point Double]
pts =
      forall a.
(FromInteger a, TrigField a) =>
CubicPosition a -> a -> Point a
cubicBezier CubicPosition Double
p
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. (a -> Bool) -> [a] -> [a]
filter
          (forall s. Space s => Element s -> s -> Bool
|.| forall a. a -> a -> Range a
Range Double
0 Double
1)
          ([Double
0, Double
1] forall a. Semigroup a => a -> a -> a
<> [Double]
ts)

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

-- | Bounding box for a path info, start and end Points.
pathBox :: Point Double -> PathData Double -> Rect Double
pathBox :: Point Double -> PathData Double -> Rect Double
pathBox Point Double
start' PathData Double
info =
  case PathData Double
info of
    StartP Point Double
p -> forall s. Space s => Element s -> s
singleton Point Double
p
    LineP Point Double
p -> forall s (f :: * -> *).
(Space s, Traversable f) =>
f (Element s) -> s
unsafeSpace1 [Point Double
start', Point Double
p]
    CubicP Point Double
c1 Point Double
c2 Point Double
p -> CubicPosition Double -> Rect Double
cubicBox (forall a.
Point a -> Point a -> Point a -> Point a -> CubicPosition a
CubicPosition Point Double
start' Point Double
p Point Double
c1 Point Double
c2)
    QuadP Point Double
c Point Double
p -> QuadPosition Double -> Rect Double
quadBox (forall a. Point a -> Point a -> Point a -> QuadPosition a
QuadPosition Point Double
start' Point Double
p Point Double
c)
    ArcP ArcInfo Double
i Point Double
p -> ArcPosition Double -> Rect Double
arcBox (forall a. Point a -> Point a -> ArcInfo a -> ArcPosition a
ArcPosition Point Double
start' Point Double
p ArcInfo Double
i)

-- | project an ArcPosition given new and old Rects
--
-- The radii of the ellipse can be represented as:
--
-- Point rx 0 & Point 0 ry
--
-- These two points are firstly rotated by p and then undergo scaling...
projectArcPosition :: Rect Double -> Rect Double -> ArcPosition Double -> ArcInfo Double
projectArcPosition :: Rect Double -> Rect Double -> ArcPosition Double -> ArcInfo Double
projectArcPosition Rect Double
new Rect Double
old (ArcPosition Point Double
_ Point Double
_ (ArcInfo (Point Double
rx Double
ry) Double
phi' Bool
l Bool
cl)) = forall a. Point a -> a -> Bool -> Bool -> ArcInfo a
ArcInfo (forall a. a -> a -> Point a
Point Double
rx'' Double
ry'') Double
phi' Bool
l Bool
cl
  where
    rx' :: Point Double
rx' = forall a. TrigField a => a -> Point a -> Point a
rotateP Double
phi' (forall a. a -> a -> Point a
Point Double
rx forall a. Additive a => a
zero)
    rx'' :: Double
rx'' = forall a b. Norm a b => a -> b
norm forall a b. (a -> b) -> a -> b
$ Point Double
rx' forall a. Multiplicative a => a -> a -> a
* forall s. (Space s, Subtractive (Element s)) => s -> Element s
width Rect Double
new forall a. Divisive a => a -> a -> a
/ forall s. (Space s, Subtractive (Element s)) => s -> Element s
width Rect Double
old
    ry' :: Point Double
ry' = forall a. TrigField a => a -> Point a -> Point a
rotateP Double
phi' (forall a. a -> a -> Point a
Point forall a. Additive a => a
zero Double
ry)
    ry'' :: Double
ry'' = forall a b. Norm a b => a -> b
norm forall a b. (a -> b) -> a -> b
$ Point Double
ry' forall a. Multiplicative a => a -> a -> a
* forall s. (Space s, Subtractive (Element s)) => s -> Element s
width Rect Double
new forall a. Divisive a => a -> a -> a
/ forall s. (Space s, Subtractive (Element s)) => s -> Element s
width Rect Double
old