{-# 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 :: (a -> b) -> Offset c v a -> Offset c v b
fmap _ OffsetOpen = Offset c v b
forall (v :: * -> *) n. Offset Open v n
OffsetOpen
fmap f :: a -> b
f (OffsetClosed v :: v a
v) = v b -> Offset Closed v b
forall (v :: * -> *) n. v n -> Offset Closed v n
OffsetClosed ((a -> b) -> v a -> v b
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 :: (v n -> f (v' n')) -> Offset c v n -> f (Offset c v' n')
each f :: v n -> f (v' n')
f (OffsetClosed v :: v n
v) = v' n' -> Offset Closed v' n'
forall (v :: * -> *) n. v n -> Offset Closed v n
OffsetClosed (v' n' -> Offset Closed v' n')
-> f (v' n') -> f (Offset Closed v' n')
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> v n -> f (v' n')
f v n
v
each _ OffsetOpen = Offset Open v' n' -> f (Offset Open v' n')
forall (f :: * -> *) a. Applicative f => a -> f a
pure Offset Open v' n'
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 off :: v n
off) = v n -> Offset c v n
forall (v :: * -> *) n. v n -> Offset Closed v n
OffsetClosed (v n -> Offset c v n) -> v n -> Offset c v n
forall a b. (a -> b) -> a -> b
$ v n -> v n
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 _ OffsetOpen = Offset c v n
forall (v :: * -> *) n. Offset Open v n
OffsetOpen
transform t :: Transformation (V (Offset c v n)) (N (Offset c v n))
t (OffsetClosed v :: v n
v) = v n -> Offset Closed v n
forall (v :: * -> *) n. v n -> Offset Closed v n
OffsetClosed (Transformation v n -> v n -> v n
forall (v :: * -> *) n. Transformation v n -> v n -> v n
apply Transformation v n
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 (a -> Segment c v b -> Segment c v a
(a -> b) -> Segment c v a -> Segment c v b
(forall a b. (a -> b) -> Segment c v a -> Segment c v b)
-> (forall a b. a -> Segment c v b -> Segment c v a)
-> Functor (Segment c v)
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
<$ :: 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 :: (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
(Segment c v n -> Segment c v n -> Bool)
-> (Segment c v n -> Segment c v n -> Bool) -> Eq (Segment c v n)
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, Eq (Segment c v n)
Eq (Segment c v n) =>
(Segment c v n -> Segment c v n -> Ordering)
-> (Segment c v n -> Segment c v n -> Bool)
-> (Segment c v n -> Segment c v n -> Bool)
-> (Segment c v n -> Segment c v n -> Bool)
-> (Segment c v n -> Segment c v n -> Bool)
-> (Segment c v n -> Segment c v n -> Segment c v n)
-> (Segment c v n -> Segment c v n -> Segment c v n)
-> Ord (Segment c v n)
Segment c v n -> Segment c v n -> Bool
Segment c v n -> Segment c v n -> Ordering
Segment c v n -> Segment c v n -> Segment c v n
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
$cp1Ord :: forall c (v :: * -> *) n. Ord (v n) => Eq (Segment c v n)
Ord)
instance Show (v n) => Show (Segment c v n) where
showsPrec :: Int -> Segment c v n -> ShowS
showsPrec d :: Int
d seg :: Segment c v n
seg = case Segment c v n
seg of
Linear (OffsetClosed v :: v n
v) -> Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
String -> ShowS
showString "straight " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> v n -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec 11 v n
v
Cubic v1 :: v n
v1 v2 :: v n
v2 (OffsetClosed v3 :: v n
v3) -> Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
String -> ShowS
showString "bézier3 " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> v n -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec 11 v n
v1 ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar ' '
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> v n -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec 11 v n
v2 ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar ' '
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> v n -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec 11 v n
v3
Linear OffsetOpen -> String -> ShowS
showString "openLinear"
Cubic v1 :: v n
v1 v2 :: v n
v2 OffsetOpen -> Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
String -> ShowS
showString "openCubic " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> v n -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec 11 v n
v1 ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar ' '
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> v n -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec 11 v n
v2
instance Each (Segment c v n) (Segment c v' n') (v n) (v' n') where
each :: (v n -> f (v' n')) -> Segment c v n -> f (Segment c v' n')
each f :: v n -> f (v' n')
f (Linear offset :: Offset c v n
offset) = Offset c v' n' -> Segment c v' n'
forall c (v :: * -> *) n. Offset c v n -> Segment c v n
Linear (Offset c v' n' -> Segment c v' n')
-> f (Offset c v' n') -> f (Segment c v' n')
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (v n -> f (v' n')) -> Offset c v n -> f (Offset c v' n')
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 f :: v n -> f (v' n')
f (Cubic v1 :: v n
v1 v2 :: v n
v2 offset :: Offset c v n
offset) = v' n' -> v' n' -> Offset c v' n' -> Segment c v' n'
forall c (v :: * -> *) n.
v n -> v n -> Offset c v n -> Segment c v n
Cubic (v' n' -> v' n' -> Offset c v' n' -> Segment c v' n')
-> f (v' n') -> f (v' n' -> Offset c v' n' -> Segment c v' n')
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> v n -> f (v' n')
f v n
v1 f (v' n' -> Offset c v' n' -> Segment c v' n')
-> f (v' n') -> f (Offset c v' n' -> Segment c v' n')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> v n -> f (v' n')
f v n
v2 f (Offset c v' n' -> Segment c v' n')
-> f (Offset c v' n') -> f (Segment c v' n')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (v n -> f (v' n')) -> Offset c v n -> f (Offset c v' n')
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 = Segment Closed v n -> Segment Closed v n
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 :: (v n -> v' n') -> Segment c v n -> Segment c v' n'
mapSegmentVectors = ASetter (Segment c v n) (Segment c v' n') (v n) (v' n')
-> (v n -> v' n') -> Segment c v n -> Segment c v' n'
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter (Segment c v n) (Segment c v' n') (v n) (v' n')
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 = (v n -> v n) -> Segment c v n -> Segment c v n
forall (v :: * -> *) n (v' :: * -> *) n' c.
(v n -> v' n') -> Segment c v n -> Segment c v' n'
mapSegmentVectors ((v n -> v n) -> Segment c v n -> Segment c v n)
-> (Transformation v n -> v n -> v n)
-> Transformation v n
-> Segment c v n
-> Segment c v n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transformation v n -> v n -> v n
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 _ _ = Render NullBackend (V (Segment c v n)) (N (Segment c v n))
forall a. Monoid a => a
mempty
straight :: v n -> Segment Closed v n
straight :: v n -> Segment Closed v n
straight = Offset Closed v n -> Segment Closed v n
forall c (v :: * -> *) n. Offset c v n -> Segment c v n
Linear (Offset Closed v n -> Segment Closed v n)
-> (v n -> Offset Closed v n) -> v n -> Segment Closed v n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v n -> Offset Closed v n
forall (v :: * -> *) n. v n -> Offset Closed v n
OffsetClosed
bezier3 :: v n -> v n -> v n -> Segment Closed v n
bezier3 :: v n -> v n -> v n -> Segment Closed v n
bezier3 c1 :: v n
c1 c2 :: v n
c2 x :: v n
x = v n -> v n -> Offset Closed v n -> Segment Closed v n
forall c (v :: * -> *) n.
v n -> v n -> Offset c v n -> Segment c v n
Cubic v n
c1 v n
c2 (v n -> Offset Closed v n
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 :: v n -> v n -> v n -> Segment Closed v n
bézier3 = v n -> v n -> v n -> Segment Closed v n
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 x :: v n
x)) t :: N (Segment Closed v n)
t = n
N (Segment Closed v n)
t n -> v n -> v n
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ v n
x
atParam (Cubic c1 :: v n
c1 c2 :: v n
c2 (OffsetClosed x2 :: v n
x2)) t :: N (Segment Closed v n)
t = (3 n -> n -> n
forall a. Num a => a -> a -> a
* n
t'n -> n -> n
forall a. Num a => a -> a -> a
*n
t'n -> n -> n
forall a. Num a => a -> a -> a
*n
N (Segment Closed v n)
t ) n -> v n -> v n
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ v n
c1
v n -> v n -> v n
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^+^ (3 n -> n -> n
forall a. Num a => a -> a -> a
* n
t'n -> n -> n
forall a. Num a => a -> a -> a
*n
N (Segment Closed v n)
t n -> n -> n
forall a. Num a => a -> a -> a
*n
N (Segment Closed v n)
t ) n -> v n -> v n
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ v n
c2
v n -> v n -> v n
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^+^ ( n
N (Segment Closed v n)
t n -> n -> n
forall a. Num a => a -> a -> a
*n
N (Segment Closed v n)
t n -> n -> n
forall a. Num a => a -> a -> a
*n
N (Segment Closed v n)
t ) n -> v n -> v n
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ v n
x2
where t' :: n
t' = 1n -> n -> n
forall a. Num a => a -> a -> a
-n
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 = v n -> Segment Closed v n -> v n
forall a b. a -> b -> a
const v n
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 :: v n
v)) = v n
Codomain (Segment Closed v n) (N (Segment Closed v n))
v
atEnd (Cubic _ _ (OffsetClosed v :: v n
v)) = v n
Codomain (Segment Closed v n) (N (Segment Closed v n))
v
segOffset :: Segment Closed v n -> v n
segOffset :: Segment Closed v n -> v n
segOffset (Linear (OffsetClosed v :: v n
v)) = v n
v
segOffset (Cubic _ _ (OffsetClosed v :: v n
v)) = v n
v
openLinear :: Segment Open v n
openLinear :: Segment Open v n
openLinear = Offset Open v n -> Segment Open v n
forall c (v :: * -> *) n. Offset c v n -> Segment c v n
Linear Offset Open v n
forall (v :: * -> *) n. Offset Open v n
OffsetOpen
openCubic :: v n -> v n -> Segment Open v n
openCubic :: v n -> v n -> Segment Open v n
openCubic v1 :: v n
v1 v2 :: v n
v2 = v n -> v n -> Offset Open v n -> Segment Open v n
forall c (v :: * -> *) n.
v n -> v n -> Offset c v n -> Segment c v n
Cubic v n
v1 v n
v2 Offset Open v n
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 {})) = (v n -> n)
-> Envelope (V (Segment Closed v n)) (N (Segment Closed v n))
forall (v :: * -> *) n. (v n -> n) -> Envelope v n
mkEnvelope ((v n -> n)
-> Envelope (V (Segment Closed v n)) (N (Segment Closed v n)))
-> (v n -> n)
-> Envelope (V (Segment Closed v n)) (N (Segment Closed v n))
forall a b. (a -> b) -> a -> b
$ \v :: v n
v ->
[n] -> n
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ((n -> n) -> [n] -> [n]
forall a b. (a -> b) -> [a] -> [b]
map (\t :: n
t -> (Segment Closed v n
s Segment Closed v n
-> N (Segment Closed v n)
-> Codomain (Segment Closed v n) (N (Segment Closed v n))
forall p. Parametric p => p -> N p -> Codomain p (N p)
`atParam` n
N (Segment Closed v n)
t) v n -> v n -> n
forall (f :: * -> *) a. (Metric f, Num a) => f a -> f a -> a
`dot` v n
v) [0,1]) n -> n -> n
forall a. Fractional a => a -> a -> a
/ v n -> n
forall (f :: * -> *) a. (Metric f, Num a) => f a -> a
quadrance v n
v
getEnvelope (s :: Segment Closed v n
s@(Cubic c1 :: v n
c1 c2 :: v n
c2 (OffsetClosed x2 :: v n
x2))) = (v n -> n)
-> Envelope (V (Segment Closed v n)) (N (Segment Closed v n))
forall (v :: * -> *) n. (v n -> n) -> Envelope v n
mkEnvelope ((v n -> n)
-> Envelope (V (Segment Closed v n)) (N (Segment Closed v n)))
-> (v n -> n)
-> Envelope (V (Segment Closed v n)) (N (Segment Closed v n))
forall a b. (a -> b) -> a -> b
$ \v :: v n
v ->
[n] -> n
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([n] -> n) -> ([n] -> [n]) -> [n] -> n
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(n -> n) -> [n] -> [n]
forall a b. (a -> b) -> [a] -> [b]
map (\t :: n
t -> ((Segment Closed v n
s Segment Closed v n
-> N (Segment Closed v n)
-> Codomain (Segment Closed v n) (N (Segment Closed v n))
forall p. Parametric p => p -> N p -> Codomain p (N p)
`atParam` n
N (Segment Closed v n)
t) v n -> v n -> n
forall (f :: * -> *) a. (Metric f, Num a) => f a -> f a -> a
`dot` v n
v) n -> n -> n
forall a. Fractional a => a -> a -> a
/ v n -> n
forall (f :: * -> *) a. (Metric f, Num a) => f a -> a
quadrance v n
v) ([n] -> n) -> [n] -> n
forall a b. (a -> b) -> a -> b
$
[0,1] [n] -> [n] -> [n]
forall a. [a] -> [a] -> [a]
++
(n -> Bool) -> [n] -> [n]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Bool -> Bool -> Bool) -> (n -> Bool) -> (n -> Bool) -> n -> Bool
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Bool -> Bool -> Bool
(&&) (n -> n -> Bool
forall a. Ord a => a -> a -> Bool
>0) (n -> n -> Bool
forall a. Ord a => a -> a -> Bool
<1))
(n -> n -> n -> [n]
forall d. (Floating d, Ord d) => d -> d -> d -> [d]
quadForm (3 n -> n -> n
forall a. Num a => a -> a -> a
* ((3 n -> v n -> v n
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ v n
c1 v n -> v n -> v n
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^-^ 3 n -> v n -> v n
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ v n
c2 v n -> v n -> v n
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^+^ v n
x2) v n -> v n -> n
forall (f :: * -> *) a. (Metric f, Num a) => f a -> f a -> a
`dot` v n
v))
(6 n -> n -> n
forall a. Num a => a -> a -> a
* (((-2) n -> v n -> v n
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ v n
c1 v n -> v n -> v n
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^+^ v n
c2) v n -> v n -> n
forall (f :: * -> *) a. (Metric f, Num a) => f a -> f a -> a
`dot` v n
v))
((3 n -> v n -> v n
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ v n
c1) v n -> v n -> n
forall (f :: * -> *) a. (Metric f, Num a) => f a -> f a -> a
`dot` 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 x1 :: v n
x1)) t :: N (Segment Closed v n)
t = (Segment Closed v n
left, Segment Closed v n
right)
where left :: Segment Closed v n
left = v n -> Segment Closed v n
forall (v :: * -> *) n. v n -> Segment Closed v n
straight v n
p
right :: Segment Closed v n
right = v n -> Segment Closed v n
forall (v :: * -> *) n. v n -> Segment Closed v n
straight (v n
x1 v n -> v n -> v n
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^-^ v n
p)
p :: v n
p = n -> v n -> v n -> v n
forall (f :: * -> *) a.
(Additive f, Num a) =>
a -> f a -> f a -> f a
lerp n
N (Segment Closed v n)
t v n
x1 v n
forall (f :: * -> *) a. (Additive f, Num a) => f a
zero
splitAtParam (Cubic c1 :: v n
c1 c2 :: v n
c2 (OffsetClosed x2 :: v n
x2)) t :: N (Segment Closed v n)
t = (Segment Closed v n
left, Segment Closed v n
right)
where left :: Segment Closed v n
left = v n -> v n -> v n -> Segment Closed v n
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 = v n -> v n -> v n -> Segment Closed v n
forall (v :: * -> *) n. v n -> v n -> v n -> Segment Closed v n
bezier3 (v n
c v n -> v n -> v n
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^-^ v n
e) (v n
d v n -> v n -> v n
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^-^ v n
e) (v n
x2 v n -> v n -> v n
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^-^ v n
e)
p :: v n
p = n -> v n -> v n -> v n
forall (f :: * -> *) a.
(Additive f, Num a) =>
a -> f a -> f a -> f a
lerp n
N (Segment Closed v n)
t v n
c2 v n
c1
a :: v n
a = n -> v n -> v n -> v n
forall (f :: * -> *) a.
(Additive f, Num a) =>
a -> f a -> f a -> f a
lerp n
N (Segment Closed v n)
t v n
c1 v n
forall (f :: * -> *) a. (Additive f, Num a) => f a
zero
b :: v n
b = n -> v n -> v n -> v n
forall (f :: * -> *) a.
(Additive f, Num a) =>
a -> f a -> f a -> f a
lerp n
N (Segment Closed v n)
t v n
p v n
a
d :: v n
d = n -> v n -> v n -> v n
forall (f :: * -> *) a.
(Additive f, Num a) =>
a -> f a -> f a -> f a
lerp n
N (Segment Closed v n)
t v n
x2 v n
c2
c :: v n
c = n -> v n -> v n -> v n
forall (f :: * -> *) a.
(Additive f, Num a) =>
a -> f a -> f a -> f a
lerp n
N (Segment Closed v n)
t v n
d v n
p
e :: v n
e = n -> v n -> v n -> v n
forall (f :: * -> *) a.
(Additive f, Num a) =>
a -> f a -> f a -> f a
lerp n
N (Segment Closed v n)
t v n
c v n
b
reverseDomain :: Segment Closed v n -> Segment Closed v n
reverseDomain = Segment Closed v n -> Segment Closed v n
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 :: Segment Closed v n -> Segment Closed v n
reverseSegment (Linear (OffsetClosed v :: v n
v)) = v n -> Segment Closed v n
forall (v :: * -> *) n. v n -> Segment Closed v n
straight (v n -> v n
forall (f :: * -> *) a. (Functor f, Num a) => f a -> f a
negated v n
v)
reverseSegment (Cubic c1 :: v n
c1 c2 :: v n
c2 (OffsetClosed x2 :: v n
x2)) = v n -> v n -> v n -> Segment Closed v n
forall (v :: * -> *) n. v n -> v n -> v n -> Segment Closed v n
bezier3 (v n
c2 v n -> v n -> v n
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^-^ v n
x2) (v n
c1 v n -> v n -> v n
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^-^ v n
x2) (v n -> v n
forall (f :: * -> *) a. (Functor f, Num a) => f a -> f a
negated v n
x2)
member :: Ord a => a -> I.Interval a -> Bool
member :: a -> Interval a -> Bool
member x :: a
x (I.I a :: a
a b :: a
b) = a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
a Bool -> Bool -> Bool
&& a
x a -> a -> Bool
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 _ (Linear (OffsetClosed x1 :: v n
x1)) = n -> Interval (N (Segment Closed v n))
forall a. a -> Interval a
I.singleton (n -> Interval (N (Segment Closed v n)))
-> n -> Interval (N (Segment Closed v n))
forall a b. (a -> b) -> a -> b
$ v n -> n
forall (f :: * -> *) a. (Metric f, Floating a) => f a -> a
norm v n
x1
arcLengthBounded m :: N (Segment Closed v n)
m s :: Segment Closed v n
s@(Cubic c1 :: v n
c1 c2 :: v n
c2 (OffsetClosed x2 :: v n
x2))
| n
ub n -> n -> n
forall a. Num a => a -> a -> a
- n
lb n -> n -> Bool
forall a. Ord a => a -> a -> Bool
< n
N (Segment Closed v n)
m = n -> n -> Interval n
forall a. a -> a -> Interval a
I n
lb n
ub
| Bool
otherwise = N (Segment Closed v n)
-> Segment Closed v n -> Interval (N (Segment Closed v n))
forall p. HasArcLength p => N p -> p -> Interval (N p)
arcLengthBounded (n
N (Segment Closed v n)
mn -> n -> n
forall a. Fractional a => a -> a -> a
/2) Segment Closed v n
l Interval n -> Interval n -> Interval n
forall a. Num a => a -> a -> a
+ N (Segment Closed v n)
-> Segment Closed v n -> Interval (N (Segment Closed v n))
forall p. HasArcLength p => N p -> p -> Interval (N p)
arcLengthBounded (n
N (Segment Closed v n)
mn -> n -> n
forall a. Fractional a => a -> a -> a
/2) Segment Closed v n
r
where (l :: Segment Closed v n
l,r :: Segment Closed v n
r) = Segment Closed v n
s Segment Closed v n
-> N (Segment Closed v n)
-> (Segment Closed v n, Segment Closed v n)
forall p. Sectionable p => p -> N p -> (p, p)
`splitAtParam` 0.5
ub :: n
ub = [n] -> n
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((v n -> n) -> [v n] -> [n]
forall a b. (a -> b) -> [a] -> [b]
map v n -> n
forall (f :: * -> *) a. (Metric f, Floating a) => f a -> a
norm [v n
c1, v n
c2 v n -> v n -> v n
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^-^ v n
c1, v n
x2 v n -> v n -> v n
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^-^ v n
c2])
lb :: n
lb = v n -> n
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 m :: N (Segment Closed v n)
m s :: Segment Closed v n
s _ | N (Segment Closed v n)
-> Segment Closed v n -> 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 n -> n -> Bool
forall a. Eq a => a -> a -> Bool
== 0 = 0.5
arcLengthToParam m :: N (Segment Closed v n)
m s :: Segment Closed v n
s@(Linear {}) len :: N (Segment Closed v n)
len = n
N (Segment Closed v n)
len n -> n -> n
forall a. Fractional a => a -> a -> a
/ N (Segment Closed v n)
-> Segment Closed v n -> 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
arcLengthToParam m :: N (Segment Closed v n)
m s :: Segment Closed v n
s@(Cubic {}) len :: N (Segment Closed v n)
len
| n
N (Segment Closed v n)
len n -> Interval n -> Bool
forall a. Ord a => a -> Interval a -> Bool
`member` n -> n -> Interval n
forall a. a -> a -> Interval a
I (-n
N (Segment Closed v n)
mn -> n -> n
forall a. Fractional a => a -> a -> a
/2) (n
N (Segment Closed v n)
mn -> n -> n
forall a. Fractional a => a -> a -> a
/2) = 0
| n
N (Segment Closed v n)
len n -> n -> Bool
forall a. Ord a => a -> a -> Bool
< 0 = - N (Segment Closed v n)
-> Segment Closed v n
-> N (Segment Closed v n)
-> N (Segment Closed v n)
forall p. HasArcLength p => N p -> p -> N p -> N p
arcLengthToParam N (Segment Closed v n)
m ((Segment Closed v n, Segment Closed v n) -> Segment Closed v n
forall a b. (a, b) -> a
fst (Segment Closed v n
-> N (Segment Closed v n)
-> (Segment Closed v n, Segment Closed v n)
forall p. Sectionable p => p -> N p -> (p, p)
splitAtParam Segment Closed v n
s (-1))) (-n
N (Segment Closed v n)
len)
| n
N (Segment Closed v n)
len n -> Interval n -> Bool
forall a. Ord a => a -> Interval a -> Bool
`member` Interval n
Interval (N (Segment Closed v n))
slen = 1
| n
N (Segment Closed v n)
len n -> n -> Bool
forall a. Ord a => a -> a -> Bool
> Interval n -> n
forall a. Interval a -> a
I.sup Interval n
Interval (N (Segment Closed v n))
slen = 2 n -> n -> n
forall a. Num a => a -> a -> a
* N (Segment Closed v n)
-> Segment Closed v n
-> N (Segment Closed v n)
-> N (Segment Closed v n)
forall p. HasArcLength p => N p -> p -> N p -> N p
arcLengthToParam N (Segment Closed v n)
m ((Segment Closed v n, Segment Closed v n) -> Segment Closed v n
forall a b. (a, b) -> a
fst (Segment Closed v n
-> N (Segment Closed v n)
-> (Segment Closed v n, Segment Closed v n)
forall p. Sectionable p => p -> N p -> (p, p)
splitAtParam Segment Closed v n
s 2)) N (Segment Closed v n)
len
| n
N (Segment Closed v n)
len n -> n -> Bool
forall a. Ord a => a -> a -> Bool
< Interval n -> n
forall a. Interval a -> a
I.sup Interval n
Interval (N (Segment Closed v n))
llen = (n -> n -> n
forall a. Num a => a -> a -> a
*0.5) (n -> N (Segment Closed v n)) -> n -> N (Segment Closed v n)
forall a b. (a -> b) -> a -> b
$ N (Segment Closed v n)
-> Segment Closed v n
-> N (Segment Closed v n)
-> N (Segment Closed v n)
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 = (n -> n -> n
forall a. Num a => a -> a -> a
+0.5) (n -> n) -> (n -> n) -> n -> n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (n -> n -> n
forall a. Num a => a -> a -> a
*0.5)
(n -> N (Segment Closed v n)) -> n -> N (Segment Closed v n)
forall a b. (a -> b) -> a -> b
$ N (Segment Closed v n)
-> Segment Closed v n
-> N (Segment Closed v n)
-> N (Segment Closed v n)
forall p. HasArcLength p => N p -> p -> N p -> N p
arcLengthToParam (9n -> n -> n
forall a. Num a => a -> a -> a
*n
N (Segment Closed v n)
mn -> n -> n
forall a. Fractional a => a -> a -> a
/10) Segment Closed v n
r (n
N (Segment Closed v n)
len n -> n -> n
forall a. Num a => a -> a -> a
- Interval n -> n
forall a. Fractional a => Interval a -> a
I.midpoint Interval n
Interval (N (Segment Closed v n))
llen)
where (l :: Segment Closed v n
l,r :: Segment Closed v n
r) = Segment Closed v n
s Segment Closed v n
-> N (Segment Closed v n)
-> (Segment Closed v n, Segment Closed v n)
forall p. Sectionable p => p -> N p -> (p, p)
`splitAtParam` 0.5
llen :: Interval (N (Segment Closed v n))
llen = N (Segment Closed v n)
-> Segment Closed v n -> Interval (N (Segment Closed v n))
forall p. HasArcLength p => N p -> p -> Interval (N p)
arcLengthBounded (n
N (Segment Closed v n)
mn -> n -> n
forall a. Fractional a => a -> a -> a
/10) Segment Closed v n
l
slen :: Interval (N (Segment Closed v n))
slen = N (Segment Closed v n)
-> Segment Closed v n -> Interval (N (Segment Closed v n))
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
(FixedSegment v n -> FixedSegment v n -> Bool)
-> (FixedSegment v n -> FixedSegment v n -> Bool)
-> Eq (FixedSegment v n)
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, Eq (FixedSegment v n)
Eq (FixedSegment v n) =>
(FixedSegment v n -> FixedSegment v n -> Ordering)
-> (FixedSegment v n -> FixedSegment v n -> Bool)
-> (FixedSegment v n -> FixedSegment v n -> Bool)
-> (FixedSegment v n -> FixedSegment v n -> Bool)
-> (FixedSegment v n -> FixedSegment v n -> Bool)
-> (FixedSegment v n -> FixedSegment v n -> FixedSegment v n)
-> (FixedSegment v n -> FixedSegment v n -> FixedSegment v n)
-> Ord (FixedSegment v n)
FixedSegment v n -> FixedSegment v n -> Bool
FixedSegment v n -> FixedSegment v n -> Ordering
FixedSegment v n -> FixedSegment v n -> FixedSegment v n
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
$cp1Ord :: forall (v :: * -> *) n. Ord (v n) => Eq (FixedSegment v n)
Ord, Int -> FixedSegment v n -> ShowS
[FixedSegment v n] -> ShowS
FixedSegment v n -> String
(Int -> FixedSegment v n -> ShowS)
-> (FixedSegment v n -> String)
-> ([FixedSegment v n] -> ShowS)
-> Show (FixedSegment v n)
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 :: (Point v n -> f (Point v' n'))
-> FixedSegment v n -> f (FixedSegment v' n')
each f :: Point v n -> f (Point v' n')
f (FLinear p0 :: Point v n
p0 p1 :: Point v n
p1) = Point v' n' -> Point v' n' -> FixedSegment v' n'
forall (v :: * -> *) n. Point v n -> Point v n -> FixedSegment v n
FLinear (Point v' n' -> Point v' n' -> FixedSegment v' n')
-> f (Point v' n') -> f (Point v' n' -> FixedSegment v' n')
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Point v n -> f (Point v' n')
f Point v n
p0 f (Point v' n' -> FixedSegment v' n')
-> f (Point v' n') -> f (FixedSegment v' n')
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 f :: Point v n -> f (Point v' n')
f (FCubic p0 :: Point v n
p0 p1 :: Point v n
p1 p2 :: Point v n
p2 p3 :: Point v n
p3) = Point v' n'
-> Point v' n' -> Point v' n' -> Point v' n' -> FixedSegment v' n'
forall (v :: * -> *) n.
Point v n
-> Point v n -> Point v n -> Point v n -> FixedSegment v n
FCubic (Point v' n'
-> Point v' n' -> Point v' n' -> Point v' n' -> FixedSegment v' n')
-> f (Point v' n')
-> f (Point v' n'
-> Point v' n' -> Point v' n' -> FixedSegment v' n')
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Point v n -> f (Point v' n')
f Point v n
p0 f (Point v' n' -> Point v' n' -> Point v' n' -> FixedSegment v' n')
-> f (Point v' n')
-> f (Point v' n' -> Point v' n' -> FixedSegment v' n')
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 f (Point v' n' -> Point v' n' -> FixedSegment v' n')
-> f (Point v' n') -> f (Point v' n' -> FixedSegment v' n')
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 f (Point v' n' -> FixedSegment v' n')
-> f (Point v' n') -> f (FixedSegment v' n')
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 p0 :: Point v n
p0 p1 :: Point v n
p1) = Point v n -> Point v n -> FixedSegment v n
forall (v :: * -> *) n. Point v n -> Point v n -> FixedSegment v n
FLinear Point v n
p1 Point v n
p0
reversing (FCubic p0 :: Point v n
p0 p1 :: Point v n
p1 p2 :: Point v n
p2 p3 :: Point v n
p3) = Point v n
-> Point v n -> Point v n -> Point v n -> FixedSegment v n
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 t :: Transformation (V (FixedSegment v n)) (N (FixedSegment v n))
t = ASetter
(FixedSegment v n) (FixedSegment v n) (Point v n) (Point v n)
-> (Point v n -> Point v n) -> FixedSegment v n -> FixedSegment v n
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
(FixedSegment v n) (FixedSegment v n) (Point v n) (Point v n)
forall s t a b. Each s t a b => Traversal s t a b
each (Transformation v n -> Point v n -> Point v n
forall (v :: * -> *) n.
(Additive v, Num n) =>
Transformation v n -> Point v n -> Point v n
papply Transformation v n
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 o :: Point (V (FixedSegment v n)) (N (FixedSegment v n))
o = ASetter
(FixedSegment v n) (FixedSegment v n) (Point v n) (Point v n)
-> (Point v n -> Point v n) -> FixedSegment v n -> FixedSegment v n
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
(FixedSegment v n) (FixedSegment v n) (Point v n) (Point v n)
forall s t a b. Each s t a b => Traversal s t a b
each (Point (V (Point v n)) (N (Point v n)) -> Point v n -> Point v n
forall t. HasOrigin t => Point (V t) (N t) -> t -> t
moveOriginTo Point (V (Point v n)) (N (Point v n))
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 f :: FixedSegment v n
f = Point v n -> Envelope v n -> Envelope v n
forall (v :: * -> *) n t.
(InSpace v n t, HasOrigin t) =>
Point v n -> t -> t
moveTo Point v n
p (Segment Closed v n
-> Envelope (V (Segment Closed v n)) (N (Segment Closed v n))
forall a. Enveloped a => a -> Envelope (V a) (N a)
getEnvelope Segment Closed v n
s)
where (p :: Point v n
p, s :: Segment Closed v n
s) = Located (Segment Closed v n) -> (Point v n, Segment Closed v n)
forall a. Located a -> (Point (V a) (N a), a)
viewLoc (Located (Segment Closed v n) -> (Point v n, Segment Closed v n))
-> Located (Segment Closed v n) -> (Point v n, Segment Closed v n)
forall a b. (a -> b) -> a -> b
$ FixedSegment v n -> Located (Segment Closed v n)
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 m :: N (FixedSegment v n)
m s :: FixedSegment v n
s = N (Located (Segment Closed v n))
-> Located (Segment Closed v n)
-> Interval (N (Located (Segment Closed v n)))
forall p. HasArcLength p => N p -> p -> Interval (N p)
arcLengthBounded N (Located (Segment Closed v n))
N (FixedSegment v n)
m (FixedSegment v n -> Located (Segment Closed v n)
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 m :: N (FixedSegment v n)
m s :: FixedSegment v n
s = N (Located (Segment Closed v n))
-> Located (Segment Closed v n)
-> N (Located (Segment Closed v n))
-> N (Located (Segment Closed v n))
forall p. HasArcLength p => N p -> p -> N p -> N p
arcLengthToParam N (Located (Segment Closed v n))
N (FixedSegment v n)
m (FixedSegment v n -> Located (Segment Closed v n)
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 :: Located (Segment Closed v n) -> FixedSegment v n
mkFixedSeg ls :: Located (Segment Closed v n)
ls =
case Located (Segment Closed v n)
-> (Point (V (Segment Closed v n)) (N (Segment Closed v n)),
Segment Closed v n)
forall a. Located a -> (Point (V a) (N a), a)
viewLoc Located (Segment Closed v n)
ls of
(p :: Point (V (Segment Closed v n)) (N (Segment Closed v n))
p, Linear (OffsetClosed v :: v n
v)) -> Point v n -> Point v n -> FixedSegment v n
forall (v :: * -> *) n. Point v n -> Point v n -> FixedSegment v n
FLinear Point v n
Point (V (Segment Closed v n)) (N (Segment Closed v n))
p (Point v n
Point (V (Segment Closed v n)) (N (Segment Closed v n))
p Point v n -> Diff (Point v) n -> Point v n
forall (p :: * -> *) a. (Affine p, Num a) => p a -> Diff p a -> p a
.+^ v n
Diff (Point v) n
v)
(p :: Point (V (Segment Closed v n)) (N (Segment Closed v n))
p, Cubic c1 :: v n
c1 c2 :: v n
c2 (OffsetClosed x2 :: v n
x2)) -> Point v n
-> Point v n -> Point v n -> Point v n -> FixedSegment v n
forall (v :: * -> *) n.
Point v n
-> Point v n -> Point v n -> Point v n -> FixedSegment v n
FCubic Point v n
Point (V (Segment Closed v n)) (N (Segment Closed v n))
p (Point v n
Point (V (Segment Closed v n)) (N (Segment Closed v n))
p Point v n -> Diff (Point v) n -> Point v n
forall (p :: * -> *) a. (Affine p, Num a) => p a -> Diff p a -> p a
.+^ v n
Diff (Point v) n
c1) (Point v n
Point (V (Segment Closed v n)) (N (Segment Closed v n))
p Point v n -> Diff (Point v) n -> Point v n
forall (p :: * -> *) a. (Affine p, Num a) => p a -> Diff p a -> p a
.+^ v n
Diff (Point v) n
c2) (Point v n
Point (V (Segment Closed v n)) (N (Segment Closed v n))
p Point v n -> Diff (Point v) n -> Point v n
forall (p :: * -> *) a. (Affine p, Num a) => p a -> Diff p a -> p a
.+^ v n
Diff (Point v) n
x2)
fromFixedSeg :: (Num n, Additive v) => FixedSegment v n -> Located (Segment Closed v n)
fromFixedSeg :: FixedSegment v n -> Located (Segment Closed v n)
fromFixedSeg (FLinear p1 :: Point v n
p1 p2 :: Point v n
p2) = v n -> Segment Closed v n
forall (v :: * -> *) n. v n -> Segment Closed v n
straight (Point v n
p2 Point v n -> Point v n -> Diff (Point v) n
forall (p :: * -> *) a. (Affine p, Num a) => p a -> p a -> Diff p a
.-. Point v n
p1) Segment Closed v n
-> Point (V (Segment Closed v n)) (N (Segment Closed v n))
-> Located (Segment Closed v n)
forall a. a -> Point (V a) (N a) -> Located a
`at` Point v n
Point (V (Segment Closed v n)) (N (Segment Closed v n))
p1
fromFixedSeg (FCubic x1 :: Point v n
x1 c1 :: Point v n
c1 c2 :: Point v n
c2 x2 :: Point v n
x2) = v n -> v n -> v n -> Segment Closed v n
forall (v :: * -> *) n. v n -> v n -> v n -> Segment Closed v n
bezier3 (Point v n
c1 Point v n -> Point v n -> Diff (Point v) n
forall (p :: * -> *) a. (Affine p, Num a) => p a -> p a -> Diff p a
.-. Point v n
x1) (Point v n
c2 Point v n -> Point v n -> Diff (Point v) n
forall (p :: * -> *) a. (Affine p, Num a) => p a -> p a -> Diff p a
.-. Point v n
x1) (Point v n
x2 Point v n -> Point v n -> Diff (Point v) n
forall (p :: * -> *) a. (Affine p, Num a) => p a -> p a -> Diff p a
.-. Point v n
x1) Segment Closed v n
-> Point (V (Segment Closed v n)) (N (Segment Closed v n))
-> Located (Segment Closed v n)
forall a. a -> Point (V a) (N a) -> Located a
`at` Point v n
Point (V (Segment Closed v n)) (N (Segment Closed v n))
x1
fixedSegIso :: (Num n, Additive v) => Iso' (FixedSegment v n) (Located (Segment Closed v n))
fixedSegIso :: Iso' (FixedSegment v n) (Located (Segment Closed v n))
fixedSegIso = (FixedSegment v n -> Located (Segment Closed v n))
-> (Located (Segment Closed v n) -> FixedSegment v n)
-> Iso' (FixedSegment v n) (Located (Segment Closed v n))
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso FixedSegment v n -> Located (Segment Closed v n)
forall n (v :: * -> *).
(Num n, Additive v) =>
FixedSegment v n -> Located (Segment Closed v n)
fromFixedSeg Located (Segment Closed v n) -> FixedSegment v n
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 p1 :: Point v n
p1 p2 :: Point v n
p2) t :: N (FixedSegment v n)
t = n -> Point v n -> Point v n -> Point v n
forall (f :: * -> *) a.
(Additive f, Num a) =>
a -> f a -> f a -> f a
lerp n
N (FixedSegment v n)
t Point v n
p2 Point v n
p1
atParam (FCubic x1 :: Point v n
x1 c1 :: Point v n
c1 c2 :: Point v n
c2 x2 :: Point v n
x2) t :: N (FixedSegment v n)
t = Point v n
Codomain (FixedSegment v n) (N (FixedSegment v n))
p3
where p11 :: Point v n
p11 = n -> Point v n -> Point v n -> Point v n
forall (f :: * -> *) a.
(Additive f, Num a) =>
a -> f a -> f a -> f a
lerp n
N (FixedSegment v n)
t Point v n
c1 Point v n
x1
p12 :: Point v n
p12 = n -> Point v n -> Point v n -> Point v n
forall (f :: * -> *) a.
(Additive f, Num a) =>
a -> f a -> f a -> f a
lerp n
N (FixedSegment v n)
t Point v n
c2 Point v n
c1
p13 :: Point v n
p13 = n -> Point v n -> Point v n -> Point v n
forall (f :: * -> *) a.
(Additive f, Num a) =>
a -> f a -> f a -> f a
lerp n
N (FixedSegment v n)
t Point v n
x2 Point v n
c2
p21 :: Point v n
p21 = n -> Point v n -> Point v n -> Point v n
forall (f :: * -> *) a.
(Additive f, Num a) =>
a -> f a -> f a -> f a
lerp n
N (FixedSegment v n)
t Point v n
p12 Point v n
p11
p22 :: Point v n
p22 = n -> Point v n -> Point v n -> Point v n
forall (f :: * -> *) a.
(Additive f, Num a) =>
a -> f a -> f a -> f a
lerp n
N (FixedSegment v n)
t Point v n
p13 Point v n
p12
p3 :: Point v n
p3 = n -> Point v n -> Point v n -> Point v n
forall (f :: * -> *) a.
(Additive f, Num a) =>
a -> f a -> f a -> f a
lerp n
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 p0 :: Point v n
p0 _) = Point v n
Codomain (FixedSegment v n) (N (FixedSegment v n))
p0
atStart (FCubic p0 :: Point v n
p0 _ _ _) = Point v n
Codomain (FixedSegment v n) (N (FixedSegment v n))
p0
atEnd :: FixedSegment v n
-> Codomain (FixedSegment v n) (N (FixedSegment v n))
atEnd (FLinear _ p1 :: Point v n
p1) = Point v n
Codomain (FixedSegment v n) (N (FixedSegment v n))
p1
atEnd (FCubic _ _ _ p1 :: Point v n
p1 ) = Point v n
Codomain (FixedSegment v n) (N (FixedSegment 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 p0 :: Point v n
p0 p1 :: Point v n
p1) t :: N (FixedSegment v n)
t = (FixedSegment v n
left, FixedSegment v n
right)
where left :: FixedSegment v n
left = Point v n -> Point v n -> FixedSegment v n
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 = Point v n -> Point v n -> FixedSegment v n
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 = n -> Point v n -> Point v n -> Point v n
forall (f :: * -> *) a.
(Additive f, Num a) =>
a -> f a -> f a -> f a
lerp n
N (FixedSegment v n)
t Point v n
p1 Point v n
p0
splitAtParam (FCubic p0 :: Point v n
p0 c1 :: Point v n
c1 c2 :: Point v n
c2 p1 :: Point v n
p1) t :: N (FixedSegment v n)
t = (FixedSegment v n
left, FixedSegment v n
right)
where left :: FixedSegment v n
left = Point v n
-> Point v n -> Point v n -> Point v n -> FixedSegment v n
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 = Point v n
-> Point v n -> Point v n -> Point v n -> FixedSegment v n
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 = n -> Point v n -> Point v n -> Point v n
forall (f :: * -> *) a.
(Additive f, Num a) =>
a -> f a -> f a -> f a
lerp n
N (FixedSegment v n)
t Point v n
c1 Point v n
p0
p :: Point v n
p = n -> Point v n -> Point v n -> Point v n
forall (f :: * -> *) a.
(Additive f, Num a) =>
a -> f a -> f a -> f a
lerp n
N (FixedSegment v n)
t Point v n
c2 Point v n
c1
d :: Point v n
d = n -> Point v n -> Point v n -> Point v n
forall (f :: * -> *) a.
(Additive f, Num a) =>
a -> f a -> f a -> f a
lerp n
N (FixedSegment v n)
t Point v n
p1 Point v n
c2
b :: Point v n
b = n -> Point v n -> Point v n -> Point v n
forall (f :: * -> *) a.
(Additive f, Num a) =>
a -> f a -> f a -> f a
lerp n
N (FixedSegment v n)
t Point v n
p Point v n
a
c :: Point v n
c = n -> Point v n -> Point v n -> Point v n
forall (f :: * -> *) a.
(Additive f, Num a) =>
a -> f a -> f a -> f a
lerp n
N (FixedSegment v n)
t Point v n
d Point v n
p
cut :: Point v n
cut = n -> Point v n -> Point v n -> Point v n
forall (f :: * -> *) a.
(Additive f, Num a) =>
a -> f a -> f a -> f a
lerp n
N (FixedSegment v n)
t Point v n
c Point v n
b
reverseDomain :: FixedSegment v n -> FixedSegment v n
reverseDomain (FLinear p0 :: Point v n
p0 p1 :: Point v n
p1) = Point v n -> Point v n -> FixedSegment v n
forall (v :: * -> *) n. Point v n -> Point v n -> FixedSegment v n
FLinear Point v n
p1 Point v n
p0
reverseDomain (FCubic p0 :: Point v n
p0 c1 :: Point v n
c1 c2 :: Point v n
c2 p1 :: Point v n
p1) = Point v n
-> Point v n -> Point v n -> Point v n -> FixedSegment v n
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 (b -> SegCount -> SegCount
NonEmpty SegCount -> SegCount
SegCount -> SegCount -> SegCount
(SegCount -> SegCount -> SegCount)
-> (NonEmpty SegCount -> SegCount)
-> (forall b. Integral b => b -> SegCount -> SegCount)
-> Semigroup 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 :: 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
Semigroup SegCount =>
SegCount
-> (SegCount -> SegCount -> SegCount)
-> ([SegCount] -> SegCount)
-> Monoid 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
$cp1Monoid :: Semigroup SegCount
Monoid)
instance Wrapped SegCount where
type Unwrapped SegCount = Sum Int
_Wrapped' :: p (Unwrapped SegCount) (f (Unwrapped SegCount))
-> p SegCount (f SegCount)
_Wrapped' = (SegCount -> Sum Int)
-> (Sum Int -> SegCount)
-> Iso SegCount SegCount (Sum Int) (Sum Int)
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (\(SegCount x :: 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' :: p (Unwrapped (ArcLength n)) (f (Unwrapped (ArcLength n)))
-> p (ArcLength n) (f (ArcLength n))
_Wrapped' = (ArcLength n -> (Sum (Interval n), n -> Sum (Interval n)))
-> ((Sum (Interval n), n -> Sum (Interval n)) -> ArcLength n)
-> Iso
(ArcLength n)
(ArcLength n)
(Sum (Interval n), n -> Sum (Interval n))
(Sum (Interval n), n -> Sum (Interval n))
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (\(ArcLength x :: (Sum (Interval n), n -> Sum (Interval n))
x) -> (Sum (Interval n), n -> Sum (Interval n))
x) (Sum (Interval n), n -> Sum (Interval n)) -> ArcLength n
forall n. (Sum (Interval n), n -> Sum (Interval n)) -> ArcLength n
ArcLength
instance Rewrapped (ArcLength n) (ArcLength n')
getArcLengthCached :: ArcLength n -> Interval n
getArcLengthCached :: ArcLength n -> Interval n
getArcLengthCached = Sum (Interval n) -> Interval n
forall a. Sum a -> a
getSum (Sum (Interval n) -> Interval n)
-> (ArcLength n -> Sum (Interval n)) -> ArcLength n -> Interval n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Sum (Interval n), n -> Sum (Interval n)) -> Sum (Interval n)
forall a b. (a, b) -> a
fst ((Sum (Interval n), n -> Sum (Interval n)) -> Sum (Interval n))
-> (ArcLength n -> (Sum (Interval n), n -> Sum (Interval n)))
-> ArcLength n
-> Sum (Interval n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Unwrapped (ArcLength n) -> ArcLength n)
-> ArcLength n -> Unwrapped (ArcLength n)
forall s. Wrapped s => (Unwrapped s -> s) -> s -> Unwrapped s
op Unwrapped (ArcLength n) -> ArcLength n
forall n. (Sum (Interval n), n -> Sum (Interval n)) -> ArcLength n
ArcLength
getArcLengthFun :: ArcLength n -> n -> Interval n
getArcLengthFun :: ArcLength n -> n -> Interval n
getArcLengthFun = (Sum (Interval n) -> Interval n)
-> (n -> Sum (Interval n)) -> n -> Interval n
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Sum (Interval n) -> Interval n
forall a. Sum a -> a
getSum ((n -> Sum (Interval n)) -> n -> Interval n)
-> (ArcLength n -> n -> Sum (Interval n))
-> ArcLength n
-> n
-> Interval n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Sum (Interval n), n -> Sum (Interval n)) -> n -> Sum (Interval n)
forall a b. (a, b) -> b
snd ((Sum (Interval n), n -> Sum (Interval n))
-> n -> Sum (Interval n))
-> (ArcLength n -> (Sum (Interval n), n -> Sum (Interval n)))
-> ArcLength n
-> n
-> Sum (Interval n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Unwrapped (ArcLength n) -> ArcLength n)
-> ArcLength n -> Unwrapped (ArcLength n)
forall s. Wrapped s => (Unwrapped s -> s) -> s -> Unwrapped s
op Unwrapped (ArcLength n) -> ArcLength n
forall n. (Sum (Interval n), n -> Sum (Interval n)) -> ArcLength n
ArcLength
getArcLengthBounded :: (Num n, Ord n)
=> n -> ArcLength n -> Interval n
getArcLengthBounded :: n -> ArcLength n -> Interval n
getArcLengthBounded eps :: n
eps al :: ArcLength n
al
| Interval n -> n
forall a. Num a => Interval a -> a
I.width Interval n
cached n -> n -> Bool
forall a. Ord a => a -> a -> Bool
<= n
eps = Interval n
cached
| Bool
otherwise = ArcLength n -> n -> Interval n
forall n. ArcLength n -> n -> Interval n
getArcLengthFun ArcLength n
al n
eps
where
cached :: Interval n
cached = ArcLength n -> Interval n
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' :: p (Unwrapped (TotalOffset v n)) (f (Unwrapped (TotalOffset v n)))
-> p (TotalOffset v n) (f (TotalOffset v n))
_Wrapped' = (TotalOffset v n -> v n)
-> (v n -> TotalOffset v n)
-> Iso (TotalOffset v n) (TotalOffset v n) (v n) (v n)
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (\(TotalOffset x :: v n
x) -> v n
x) v n -> TotalOffset v n
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 v1 :: v n
v1 <> :: TotalOffset v n -> TotalOffset v n -> TotalOffset v n
<> TotalOffset v2 :: v n
v2 = v n -> TotalOffset v n
forall (v :: * -> *) n. v n -> TotalOffset v n
TotalOffset (v n
v1 v n -> v n -> v n
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 = v n -> TotalOffset v n
forall (v :: * -> *) n. v n -> TotalOffset v n
TotalOffset v n
forall (f :: * -> *) a. (Additive f, Num a) => f a
zero
mappend :: TotalOffset v n -> TotalOffset v n -> TotalOffset v n
mappend = TotalOffset v n -> TotalOffset v n -> TotalOffset v n
forall a. Semigroup a => a -> a -> a
(<>)
data OffsetEnvelope v n = OffsetEnvelope
{ OffsetEnvelope v n -> TotalOffset v n
_oeOffset :: !(TotalOffset 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 o1 :: TotalOffset v n
o1 e1 :: Envelope v n
e1) <> :: OffsetEnvelope v n -> OffsetEnvelope v n -> OffsetEnvelope v n
<> (OffsetEnvelope o2 :: TotalOffset v n
o2 e2 :: Envelope v n
e2)
= let !negOff :: v n
negOff = v n -> v n
forall (f :: * -> *) a. (Functor f, Num a) => f a -> f a
negated (v n -> v n) -> (TotalOffset v n -> v n) -> TotalOffset v n -> v n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Unwrapped (TotalOffset v n) -> TotalOffset v n)
-> TotalOffset v n -> Unwrapped (TotalOffset v n)
forall s. Wrapped s => (Unwrapped s -> s) -> s -> Unwrapped s
op Unwrapped (TotalOffset v n) -> TotalOffset v n
forall (v :: * -> *) n. v n -> TotalOffset v n
TotalOffset (TotalOffset v n -> v n) -> TotalOffset v n -> v n
forall a b. (a -> b) -> a -> b
$ TotalOffset v n
o1
e2Off :: Envelope v n
e2Off = v n -> Envelope v n -> Envelope v n
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 = () -> ((v n -> n) -> ()) -> Maybe (v n -> n) -> ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe () (\f :: v n -> n
f -> v n -> n
f (v n -> n) -> () -> ()
forall a b. a -> b -> b
`seq` ()) (Maybe (v n -> n) -> ()) -> Maybe (v n -> n) -> ()
forall a b. (a -> b) -> a -> b
$ Envelope v n -> Maybe (v n -> n)
forall (v :: * -> *) n. Envelope v n -> Maybe (v n -> n)
appEnvelope Envelope v n
e2Off
in TotalOffset v n -> Envelope v n -> OffsetEnvelope v n
forall (v :: * -> *) n.
TotalOffset v n -> Envelope v n -> OffsetEnvelope v n
OffsetEnvelope
(TotalOffset v n
o1 TotalOffset v n -> TotalOffset v n -> TotalOffset v n
forall a. Semigroup a => a -> a -> a
<> TotalOffset v n
o2)
(Envelope v n
e1 Envelope v n -> Envelope v n -> Envelope v n
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 = SegMeasure v n -> SegMeasure v n
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 s :: Segment Closed v n
s = (Sum Int -> SegCount
SegCount (Sum Int -> SegCount) -> (Int -> Sum Int) -> Int -> SegCount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Sum Int
forall a. a -> Sum a
Sum) 1
SegCount
-> (ArcLength n ::: (OffsetEnvelope v n ::: ())) -> SegMeasure v n
forall a l. a -> l -> a ::: l
*: (Sum (Interval n), n -> Sum (Interval n)) -> ArcLength n
forall n. (Sum (Interval n), n -> Sum (Interval n)) -> ArcLength n
ArcLength ( Interval n -> Sum (Interval n)
forall a. a -> Sum a
Sum (Interval n -> Sum (Interval n)) -> Interval n -> Sum (Interval n)
forall a b. (a -> b) -> a -> b
$ N (Segment Closed v n)
-> Segment Closed v n -> Interval (N (Segment Closed v n))
forall p. HasArcLength p => N p -> p -> Interval (N p)
arcLengthBounded (n
forall a. Fractional a => a
stdTolerancen -> n -> n
forall a. Fractional a => a -> a -> a
/100) Segment Closed v n
s
, Interval n -> Sum (Interval n)
forall a. a -> Sum a
Sum (Interval n -> Sum (Interval n))
-> (n -> Interval n) -> n -> Sum (Interval n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (n -> Segment Closed v n -> Interval n)
-> Segment Closed v n -> n -> Interval n
forall a b c. (a -> b -> c) -> b -> a -> c
flip n -> Segment Closed v n -> Interval n
forall p. HasArcLength p => N p -> p -> Interval (N p)
arcLengthBounded Segment Closed v n
s )
ArcLength n
-> (OffsetEnvelope v n ::: ())
-> ArcLength n ::: (OffsetEnvelope v n ::: ())
forall a l. a -> l -> a ::: l
*: TotalOffset v n -> Envelope v n -> OffsetEnvelope v n
forall (v :: * -> *) n.
TotalOffset v n -> Envelope v n -> OffsetEnvelope v n
OffsetEnvelope (v n -> TotalOffset v n
forall (v :: * -> *) n. v n -> TotalOffset v n
TotalOffset (v n -> TotalOffset v n)
-> (Segment Closed v n -> v n)
-> Segment Closed v n
-> TotalOffset v n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Segment Closed v n -> v n
forall (v :: * -> *) n. Segment Closed v n -> v n
segOffset (Segment Closed v n -> TotalOffset v n)
-> Segment Closed v n -> TotalOffset v n
forall a b. (a -> b) -> a -> b
$ Segment Closed v n
s)
(Segment Closed v n
-> Envelope (V (Segment Closed v n)) (N (Segment Closed v n))
forall a. Enveloped a => a -> Envelope (V a) (N a)
getEnvelope Segment Closed v n
s)
OffsetEnvelope v n -> () -> OffsetEnvelope v n ::: ()
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 :: Segment Open v n
segment = case Segment Open v n
segment of
Linear OffsetOpen -> Putter Bool
forall t. Serialize t => Putter t
Serialize.put Bool
True
Cubic v :: v n
v w :: v n
w OffsetOpen -> do
Putter Bool
forall t. Serialize t => Putter t
Serialize.put Bool
False
Putter (v n)
forall t. Serialize t => Putter t
Serialize.put v n
v
Putter (v n)
forall t. Serialize t => Putter t
Serialize.put v n
w
{-# INLINE get #-}
get :: Get (Segment Open v n)
get = do
Bool
isLinear <- Get Bool
forall t. Serialize t => Get t
Serialize.get
case Bool
isLinear of
True -> Segment Open v n -> Get (Segment Open v n)
forall (m :: * -> *) a. Monad m => a -> m a
return (Offset Open v n -> Segment Open v n
forall c (v :: * -> *) n. Offset c v n -> Segment c v n
Linear Offset Open v n
forall (v :: * -> *) n. Offset Open v n
OffsetOpen)
False -> do
v n
v <- Get (v n)
forall t. Serialize t => Get t
Serialize.get
v n
w <- Get (v n)
forall t. Serialize t => Get t
Serialize.get
Segment Open v n -> Get (Segment Open v n)
forall (m :: * -> *) a. Monad m => a -> m a
return (v n -> v n -> Offset Open v n -> Segment Open v n
forall c (v :: * -> *) n.
v n -> v n -> Offset c v n -> Segment c v n
Cubic v n
v v n
w Offset Open v n
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 :: Segment Closed v n
segment = case Segment Closed v n
segment of
Linear (OffsetClosed z :: v n
z) -> do
Putter (v n)
forall t. Serialize t => Putter t
Serialize.put v n
z
Putter Bool
forall t. Serialize t => Putter t
Serialize.put Bool
True
Cubic v :: v n
v w :: v n
w (OffsetClosed z :: v n
z) -> do
Putter (v n)
forall t. Serialize t => Putter t
Serialize.put v n
z
Putter Bool
forall t. Serialize t => Putter t
Serialize.put Bool
False
Putter (v n)
forall t. Serialize t => Putter t
Serialize.put v n
v
Putter (v n)
forall t. Serialize t => Putter t
Serialize.put v n
w
{-# INLINE get #-}
get :: Get (Segment Closed v n)
get = do
v n
z <- Get (v n)
forall t. Serialize t => Get t
Serialize.get
Bool
isLinear <- Get Bool
forall t. Serialize t => Get t
Serialize.get
case Bool
isLinear of
True -> Segment Closed v n -> Get (Segment Closed v n)
forall (m :: * -> *) a. Monad m => a -> m a
return (Offset Closed v n -> Segment Closed v n
forall c (v :: * -> *) n. Offset c v n -> Segment c v n
Linear (v n -> Offset Closed v n
forall (v :: * -> *) n. v n -> Offset Closed v n
OffsetClosed v n
z))
False -> do
v n
v <- Get (v n)
forall t. Serialize t => Get t
Serialize.get
v n
w <- Get (v n)
forall t. Serialize t => Get t
Serialize.get
Segment Closed v n -> Get (Segment Closed v n)
forall (m :: * -> *) a. Monad m => a -> m a
return (v n -> v n -> Offset Closed v n -> Segment Closed v n
forall c (v :: * -> *) n.
v n -> v n -> Offset c v n -> Segment c v n
Cubic v n
v v n
w (v n -> Offset Closed v n
forall (v :: * -> *) n. v n -> Offset Closed v n
OffsetClosed v n
z))