{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
module Diagrams.Segment
(
Open, Closed
, Offset(..) , segOffset
, Segment(..), straight, bezier3, bézier3, reverseSegment, mapSegmentVectors
, openLinear, openCubic
, FixedSegment(..)
, mkFixedSeg, fromFixedSeg
, fixedSegIso
, SegCount(..)
, ArcLength(..)
, getArcLengthCached, getArcLengthFun, getArcLengthBounded
, TotalOffset(..)
, OffsetEnvelope(..), oeOffset, oeEnvelope
, SegMeasure
) where
import Control.Lens hiding (at, transform)
import Data.FingerTree
import Data.Monoid.MList
import Data.Semigroup
import Numeric.Interval.Kaucher (Interval (..))
import qualified Numeric.Interval.Kaucher as I
import Linear.Affine
import Linear.Metric
import Linear.Vector
import Control.Applicative
import Diagrams.Core hiding (Measured)
import Diagrams.Located
import Diagrams.Parametric
import Diagrams.Solve.Polynomial
import Data.Serialize (Serialize)
import qualified Data.Serialize as Serialize
data Open
data Closed
data Offset c v n where
OffsetOpen :: Offset Open v n
OffsetClosed :: v n -> Offset Closed v n
deriving instance Show (v n) => Show (Offset c v n)
deriving instance Eq (v n) => Eq (Offset c v n)
deriving instance Ord (v n) => Ord (Offset c v n)
instance Functor v => Functor (Offset c v) where
fmap :: forall a b. (a -> b) -> Offset c v a -> Offset c v b
fmap a -> b
_ Offset c v a
OffsetOpen = forall (v :: * -> *) n. Offset Open v n
OffsetOpen
fmap a -> b
f (OffsetClosed v a
v) = forall (v :: * -> *) n. v n -> Offset Closed v n
OffsetClosed (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f v a
v)
instance Each (Offset c v n) (Offset c v' n') (v n) (v' n') where
each :: Traversal (Offset c v n) (Offset c v' n') (v n) (v' n')
each v n -> f (v' n')
f (OffsetClosed v n
v) = forall (v :: * -> *) n. v n -> Offset Closed v n
OffsetClosed forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> v n -> f (v' n')
f v n
v
each v n -> f (v' n')
_ Offset c v n
OffsetOpen = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (v :: * -> *) n. Offset Open v n
OffsetOpen
{-# INLINE each #-}
instance (Additive v, Num n) => Reversing (Offset c v n) where
reversing :: Offset c v n -> Offset c v n
reversing (OffsetClosed v n
off) = forall (v :: * -> *) n. v n -> Offset Closed v n
OffsetClosed forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. (Functor f, Num a) => f a -> f a
negated v n
off
reversing a :: Offset c v n
a@Offset c v n
OffsetOpen = Offset c v n
a
type instance V (Offset c v n) = v
type instance N (Offset c v n) = n
instance Transformable (Offset c v n) where
transform :: Transformation (V (Offset c v n)) (N (Offset c v n))
-> Offset c v n -> Offset c v n
transform Transformation (V (Offset c v n)) (N (Offset c v n))
_ Offset c v n
OffsetOpen = forall (v :: * -> *) n. Offset Open v n
OffsetOpen
transform Transformation (V (Offset c v n)) (N (Offset c v n))
t (OffsetClosed v n
v) = forall (v :: * -> *) n. v n -> Offset Closed v n
OffsetClosed (forall (v :: * -> *) n. Transformation v n -> v n -> v n
apply Transformation (V (Offset c v n)) (N (Offset c v n))
t v n
v)
data Segment c v n
= Linear !(Offset c v n)
| Cubic !(v n) !(v n) !(Offset c v n)
deriving (forall a b. a -> Segment c v b -> Segment c v a
forall a b. (a -> b) -> Segment c v a -> Segment c v b
forall c (v :: * -> *) a b.
Functor v =>
a -> Segment c v b -> Segment c v a
forall c (v :: * -> *) a b.
Functor v =>
(a -> b) -> Segment c v a -> Segment c v b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Segment c v b -> Segment c v a
$c<$ :: forall c (v :: * -> *) a b.
Functor v =>
a -> Segment c v b -> Segment c v a
fmap :: forall a b. (a -> b) -> Segment c v a -> Segment c v b
$cfmap :: forall c (v :: * -> *) a b.
Functor v =>
(a -> b) -> Segment c v a -> Segment c v b
Functor, Segment c v n -> Segment c v n -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall c (v :: * -> *) n.
Eq (v n) =>
Segment c v n -> Segment c v n -> Bool
/= :: Segment c v n -> Segment c v n -> Bool
$c/= :: forall c (v :: * -> *) n.
Eq (v n) =>
Segment c v n -> Segment c v n -> Bool
== :: Segment c v n -> Segment c v n -> Bool
$c== :: forall c (v :: * -> *) n.
Eq (v n) =>
Segment c v n -> Segment c v n -> Bool
Eq, Segment c v n -> Segment c v n -> Bool
Segment c v n -> Segment c v n -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {c} {v :: * -> *} {n}. Ord (v n) => Eq (Segment c v n)
forall c (v :: * -> *) n.
Ord (v n) =>
Segment c v n -> Segment c v n -> Bool
forall c (v :: * -> *) n.
Ord (v n) =>
Segment c v n -> Segment c v n -> Ordering
forall c (v :: * -> *) n.
Ord (v n) =>
Segment c v n -> Segment c v n -> Segment c v n
min :: Segment c v n -> Segment c v n -> Segment c v n
$cmin :: forall c (v :: * -> *) n.
Ord (v n) =>
Segment c v n -> Segment c v n -> Segment c v n
max :: Segment c v n -> Segment c v n -> Segment c v n
$cmax :: forall c (v :: * -> *) n.
Ord (v n) =>
Segment c v n -> Segment c v n -> Segment c v n
>= :: Segment c v n -> Segment c v n -> Bool
$c>= :: forall c (v :: * -> *) n.
Ord (v n) =>
Segment c v n -> Segment c v n -> Bool
> :: Segment c v n -> Segment c v n -> Bool
$c> :: forall c (v :: * -> *) n.
Ord (v n) =>
Segment c v n -> Segment c v n -> Bool
<= :: Segment c v n -> Segment c v n -> Bool
$c<= :: forall c (v :: * -> *) n.
Ord (v n) =>
Segment c v n -> Segment c v n -> Bool
< :: Segment c v n -> Segment c v n -> Bool
$c< :: forall c (v :: * -> *) n.
Ord (v n) =>
Segment c v n -> Segment c v n -> Bool
compare :: Segment c v n -> Segment c v n -> Ordering
$ccompare :: forall c (v :: * -> *) n.
Ord (v n) =>
Segment c v n -> Segment c v n -> Ordering
Ord)
instance Show (v n) => Show (Segment c v n) where
showsPrec :: Int -> Segment c v n -> ShowS
showsPrec Int
d Segment c v n
seg = case Segment c v n
seg of
Linear (OffsetClosed v n
v) -> Bool -> ShowS -> ShowS
showParen (Int
d forall a. Ord a => a -> a -> Bool
> Int
10) forall a b. (a -> b) -> a -> b
$
String -> ShowS
showString String
"straight " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 v n
v
Cubic v n
v1 v n
v2 (OffsetClosed v n
v3) -> Bool -> ShowS -> ShowS
showParen (Int
d forall a. Ord a => a -> a -> Bool
> Int
10) forall a b. (a -> b) -> a -> b
$
String -> ShowS
showString String
"bézier3 " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 v n
v1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' '
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 v n
v2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' '
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 v n
v3
Linear Offset c v n
OffsetOpen -> String -> ShowS
showString String
"openLinear"
Cubic v n
v1 v n
v2 Offset c v n
OffsetOpen -> Bool -> ShowS -> ShowS
showParen (Int
d forall a. Ord a => a -> a -> Bool
> Int
10) forall a b. (a -> b) -> a -> b
$
String -> ShowS
showString String
"openCubic " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 v n
v1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' '
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 v n
v2
instance Each (Segment c v n) (Segment c v' n') (v n) (v' n') where
each :: Traversal (Segment c v n) (Segment c v' n') (v n) (v' n')
each v n -> f (v' n')
f (Linear Offset c v n
offset) = forall c (v :: * -> *) n. Offset c v n -> Segment c v n
Linear forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s t a b. Each s t a b => Traversal s t a b
each v n -> f (v' n')
f Offset c v n
offset
each v n -> f (v' n')
f (Cubic v n
v1 v n
v2 Offset c v n
offset) = forall c (v :: * -> *) n.
v n -> v n -> Offset c v n -> Segment c v n
Cubic forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> v n -> f (v' n')
f v n
v1 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> v n -> f (v' n')
f v n
v2 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall s t a b. Each s t a b => Traversal s t a b
each v n -> f (v' n')
f Offset c v n
offset
{-# INLINE each #-}
instance (Additive v, Num n) => Reversing (Segment Closed v n) where
reversing :: Segment Closed v n -> Segment Closed v n
reversing = forall n (v :: * -> *).
(Num n, Additive v) =>
Segment Closed v n -> Segment Closed v n
reverseSegment
mapSegmentVectors :: (v n -> v' n') -> Segment c v n -> Segment c v' n'
mapSegmentVectors :: forall (v :: * -> *) n (v' :: * -> *) n' c.
(v n -> v' n') -> Segment c v n -> Segment c v' n'
mapSegmentVectors = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over forall s t a b. Each s t a b => Traversal s t a b
each
type instance V (Segment c v n) = v
type instance N (Segment c v n) = n
instance Transformable (Segment c v n) where
transform :: Transformation (V (Segment c v n)) (N (Segment c v n))
-> Segment c v n -> Segment c v n
transform = forall (v :: * -> *) n (v' :: * -> *) n' c.
(v n -> v' n') -> Segment c v n -> Segment c v' n'
mapSegmentVectors forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (v :: * -> *) n. Transformation v n -> v n -> v n
apply
instance Renderable (Segment c v n) NullBackend where
render :: NullBackend
-> Segment c v n
-> Render NullBackend (V (Segment c v n)) (N (Segment c v n))
render NullBackend
_ Segment c v n
_ = forall a. Monoid a => a
mempty
straight :: v n -> Segment Closed v n
straight :: forall (v :: * -> *) n. v n -> Segment Closed v n
straight = forall c (v :: * -> *) n. Offset c v n -> Segment c v n
Linear forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (v :: * -> *) n. v n -> Offset Closed v n
OffsetClosed
bezier3 :: v n -> v n -> v n -> Segment Closed v n
bezier3 :: forall (v :: * -> *) n. v n -> v n -> v n -> Segment Closed v n
bezier3 v n
c1 v n
c2 v n
x = forall c (v :: * -> *) n.
v n -> v n -> Offset c v n -> Segment c v n
Cubic v n
c1 v n
c2 (forall (v :: * -> *) n. v n -> Offset Closed v n
OffsetClosed v n
x)
bézier3 :: v n -> v n -> v n -> Segment Closed v n
bézier3 :: forall (v :: * -> *) n. v n -> v n -> v n -> Segment Closed v n
bézier3 = forall (v :: * -> *) n. v n -> v n -> v n -> Segment Closed v n
bezier3
type instance Codomain (Segment Closed v n) = v
instance (Additive v, Num n) => Parametric (Segment Closed v n) where
atParam :: Segment Closed v n
-> N (Segment Closed v n)
-> Codomain (Segment Closed v n) (N (Segment Closed v n))
atParam (Linear (OffsetClosed v n
x)) N (Segment Closed v n)
t = N (Segment Closed v n)
t forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ v n
x
atParam (Cubic v n
c1 v n
c2 (OffsetClosed v n
x2)) N (Segment Closed v n)
t = (n
3 forall a. Num a => a -> a -> a
* n
t'forall a. Num a => a -> a -> a
*n
t'forall a. Num a => a -> a -> a
*N (Segment Closed v n)
t ) forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ v n
c1
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^+^ (n
3 forall a. Num a => a -> a -> a
* n
t'forall a. Num a => a -> a -> a
*N (Segment Closed v n)
t forall a. Num a => a -> a -> a
*N (Segment Closed v n)
t ) forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ v n
c2
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^+^ ( N (Segment Closed v n)
t forall a. Num a => a -> a -> a
*N (Segment Closed v n)
t forall a. Num a => a -> a -> a
*N (Segment Closed v n)
t ) forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ v n
x2
where t' :: n
t' = n
1forall a. Num a => a -> a -> a
-N (Segment Closed v n)
t
instance Num n => DomainBounds (Segment Closed v n)
instance (Additive v, Num n) => EndValues (Segment Closed v n) where
atStart :: Segment Closed v n
-> Codomain (Segment Closed v n) (N (Segment Closed v n))
atStart = forall a b. a -> b -> a
const forall (f :: * -> *) a. (Additive f, Num a) => f a
zero
atEnd :: Segment Closed v n
-> Codomain (Segment Closed v n) (N (Segment Closed v n))
atEnd (Linear (OffsetClosed v n
v)) = v n
v
atEnd (Cubic v n
_ v n
_ (OffsetClosed v n
v)) = v n
v
segOffset :: Segment Closed v n -> v n
segOffset :: forall (v :: * -> *) n. Segment Closed v n -> v n
segOffset (Linear (OffsetClosed v n
v)) = v n
v
segOffset (Cubic v n
_ v n
_ (OffsetClosed v n
v)) = v n
v
openLinear :: Segment Open v n
openLinear :: forall (v :: * -> *) n. Segment Open v n
openLinear = forall c (v :: * -> *) n. Offset c v n -> Segment c v n
Linear forall (v :: * -> *) n. Offset Open v n
OffsetOpen
openCubic :: v n -> v n -> Segment Open v n
openCubic :: forall (v :: * -> *) n. v n -> v n -> Segment Open v n
openCubic v n
v1 v n
v2 = forall c (v :: * -> *) n.
v n -> v n -> Offset c v n -> Segment c v n
Cubic v n
v1 v n
v2 forall (v :: * -> *) n. Offset Open v n
OffsetOpen
instance (Metric v, OrderedField n) => Enveloped (Segment Closed v n) where
getEnvelope :: Segment Closed v n
-> Envelope (V (Segment Closed v n)) (N (Segment Closed v n))
getEnvelope (s :: Segment Closed v n
s@(Linear {})) = forall (v :: * -> *) n. (v n -> n) -> Envelope v n
mkEnvelope forall a b. (a -> b) -> a -> b
$ \V (Segment Closed v n) (N (Segment Closed v n))
v ->
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (forall a b. (a -> b) -> [a] -> [b]
map (\n
t -> (Segment Closed v n
s forall p. Parametric p => p -> N p -> Codomain p (N p)
`atParam` n
t) forall (f :: * -> *) a. (Metric f, Num a) => f a -> f a -> a
`dot` V (Segment Closed v n) (N (Segment Closed v n))
v) [n
0,n
1]) forall a. Fractional a => a -> a -> a
/ forall (f :: * -> *) a. (Metric f, Num a) => f a -> a
quadrance V (Segment Closed v n) (N (Segment Closed v n))
v
getEnvelope (s :: Segment Closed v n
s@(Cubic v n
c1 v n
c2 (OffsetClosed v n
x2))) = forall (v :: * -> *) n. (v n -> n) -> Envelope v n
mkEnvelope forall a b. (a -> b) -> a -> b
$ \V (Segment Closed v n) (N (Segment Closed v n))
v ->
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall a b. (a -> b) -> [a] -> [b]
map (\n
t -> ((Segment Closed v n
s forall p. Parametric p => p -> N p -> Codomain p (N p)
`atParam` n
t) forall (f :: * -> *) a. (Metric f, Num a) => f a -> f a -> a
`dot` V (Segment Closed v n) (N (Segment Closed v n))
v) forall a. Fractional a => a -> a -> a
/ forall (f :: * -> *) a. (Metric f, Num a) => f a -> a
quadrance V (Segment Closed v n) (N (Segment Closed v n))
v) forall a b. (a -> b) -> a -> b
$
[n
0,n
1] forall a. [a] -> [a] -> [a]
++
forall a. (a -> Bool) -> [a] -> [a]
filter (forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Bool -> Bool -> Bool
(&&) (forall a. Ord a => a -> a -> Bool
>n
0) (forall a. Ord a => a -> a -> Bool
<n
1))
(forall d. (Floating d, Ord d) => d -> d -> d -> [d]
quadForm (n
3 forall a. Num a => a -> a -> a
* ((n
3 forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ v n
c1 forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^-^ n
3 forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ v n
c2 forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^+^ v n
x2) forall (f :: * -> *) a. (Metric f, Num a) => f a -> f a -> a
`dot` V (Segment Closed v n) (N (Segment Closed v n))
v))
(n
6 forall a. Num a => a -> a -> a
* (((-n
2) forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ v n
c1 forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^+^ v n
c2) forall (f :: * -> *) a. (Metric f, Num a) => f a -> f a -> a
`dot` V (Segment Closed v n) (N (Segment Closed v n))
v))
((n
3 forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ v n
c1) forall (f :: * -> *) a. (Metric f, Num a) => f a -> f a -> a
`dot` V (Segment Closed v n) (N (Segment Closed v n))
v))
instance (Additive v, Fractional n) => Sectionable (Segment Closed v n) where
splitAtParam :: Segment Closed v n
-> N (Segment Closed v n)
-> (Segment Closed v n, Segment Closed v n)
splitAtParam (Linear (OffsetClosed v n
x1)) N (Segment Closed v n)
t = (Segment Closed v n
left, Segment Closed v n
right)
where left :: Segment Closed v n
left = forall (v :: * -> *) n. v n -> Segment Closed v n
straight v n
p
right :: Segment Closed v n
right = forall (v :: * -> *) n. v n -> Segment Closed v n
straight (v n
x1 forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^-^ v n
p)
p :: v n
p = forall (f :: * -> *) a.
(Additive f, Num a) =>
a -> f a -> f a -> f a
lerp N (Segment Closed v n)
t v n
x1 forall (f :: * -> *) a. (Additive f, Num a) => f a
zero
splitAtParam (Cubic v n
c1 v n
c2 (OffsetClosed v n
x2)) N (Segment Closed v n)
t = (Segment Closed v n
left, Segment Closed v n
right)
where left :: Segment Closed v n
left = forall (v :: * -> *) n. v n -> v n -> v n -> Segment Closed v n
bezier3 v n
a v n
b v n
e
right :: Segment Closed v n
right = forall (v :: * -> *) n. v n -> v n -> v n -> Segment Closed v n
bezier3 (v n
c forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^-^ v n
e) (v n
d forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^-^ v n
e) (v n
x2 forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^-^ v n
e)
p :: v n
p = forall (f :: * -> *) a.
(Additive f, Num a) =>
a -> f a -> f a -> f a
lerp N (Segment Closed v n)
t v n
c2 v n
c1
a :: v n
a = forall (f :: * -> *) a.
(Additive f, Num a) =>
a -> f a -> f a -> f a
lerp N (Segment Closed v n)
t v n
c1 forall (f :: * -> *) a. (Additive f, Num a) => f a
zero
b :: v n
b = forall (f :: * -> *) a.
(Additive f, Num a) =>
a -> f a -> f a -> f a
lerp N (Segment Closed v n)
t v n
p v n
a
d :: v n
d = forall (f :: * -> *) a.
(Additive f, Num a) =>
a -> f a -> f a -> f a
lerp N (Segment Closed v n)
t v n
x2 v n
c2
c :: v n
c = forall (f :: * -> *) a.
(Additive f, Num a) =>
a -> f a -> f a -> f a
lerp N (Segment Closed v n)
t v n
d v n
p
e :: v n
e = forall (f :: * -> *) a.
(Additive f, Num a) =>
a -> f a -> f a -> f a
lerp N (Segment Closed v n)
t v n
c v n
b
reverseDomain :: Segment Closed v n -> Segment Closed v n
reverseDomain = forall n (v :: * -> *).
(Num n, Additive v) =>
Segment Closed v n -> Segment Closed v n
reverseSegment
reverseSegment :: (Num n, Additive v) => Segment Closed v n -> Segment Closed v n
reverseSegment :: forall n (v :: * -> *).
(Num n, Additive v) =>
Segment Closed v n -> Segment Closed v n
reverseSegment (Linear (OffsetClosed v n
v)) = forall (v :: * -> *) n. v n -> Segment Closed v n
straight (forall (f :: * -> *) a. (Functor f, Num a) => f a -> f a
negated v n
v)
reverseSegment (Cubic v n
c1 v n
c2 (OffsetClosed v n
x2)) = forall (v :: * -> *) n. v n -> v n -> v n -> Segment Closed v n
bezier3 (v n
c2 forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^-^ v n
x2) (v n
c1 forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^-^ v n
x2) (forall (f :: * -> *) a. (Functor f, Num a) => f a -> f a
negated v n
x2)
member :: Ord a => a -> I.Interval a -> Bool
member :: forall a. Ord a => a -> Interval a -> Bool
member a
x (I.I a
a a
b) = a
x forall a. Ord a => a -> a -> Bool
>= a
a Bool -> Bool -> Bool
&& a
x forall a. Ord a => a -> a -> Bool
<= a
b
{-# INLINE member #-}
instance (Metric v, OrderedField n)
=> HasArcLength (Segment Closed v n) where
arcLengthBounded :: N (Segment Closed v n)
-> Segment Closed v n -> Interval (N (Segment Closed v n))
arcLengthBounded N (Segment Closed v n)
_ (Linear (OffsetClosed v n
x1)) = forall a. a -> Interval a
I.singleton forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. (Metric f, Floating a) => f a -> a
norm v n
x1
arcLengthBounded N (Segment Closed v n)
m s :: Segment Closed v n
s@(Cubic v n
c1 v n
c2 (OffsetClosed v n
x2))
| n
ub forall a. Num a => a -> a -> a
- n
lb forall a. Ord a => a -> a -> Bool
< N (Segment Closed v n)
m = forall a. a -> a -> Interval a
I n
lb n
ub
| Bool
otherwise = forall p. HasArcLength p => N p -> p -> Interval (N p)
arcLengthBounded (N (Segment Closed v n)
mforall a. Fractional a => a -> a -> a
/n
2) Segment Closed v n
l forall a. Num a => a -> a -> a
+ forall p. HasArcLength p => N p -> p -> Interval (N p)
arcLengthBounded (N (Segment Closed v n)
mforall a. Fractional a => a -> a -> a
/n
2) Segment Closed v n
r
where (Segment Closed v n
l,Segment Closed v n
r) = Segment Closed v n
s forall p. Sectionable p => p -> N p -> (p, p)
`splitAtParam` n
0.5
ub :: n
ub = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (forall a b. (a -> b) -> [a] -> [b]
map forall (f :: * -> *) a. (Metric f, Floating a) => f a -> a
norm [v n
c1, v n
c2 forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^-^ v n
c1, v n
x2 forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^-^ v n
c2])
lb :: n
lb = forall (f :: * -> *) a. (Metric f, Floating a) => f a -> a
norm v n
x2
arcLengthToParam :: N (Segment Closed v n)
-> Segment Closed v n
-> N (Segment Closed v n)
-> N (Segment Closed v n)
arcLengthToParam N (Segment Closed v n)
m Segment Closed v n
s N (Segment Closed v n)
_ | forall p. HasArcLength p => N p -> p -> N p
arcLength N (Segment Closed v n)
m Segment Closed v n
s forall a. Eq a => a -> a -> Bool
== n
0 = n
0.5
arcLengthToParam N (Segment Closed v n)
m s :: Segment Closed v n
s@(Linear {}) N (Segment Closed v n)
len = N (Segment Closed v n)
len forall a. Fractional a => a -> a -> a
/ forall p. HasArcLength p => N p -> p -> N p
arcLength N (Segment Closed v n)
m Segment Closed v n
s
arcLengthToParam N (Segment Closed v n)
m s :: Segment Closed v n
s@(Cubic {}) N (Segment Closed v n)
len
| N (Segment Closed v n)
len forall a. Ord a => a -> Interval a -> Bool
`member` forall a. a -> a -> Interval a
I (-N (Segment Closed v n)
mforall a. Fractional a => a -> a -> a
/n
2) (N (Segment Closed v n)
mforall a. Fractional a => a -> a -> a
/n
2) = n
0
| N (Segment Closed v n)
len forall a. Ord a => a -> a -> Bool
< n
0 = - forall p. HasArcLength p => N p -> p -> N p -> N p
arcLengthToParam N (Segment Closed v n)
m (forall a b. (a, b) -> a
fst (forall p. Sectionable p => p -> N p -> (p, p)
splitAtParam Segment Closed v n
s (-n
1))) (-N (Segment Closed v n)
len)
| N (Segment Closed v n)
len forall a. Ord a => a -> Interval a -> Bool
`member` Interval (N (Segment Closed v n))
slen = n
1
| N (Segment Closed v n)
len forall a. Ord a => a -> a -> Bool
> forall a. Interval a -> a
I.sup Interval (N (Segment Closed v n))
slen = n
2 forall a. Num a => a -> a -> a
* forall p. HasArcLength p => N p -> p -> N p -> N p
arcLengthToParam N (Segment Closed v n)
m (forall a b. (a, b) -> a
fst (forall p. Sectionable p => p -> N p -> (p, p)
splitAtParam Segment Closed v n
s n
2)) N (Segment Closed v n)
len
| N (Segment Closed v n)
len forall a. Ord a => a -> a -> Bool
< forall a. Interval a -> a
I.sup Interval (N (Segment Closed v n))
llen = (forall a. Num a => a -> a -> a
*n
0.5) forall a b. (a -> b) -> a -> b
$ forall p. HasArcLength p => N p -> p -> N p -> N p
arcLengthToParam N (Segment Closed v n)
m Segment Closed v n
l N (Segment Closed v n)
len
| Bool
otherwise = (forall a. Num a => a -> a -> a
+n
0.5) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Num a => a -> a -> a
*n
0.5)
forall a b. (a -> b) -> a -> b
$ forall p. HasArcLength p => N p -> p -> N p -> N p
arcLengthToParam (n
9forall a. Num a => a -> a -> a
*N (Segment Closed v n)
mforall a. Fractional a => a -> a -> a
/n
10) Segment Closed v n
r (N (Segment Closed v n)
len forall a. Num a => a -> a -> a
- forall a. Fractional a => Interval a -> a
I.midpoint Interval (N (Segment Closed v n))
llen)
where (Segment Closed v n
l,Segment Closed v n
r) = Segment Closed v n
s forall p. Sectionable p => p -> N p -> (p, p)
`splitAtParam` n
0.5
llen :: Interval (N (Segment Closed v n))
llen = forall p. HasArcLength p => N p -> p -> Interval (N p)
arcLengthBounded (N (Segment Closed v n)
mforall a. Fractional a => a -> a -> a
/n
10) Segment Closed v n
l
slen :: Interval (N (Segment Closed v n))
slen = forall p. HasArcLength p => N p -> p -> Interval (N p)
arcLengthBounded N (Segment Closed v n)
m Segment Closed v n
s
data FixedSegment v n = FLinear (Point v n) (Point v n)
| FCubic (Point v n) (Point v n) (Point v n) (Point v n)
deriving (FixedSegment v n -> FixedSegment v n -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (v :: * -> *) n.
Eq (v n) =>
FixedSegment v n -> FixedSegment v n -> Bool
/= :: FixedSegment v n -> FixedSegment v n -> Bool
$c/= :: forall (v :: * -> *) n.
Eq (v n) =>
FixedSegment v n -> FixedSegment v n -> Bool
== :: FixedSegment v n -> FixedSegment v n -> Bool
$c== :: forall (v :: * -> *) n.
Eq (v n) =>
FixedSegment v n -> FixedSegment v n -> Bool
Eq, FixedSegment v n -> FixedSegment v n -> Bool
FixedSegment v n -> FixedSegment v n -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {v :: * -> *} {n}. Ord (v n) => Eq (FixedSegment v n)
forall (v :: * -> *) n.
Ord (v n) =>
FixedSegment v n -> FixedSegment v n -> Bool
forall (v :: * -> *) n.
Ord (v n) =>
FixedSegment v n -> FixedSegment v n -> Ordering
forall (v :: * -> *) n.
Ord (v n) =>
FixedSegment v n -> FixedSegment v n -> FixedSegment v n
min :: FixedSegment v n -> FixedSegment v n -> FixedSegment v n
$cmin :: forall (v :: * -> *) n.
Ord (v n) =>
FixedSegment v n -> FixedSegment v n -> FixedSegment v n
max :: FixedSegment v n -> FixedSegment v n -> FixedSegment v n
$cmax :: forall (v :: * -> *) n.
Ord (v n) =>
FixedSegment v n -> FixedSegment v n -> FixedSegment v n
>= :: FixedSegment v n -> FixedSegment v n -> Bool
$c>= :: forall (v :: * -> *) n.
Ord (v n) =>
FixedSegment v n -> FixedSegment v n -> Bool
> :: FixedSegment v n -> FixedSegment v n -> Bool
$c> :: forall (v :: * -> *) n.
Ord (v n) =>
FixedSegment v n -> FixedSegment v n -> Bool
<= :: FixedSegment v n -> FixedSegment v n -> Bool
$c<= :: forall (v :: * -> *) n.
Ord (v n) =>
FixedSegment v n -> FixedSegment v n -> Bool
< :: FixedSegment v n -> FixedSegment v n -> Bool
$c< :: forall (v :: * -> *) n.
Ord (v n) =>
FixedSegment v n -> FixedSegment v n -> Bool
compare :: FixedSegment v n -> FixedSegment v n -> Ordering
$ccompare :: forall (v :: * -> *) n.
Ord (v n) =>
FixedSegment v n -> FixedSegment v n -> Ordering
Ord, Int -> FixedSegment v n -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (v :: * -> *) n.
Show (v n) =>
Int -> FixedSegment v n -> ShowS
forall (v :: * -> *) n. Show (v n) => [FixedSegment v n] -> ShowS
forall (v :: * -> *) n. Show (v n) => FixedSegment v n -> String
showList :: [FixedSegment v n] -> ShowS
$cshowList :: forall (v :: * -> *) n. Show (v n) => [FixedSegment v n] -> ShowS
show :: FixedSegment v n -> String
$cshow :: forall (v :: * -> *) n. Show (v n) => FixedSegment v n -> String
showsPrec :: Int -> FixedSegment v n -> ShowS
$cshowsPrec :: forall (v :: * -> *) n.
Show (v n) =>
Int -> FixedSegment v n -> ShowS
Show)
type instance V (FixedSegment v n) = v
type instance N (FixedSegment v n) = n
instance Each (FixedSegment v n) (FixedSegment v' n') (Point v n) (Point v' n') where
each :: Traversal
(FixedSegment v n) (FixedSegment v' n') (Point v n) (Point v' n')
each Point v n -> f (Point v' n')
f (FLinear Point v n
p0 Point v n
p1) = forall (v :: * -> *) n. Point v n -> Point v n -> FixedSegment v n
FLinear forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Point v n -> f (Point v' n')
f Point v n
p0 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Point v n -> f (Point v' n')
f Point v n
p1
each Point v n -> f (Point v' n')
f (FCubic Point v n
p0 Point v n
p1 Point v n
p2 Point v n
p3) = forall (v :: * -> *) n.
Point v n
-> Point v n -> Point v n -> Point v n -> FixedSegment v n
FCubic forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Point v n -> f (Point v' n')
f Point v n
p0 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Point v n -> f (Point v' n')
f Point v n
p1 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Point v n -> f (Point v' n')
f Point v n
p2 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Point v n -> f (Point v' n')
f Point v n
p3
{-# INLINE each #-}
instance Reversing (FixedSegment v n) where
reversing :: FixedSegment v n -> FixedSegment v n
reversing (FLinear Point v n
p0 Point v n
p1) = forall (v :: * -> *) n. Point v n -> Point v n -> FixedSegment v n
FLinear Point v n
p1 Point v n
p0
reversing (FCubic Point v n
p0 Point v n
p1 Point v n
p2 Point v n
p3) = forall (v :: * -> *) n.
Point v n
-> Point v n -> Point v n -> Point v n -> FixedSegment v n
FCubic Point v n
p3 Point v n
p2 Point v n
p1 Point v n
p0
instance (Additive v, Num n) => Transformable (FixedSegment v n) where
transform :: Transformation (V (FixedSegment v n)) (N (FixedSegment v n))
-> FixedSegment v n -> FixedSegment v n
transform Transformation (V (FixedSegment v n)) (N (FixedSegment v n))
t = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over forall s t a b. Each s t a b => Traversal s t a b
each (forall (v :: * -> *) n.
(Additive v, Num n) =>
Transformation v n -> Point v n -> Point v n
papply Transformation (V (FixedSegment v n)) (N (FixedSegment v n))
t)
instance (Additive v, Num n) => HasOrigin (FixedSegment v n) where
moveOriginTo :: Point (V (FixedSegment v n)) (N (FixedSegment v n))
-> FixedSegment v n -> FixedSegment v n
moveOriginTo Point (V (FixedSegment v n)) (N (FixedSegment v n))
o = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over forall s t a b. Each s t a b => Traversal s t a b
each (forall t. HasOrigin t => Point (V t) (N t) -> t -> t
moveOriginTo Point (V (FixedSegment v n)) (N (FixedSegment v n))
o)
instance (Metric v, OrderedField n) => Enveloped (FixedSegment v n) where
getEnvelope :: FixedSegment v n
-> Envelope (V (FixedSegment v n)) (N (FixedSegment v n))
getEnvelope FixedSegment v n
f = forall (v :: * -> *) n t.
(InSpace v n t, HasOrigin t) =>
Point v n -> t -> t
moveTo Point (V (Segment Closed v n)) (N (Segment Closed v n))
p (forall a. Enveloped a => a -> Envelope (V a) (N a)
getEnvelope Segment Closed v n
s)
where (Point (V (Segment Closed v n)) (N (Segment Closed v n))
p, Segment Closed v n
s) = forall a. Located a -> (Point (V a) (N a), a)
viewLoc forall a b. (a -> b) -> a -> b
$ forall n (v :: * -> *).
(Num n, Additive v) =>
FixedSegment v n -> Located (Segment Closed v n)
fromFixedSeg FixedSegment v n
f
instance (Metric v, OrderedField n)
=> HasArcLength (FixedSegment v n) where
arcLengthBounded :: N (FixedSegment v n)
-> FixedSegment v n -> Interval (N (FixedSegment v n))
arcLengthBounded N (FixedSegment v n)
m FixedSegment v n
s = forall p. HasArcLength p => N p -> p -> Interval (N p)
arcLengthBounded N (FixedSegment v n)
m (forall n (v :: * -> *).
(Num n, Additive v) =>
FixedSegment v n -> Located (Segment Closed v n)
fromFixedSeg FixedSegment v n
s)
arcLengthToParam :: N (FixedSegment v n)
-> FixedSegment v n -> N (FixedSegment v n) -> N (FixedSegment v n)
arcLengthToParam N (FixedSegment v n)
m FixedSegment v n
s = forall p. HasArcLength p => N p -> p -> N p -> N p
arcLengthToParam N (FixedSegment v n)
m (forall n (v :: * -> *).
(Num n, Additive v) =>
FixedSegment v n -> Located (Segment Closed v n)
fromFixedSeg FixedSegment v n
s)
mkFixedSeg :: (Num n, Additive v) => Located (Segment Closed v n) -> FixedSegment v n
mkFixedSeg :: forall n (v :: * -> *).
(Num n, Additive v) =>
Located (Segment Closed v n) -> FixedSegment v n
mkFixedSeg Located (Segment Closed v n)
ls =
case forall a. Located a -> (Point (V a) (N a), a)
viewLoc Located (Segment Closed v n)
ls of
(Point (V (Segment Closed v n)) (N (Segment Closed v n))
p, Linear (OffsetClosed v n
v)) -> forall (v :: * -> *) n. Point v n -> Point v n -> FixedSegment v n
FLinear Point (V (Segment Closed v n)) (N (Segment Closed v n))
p (Point (V (Segment Closed v n)) (N (Segment Closed v n))
p forall (p :: * -> *) a. (Affine p, Num a) => p a -> Diff p a -> p a
.+^ v n
v)
(Point (V (Segment Closed v n)) (N (Segment Closed v n))
p, Cubic v n
c1 v n
c2 (OffsetClosed v n
x2)) -> forall (v :: * -> *) n.
Point v n
-> Point v n -> Point v n -> Point v n -> FixedSegment v n
FCubic Point (V (Segment Closed v n)) (N (Segment Closed v n))
p (Point (V (Segment Closed v n)) (N (Segment Closed v n))
p forall (p :: * -> *) a. (Affine p, Num a) => p a -> Diff p a -> p a
.+^ v n
c1) (Point (V (Segment Closed v n)) (N (Segment Closed v n))
p forall (p :: * -> *) a. (Affine p, Num a) => p a -> Diff p a -> p a
.+^ v n
c2) (Point (V (Segment Closed v n)) (N (Segment Closed v n))
p forall (p :: * -> *) a. (Affine p, Num a) => p a -> Diff p a -> p a
.+^ v n
x2)
fromFixedSeg :: (Num n, Additive v) => FixedSegment v n -> Located (Segment Closed v n)
fromFixedSeg :: forall n (v :: * -> *).
(Num n, Additive v) =>
FixedSegment v n -> Located (Segment Closed v n)
fromFixedSeg (FLinear Point v n
p1 Point v n
p2) = forall (v :: * -> *) n. v n -> Segment Closed v n
straight (Point v n
p2 forall (p :: * -> *) a. (Affine p, Num a) => p a -> p a -> Diff p a
.-. Point v n
p1) forall a. a -> Point (V a) (N a) -> Located a
`at` Point v n
p1
fromFixedSeg (FCubic Point v n
x1 Point v n
c1 Point v n
c2 Point v n
x2) = forall (v :: * -> *) n. v n -> v n -> v n -> Segment Closed v n
bezier3 (Point v n
c1 forall (p :: * -> *) a. (Affine p, Num a) => p a -> p a -> Diff p a
.-. Point v n
x1) (Point v n
c2 forall (p :: * -> *) a. (Affine p, Num a) => p a -> p a -> Diff p a
.-. Point v n
x1) (Point v n
x2 forall (p :: * -> *) a. (Affine p, Num a) => p a -> p a -> Diff p a
.-. Point v n
x1) forall a. a -> Point (V a) (N a) -> Located a
`at` Point v n
x1
fixedSegIso :: (Num n, Additive v) => Iso' (FixedSegment v n) (Located (Segment Closed v n))
fixedSegIso :: forall n (v :: * -> *).
(Num n, Additive v) =>
Iso' (FixedSegment v n) (Located (Segment Closed v n))
fixedSegIso = forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso forall n (v :: * -> *).
(Num n, Additive v) =>
FixedSegment v n -> Located (Segment Closed v n)
fromFixedSeg forall n (v :: * -> *).
(Num n, Additive v) =>
Located (Segment Closed v n) -> FixedSegment v n
mkFixedSeg
type instance Codomain (FixedSegment v n) = Point v
instance (Additive v, Num n) => Parametric (FixedSegment v n) where
atParam :: FixedSegment v n
-> N (FixedSegment v n)
-> Codomain (FixedSegment v n) (N (FixedSegment v n))
atParam (FLinear Point v n
p1 Point v n
p2) N (FixedSegment v n)
t = forall (f :: * -> *) a.
(Additive f, Num a) =>
a -> f a -> f a -> f a
lerp N (FixedSegment v n)
t Point v n
p2 Point v n
p1
atParam (FCubic Point v n
x1 Point v n
c1 Point v n
c2 Point v n
x2) N (FixedSegment v n)
t = Point v n
p3
where p11 :: Point v n
p11 = forall (f :: * -> *) a.
(Additive f, Num a) =>
a -> f a -> f a -> f a
lerp N (FixedSegment v n)
t Point v n
c1 Point v n
x1
p12 :: Point v n
p12 = forall (f :: * -> *) a.
(Additive f, Num a) =>
a -> f a -> f a -> f a
lerp N (FixedSegment v n)
t Point v n
c2 Point v n
c1
p13 :: Point v n
p13 = forall (f :: * -> *) a.
(Additive f, Num a) =>
a -> f a -> f a -> f a
lerp N (FixedSegment v n)
t Point v n
x2 Point v n
c2
p21 :: Point v n
p21 = forall (f :: * -> *) a.
(Additive f, Num a) =>
a -> f a -> f a -> f a
lerp N (FixedSegment v n)
t Point v n
p12 Point v n
p11
p22 :: Point v n
p22 = forall (f :: * -> *) a.
(Additive f, Num a) =>
a -> f a -> f a -> f a
lerp N (FixedSegment v n)
t Point v n
p13 Point v n
p12
p3 :: Point v n
p3 = forall (f :: * -> *) a.
(Additive f, Num a) =>
a -> f a -> f a -> f a
lerp N (FixedSegment v n)
t Point v n
p22 Point v n
p21
instance Num n => DomainBounds (FixedSegment v n)
instance (Additive v, Num n) => EndValues (FixedSegment v n) where
atStart :: FixedSegment v n
-> Codomain (FixedSegment v n) (N (FixedSegment v n))
atStart (FLinear Point v n
p0 Point v n
_) = Point v n
p0
atStart (FCubic Point v n
p0 Point v n
_ Point v n
_ Point v n
_) = Point v n
p0
atEnd :: FixedSegment v n
-> Codomain (FixedSegment v n) (N (FixedSegment v n))
atEnd (FLinear Point v n
_ Point v n
p1) = Point v n
p1
atEnd (FCubic Point v n
_ Point v n
_ Point v n
_ Point v n
p1 ) = Point v n
p1
instance (Additive v, Fractional n) => Sectionable (FixedSegment v n) where
splitAtParam :: FixedSegment v n
-> N (FixedSegment v n) -> (FixedSegment v n, FixedSegment v n)
splitAtParam (FLinear Point v n
p0 Point v n
p1) N (FixedSegment v n)
t = (FixedSegment v n
left, FixedSegment v n
right)
where left :: FixedSegment v n
left = forall (v :: * -> *) n. Point v n -> Point v n -> FixedSegment v n
FLinear Point v n
p0 Point v n
p
right :: FixedSegment v n
right = forall (v :: * -> *) n. Point v n -> Point v n -> FixedSegment v n
FLinear Point v n
p Point v n
p1
p :: Point v n
p = forall (f :: * -> *) a.
(Additive f, Num a) =>
a -> f a -> f a -> f a
lerp N (FixedSegment v n)
t Point v n
p1 Point v n
p0
splitAtParam (FCubic Point v n
p0 Point v n
c1 Point v n
c2 Point v n
p1) N (FixedSegment v n)
t = (FixedSegment v n
left, FixedSegment v n
right)
where left :: FixedSegment v n
left = forall (v :: * -> *) n.
Point v n
-> Point v n -> Point v n -> Point v n -> FixedSegment v n
FCubic Point v n
p0 Point v n
a Point v n
b Point v n
cut
right :: FixedSegment v n
right = forall (v :: * -> *) n.
Point v n
-> Point v n -> Point v n -> Point v n -> FixedSegment v n
FCubic Point v n
cut Point v n
c Point v n
d Point v n
p1
a :: Point v n
a = forall (f :: * -> *) a.
(Additive f, Num a) =>
a -> f a -> f a -> f a
lerp N (FixedSegment v n)
t Point v n
c1 Point v n
p0
p :: Point v n
p = forall (f :: * -> *) a.
(Additive f, Num a) =>
a -> f a -> f a -> f a
lerp N (FixedSegment v n)
t Point v n
c2 Point v n
c1
d :: Point v n
d = forall (f :: * -> *) a.
(Additive f, Num a) =>
a -> f a -> f a -> f a
lerp N (FixedSegment v n)
t Point v n
p1 Point v n
c2
b :: Point v n
b = forall (f :: * -> *) a.
(Additive f, Num a) =>
a -> f a -> f a -> f a
lerp N (FixedSegment v n)
t Point v n
p Point v n
a
c :: Point v n
c = forall (f :: * -> *) a.
(Additive f, Num a) =>
a -> f a -> f a -> f a
lerp N (FixedSegment v n)
t Point v n
d Point v n
p
cut :: Point v n
cut = forall (f :: * -> *) a.
(Additive f, Num a) =>
a -> f a -> f a -> f a
lerp N (FixedSegment v n)
t Point v n
c Point v n
b
reverseDomain :: FixedSegment v n -> FixedSegment v n
reverseDomain (FLinear Point v n
p0 Point v n
p1) = forall (v :: * -> *) n. Point v n -> Point v n -> FixedSegment v n
FLinear Point v n
p1 Point v n
p0
reverseDomain (FCubic Point v n
p0 Point v n
c1 Point v n
c2 Point v n
p1) = forall (v :: * -> *) n.
Point v n
-> Point v n -> Point v n -> Point v n -> FixedSegment v n
FCubic Point v n
p1 Point v n
c2 Point v n
c1 Point v n
p0
newtype SegCount = SegCount (Sum Int)
deriving (NonEmpty SegCount -> SegCount
SegCount -> SegCount -> SegCount
forall b. Integral b => b -> SegCount -> SegCount
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> SegCount -> SegCount
$cstimes :: forall b. Integral b => b -> SegCount -> SegCount
sconcat :: NonEmpty SegCount -> SegCount
$csconcat :: NonEmpty SegCount -> SegCount
<> :: SegCount -> SegCount -> SegCount
$c<> :: SegCount -> SegCount -> SegCount
Semigroup, Semigroup SegCount
SegCount
[SegCount] -> SegCount
SegCount -> SegCount -> SegCount
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [SegCount] -> SegCount
$cmconcat :: [SegCount] -> SegCount
mappend :: SegCount -> SegCount -> SegCount
$cmappend :: SegCount -> SegCount -> SegCount
mempty :: SegCount
$cmempty :: SegCount
Monoid)
instance Wrapped SegCount where
type Unwrapped SegCount = Sum Int
_Wrapped' :: Iso' SegCount (Unwrapped SegCount)
_Wrapped' = forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (\(SegCount Sum Int
x) -> Sum Int
x) Sum Int -> SegCount
SegCount
instance Rewrapped SegCount SegCount
newtype ArcLength n
= ArcLength (Sum (Interval n), n -> Sum (Interval n))
instance Wrapped (ArcLength n) where
type Unwrapped (ArcLength n) = (Sum (Interval n), n -> Sum (Interval n))
_Wrapped' :: Iso' (ArcLength n) (Unwrapped (ArcLength n))
_Wrapped' = forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (\(ArcLength (Sum (Interval n), n -> Sum (Interval n))
x) -> (Sum (Interval n), n -> Sum (Interval n))
x) forall n. (Sum (Interval n), n -> Sum (Interval n)) -> ArcLength n
ArcLength
instance Rewrapped (ArcLength n) (ArcLength n')
getArcLengthCached :: ArcLength n -> Interval n
getArcLengthCached :: forall n. ArcLength n -> Interval n
getArcLengthCached = forall a. Sum a -> a
getSum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. Wrapped s => (Unwrapped s -> s) -> s -> Unwrapped s
op forall n. (Sum (Interval n), n -> Sum (Interval n)) -> ArcLength n
ArcLength
getArcLengthFun :: ArcLength n -> n -> Interval n
getArcLengthFun :: forall n. ArcLength n -> n -> Interval n
getArcLengthFun = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Sum a -> a
getSum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. Wrapped s => (Unwrapped s -> s) -> s -> Unwrapped s
op forall n. (Sum (Interval n), n -> Sum (Interval n)) -> ArcLength n
ArcLength
getArcLengthBounded :: (Num n, Ord n)
=> n -> ArcLength n -> Interval n
getArcLengthBounded :: forall n. (Num n, Ord n) => n -> ArcLength n -> Interval n
getArcLengthBounded n
eps ArcLength n
al
| forall a. Num a => Interval a -> a
I.width Interval n
cached forall a. Ord a => a -> a -> Bool
<= n
eps = Interval n
cached
| Bool
otherwise = forall n. ArcLength n -> n -> Interval n
getArcLengthFun ArcLength n
al n
eps
where
cached :: Interval n
cached = forall n. ArcLength n -> Interval n
getArcLengthCached ArcLength n
al
deriving instance (Num n, Ord n) => Semigroup (ArcLength n)
deriving instance (Num n, Ord n) => Monoid (ArcLength n)
newtype TotalOffset v n = TotalOffset (v n)
instance Wrapped (TotalOffset v n) where
type Unwrapped (TotalOffset v n) = v n
_Wrapped' :: Iso' (TotalOffset v n) (Unwrapped (TotalOffset v n))
_Wrapped' = forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (\(TotalOffset v n
x) -> v n
x) forall (v :: * -> *) n. v n -> TotalOffset v n
TotalOffset
instance Rewrapped (TotalOffset v n) (TotalOffset v' n')
instance (Num n, Additive v) => Semigroup (TotalOffset v n) where
TotalOffset v n
v1 <> :: TotalOffset v n -> TotalOffset v n -> TotalOffset v n
<> TotalOffset v n
v2 = forall (v :: * -> *) n. v n -> TotalOffset v n
TotalOffset (v n
v1 forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^+^ v n
v2)
instance (Num n, Additive v) => Monoid (TotalOffset v n) where
mempty :: TotalOffset v n
mempty = forall (v :: * -> *) n. v n -> TotalOffset v n
TotalOffset forall (f :: * -> *) a. (Additive f, Num a) => f a
zero
mappend :: TotalOffset v n -> TotalOffset v n -> TotalOffset v n
mappend = forall a. Semigroup a => a -> a -> a
(<>)
data OffsetEnvelope v n = OffsetEnvelope
{ forall (v :: * -> *) n. OffsetEnvelope v n -> TotalOffset v n
_oeOffset :: !(TotalOffset v n)
, forall (v :: * -> *) n. OffsetEnvelope v n -> Envelope v n
_oeEnvelope :: Envelope v n
}
makeLenses ''OffsetEnvelope
instance (Metric v, OrderedField n) => Semigroup (OffsetEnvelope v n) where
(OffsetEnvelope TotalOffset v n
o1 Envelope v n
e1) <> :: OffsetEnvelope v n -> OffsetEnvelope v n -> OffsetEnvelope v n
<> (OffsetEnvelope TotalOffset v n
o2 Envelope v n
e2)
= let !negOff :: v n
negOff = forall (f :: * -> *) a. (Functor f, Num a) => f a -> f a
negated forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. Wrapped s => (Unwrapped s -> s) -> s -> Unwrapped s
op forall (v :: * -> *) n. v n -> TotalOffset v n
TotalOffset forall a b. (a -> b) -> a -> b
$ TotalOffset v n
o1
e2Off :: Envelope v n
e2Off = forall t (v :: * -> *) n.
(V t ~ v, N t ~ n, HasOrigin t) =>
v n -> t -> t
moveOriginBy v n
negOff Envelope v n
e2
!_unused :: ()
_unused = forall b a. b -> (a -> b) -> Maybe a -> b
maybe () (\v n -> n
f -> v n -> n
f seq :: forall a b. a -> b -> b
`seq` ()) forall a b. (a -> b) -> a -> b
$ forall (v :: * -> *) n. Envelope v n -> Maybe (v n -> n)
appEnvelope Envelope v n
e2Off
in forall (v :: * -> *) n.
TotalOffset v n -> Envelope v n -> OffsetEnvelope v n
OffsetEnvelope
(TotalOffset v n
o1 forall a. Semigroup a => a -> a -> a
<> TotalOffset v n
o2)
(Envelope v n
e1 forall a. Semigroup a => a -> a -> a
<> Envelope v n
e2Off)
type SegMeasure v n = SegCount
::: ArcLength n
::: OffsetEnvelope v n
::: ()
instance (Metric v, OrderedField n)
=> Measured (SegMeasure v n) (SegMeasure v n) where
measure :: SegMeasure v n -> SegMeasure v n
measure = forall a. a -> a
id
instance (OrderedField n, Metric v)
=> Measured (SegMeasure v n) (Segment Closed v n) where
measure :: Segment Closed v n -> SegMeasure v n
measure Segment Closed v n
s = (Sum Int -> SegCount
SegCount forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Sum a
Sum) Int
1
forall a l. a -> l -> a ::: l
*: forall n. (Sum (Interval n), n -> Sum (Interval n)) -> ArcLength n
ArcLength ( forall a. a -> Sum a
Sum forall a b. (a -> b) -> a -> b
$ forall p. HasArcLength p => N p -> p -> Interval (N p)
arcLengthBounded (forall a. Fractional a => a
stdToleranceforall a. Fractional a => a -> a -> a
/n
100) Segment Closed v n
s
, forall a. a -> Sum a
Sum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall p. HasArcLength p => N p -> p -> Interval (N p)
arcLengthBounded Segment Closed v n
s )
forall a l. a -> l -> a ::: l
*: forall (v :: * -> *) n.
TotalOffset v n -> Envelope v n -> OffsetEnvelope v n
OffsetEnvelope (forall (v :: * -> *) n. v n -> TotalOffset v n
TotalOffset forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (v :: * -> *) n. Segment Closed v n -> v n
segOffset forall a b. (a -> b) -> a -> b
$ Segment Closed v n
s)
(forall a. Enveloped a => a -> Envelope (V a) (N a)
getEnvelope Segment Closed v n
s)
forall a l. a -> l -> a ::: l
*: ()
instance (Serialize (v n)) => Serialize (Segment Open v n) where
{-# INLINE put #-}
put :: Putter (Segment Open v n)
put Segment Open v n
segment = case Segment Open v n
segment of
Linear Offset Open v n
OffsetOpen -> forall t. Serialize t => Putter t
Serialize.put Bool
True
Cubic v n
v v n
w Offset Open v n
OffsetOpen -> do
forall t. Serialize t => Putter t
Serialize.put Bool
False
forall t. Serialize t => Putter t
Serialize.put v n
v
forall t. Serialize t => Putter t
Serialize.put v n
w
{-# INLINE get #-}
get :: Get (Segment Open v n)
get = do
Bool
isLinear <- forall t. Serialize t => Get t
Serialize.get
case Bool
isLinear of
Bool
True -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall c (v :: * -> *) n. Offset c v n -> Segment c v n
Linear forall (v :: * -> *) n. Offset Open v n
OffsetOpen)
Bool
False -> do
v n
v <- forall t. Serialize t => Get t
Serialize.get
v n
w <- forall t. Serialize t => Get t
Serialize.get
forall (m :: * -> *) a. Monad m => a -> m a
return (forall c (v :: * -> *) n.
v n -> v n -> Offset c v n -> Segment c v n
Cubic v n
v v n
w forall (v :: * -> *) n. Offset Open v n
OffsetOpen)
instance (Serialize (v n)) => Serialize (Segment Closed v n) where
{-# INLINE put #-}
put :: Putter (Segment Closed v n)
put Segment Closed v n
segment = case Segment Closed v n
segment of
Linear (OffsetClosed v n
z) -> do
forall t. Serialize t => Putter t
Serialize.put v n
z
forall t. Serialize t => Putter t
Serialize.put Bool
True
Cubic v n
v v n
w (OffsetClosed v n
z) -> do
forall t. Serialize t => Putter t
Serialize.put v n
z
forall t. Serialize t => Putter t
Serialize.put Bool
False
forall t. Serialize t => Putter t
Serialize.put v n
v
forall t. Serialize t => Putter t
Serialize.put v n
w
{-# INLINE get #-}
get :: Get (Segment Closed v n)
get = do
v n
z <- forall t. Serialize t => Get t
Serialize.get
Bool
isLinear <- forall t. Serialize t => Get t
Serialize.get
case Bool
isLinear of
Bool
True -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall c (v :: * -> *) n. Offset c v n -> Segment c v n
Linear (forall (v :: * -> *) n. v n -> Offset Closed v n
OffsetClosed v n
z))
Bool
False -> do
v n
v <- forall t. Serialize t => Get t
Serialize.get
v n
w <- forall t. Serialize t => Get t
Serialize.get
forall (m :: * -> *) a. Monad m => a -> m a
return (forall c (v :: * -> *) n.
v n -> v n -> Offset c v n -> Segment c v n
Cubic v n
v v n
w (forall (v :: * -> *) n. v n -> Offset Closed v n
OffsetClosed v n
z))