{-# LANGUAGE BangPatterns         #-}
{-# LANGUAGE UndecidableInstances #-}
--------------------------------------------------------------------------------
-- |
-- Module      :  Data.Geometry.BezierSpline
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
--------------------------------------------------------------------------------
module Data.Geometry.BezierSpline(
    BezierSpline (BezierSpline)
  , controlPoints
  , fromPointSeq

  , evaluate
  , split
  , subBezier
  , tangent
  , approximate
  , parameterOf
  , snap

  , pattern Bezier2, pattern Bezier3

  , colinear
  , lineApproximate
  , quadToCubic
  ) where

import           Control.Lens                 hiding (Empty)
import qualified Data.Foldable                as F
import           Data.Geometry.Line
import           Data.Geometry.Point
import           Data.Geometry.Properties
import           Data.Geometry.Transformation
import           Data.Geometry.Vector
import           Data.LSeq                    (LSeq)
import qualified Data.LSeq                    as LSeq
import           Data.Sequence                (Seq (..))
import qualified Data.Sequence                as Seq
import           Data.Traversable             (fmapDefault, foldMapDefault)
import           GHC.TypeNats
import qualified Test.QuickCheck              as QC

--------------------------------------------------------------------------------

-- | Datatype representing a Bezier curve of degree \(n\) in \(d\)-dimensional space.
newtype BezierSpline n d r = BezierSpline { BezierSpline n d r -> LSeq (1 + n) (Point d r)
_controlPoints :: LSeq (1+n) (Point d r) }
-- makeLenses ''BezierSpline

-- | Bezier control points. With n degrees, there are n+1 control points.
controlPoints :: Iso (BezierSpline n1 d1 r1) (BezierSpline n2 d2 r2) (LSeq (1+n1) (Point d1 r1)) (LSeq (1+n2) (Point d2 r2))
controlPoints :: p (LSeq (1 + n1) (Point d1 r1)) (f (LSeq (1 + n2) (Point d2 r2)))
-> p (BezierSpline n1 d1 r1) (f (BezierSpline n2 d2 r2))
controlPoints = (BezierSpline n1 d1 r1 -> LSeq (1 + n1) (Point d1 r1))
-> (LSeq (1 + n2) (Point d2 r2) -> BezierSpline n2 d2 r2)
-> Iso
     (BezierSpline n1 d1 r1)
     (BezierSpline n2 d2 r2)
     (LSeq (1 + n1) (Point d1 r1))
     (LSeq (1 + n2) (Point d2 r2))
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso BezierSpline n1 d1 r1 -> LSeq (1 + n1) (Point d1 r1)
forall (n :: Nat) (d :: Nat) r.
BezierSpline n d r -> LSeq (1 + n) (Point d r)
_controlPoints LSeq (1 + n2) (Point d2 r2) -> BezierSpline n2 d2 r2
forall (n :: Nat) (d :: Nat) r.
LSeq (1 + n) (Point d r) -> BezierSpline n d r
BezierSpline

-- | Quadratic Bezier Spline
pattern Bezier2      :: Point d r -> Point d r -> Point d r -> BezierSpline 2 d r
pattern $bBezier2 :: Point d r -> Point d r -> Point d r -> BezierSpline 2 d r
$mBezier2 :: forall r (d :: Nat) r.
BezierSpline 2 d r
-> (Point d r -> Point d r -> Point d r -> r) -> (Void# -> r) -> r
Bezier2 p q r <- (F.toList . LSeq.take 3 . _controlPoints -> [p,q,r])
  where
    Bezier2 Point d r
p Point d r
q Point d r
r = Seq (Point d r) -> BezierSpline 2 d r
forall (d :: Nat) r (n :: Nat).
Seq (Point d r) -> BezierSpline n d r
fromPointSeq (Seq (Point d r) -> BezierSpline 2 d r)
-> ([Point d r] -> Seq (Point d r))
-> [Point d r]
-> BezierSpline 2 d r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Point d r] -> Seq (Point d r)
forall a. [a] -> Seq a
Seq.fromList ([Point d r] -> BezierSpline 2 d r)
-> [Point d r] -> BezierSpline 2 d r
forall a b. (a -> b) -> a -> b
$ [Point d r
p,Point d r
q,Point d r
r]
{-# COMPLETE Bezier2 #-}

-- | Cubic Bezier Spline
pattern Bezier3         :: Point d r -> Point d r -> Point d r -> Point d r -> BezierSpline 3 d r
pattern $bBezier3 :: Point d r
-> Point d r -> Point d r -> Point d r -> BezierSpline 3 d r
$mBezier3 :: forall r (d :: Nat) r.
BezierSpline 3 d r
-> (Point d r -> Point d r -> Point d r -> Point d r -> r)
-> (Void# -> r)
-> r
Bezier3 p q r s <- (F.toList . LSeq.take 4 . _controlPoints -> [p,q,r,s])
  where
    Bezier3 Point d r
p Point d r
q Point d r
r Point d r
s = Seq (Point d r) -> BezierSpline 3 d r
forall (d :: Nat) r (n :: Nat).
Seq (Point d r) -> BezierSpline n d r
fromPointSeq (Seq (Point d r) -> BezierSpline 3 d r)
-> ([Point d r] -> Seq (Point d r))
-> [Point d r]
-> BezierSpline 3 d r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Point d r] -> Seq (Point d r)
forall a. [a] -> Seq a
Seq.fromList ([Point d r] -> BezierSpline 3 d r)
-> [Point d r] -> BezierSpline 3 d r
forall a b. (a -> b) -> a -> b
$ [Point d r
p,Point d r
q,Point d r
r,Point d r
s]
{-# COMPLETE Bezier3 #-}

deriving instance (Arity d, Eq r) => Eq (BezierSpline n d r)

type instance Dimension (BezierSpline n d r) = d
type instance NumType   (BezierSpline n d r) = r


instance (Arity n, Arity d, QC.Arbitrary r) => QC.Arbitrary (BezierSpline n d r) where
  arbitrary :: Gen (BezierSpline n d r)
arbitrary = Seq (Point d r) -> BezierSpline n d r
forall (d :: Nat) r (n :: Nat).
Seq (Point d r) -> BezierSpline n d r
fromPointSeq (Seq (Point d r) -> BezierSpline n d r)
-> ([Point d r] -> Seq (Point d r))
-> [Point d r]
-> BezierSpline n d r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Point d r] -> Seq (Point d r)
forall a. [a] -> Seq a
Seq.fromList ([Point d r] -> BezierSpline n d r)
-> Gen [Point d r] -> Gen (BezierSpline n d r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen [Point d r]
forall a. Arbitrary a => Int -> Gen [a]
QC.vector (Natural -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Natural -> Int) -> (C n -> Natural) -> C n -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Natural
1Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
+) (Natural -> Natural) -> (C n -> Natural) -> C n -> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. C n -> Natural
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Natural
natVal (C n -> Int) -> C n -> Int
forall a b. (a -> b) -> a -> b
$ C n
forall (n :: Nat). C n
C @n)

-- | Constructs the Bezier Spline from a given sequence of points.
fromPointSeq :: Seq (Point d r) -> BezierSpline n d r
fromPointSeq :: Seq (Point d r) -> BezierSpline n d r
fromPointSeq = LSeq (1 + n) (Point d r) -> BezierSpline n d r
forall (n :: Nat) (d :: Nat) r.
LSeq (1 + n) (Point d r) -> BezierSpline n d r
BezierSpline (LSeq (1 + n) (Point d r) -> BezierSpline n d r)
-> (Seq (Point d r) -> LSeq (1 + n) (Point d r))
-> Seq (Point d r)
-> BezierSpline n d r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LSeq 0 (Point d r) -> LSeq (1 + n) (Point d r)
forall (m :: Nat) (n :: Nat) a. LSeq m a -> LSeq n a
LSeq.promise (LSeq 0 (Point d r) -> LSeq (1 + n) (Point d r))
-> (Seq (Point d r) -> LSeq 0 (Point d r))
-> Seq (Point d r)
-> LSeq (1 + n) (Point d r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq (Point d r) -> LSeq 0 (Point d r)
forall a. Seq a -> LSeq 0 a
LSeq.fromSeq


instance (Arity d, Show r) => Show (BezierSpline n d r) where
  show :: BezierSpline n d r -> String
show (BezierSpline LSeq (1 + n) (Point d r)
ps) =
    [String] -> String
forall a. Monoid a => [a] -> a
mconcat [ String
"BezierSpline", Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ LSeq (1 + n) (Point d r) -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length LSeq (1 + n) (Point d r)
ps Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1, String
" ", [Point d r] -> String
forall a. Show a => a -> String
show (LSeq (1 + n) (Point d r) -> [Point d r]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList LSeq (1 + n) (Point d r)
ps) ]

instance Arity d => Functor (BezierSpline n d) where
  fmap :: (a -> b) -> BezierSpline n d a -> BezierSpline n d b
fmap = (a -> b) -> BezierSpline n d a -> BezierSpline n d b
forall (t :: * -> *) a b. Traversable t => (a -> b) -> t a -> t b
fmapDefault

instance Arity d => Foldable (BezierSpline n d) where
  foldMap :: (a -> m) -> BezierSpline n d a -> m
foldMap = (a -> m) -> BezierSpline n d a -> m
forall (t :: * -> *) m a.
(Traversable t, Monoid m) =>
(a -> m) -> t a -> m
foldMapDefault

instance Arity d => Traversable (BezierSpline n d) where
  traverse :: (a -> f b) -> BezierSpline n d a -> f (BezierSpline n d b)
traverse a -> f b
f (BezierSpline LSeq (1 + n) (Point d a)
ps) = LSeq (1 + n) (Point d b) -> BezierSpline n d b
forall (n :: Nat) (d :: Nat) r.
LSeq (1 + n) (Point d r) -> BezierSpline n d r
BezierSpline (LSeq (1 + n) (Point d b) -> BezierSpline n d b)
-> f (LSeq (1 + n) (Point d b)) -> f (BezierSpline n d b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Point d a -> f (Point d b))
-> LSeq (1 + n) (Point d a) -> f (LSeq (1 + n) (Point d b))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((a -> f b) -> Point d a -> f (Point d b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f) LSeq (1 + n) (Point d a)
ps

instance (Fractional r, Arity d, Arity (d + 1), Arity n)
          => IsTransformable (BezierSpline n d r) where
  transformBy :: Transformation
  (Dimension (BezierSpline n d r)) (NumType (BezierSpline n d r))
-> BezierSpline n d r -> BezierSpline n d r
transformBy = Transformation
  (Dimension (BezierSpline n d r)) (NumType (BezierSpline n d r))
-> BezierSpline n d r -> BezierSpline n d r
forall (g :: * -> *) r (d :: Nat).
(PointFunctor g, Fractional r, d ~ Dimension (g r), Arity d,
 Arity (d + 1)) =>
Transformation d r -> g r -> g r
transformPointFunctor

instance PointFunctor (BezierSpline n d) where
  pmap :: (Point (Dimension (BezierSpline n d r)) r
 -> Point (Dimension (BezierSpline n d s)) s)
-> BezierSpline n d r -> BezierSpline n d s
pmap Point (Dimension (BezierSpline n d r)) r
-> Point (Dimension (BezierSpline n d s)) s
f = ASetter
  (BezierSpline n d r)
  (BezierSpline n d s)
  (LSeq (1 + n) (Point d r))
  (LSeq (1 + n) (Point d s))
-> (LSeq (1 + n) (Point d r) -> LSeq (1 + n) (Point d s))
-> BezierSpline n d r
-> BezierSpline n d s
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  (BezierSpline n d r)
  (BezierSpline n d s)
  (LSeq (1 + n) (Point d r))
  (LSeq (1 + n) (Point d s))
forall (n1 :: Nat) (d1 :: Nat) r1 (n2 :: Nat) (d2 :: Nat) r2.
Iso
  (BezierSpline n1 d1 r1)
  (BezierSpline n2 d2 r2)
  (LSeq (1 + n1) (Point d1 r1))
  (LSeq (1 + n2) (Point d2 r2))
controlPoints ((Point d r -> Point d s)
-> LSeq (1 + n) (Point d r) -> LSeq (1 + n) (Point d s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Point d r -> Point d s
Point (Dimension (BezierSpline n d r)) r
-> Point (Dimension (BezierSpline n d s)) s
f)

-- | Evaluate a BezierSpline curve at time t in [0, 1]
--
-- pre: \(t \in [0,1]\)
evaluate    :: (Arity d, Ord r, Num r) => BezierSpline n d r -> r -> Point d r
evaluate :: BezierSpline n d r -> r -> Point d r
evaluate BezierSpline n d r
b r
t = Seq (Point d r) -> Point d r
evaluate' (BezierSpline n d r
bBezierSpline n d r
-> Getting (Seq (Point d r)) (BezierSpline n d r) (Seq (Point d r))
-> Seq (Point d r)
forall s a. s -> Getting a s a -> a
^.(LSeq (1 + n) (Point d r)
 -> Const (Seq (Point d r)) (LSeq (1 + n) (Point d r)))
-> BezierSpline n d r
-> Const (Seq (Point d r)) (BezierSpline n d r)
forall (n1 :: Nat) (d1 :: Nat) r1 (n2 :: Nat) (d2 :: Nat) r2.
Iso
  (BezierSpline n1 d1 r1)
  (BezierSpline n2 d2 r2)
  (LSeq (1 + n1) (Point d1 r1))
  (LSeq (1 + n2) (Point d2 r2))
controlPoints((LSeq (1 + n) (Point d r)
  -> Const (Seq (Point d r)) (LSeq (1 + n) (Point d r)))
 -> BezierSpline n d r
 -> Const (Seq (Point d r)) (BezierSpline n d r))
-> ((Seq (Point d r) -> Const (Seq (Point d r)) (Seq (Point d r)))
    -> LSeq (1 + n) (Point d r)
    -> Const (Seq (Point d r)) (LSeq (1 + n) (Point d r)))
-> Getting (Seq (Point d r)) (BezierSpline n d r) (Seq (Point d r))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(LSeq (1 + n) (Point d r) -> Seq (Point d r))
-> (Seq (Point d r) -> Const (Seq (Point d r)) (Seq (Point d r)))
-> LSeq (1 + n) (Point d r)
-> Const (Seq (Point d r)) (LSeq (1 + n) (Point d r))
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to LSeq (1 + n) (Point d r) -> Seq (Point d r)
forall (n :: Nat) a. LSeq n a -> Seq a
LSeq.toSeq)
  where
    evaluate' :: Seq (Point d r) -> Point d r
evaluate' = \case
      (Point d r
p :<| Seq (Point d r)
Empty)  -> Point d r
p
      pts :: Seq (Point d r)
pts@(Point d r
_ :<| Seq (Point d r)
tl) -> let (Seq (Point d r)
ini :|> Point d r
_) = Seq (Point d r)
pts in Seq (Point d r) -> Point d r
evaluate' (Seq (Point d r) -> Point d r) -> Seq (Point d r) -> Point d r
forall a b. (a -> b) -> a -> b
$ (Point d r -> Point d r -> Point d r)
-> Seq (Point d r) -> Seq (Point d r) -> Seq (Point d r)
forall a b c. (a -> b -> c) -> Seq a -> Seq b -> Seq c
Seq.zipWith Point d r -> Point d r -> Point d r
blend Seq (Point d r)
ini Seq (Point d r)
tl
      Seq (Point d r)
_              -> String -> Point d r
forall a. HasCallStack => String -> a
error String
"evaluate: absurd"

    blend :: Point d r -> Point d r -> Point d r
blend Point d r
p Point d r
q = Point d r
p Point d r -> Diff (Point d) r -> Point d r
forall (p :: * -> *) a. (Affine p, Num a) => p a -> Diff p a -> p a
.+^ r
t r -> Vector d r -> Vector d r
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ (Point d r
q Point d r -> Point d r -> Diff (Point d) r
forall (p :: * -> *) a. (Affine p, Num a) => p a -> p a -> Diff p a
.-. Point d r
p)

-- | Tangent to the bezier spline at the starting point.
tangent   :: (Arity d, Num r, 1 <= n) => BezierSpline n d r -> Vector d r
tangent :: BezierSpline n d r -> Vector d r
tangent BezierSpline n d r
b = BezierSpline n d r
bBezierSpline n d r
-> Getting (Endo (Point d r)) (BezierSpline n d r) (Point d r)
-> Point d r
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?!(LSeq (1 + n) (Point d r)
 -> Const (Endo (Point d r)) (LSeq (1 + n) (Point d r)))
-> BezierSpline n d r
-> Const (Endo (Point d r)) (BezierSpline n d r)
forall (n1 :: Nat) (d1 :: Nat) r1 (n2 :: Nat) (d2 :: Nat) r2.
Iso
  (BezierSpline n1 d1 r1)
  (BezierSpline n2 d2 r2)
  (LSeq (1 + n1) (Point d1 r1))
  (LSeq (1 + n2) (Point d2 r2))
controlPoints((LSeq (1 + n) (Point d r)
  -> Const (Endo (Point d r)) (LSeq (1 + n) (Point d r)))
 -> BezierSpline n d r
 -> Const (Endo (Point d r)) (BezierSpline n d r))
-> ((Point d r -> Const (Endo (Point d r)) (Point d r))
    -> LSeq (1 + n) (Point d r)
    -> Const (Endo (Point d r)) (LSeq (1 + n) (Point d r)))
-> Getting (Endo (Point d r)) (BezierSpline n d r) (Point d r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Index (LSeq (1 + n) (Point d r))
-> Traversal'
     (LSeq (1 + n) (Point d r)) (IxValue (LSeq (1 + n) (Point d r)))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index (LSeq (1 + n) (Point d r))
1  Point d r -> Point d r -> Diff (Point d) r
forall (p :: * -> *) a. (Affine p, Num a) => p a -> p a -> Diff p a
.-. BezierSpline n d r
bBezierSpline n d r
-> Getting (Endo (Point d r)) (BezierSpline n d r) (Point d r)
-> Point d r
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?!(LSeq (1 + n) (Point d r)
 -> Const (Endo (Point d r)) (LSeq (1 + n) (Point d r)))
-> BezierSpline n d r
-> Const (Endo (Point d r)) (BezierSpline n d r)
forall (n1 :: Nat) (d1 :: Nat) r1 (n2 :: Nat) (d2 :: Nat) r2.
Iso
  (BezierSpline n1 d1 r1)
  (BezierSpline n2 d2 r2)
  (LSeq (1 + n1) (Point d1 r1))
  (LSeq (1 + n2) (Point d2 r2))
controlPoints((LSeq (1 + n) (Point d r)
  -> Const (Endo (Point d r)) (LSeq (1 + n) (Point d r)))
 -> BezierSpline n d r
 -> Const (Endo (Point d r)) (BezierSpline n d r))
-> ((Point d r -> Const (Endo (Point d r)) (Point d r))
    -> LSeq (1 + n) (Point d r)
    -> Const (Endo (Point d r)) (LSeq (1 + n) (Point d r)))
-> Getting (Endo (Point d r)) (BezierSpline n d r) (Point d r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Index (LSeq (1 + n) (Point d r))
-> Traversal'
     (LSeq (1 + n) (Point d r)) (IxValue (LSeq (1 + n) (Point d r)))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index (LSeq (1 + n) (Point d r))
0

-- | Restrict a Bezier curve to th,e piece between parameters t < u in [0, 1].
subBezier     :: (KnownNat n, Arity d, Ord r, Num r)
              => r -> r -> BezierSpline n d r -> BezierSpline n d r
subBezier :: r -> r -> BezierSpline n d r -> BezierSpline n d r
subBezier r
t r
u = (BezierSpline n d r, BezierSpline n d r) -> BezierSpline n d r
forall a b. (a, b) -> a
fst ((BezierSpline n d r, BezierSpline n d r) -> BezierSpline n d r)
-> (BezierSpline n d r -> (BezierSpline n d r, BezierSpline n d r))
-> BezierSpline n d r
-> BezierSpline n d r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r -> BezierSpline n d r -> (BezierSpline n d r, BezierSpline n d r)
forall (n :: Nat) (d :: Nat) r.
(KnownNat n, Arity d, Ord r, Num r) =>
r -> BezierSpline n d r -> (BezierSpline n d r, BezierSpline n d r)
split r
u (BezierSpline n d r -> (BezierSpline n d r, BezierSpline n d r))
-> (BezierSpline n d r -> BezierSpline n d r)
-> BezierSpline n d r
-> (BezierSpline n d r, BezierSpline n d r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BezierSpline n d r, BezierSpline n d r) -> BezierSpline n d r
forall a b. (a, b) -> b
snd ((BezierSpline n d r, BezierSpline n d r) -> BezierSpline n d r)
-> (BezierSpline n d r -> (BezierSpline n d r, BezierSpline n d r))
-> BezierSpline n d r
-> BezierSpline n d r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r -> BezierSpline n d r -> (BezierSpline n d r, BezierSpline n d r)
forall (n :: Nat) (d :: Nat) r.
(KnownNat n, Arity d, Ord r, Num r) =>
r -> BezierSpline n d r -> (BezierSpline n d r, BezierSpline n d r)
split r
t

-- | Split a Bezier curve at time t in [0, 1] into two pieces.
split :: forall n d r. (KnownNat n, Arity d, Ord r, Num r)
      => r -> BezierSpline n d r -> (BezierSpline n d r, BezierSpline n d r)
split :: r -> BezierSpline n d r -> (BezierSpline n d r, BezierSpline n d r)
split r
t BezierSpline n d r
b | r
t r -> r -> Bool
forall a. Ord a => a -> a -> Bool
< r
0 Bool -> Bool -> Bool
|| r
t r -> r -> Bool
forall a. Ord a => a -> a -> Bool
> r
1 = String -> (BezierSpline n d r, BezierSpline n d r)
forall a. HasCallStack => String -> a
error String
"Split parameter out of bounds."
          | Bool
otherwise      = let n :: Int
n  = Natural -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Natural -> Int) -> Natural -> Int
forall a b. (a -> b) -> a -> b
$ C n -> Natural
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Natural
natVal (C n
forall (n :: Nat). C n
C @n)
                                 ps :: Seq (Point d r)
ps = r -> LSeq (1 + n) (Point d r) -> Seq (Point d r)
forall (d :: Nat) r (n :: Nat).
(Arity d, Ord r, Num r) =>
r -> LSeq n (Point d r) -> Seq (Point d r)
collect r
t (LSeq (1 + n) (Point d r) -> Seq (Point d r))
-> LSeq (1 + n) (Point d r) -> Seq (Point d r)
forall a b. (a -> b) -> a -> b
$ BezierSpline n d r
bBezierSpline n d r
-> Getting
     (LSeq (1 + n) (Point d r))
     (BezierSpline n d r)
     (LSeq (1 + n) (Point d r))
-> LSeq (1 + n) (Point d r)
forall s a. s -> Getting a s a -> a
^.Getting
  (LSeq (1 + n) (Point d r))
  (BezierSpline n d r)
  (LSeq (1 + n) (Point d r))
forall (n1 :: Nat) (d1 :: Nat) r1 (n2 :: Nat) (d2 :: Nat) r2.
Iso
  (BezierSpline n1 d1 r1)
  (BezierSpline n2 d2 r2)
  (LSeq (1 + n1) (Point d1 r1))
  (LSeq (1 + n2) (Point d2 r2))
controlPoints
                             in ( Seq (Point d r) -> BezierSpline n d r
forall (d :: Nat) r (n :: Nat).
Seq (Point d r) -> BezierSpline n d r
fromPointSeq (Seq (Point d r) -> BezierSpline n d r)
-> (Seq (Point d r) -> Seq (Point d r))
-> Seq (Point d r)
-> BezierSpline n d r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Seq (Point d r) -> Seq (Point d r)
forall a. Int -> Seq a -> Seq a
Seq.take (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Seq (Point d r) -> BezierSpline n d r)
-> Seq (Point d r) -> BezierSpline n d r
forall a b. (a -> b) -> a -> b
$ Seq (Point d r)
ps
                                , Seq (Point d r) -> BezierSpline n d r
forall (d :: Nat) r (n :: Nat).
Seq (Point d r) -> BezierSpline n d r
fromPointSeq (Seq (Point d r) -> BezierSpline n d r)
-> (Seq (Point d r) -> Seq (Point d r))
-> Seq (Point d r)
-> BezierSpline n d r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Seq (Point d r) -> Seq (Point d r)
forall a. Int -> Seq a -> Seq a
Seq.drop Int
n       (Seq (Point d r) -> BezierSpline n d r)
-> Seq (Point d r) -> BezierSpline n d r
forall a b. (a -> b) -> a -> b
$ Seq (Point d r)
ps
                                )

collect   :: (Arity d, Ord r, Num r) => r -> LSeq n (Point d r) -> Seq (Point d r)
collect :: r -> LSeq n (Point d r) -> Seq (Point d r)
collect r
t = Seq (Point d r) -> Seq (Point d r)
go (Seq (Point d r) -> Seq (Point d r))
-> (LSeq n (Point d r) -> Seq (Point d r))
-> LSeq n (Point d r)
-> Seq (Point d r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LSeq n (Point d r) -> Seq (Point d r)
forall (n :: Nat) a. LSeq n a -> Seq a
LSeq.toSeq
  where
    go :: Seq (Point d r) -> Seq (Point d r)
go = \case
      ps :: Seq (Point d r)
ps@(Point d r
_ :<| Seq (Point d r)
Empty) -> Seq (Point d r)
ps
      ps :: Seq (Point d r)
ps@(Point d r
p :<| Seq (Point d r)
tl)    -> let (Seq (Point d r)
ini :|> Point d r
q) = Seq (Point d r)
ps in (Point d r
p Point d r -> Seq (Point d r) -> Seq (Point d r)
forall a. a -> Seq a -> Seq a
:<| Seq (Point d r) -> Seq (Point d r)
go ((Point d r -> Point d r -> Point d r)
-> Seq (Point d r) -> Seq (Point d r) -> Seq (Point d r)
forall a b c. (a -> b -> c) -> Seq a -> Seq b -> Seq c
Seq.zipWith Point d r -> Point d r -> Point d r
blend Seq (Point d r)
ini Seq (Point d r)
tl)) Seq (Point d r) -> Point d r -> Seq (Point d r)
forall a. Seq a -> a -> Seq a
:|> Point d r
q
      Seq (Point d r)
_                -> String -> Seq (Point d r)
forall a. HasCallStack => String -> a
error String
"collect: absurd"

    blend :: Point d r -> Point d r -> Point d r
blend Point d r
p Point d r
q = Point d r
p Point d r -> Diff (Point d) r -> Point d r
forall (p :: * -> *) a. (Affine p, Num a) => p a -> Diff p a -> p a
.+^ r
t r -> Vector d r -> Vector d r
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ (Point d r
q Point d r -> Point d r -> Diff (Point d) r
forall (p :: * -> *) a. (Affine p, Num a) => p a -> p a -> Diff p a
.-. Point d r
p)

-- {-

-- -- | Merge to Bezier pieces. Assumes they can be merged into a single piece of the same degree
-- --   (as would e.g. be the case for the result of a 'split' operation).
-- --   Does not test whether this is the case!
-- merge :: (Arity d, Ord r, Num r) => (Bezier d r, Bezier d r) -> Bezier d r

-- -}

-- | Approximate Bezier curve by Polyline with given resolution.
approximate :: forall n d r. (KnownNat n, Arity d, Ord r, Fractional r)
            => r -> BezierSpline n d r -> [Point d r]
approximate :: r -> BezierSpline n d r -> [Point d r]
approximate r
eps BezierSpline n d r
b
    | Point d r -> Point d r -> r
forall r (d :: Nat).
(Num r, Arity d) =>
Point d r -> Point d r -> r
squaredEuclideanDist Point d r
p Point d r
q r -> r -> Bool
forall a. Ord a => a -> a -> Bool
< r
epsr -> Integer -> r
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
2 = [Point d r
p,Point d r
q]
    | Bool
otherwise                        = let (BezierSpline n d r
b1, BezierSpline n d r
b2) = r -> BezierSpline n d r -> (BezierSpline n d r, BezierSpline n d r)
forall (n :: Nat) (d :: Nat) r.
(KnownNat n, Arity d, Ord r, Num r) =>
r -> BezierSpline n d r -> (BezierSpline n d r, BezierSpline n d r)
split r
0.5 BezierSpline n d r
b
                                         in r -> BezierSpline n d r -> [Point d r]
forall (n :: Nat) (d :: Nat) r.
(KnownNat n, Arity d, Ord r, Fractional r) =>
r -> BezierSpline n d r -> [Point d r]
approximate r
eps BezierSpline n d r
b1 [Point d r] -> [Point d r] -> [Point d r]
forall a. [a] -> [a] -> [a]
++ [Point d r] -> [Point d r]
forall a. [a] -> [a]
tail (r -> BezierSpline n d r -> [Point d r]
forall (n :: Nat) (d :: Nat) r.
(KnownNat n, Arity d, Ord r, Fractional r) =>
r -> BezierSpline n d r -> [Point d r]
approximate r
eps BezierSpline n d r
b2)
  where
    p :: Point d r
p = BezierSpline n d r
bBezierSpline n d r
-> Getting (Point d r) (BezierSpline n d r) (Point d r)
-> Point d r
forall s a. s -> Getting a s a -> a
^.(LSeq (1 + n) (Point d r)
 -> Const (Point d r) (LSeq (1 + n) (Point d r)))
-> BezierSpline n d r -> Const (Point d r) (BezierSpline n d r)
forall (n1 :: Nat) (d1 :: Nat) r1 (n2 :: Nat) (d2 :: Nat) r2.
Iso
  (BezierSpline n1 d1 r1)
  (BezierSpline n2 d2 r2)
  (LSeq (1 + n1) (Point d1 r1))
  (LSeq (1 + n2) (Point d2 r2))
controlPoints((LSeq (1 + n) (Point d r)
  -> Const (Point d r) (LSeq (1 + n) (Point d r)))
 -> BezierSpline n d r -> Const (Point d r) (BezierSpline n d r))
-> ((Point d r -> Const (Point d r) (Point d r))
    -> LSeq (1 + n) (Point d r)
    -> Const (Point d r) (LSeq (1 + n) (Point d r)))
-> Getting (Point d r) (BezierSpline n d r) (Point d r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(LSeq (1 + n) (Point d r) -> Point d r)
-> (Point d r -> Const (Point d r) (Point d r))
-> LSeq (1 + n) (Point d r)
-> Const (Point d r) (LSeq (1 + n) (Point d r))
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to LSeq (1 + n) (Point d r) -> Point d r
forall (n :: Nat) a. LSeq (1 + n) a -> a
LSeq.head
    q :: Point d r
q = BezierSpline n d r
bBezierSpline n d r
-> Getting (Point d r) (BezierSpline n d r) (Point d r)
-> Point d r
forall s a. s -> Getting a s a -> a
^.(LSeq (1 + n) (Point d r)
 -> Const (Point d r) (LSeq (1 + n) (Point d r)))
-> BezierSpline n d r -> Const (Point d r) (BezierSpline n d r)
forall (n1 :: Nat) (d1 :: Nat) r1 (n2 :: Nat) (d2 :: Nat) r2.
Iso
  (BezierSpline n1 d1 r1)
  (BezierSpline n2 d2 r2)
  (LSeq (1 + n1) (Point d1 r1))
  (LSeq (1 + n2) (Point d2 r2))
controlPoints((LSeq (1 + n) (Point d r)
  -> Const (Point d r) (LSeq (1 + n) (Point d r)))
 -> BezierSpline n d r -> Const (Point d r) (BezierSpline n d r))
-> ((Point d r -> Const (Point d r) (Point d r))
    -> LSeq (1 + n) (Point d r)
    -> Const (Point d r) (LSeq (1 + n) (Point d r)))
-> Getting (Point d r) (BezierSpline n d r) (Point d r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(LSeq (1 + n) (Point d r) -> Point d r)
-> (Point d r -> Const (Point d r) (Point d r))
-> LSeq (1 + n) (Point d r)
-> Const (Point d r) (LSeq (1 + n) (Point d r))
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to LSeq (1 + n) (Point d r) -> Point d r
forall (n :: Nat) a. LSeq (1 + n) a -> a
LSeq.last

-- | Given a point on (or close to) a Bezier curve, return the corresponding parameter value.
--   (For points far away from the curve, the function will return the parameter value of
--   an approximate locally closest point to the input point.)
parameterOf      :: (Arity d, Ord r, Fractional r) => BezierSpline n d r -> Point d r -> r
parameterOf :: BezierSpline n d r -> Point d r -> r
parameterOf BezierSpline n d r
b Point d r
p = (r -> r) -> r -> r -> r
forall r. (Ord r, Fractional r) => (r -> r) -> r -> r -> r
binarySearch (Point d r -> Point d r -> r
forall (p :: * -> *) a.
(Affine p, Foldable (Diff p), Num a) =>
p a -> p a -> a
qdA Point d r
p (Point d r -> r) -> (r -> Point d r) -> r -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BezierSpline n d r -> r -> Point d r
forall (d :: Nat) r (n :: Nat).
(Arity d, Ord r, Num r) =>
BezierSpline n d r -> r -> Point d r
evaluate BezierSpline n d r
b) r
treshold (r
1 r -> r -> r
forall a. Num a => a -> a -> a
- r
treshold)
  where treshold :: r
treshold = r
0.0001

binarySearch                                    :: (Ord r, Fractional r) => (r -> r) -> r -> r -> r
binarySearch :: (r -> r) -> r -> r -> r
binarySearch r -> r
f r
l r
r | r -> r
forall a. Num a => a -> a
abs (r -> r
f r
l r -> r -> r
forall a. Num a => a -> a -> a
- r -> r
f r
r) r -> r -> Bool
forall a. Ord a => a -> a -> Bool
< r
treshold = r
m
                   | (r -> r) -> r -> r
forall r. Fractional r => (r -> r) -> r -> r
derivative r -> r
f r
m  r -> r -> Bool
forall a. Ord a => a -> a -> Bool
> r
0        = (r -> r) -> r -> r -> r
forall r. (Ord r, Fractional r) => (r -> r) -> r -> r -> r
binarySearch r -> r
f r
l r
m
                   | Bool
otherwise                  = (r -> r) -> r -> r -> r
forall r. (Ord r, Fractional r) => (r -> r) -> r -> r -> r
binarySearch r -> r
f r
m r
r
  where m :: r
m = (r
l r -> r -> r
forall a. Num a => a -> a -> a
+ r
r) r -> r -> r
forall a. Fractional a => a -> a -> a
/ r
2
        treshold :: r
treshold = r
0.0001

derivative     :: Fractional r => (r -> r) -> r -> r
derivative :: (r -> r) -> r -> r
derivative r -> r
f r
x = (r -> r
f (r
x r -> r -> r
forall a. Num a => a -> a -> a
+ r
delta) r -> r -> r
forall a. Num a => a -> a -> a
- r -> r
f r
x) r -> r -> r
forall a. Fractional a => a -> a -> a
/ r
delta
  where delta :: r
delta = r
0.00001

-- | Snap a point close to a Bezier curve to the curve.
snap   :: (Arity d, Ord r, Fractional r) => BezierSpline n d r -> Point d r -> Point d r
snap :: BezierSpline n d r -> Point d r -> Point d r
snap BezierSpline n d r
b = BezierSpline n d r -> r -> Point d r
forall (d :: Nat) r (n :: Nat).
(Arity d, Ord r, Num r) =>
BezierSpline n d r -> r -> Point d r
evaluate BezierSpline n d r
b (r -> Point d r) -> (Point d r -> r) -> Point d r -> Point d r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BezierSpline n d r -> Point d r -> r
forall (d :: Nat) r (n :: Nat).
(Arity d, Ord r, Fractional r) =>
BezierSpline n d r -> Point d r -> r
parameterOf BezierSpline n d r
b

-- If both control points are on the same side of the straight line from the start and end
-- points then the curve is guaranteed to be within 3/4 of the distance from the straight line
-- to the furthest control point.
-- Otherwise, if the control points are on either side of the straight line, the curve is
-- guaranteed to be within 4/9 of the maximum distance from the straight line to a control
-- point.
-- Also: 3/4 * sqrt(v) = sqrt (9/16 * v)
--       4/9 * sqrt(v) = sqrt (16/81 * v)
-- So: 3/4 * sqrt(v) < eps =>
--     sqrt(9/16 * v) < eps =>
--     9/16*v < eps*eps
-- | Return True if the curve is definitely completely covered by a line of thickness
--   twice the given tolerance. May return false negatives but not false positives.
colinear :: (Ord r, Fractional r) => r -> BezierSpline 3 2 r -> Bool
colinear :: r -> BezierSpline 3 2 r -> Bool
colinear r
eps (Bezier3 !Point 2 r
a !Point 2 r
b !Point 2 r
c !Point 2 r
d) = r
sqBound r -> r -> Bool
forall a. Ord a => a -> a -> Bool
< r
epsr -> r -> r
forall a. Num a => a -> a -> a
*r
eps
  where ld :: Point 2 r -> r
ld = (Point 2 r -> Line 2 r -> r) -> Line 2 r -> Point 2 r -> r
forall a b c. (a -> b -> c) -> b -> a -> c
flip Point 2 r -> Line 2 r -> r
forall r (d :: Nat).
(Fractional r, Arity d) =>
Point d r -> Line d r -> r
sqDistanceTo (Point 2 r -> Point 2 r -> Line 2 r
forall r (d :: Nat).
(Num r, Arity d) =>
Point d r -> Point d r -> Line d r
lineThrough Point 2 r
a Point 2 r
d)
        sameSide :: Bool
sameSide = Point 2 r -> Point 2 r -> Point 2 r -> CCW
forall r.
(Ord r, Num r) =>
Point 2 r -> Point 2 r -> Point 2 r -> CCW
ccw Point 2 r
a Point 2 r
d Point 2 r
b CCW -> CCW -> Bool
forall a. Eq a => a -> a -> Bool
== Point 2 r -> Point 2 r -> Point 2 r -> CCW
forall r.
(Ord r, Num r) =>
Point 2 r -> Point 2 r -> Point 2 r -> CCW
ccw Point 2 r
a Point 2 r
d Point 2 r
c
        maxDist :: r
maxDist = r -> r -> r
forall a. Ord a => a -> a -> a
max (Point 2 r -> r
ld Point 2 r
b) (Point 2 r -> r
ld Point 2 r
c)
        sqBound :: r
sqBound
          | Bool
sameSide  = r
9r -> r -> r
forall a. Fractional a => a -> a -> a
/r
16  r -> r -> r
forall a. Num a => a -> a -> a
* r
maxDist
          | Bool
otherwise = r
16r -> r -> r
forall a. Fractional a => a -> a -> a
/r
81 r -> r -> r
forall a. Num a => a -> a -> a
* r
maxDist

-- | Approximate curve as line segments where no point on the curve is further away
--   from the nearest line segment than the given tolerance.
lineApproximate :: (Ord r, Fractional r) => r -> BezierSpline 3 2 r -> [Point 2 r]
lineApproximate :: r -> BezierSpline 3 2 r -> [Point 2 r]
lineApproximate r
eps BezierSpline 3 2 r
bezier
  | r -> BezierSpline 3 2 r -> Bool
forall r. (Ord r, Fractional r) => r -> BezierSpline 3 2 r -> Bool
colinear r
eps BezierSpline 3 2 r
bezier =
    [ BezierSpline 3 2 r
bezierBezierSpline 3 2 r
-> Getting (Point 2 r) (BezierSpline 3 2 r) (Point 2 r)
-> Point 2 r
forall s a. s -> Getting a s a -> a
^.(LSeq 4 (Point 2 r) -> Const (Point 2 r) (LSeq 4 (Point 2 r)))
-> BezierSpline 3 2 r -> Const (Point 2 r) (BezierSpline 3 2 r)
forall (n1 :: Nat) (d1 :: Nat) r1 (n2 :: Nat) (d2 :: Nat) r2.
Iso
  (BezierSpline n1 d1 r1)
  (BezierSpline n2 d2 r2)
  (LSeq (1 + n1) (Point d1 r1))
  (LSeq (1 + n2) (Point d2 r2))
controlPoints((LSeq 4 (Point 2 r) -> Const (Point 2 r) (LSeq 4 (Point 2 r)))
 -> BezierSpline 3 2 r -> Const (Point 2 r) (BezierSpline 3 2 r))
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> LSeq 4 (Point 2 r) -> Const (Point 2 r) (LSeq 4 (Point 2 r)))
-> Getting (Point 2 r) (BezierSpline 3 2 r) (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(LSeq 4 (Point 2 r) -> Point 2 r)
-> (Point 2 r -> Const (Point 2 r) (Point 2 r))
-> LSeq 4 (Point 2 r)
-> Const (Point 2 r) (LSeq 4 (Point 2 r))
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to LSeq 4 (Point 2 r) -> Point 2 r
forall (n :: Nat) a. LSeq (1 + n) a -> a
LSeq.head
    , BezierSpline 3 2 r
bezierBezierSpline 3 2 r
-> Getting (Point 2 r) (BezierSpline 3 2 r) (Point 2 r)
-> Point 2 r
forall s a. s -> Getting a s a -> a
^.(LSeq 4 (Point 2 r) -> Const (Point 2 r) (LSeq 4 (Point 2 r)))
-> BezierSpline 3 2 r -> Const (Point 2 r) (BezierSpline 3 2 r)
forall (n1 :: Nat) (d1 :: Nat) r1 (n2 :: Nat) (d2 :: Nat) r2.
Iso
  (BezierSpline n1 d1 r1)
  (BezierSpline n2 d2 r2)
  (LSeq (1 + n1) (Point d1 r1))
  (LSeq (1 + n2) (Point d2 r2))
controlPoints((LSeq 4 (Point 2 r) -> Const (Point 2 r) (LSeq 4 (Point 2 r)))
 -> BezierSpline 3 2 r -> Const (Point 2 r) (BezierSpline 3 2 r))
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> LSeq 4 (Point 2 r) -> Const (Point 2 r) (LSeq 4 (Point 2 r)))
-> Getting (Point 2 r) (BezierSpline 3 2 r) (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(LSeq 4 (Point 2 r) -> Point 2 r)
-> (Point 2 r -> Const (Point 2 r) (Point 2 r))
-> LSeq 4 (Point 2 r)
-> Const (Point 2 r) (LSeq 4 (Point 2 r))
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to LSeq 4 (Point 2 r) -> Point 2 r
forall (n :: Nat) a. LSeq (1 + n) a -> a
LSeq.last ]
  | Bool
otherwise =
    let (BezierSpline 3 2 r
b1, BezierSpline 3 2 r
b2) = r -> BezierSpline 3 2 r -> (BezierSpline 3 2 r, BezierSpline 3 2 r)
forall (n :: Nat) (d :: Nat) r.
(KnownNat n, Arity d, Ord r, Num r) =>
r -> BezierSpline n d r -> (BezierSpline n d r, BezierSpline n d r)
split r
0.5 BezierSpline 3 2 r
bezier
    in r -> BezierSpline 3 2 r -> [Point 2 r]
forall r.
(Ord r, Fractional r) =>
r -> BezierSpline 3 2 r -> [Point 2 r]
lineApproximate r
eps BezierSpline 3 2 r
b1 [Point 2 r] -> [Point 2 r] -> [Point 2 r]
forall a. [a] -> [a] -> [a]
++ [Point 2 r] -> [Point 2 r]
forall a. [a] -> [a]
tail (r -> BezierSpline 3 2 r -> [Point 2 r]
forall r.
(Ord r, Fractional r) =>
r -> BezierSpline 3 2 r -> [Point 2 r]
lineApproximate r
eps BezierSpline 3 2 r
b2)

-- | Convert a quadratic bezier to a cubic bezier.
quadToCubic :: (Fractional r) => BezierSpline 2 2 r -> BezierSpline 3 2 r
quadToCubic :: BezierSpline 2 2 r -> BezierSpline 3 2 r
quadToCubic (Bezier2 Point 2 r
a Point 2 r
b Point 2 r
c) =
  Point 2 r
-> Point 2 r -> Point 2 r -> Point 2 r -> BezierSpline 3 2 r
forall (d :: Nat) r.
Point d r
-> Point d r -> Point d r -> Point d r -> BezierSpline 3 d r
Bezier3 Point 2 r
a ((r
1r -> r -> r
forall a. Fractional a => a -> a -> a
/r
3)r -> Point 2 r -> Point 2 r
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^(Vector 2 r -> Point 2 r
forall (d :: Nat) r. Vector d r -> Point d r
Point (Point 2 r -> Vector 2 r
forall (d :: Nat) r. Point d r -> Vector d r
toVec Point 2 r
a Vector 2 r -> Vector 2 r -> Vector 2 r
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^+^ r
2r -> Vector 2 r -> Vector 2 r
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^Point 2 r -> Vector 2 r
forall (d :: Nat) r. Point d r -> Vector d r
toVec Point 2 r
b))) ((r
1r -> r -> r
forall a. Fractional a => a -> a -> a
/r
3)r -> Point 2 r -> Point 2 r
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^(Vector 2 r -> Point 2 r
forall (d :: Nat) r. Vector d r -> Point d r
Point (r
2r -> Vector 2 r -> Vector 2 r
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ Point 2 r -> Vector 2 r
forall (d :: Nat) r. Point d r -> Vector d r
toVec Point 2 r
b Vector 2 r -> Vector 2 r -> Vector 2 r
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^+^ Point 2 r -> Vector 2 r
forall (d :: Nat) r. Point d r -> Vector d r
toVec Point 2 r
c))) Point 2 r
c