{-# 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             hiding (lerp)
import           Linear.Vector.Compat      (lerp)

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 :: forall a b. (a -> b) -> Offset c v a -> Offset c v b
fmap a -> b
_ Offset c v a
OffsetOpen       = Offset c v b
Offset Open 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 a b. (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 :: Traversal (Offset c v n) (Offset c v' n') (v n) (v' n')
each v n -> f (v' n')
f (OffsetClosed v n
v) = v' n' -> Offset c v' n'
v' n' -> Offset Closed v' n'
forall (v :: * -> *) n. v n -> Offset Closed v n
OffsetClosed (v' n' -> Offset c v' n') -> f (v' n') -> f (Offset c 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 c v' n' -> f (Offset c v' n')
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Offset c v' n'
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
Offset Open 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 ((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
$cfmap :: forall c (v :: * -> *) a b.
Functor v =>
(a -> b) -> Segment c v a -> Segment c v b
fmap :: forall a b. (a -> b) -> Segment c v a -> Segment c v b
$c<$ :: forall c (v :: * -> *) a b.
Functor v =>
a -> Segment c v b -> Segment c v a
<$ :: forall a b. a -> Segment c v b -> Segment c v a
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
$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
/= :: 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
$ccompare :: forall c (v :: * -> *) n.
Ord (v n) =>
Segment c v n -> Segment c v n -> Ordering
compare :: Segment c v n -> Segment c v n -> Ordering
$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
>= :: Segment c v n -> Segment c v n -> Bool
$cmax :: 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
$cmin :: 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
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 :: Traversal (Segment c v n) (Segment c v' n') (v n) (v' n')
each v n -> f (v' n')
f (Linear Offset c v n
offset)      = 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
Traversal (Offset c v n) (Offset c v' n') (v n) (v' n')
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 a b. f (a -> b) -> f a -> f b
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 a b. f (a -> b) -> f a -> f b
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
Traversal (Offset c v n) (Offset c v' n') (v n) (v' n')
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 :: forall (v :: * -> *) n (v' :: * -> *) n' c.
(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
Traversal (Segment c v n) (Segment c v' n') (v n) (v' n')
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 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 :: forall (v :: * -> *) n. 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 :: forall (v :: * -> *) n. 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 :: forall (v :: * -> *) n. 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 a. Num a => v a -> v a -> v a
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 a. Num a => v a -> v a -> v a
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 a. Num a => v a
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 :: forall (v :: * -> *) n. Segment Closed v n -> v n
segOffset (Linear (OffsetClosed v n
v))    = v n
v
segOffset (Cubic v n
_ v n
_ (OffsetClosed v n
v)) = v n
v

-- | 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 :: forall (v :: * -> *) n. 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 :: forall (v :: * -> *) n. 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 (Segment Closed v n) (N (Segment Closed v n))
 -> N (Segment Closed v n))
-> Envelope (V (Segment Closed v n)) (N (Segment Closed v n))
forall (v :: * -> *) n. (v n -> n) -> Envelope v n
mkEnvelope ((V (Segment Closed v n) (N (Segment Closed v n))
  -> N (Segment Closed v n))
 -> Envelope (V (Segment Closed v n)) (N (Segment Closed v n)))
-> (V (Segment Closed v n) (N (Segment Closed v n))
    -> N (Segment Closed v n))
-> Envelope (V (Segment Closed v n)) (N (Segment Closed v n))
forall a b. (a -> b) -> a -> b
$ \V (Segment Closed v n) (N (Segment Closed v n))
v ->
    [n] -> n
forall a. Ord a => [a] -> a
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 a. Num a => v a -> v a -> a
forall (f :: * -> *) a. (Metric f, Num a) => f a -> f a -> a
`dot` v n
V (Segment Closed v n) (N (Segment Closed v n))
v) [n
0,n
1]) n -> n -> n
forall a. Fractional a => a -> a -> a
/ v n -> n
forall a. Num a => v a -> a
forall (f :: * -> *) a. (Metric f, Num a) => f a -> a
quadrance v n
V (Segment Closed v n) (N (Segment Closed v n))
v

  getEnvelope (s :: Segment Closed v n
s@(Cubic v n
c1 v n
c2 (OffsetClosed v n
x2))) = (V (Segment Closed v n) (N (Segment Closed v n))
 -> N (Segment Closed v n))
-> Envelope (V (Segment Closed v n)) (N (Segment Closed v n))
forall (v :: * -> *) n. (v n -> n) -> Envelope v n
mkEnvelope ((V (Segment Closed v n) (N (Segment Closed v n))
  -> N (Segment Closed v n))
 -> Envelope (V (Segment Closed v n)) (N (Segment Closed v n)))
-> (V (Segment Closed v n) (N (Segment Closed v n))
    -> N (Segment Closed v n))
-> Envelope (V (Segment Closed v n)) (N (Segment Closed v n))
forall a b. (a -> b) -> a -> b
$ \V (Segment Closed v n) (N (Segment Closed v n))
v ->
    [n] -> n
[n] -> N (Segment Closed v n)
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([n] -> N (Segment Closed v n))
-> ([n] -> [n]) -> [n] -> N (Segment Closed v 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 a. Num a => v a -> v a -> a
forall (f :: * -> *) a. (Metric f, Num a) => f a -> f a -> a
`dot` v n
V (Segment Closed v n) (N (Segment Closed v n))
v) n -> n -> n
forall a. Fractional a => a -> a -> a
/ v n -> n
forall a. Num a => v a -> a
forall (f :: * -> *) a. (Metric f, Num a) => f a -> a
quadrance v n
V (Segment Closed v n) (N (Segment Closed v n))
v) ([n] -> N (Segment Closed v n)) -> [n] -> N (Segment Closed v 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 a b c. (a -> b -> c) -> (n -> a) -> (n -> b) -> n -> c
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 a. Num a => v a -> v a -> v a
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 a. Num a => v a -> v a -> v a
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^+^ v n
x2) v n -> v n -> n
forall a. Num a => v a -> v a -> a
forall (f :: * -> *) a. (Metric f, Num a) => f a -> f a -> a
`dot` v n
V (Segment Closed v n) (N (Segment Closed 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 a. Num a => v a -> v a -> v a
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^+^ v n
c2) v n -> v n -> n
forall a. Num a => v a -> v a -> a
forall (f :: * -> *) a. (Metric f, Num a) => f a -> f a -> a
`dot` v n
V (Segment Closed v n) (N (Segment Closed 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 a. Num a => v a -> v a -> a
forall (f :: * -> *) a. (Metric f, Num a) => f a -> f a -> a
`dot` v n
V (Segment Closed v n) (N (Segment Closed 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 a. Num a => v a -> v a -> v a
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
forall a. Num a => v a
forall (f :: * -> *) a. (Additive f, Num a) => f a
zero v n
x1
  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 a. Num a => v a -> v a -> v a
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 a. Num a => v a -> v a -> v a
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 a. Num a => v a -> v a -> v a
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
c1 v n
c2
          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
forall a. Num a => v a
forall (f :: * -> *) a. (Additive f, Num a) => f a
zero v n
c1
          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
a v n
p
          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
c2 v n
x2
          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
p v n
d
          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
b v n
c

  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 :: forall n (v :: * -> *).
(Num n, Additive v) =>
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 a. Num a => v a -> v a -> v a
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 a. Num a => v a -> v a -> v a
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 :: forall a. Ord a => 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 (Segment Closed v n) -> Interval (N (Segment Closed v n))
forall a. a -> Interval a
I.singleton (N (Segment Closed v n) -> Interval (N (Segment Closed v n)))
-> N (Segment Closed v n) -> Interval (N (Segment Closed v n))
forall a b. (a -> b) -> a -> b
$ v n -> n
forall a. Floating a => v a -> a
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
N (Segment Closed v n)
0.5
         ub :: n
ub    = [n] -> n
forall a. Num a => [a] -> a
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 a. Floating a => v a -> a
forall (f :: * -> *) a. (Metric f, Floating a) => f a -> a
norm [v n
c1, v n
c2 v n -> v n -> v n
forall a. Num a => v a -> v a -> v a
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 a. Num a => v a -> v a -> v a
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^-^ v n
c2])
         lb :: n
lb    = v n -> n
forall a. Floating a => v a -> a
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
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
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
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
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 (Segment Closed v n))
-> (n -> n) -> n -> N (Segment Closed v 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 (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
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
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
$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
/= :: 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
$ccompare :: forall (v :: * -> *) n.
Ord (v n) =>
FixedSegment v n -> FixedSegment v n -> Ordering
compare :: FixedSegment v n -> FixedSegment v n -> Ordering
$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
>= :: FixedSegment v n -> FixedSegment v n -> Bool
$cmax :: 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
$cmin :: 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
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
$cshowsPrec :: forall (v :: * -> *) n.
Show (v n) =>
Int -> FixedSegment v n -> ShowS
showsPrec :: Int -> FixedSegment v n -> ShowS
$cshow :: forall (v :: * -> *) n. Show (v n) => FixedSegment v n -> String
show :: FixedSegment v n -> String
$cshowList :: forall (v :: * -> *) n. Show (v n) => [FixedSegment v n] -> ShowS
showList :: [FixedSegment v n] -> ShowS
Show)

type instance V (FixedSegment v n) = v
type instance N (FixedSegment v n) = n

instance Each (FixedSegment v n) (FixedSegment v' n') (Point v n) (Point v' n') where
  each :: Traversal
  (FixedSegment v n) (FixedSegment v' n') (Point v n) (Point v' n')
each Point v n -> f (Point v' n')
f (FLinear Point v n
p0 Point v n
p1)      = 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 a b. f (a -> b) -> f a -> f b
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 a b. f (a -> b) -> f a -> f b
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 a b. f (a -> b) -> f a -> f b
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 a b. f (a -> b) -> f a -> f b
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
Traversal
  (FixedSegment v n) (FixedSegment v n) (Point v n) (Point v n)
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
Traversal
  (FixedSegment v n) (FixedSegment v n) (Point v n) (Point v n)
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
Point (V (Segment Closed v n)) (N (Segment Closed 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 (Segment Closed v n)) (N (Segment Closed 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 :: forall n (v :: * -> *).
(Num n, Additive v) =>
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 a. Num a => Point v a -> Diff (Point v) a -> Point v a
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 a. Num a => Point v a -> Diff (Point v) a -> Point v a
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 a. Num a => Point v a -> Diff (Point v) a -> Point v a
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 a. Num a => Point v a -> Diff (Point v) a -> Point v a
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 :: forall n (v :: * -> *).
(Num n, Additive v) =>
FixedSegment v n -> Located (Segment Closed v n)
fromFixedSeg (FLinear Point v n
p1 Point v n
p2)      = 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 a. Num a => Point v a -> Point v a -> Diff (Point v) a
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 a. Num a => Point v a -> Point v a -> Diff (Point v) a
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 a. Num a => Point v a -> Point v a -> Diff (Point v) a
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 a. Num a => Point v a -> Point v a -> Diff (Point v) a
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 :: forall n (v :: * -> *).
(Num n, Additive v) =>
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)
     (FixedSegment v n)
     (Located (Segment Closed 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
p1 Point v n
p2
  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
x1 Point v n
c1
          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
c1 Point v n
c2
          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
c2 Point v n
x2

          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
p11 Point v n
p12
          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
p12 Point v n
p13

          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
p21 Point v n
p22

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
p0 Point v n
p1
  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
p0 Point v n
c1
          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
c1 Point v n
c2
          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
c2 Point v n
p1
          -- 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
a Point v n
p
          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
p Point v n
d
          -- 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
b Point v n
c

  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 (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
$c<> :: SegCount -> SegCount -> SegCount
<> :: SegCount -> SegCount -> SegCount
$csconcat :: NonEmpty SegCount -> SegCount
sconcat :: NonEmpty SegCount -> SegCount
$cstimes :: forall b. Integral b => b -> SegCount -> SegCount
stimes :: forall b. Integral b => b -> 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
$cmempty :: SegCount
mempty :: SegCount
$cmappend :: SegCount -> SegCount -> SegCount
mappend :: SegCount -> SegCount -> SegCount
$cmconcat :: [SegCount] -> SegCount
mconcat :: [SegCount] -> SegCount
Monoid)

instance Wrapped SegCount where
  type Unwrapped SegCount = Sum Int
  _Wrapped' :: Iso' SegCount (Unwrapped 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' :: Iso' (ArcLength n) (Unwrapped (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 :: forall n. 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 (Sum (Interval n), n -> Sum (Interval n)) -> ArcLength n
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 :: forall n. ArcLength n -> n -> Interval n
getArcLengthFun = (Sum (Interval n) -> Interval n)
-> (n -> Sum (Interval n)) -> n -> Interval n
forall a b. (a -> b) -> (n -> a) -> n -> b
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 (Sum (Interval n), n -> Sum (Interval n)) -> ArcLength n
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 :: forall n. (Num n, Ord n) => 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' :: Iso' (TotalOffset v n) (Unwrapped (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 a. Num a => v a -> v a -> v a
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 a. Num a => v a
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
  { forall (v :: * -> *) n. OffsetEnvelope v n -> TotalOffset v n
_oeOffset   :: !(TotalOffset v n)
  , forall (v :: * -> *) n. OffsetEnvelope v n -> Envelope v n
_oeEnvelope :: Envelope v n
  }

makeLenses ''OffsetEnvelope

instance (Metric v, OrderedField n) => Semigroup (OffsetEnvelope v n) where
  (OffsetEnvelope TotalOffset v n
o1 Envelope v n
e1) <> :: OffsetEnvelope v n -> OffsetEnvelope v n -> OffsetEnvelope v n
<> (OffsetEnvelope TotalOffset v n
o2 Envelope v n
e2)
    = let !negOff :: v n
negOff = 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 v n -> TotalOffset v n
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) -> () -> ()
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)

-- | @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
-> (Maybe (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
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 Segment Closed v n
s               )

            ArcLength n
-> (OffsetEnvelope v n ::: ())
-> (Maybe (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 a. a -> Get a
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 a. a -> Get a
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 a. a -> Get a
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 a. a -> Get a
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))