{-# 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
-- Copyright   :  (c) 2011-2013 diagrams-lib team (see LICENSE)
-- License     :  BSD-style (see LICENSE)
-- Maintainer  :  diagrams-discuss@googlegroups.com
--
-- A /segment/ is a translation-invariant, atomic path.  Currently,
-- there are two types: linear (/i.e./ just a straight line to the
-- endpoint) and cubic Bézier curves (/i.e./ a curve to an endpoint
-- with two control points).  This module contains tools for creating
-- and manipulating segments, as well as a definition of segments with
-- a fixed location (useful for backend implementors).
--
-- Generally speaking, casual users of diagrams should not need this
-- module; the higher-level functionality provided by
-- "Diagrams.Trail", "Diagrams.TrailLike", and "Diagrams.Path" should
-- usually suffice.  However, directly manipulating segments can
-- occasionally be useful.
--
-----------------------------------------------------------------------------

module Diagrams.Segment
       ( -- * Open/closed tags

         Open, Closed

         -- * Segment offsets

       , Offset(..) , segOffset

         -- * Constructing and modifying segments

       , Segment(..), straight, bezier3, bézier3, reverseSegment, mapSegmentVectors
       , openLinear, openCubic

         -- * Fixed (absolutely located) segments
       , FixedSegment(..)
       , mkFixedSeg, fromFixedSeg
       , fixedSegIso

         -- * Segment measures
         -- $segmeas

       , 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

------------------------------------------------------------
--  Open/closed type tags  ---------------------------------
------------------------------------------------------------

-- Eventually we should use DataKinds for this, but not until we drop
-- support for GHC 7.4.

-- | Type tag for open segments.
data Open

-- | Type tag for closed segments.
data Closed

------------------------------------------------------------
--  Segment offsets  ---------------------------------------
------------------------------------------------------------

-- | The /offset/ of a segment is the vector from its starting point
--   to its end.  The offset for an /open/ segment is determined by
--   the context, /i.e./ its endpoint is not fixed.  The offset for a
--   /closed/ segment is stored explicitly, /i.e./ its endpoint is at
--   a fixed offset from its start.
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 a -> b
_ Offset c v a
OffsetOpen       = Offset c v b
forall (v :: * -> *) n. Offset Open v n
OffsetOpen
  fmap a -> b
f (OffsetClosed 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 v n -> f (v' n')
f (OffsetClosed 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 v n -> f (v' n')
_ Offset c v n
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 #-}

-- | Reverses the direction of closed offsets.
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) = v n -> Offset Closed v n
forall (v :: * -> *) n. v n -> Offset Closed v n
OffsetClosed (v n -> Offset Closed v n) -> v n -> Offset Closed 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 Transformation (V (Offset c v n)) (N (Offset c v n))
_ Offset c v n
OffsetOpen       = Offset c v n
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) = 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)

------------------------------------------------------------
--  Constructing segments  ---------------------------------
------------------------------------------------------------

-- | The atomic constituents of the concrete representation currently
--   used for trails are /segments/, currently limited to
--   single straight lines or cubic Bézier curves.  Segments are
--   /translationally invariant/, that is, they have no particular
--   \"location\" and are unaffected by translations.  They are,
--   however, affected by other transformations such as rotations and
--   scales.
data Segment c v n
    = Linear !(Offset c v n)
      -- ^ A linear segment with given offset.

    | Cubic !(v n) !(v n) !(Offset c v n)
      -- ^ A cubic Bézier segment specified by
      --   three offsets from the starting
      --   point to the first control point,
      --   second control point, and ending
      --   point, respectively.

  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 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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
      String -> ShowS
showString String
"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 Int
11 v n
v
    Cubic v n
v1 v n
v2 (OffsetClosed v n
v3) -> Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
      String -> ShowS
showString String
"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 Int
11 v n
v1 ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' '
                             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 Int
11 v n
v2 ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' '
                             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 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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
      String -> ShowS
showString String
"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 Int
11 v n
v1 ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' '
                              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 Int
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 v n -> f (v' n')
f (Linear 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 v n -> f (v' n')
f (Cubic v n
v1 v n
v2 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 #-}

-- | Reverse the direction of a segment.
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

-- | Map over the vectors of each segment.
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

-- Note, can't yet have Haddock comments on GADT constructors; see
-- http://trac.haskell.org/haddock/ticket/43. For now we don't need
-- Segment to be a GADT but we might in the future. (?)

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 NullBackend
_ Segment c v n
_ = Render NullBackend (V (Segment c v n)) (N (Segment c v n))
forall a. Monoid a => a
mempty

-- | @'straight' v@ constructs a translationally invariant linear
--   segment with direction and length given by the vector @v@.
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

-- Note, if we didn't have a Linear constructor we could also create
-- linear segments with @Cubic (v ^/ 3) (2 *^ (v ^/ 3)) v@.  Those
-- would not be precisely the same, however, since we can actually
-- observe how segments are parametrized.

-- | @bezier3 c1 c2 x@ constructs a translationally invariant cubic
--   Bézier curve where the offsets from the first endpoint to the
--   first and second control point and endpoint are respectively
--   given by @c1@, @c2@, and @x@.
bezier3 :: v n -> v n -> v n -> Segment Closed v n
bezier3 :: v n -> v n -> v n -> Segment Closed v n
bezier3 v n
c1 v n
c2 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@ is the same as @bezier3@, but with more snobbery.
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

-- | 'atParam' yields a parametrized view of segments as continuous
--   functions @[0,1] -> v@, which give the offset from the start of
--   the segment for each value of the parameter between @0@ and @1@.
--   It is designed to be used infix, like @seg ``atParam`` 0.5@.
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
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 v n
c1 v n
c2 (OffsetClosed v n
x2)) N (Segment Closed v n)
t =     (n
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
^+^ (n
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' = n
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 n
v))    = v n
Codomain (Segment Closed v n) (N (Segment Closed v n))
v
  atEnd (Cubic v n
_ v n
_ (OffsetClosed v n
v)) = v n
Codomain (Segment Closed v n) (N (Segment Closed v n))
v

-- | Compute the offset from the start of a segment to the
--   end.  Note that in the case of a Bézier segment this is /not/ the
--   same as the length of the curve itself; for that, see 'arcLength'.
segOffset :: Segment Closed v n -> v n
segOffset :: 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

-- | An open linear segment. This means the trail makes a straight line
-- from the last segment the beginning to form a loop.
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

-- | An open cubic segment. This means the trail makes a cubic bézier
-- with control vectors @v1@ and @v2@ to form a loop.
openCubic :: v n -> v n -> Segment Open v n
openCubic :: v n -> v n -> Segment Open v n
openCubic v n
v1 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

------------------------------------------------------------
--  Computing segment envelope  ------------------------------
------------------------------------------------------------

{- 3 (1-t)^2 t c1 + 3 (1-t) t^2 c2 + t^3 x2

   Can we compute the projection of B(t) onto a given vector v?

   u.v = |u||v| cos th

   |proj_v u| = cos th * |u|
              = (u.v/|v|)

   so B_v(t) = (B(t).v/|v|)

   Then take the derivative of this wrt. t, get a quadratic, solve.

   B_v(t) = (1/|v|) *     -- note this does not affect max/min, can solve for t first
            3 (1-t)^2 t (c1.v) + 3 (1-t) t^2 (c2.v) + t^3 (x2.v)
          = t^3 ((3c1 - 3c2 + x2).v) + t^2 ((-6c1 + 3c2).v) + t (3c1.v)

   B_v'(t) = t^2 (3(3c1 - 3c2 + x2).v) + t (6(-2c1 + c2).v) + 3c1.v

   Set equal to zero, use quadratic formula.
-}

-- | The envelope for a segment is based at the segment's start.
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 n
forall (v :: * -> *) n. (v n -> n) -> Envelope v n
mkEnvelope ((v n -> n) -> Envelope v n) -> (v n -> n) -> Envelope v n
forall a b. (a -> b) -> a -> b
$ \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 (\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
0,n
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 v n
c1 v n
c2 (OffsetClosed v n
x2))) = (v n -> n) -> Envelope v n
forall (v :: * -> *) n. (v n -> n) -> Envelope v n
mkEnvelope ((v n -> n) -> Envelope v n) -> (v n -> n) -> Envelope v n
forall a b. (a -> b) -> a -> b
$ \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 (\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
$
    [n
0,n
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
>n
0) (n -> n -> Bool
forall a. Ord a => a -> a -> Bool
<n
1))
      (n -> n -> n -> [n]
forall d. (Floating d, Ord d) => d -> d -> d -> [d]
quadForm (n
3 n -> n -> n
forall a. Num a => a -> a -> a
* ((n
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
^-^ n
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))
                (n
6 n -> n -> n
forall a. Num a => a -> a -> a
* (((-n
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))
                ((n
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))

------------------------------------------------------------
--  Manipulating segments
------------------------------------------------------------

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  = 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 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  = 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

-- | Reverse the direction of a segment.
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 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 v n
c1 v n
c2 (OffsetClosed 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)

-- Imitates I.elem for intervals<0.8 and I.member for intervals>=0.8
member :: Ord a => a -> I.Interval a -> Bool
member :: a -> Interval a -> Bool
member a
x (I.I a
a 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 N (Segment Closed v n)
_ (Linear (OffsetClosed v n
x1)) = n -> Interval n
forall a. a -> Interval a
I.singleton (n -> Interval n) -> n -> Interval 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 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 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
/n
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
/n
2) Segment Closed v n
r
   where (Segment Closed v n
l,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` N (Segment Closed v n)
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 N (Segment Closed v n)
m Segment Closed v n
s N (Segment Closed v n)
_ | 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
== n
0 = N (Segment Closed v n)
0.5
  arcLengthToParam N (Segment Closed v n)
m s :: Segment Closed v n
s@(Linear {}) 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 N (Segment Closed v n)
m s :: Segment Closed v n
s@(Cubic {})  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
/n
2) (n
N (Segment Closed v n)
mn -> n -> n
forall a. Fractional a => a -> a -> a
/n
2) = N (Segment Closed v n)
0
    | n
N (Segment Closed v n)
len n -> n -> Bool
forall a. Ord a => a -> a -> Bool
< n
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 (-n
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    = N (Segment Closed v n)
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     = n
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 N (Segment Closed v n)
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
*n
0.5) (n -> n) -> n -> 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
+n
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
*n
0.5)
                           (n -> n) -> n -> 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
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
/n
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 (Segment Closed v n
l,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` N (Segment Closed v n)
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
/n
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

  -- Note, the above seems to be quite slow since it duplicates a lot of
  -- work.  We could trade off some time for space by building a tree of
  -- parameter values (up to a certain depth...)

------------------------------------------------------------
--  Fixed segments
------------------------------------------------------------

-- | @FixedSegment@s are like 'Segment's except that they have
--   absolute locations.  @FixedSegment v@ is isomorphic to @Located
--   (Segment Closed v)@, as witnessed by 'mkFixedSeg' and
--   'fromFixedSeg', but @FixedSegment@ is convenient when one needs
--   the absolute locations of the vertices and control points.
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 Point v n -> f (Point v' n')
f (FLinear Point v n
p0 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 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) = 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 #-}

-- | Reverses the control points.
instance Reversing (FixedSegment v n) where
  reversing :: FixedSegment v n -> FixedSegment v n
reversing (FLinear Point v n
p0 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 Point v n
p0 Point v n
p1 Point v n
p2 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 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 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 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 (Point v n
p, Segment Closed v n
s) = 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)
 -> (Point (V (Segment Closed v n)) (N (Segment Closed v n)),
     Segment Closed v n))
-> Located (Segment Closed v n)
-> (Point (V (Segment Closed v n)) (N (Segment Closed 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

    -- Eventually we might decide it's cleaner/more efficient (?) to
    -- have all the computation in the FixedSegment instance of
    -- Envelope, and implement the Segment instance in terms of it,
    -- instead of the other way around

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 = 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 N (FixedSegment v n)
m 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)

-- | Create a 'FixedSegment' from a located 'Segment'.
mkFixedSeg :: (Num n, Additive v) => Located (Segment Closed v n) -> FixedSegment v n
mkFixedSeg :: Located (Segment Closed v n) -> FixedSegment v n
mkFixedSeg 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
    (Point (V (Segment Closed v n)) (N (Segment Closed v n))
p, Linear (OffsetClosed 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)
    (Point (V (Segment Closed v n)) (N (Segment Closed v n))
p, Cubic v n
c1 v n
c2 (OffsetClosed 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)

-- | Convert a 'FixedSegment' back into a located 'Segment'.
fromFixedSeg :: (Num n, Additive v) => FixedSegment v n -> Located (Segment Closed v n)
fromFixedSeg :: FixedSegment v n -> Located (Segment Closed v n)
fromFixedSeg (FLinear Point v n
p1 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 Point v n
x1 Point v n
c1 Point v n
c2 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

-- | Use a 'FixedSegment' to make an 'Iso' between an
-- a fixed segment and a located segment.
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 Point v n
p1 Point v n
p2) 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 Point v n
x1 Point v n
c1 Point v n
c2 Point v n
x2) 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 Point v n
p0 Point v n
_)     = Point v n
Codomain (FixedSegment v n) (N (FixedSegment v n))
p0
  atStart (FCubic  Point v n
p0 Point v n
_ Point v n
_ Point v n
_) = 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 Point v n
_ Point v n
p1)     = Point v n
Codomain (FixedSegment v n) (N (FixedSegment v n))
p1
  atEnd   (FCubic Point v n
_ Point v n
_ Point v n
_ 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 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  = 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 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  = 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
          -- first round
          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
          -- second round
          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
          -- final round
          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 Point v n
p0 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 Point v n
p0 Point v n
c1 Point v n
c2 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

------------------------------------------------------------
--  Segment measures  --------------------------------------
------------------------------------------------------------

-- $segmeas
-- Trails store a sequence of segments in a fingertree, which can
-- automatically track various monoidal \"measures\" on segments.

-- | A type to track the count of segments in a 'Trail'.
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 Sum Int
x) -> Sum Int
x) Sum Int -> SegCount
SegCount

instance Rewrapped SegCount SegCount

-- | A type to represent the total arc length of a chain of
--   segments. The first component is a \"standard\" arc length,
--   computed to within a tolerance of @10e-6@.  The second component is
--   a generic arc length function taking the tolerance as an
--   argument.

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 (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')

-- | Project out the cached arc length, stored together with error
--   bounds.
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

-- | Project out the generic arc length function taking the tolerance as
--   an argument.
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

-- | Given a specified tolerance, project out the cached arc length if
--   it is accurate enough; otherwise call the generic arc length
--   function with the given tolerance.
getArcLengthBounded :: (Num n, Ord n)
                    => n -> ArcLength n -> Interval n
getArcLengthBounded :: n -> ArcLength n -> Interval n
getArcLengthBounded n
eps 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)

-- | A type to represent the total cumulative offset of a chain of
--   segments.
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 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 v n
v1 <> :: TotalOffset v n -> TotalOffset v n -> TotalOffset v n
<> TotalOffset 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
(<>)

-- | A type to represent the offset and envelope of a chain of
--   segments.  They have to be paired into one data structure, since
--   combining the envelopes of two consecutive chains needs to take
--   the offset of the first into account.
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 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 = 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 () (\v n -> n
f -> v n -> n
f (v n -> n) -> () -> ()
`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)

-- | @SegMeasure@ collects up all the measurements over a chain of
--   segments.
type SegMeasure v n = SegCount
                  ::: ArcLength n
                  ::: OffsetEnvelope v n
                  ::: ()
  -- unfortunately we can't cache Trace, since there is not a generic
  -- instance Traced (Segment Closed v), only Traced (Segment Closed R2).

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 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) Int
1

            -- cache arc length with two orders of magnitude more
            -- accuracy than standard, so we have a hope of coming out
            -- with an accurate enough total arc length for
            -- reasonable-length trails
            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
/n
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
*: ()

------------------------------------------------------------
--  Serialize instances
------------------------------------------------------------

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    -> Putter Bool
forall t. Serialize t => Putter t
Serialize.put Bool
True
    Cubic v n
v v n
w Offset Open v n
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
      Bool
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)
      Bool
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 Closed v n
segment = case Segment Closed v n
segment of
    Linear (OffsetClosed 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 n
v v n
w (OffsetClosed 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
      Bool
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))
      Bool
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))