{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE CPP                        #-}
{-# LANGUAGE EmptyDataDecls             #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GADTs                      #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase                 #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE StandaloneDeriving         #-}
{-# LANGUAGE TypeFamilies               #-}
{-# LANGUAGE TypeOperators              #-}
{-# LANGUAGE UndecidableInstances       #-}
{-# LANGUAGE ViewPatterns               #-}

{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
-- We have an orphan Transformable FingerTree instance here.

-----------------------------------------------------------------------------
-- |
-- Module      :  Diagrams.Trail
-- Copyright   :  (c) 2013-2015 diagrams-lib team (see LICENSE)
-- License     :  BSD-style (see LICENSE)
-- Maintainer  :  diagrams-discuss@googlegroups.com
--
-- This module defines /trails/, translationally invariant paths
-- through space.  Trails form a central part of the diagrams-lib API,
-- so the documentation for this module merits careful study.
--
-- Related modules include:
--
-- * The 'TrailLike' class ("Diagrams.TrailLike") exposes a generic
--   API for building a wide range of things out of trails.
--
-- * 'Path's ("Diagrams.Path") are collections of 'Located'
--   ("Diagrams.Located") trails.
--
-- * Trails are composed of 'Segment's (see "Diagrams.Segment"),
--   though most users should not need to work with segments directly.
--
-----------------------------------------------------------------------------

module Diagrams.Trail
       (
         -- * Type definitions

         -- ** Lines and loops

         Trail'(..)

       , glueLine
       , closeLine
       , cutLoop

         -- ** Generic trails

       , Trail(..)
       , _Line, _Loop
       , _LocLine, _LocLoop
       , wrapTrail, wrapLine, wrapLoop
       , onTrail, onLine

       , glueTrail, closeTrail, cutTrail

         -- * Constructing trails

       , emptyLine, emptyTrail
       , lineFromVertices, trailFromVertices
       , lineFromOffsets,  trailFromOffsets
       , lineFromSegments, trailFromSegments
       , loopFromSegments

         -- * Eliminating trails

       , withTrail', withTrail, withLine
       , isLineEmpty, isTrailEmpty
       , isLine, isLoop
       , trailSegments, lineSegments, loopSegments
       , onLineSegments
       , trailOffsets, trailOffset
       , lineOffsets, lineOffset, loopOffsets
       , trailPoints, linePoints, loopPoints
       , trailVertices', lineVertices', loopVertices'
       , trailVertices, lineVertices, loopVertices
       , trailLocSegments, fixTrail, unfixTrail

         -- * Modifying trails

       , reverseTrail, reverseLocTrail
       , reverseLine, reverseLocLine
       , reverseLoop, reverseLocLoop

         -- * Internals
         -- $internals

         -- ** Type tags

       , Line, Loop

         -- ** Segment trees

       , SegTree(..), trailMeasure, numSegs, offset

         -- ** Extracting segments

       , GetSegment(..), getSegment, GetSegmentCodomain(..)

       ) where

import           Control.Arrow            ((***))
import           Control.Lens             hiding (at, transform, (<|), (|>))
import           Data.FingerTree          (FingerTree, ViewL (..), ViewR (..),
                                           viewl, (<|), (|>))
import qualified Data.FingerTree          as FT
import           Data.Fixed
import qualified Data.Foldable            as F
import           Data.Monoid.MList
import           Data.Semigroup
import qualified Numeric.Interval.Kaucher as I

import           Diagrams.Core
import           Diagrams.Located
import           Diagrams.Parametric
import           Diagrams.Segment
import           Diagrams.Tangent

import           Linear.Affine
import           Linear.Metric
import           Linear.Vector

import           Data.Serialize            (Serialize)
import qualified Data.Serialize            as Serialize

-- $internals
--
-- Most users of diagrams should not need to use anything in this
-- section directly, but they are exported on the principle that we
-- can't forsee what uses people might have for them.

------------------------------------------------------------
--  FingerTree instances
------------------------------------------------------------

type instance V (FingerTree m a) = V a
type instance N (FingerTree m a) = N a

instance (FT.Measured m a, Transformable a)
    => Transformable (FingerTree m a) where
  transform :: Transformation (V (FingerTree m a)) (N (FingerTree m a))
-> FingerTree m a -> FingerTree m a
transform = (a -> a) -> FingerTree m a -> FingerTree m a
forall v1 a1 v2 a2.
(Measured v1 a1, Measured v2 a2) =>
(a1 -> a2) -> FingerTree v1 a1 -> FingerTree v2 a2
FT.fmap' ((a -> a) -> FingerTree m a -> FingerTree m a)
-> (Transformation (V a) (N a) -> a -> a)
-> Transformation (V a) (N a)
-> FingerTree m a
-> FingerTree m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transformation (V a) (N a) -> a -> a
forall t. Transformable t => Transformation (V t) (N t) -> t -> t
transform

instance (FT.Measured m a, FT.Measured n b)
  => Cons (FingerTree m a) (FingerTree n b) a b where
  _Cons :: Prism
  (FingerTree m a)
  (FingerTree n b)
  (a, FingerTree m a)
  (b, FingerTree n b)
_Cons = ((b, FingerTree n b) -> FingerTree n b)
-> (FingerTree m a -> Either (FingerTree n b) (a, FingerTree m a))
-> Prism
     (FingerTree m a)
     (FingerTree n b)
     (a, FingerTree m a)
     (b, FingerTree n b)
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism ((b -> FingerTree n b -> FingerTree n b)
-> (b, FingerTree n b) -> FingerTree n b
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry b -> FingerTree n b -> FingerTree n b
forall v a. Measured v a => a -> FingerTree v a -> FingerTree v a
(FT.<|)) ((FingerTree m a -> Either (FingerTree n b) (a, FingerTree m a))
 -> Prism
      (FingerTree m a)
      (FingerTree n b)
      (a, FingerTree m a)
      (b, FingerTree n b))
-> (FingerTree m a -> Either (FingerTree n b) (a, FingerTree m a))
-> Prism
     (FingerTree m a)
     (FingerTree n b)
     (a, FingerTree m a)
     (b, FingerTree n b)
forall a b. (a -> b) -> a -> b
$ \FingerTree m a
aas -> case FingerTree m a -> ViewL (FingerTree m) a
forall v a.
Measured v a =>
FingerTree v a -> ViewL (FingerTree v) a
FT.viewl FingerTree m a
aas of
    a
a FT.:< FingerTree m a
as -> (a, FingerTree m a) -> Either (FingerTree n b) (a, FingerTree m a)
forall a b. b -> Either a b
Right (a
a, FingerTree m a
as)
    ViewL (FingerTree m) a
EmptyL     -> FingerTree n b -> Either (FingerTree n b) (a, FingerTree m a)
forall a b. a -> Either a b
Left FingerTree n b
forall a. Monoid a => a
mempty
  {-# INLINE _Cons #-}

instance (FT.Measured m a, FT.Measured n b)
  => Snoc (FingerTree m a) (FingerTree n b) a b where
  _Snoc :: Prism
  (FingerTree m a)
  (FingerTree n b)
  (FingerTree m a, a)
  (FingerTree n b, b)
_Snoc = ((FingerTree n b, b) -> FingerTree n b)
-> (FingerTree m a -> Either (FingerTree n b) (FingerTree m a, a))
-> Prism
     (FingerTree m a)
     (FingerTree n b)
     (FingerTree m a, a)
     (FingerTree n b, b)
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism ((FingerTree n b -> b -> FingerTree n b)
-> (FingerTree n b, b) -> FingerTree n b
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry FingerTree n b -> b -> FingerTree n b
forall v a. Measured v a => FingerTree v a -> a -> FingerTree v a
(FT.|>)) ((FingerTree m a -> Either (FingerTree n b) (FingerTree m a, a))
 -> Prism
      (FingerTree m a)
      (FingerTree n b)
      (FingerTree m a, a)
      (FingerTree n b, b))
-> (FingerTree m a -> Either (FingerTree n b) (FingerTree m a, a))
-> Prism
     (FingerTree m a)
     (FingerTree n b)
     (FingerTree m a, a)
     (FingerTree n b, b)
forall a b. (a -> b) -> a -> b
$ \FingerTree m a
aas -> case FingerTree m a -> ViewR (FingerTree m) a
forall v a.
Measured v a =>
FingerTree v a -> ViewR (FingerTree v) a
FT.viewr FingerTree m a
aas of
    FingerTree m a
as FT.:> a
a -> (FingerTree m a, a) -> Either (FingerTree n b) (FingerTree m a, a)
forall a b. b -> Either a b
Right (FingerTree m a
as, a
a)
    ViewR (FingerTree m) a
EmptyR  -> FingerTree n b -> Either (FingerTree n b) (FingerTree m a, a)
forall a b. a -> Either a b
Left FingerTree n b
forall a. Monoid a => a
mempty
  {-# INLINE _Snoc #-}

------------------------------------------------------------
--  Segment trees  -----------------------------------------
------------------------------------------------------------

-- | A @SegTree@ represents a sequence of closed segments, stored in a
--   fingertree so we can easily recover various monoidal measures of
--   the segments (number of segments, arc length, envelope...) and
--   also easily slice and dice them according to the measures
--   (/e.g./, split off the smallest number of segments from the
--   beginning which have a combined arc length of at least 5).

newtype SegTree v n = SegTree (FingerTree (SegMeasure v n) (Segment Closed v n))
  deriving (SegTree v n -> SegTree v n -> Bool
(SegTree v n -> SegTree v n -> Bool)
-> (SegTree v n -> SegTree v n -> Bool) -> Eq (SegTree v n)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (v :: * -> *) n.
Eq (v n) =>
SegTree v n -> SegTree v n -> Bool
$c== :: forall (v :: * -> *) n.
Eq (v n) =>
SegTree v n -> SegTree v n -> Bool
== :: SegTree v n -> SegTree v n -> Bool
$c/= :: forall (v :: * -> *) n.
Eq (v n) =>
SegTree v n -> SegTree v n -> Bool
/= :: SegTree v n -> SegTree v n -> Bool
Eq, Eq (SegTree v n)
Eq (SegTree v n) =>
(SegTree v n -> SegTree v n -> Ordering)
-> (SegTree v n -> SegTree v n -> Bool)
-> (SegTree v n -> SegTree v n -> Bool)
-> (SegTree v n -> SegTree v n -> Bool)
-> (SegTree v n -> SegTree v n -> Bool)
-> (SegTree v n -> SegTree v n -> SegTree v n)
-> (SegTree v n -> SegTree v n -> SegTree v n)
-> Ord (SegTree v n)
SegTree v n -> SegTree v n -> Bool
SegTree v n -> SegTree v n -> Ordering
SegTree v n -> SegTree v n -> SegTree 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 (SegTree v n)
forall (v :: * -> *) n.
Ord (v n) =>
SegTree v n -> SegTree v n -> Bool
forall (v :: * -> *) n.
Ord (v n) =>
SegTree v n -> SegTree v n -> Ordering
forall (v :: * -> *) n.
Ord (v n) =>
SegTree v n -> SegTree v n -> SegTree v n
$ccompare :: forall (v :: * -> *) n.
Ord (v n) =>
SegTree v n -> SegTree v n -> Ordering
compare :: SegTree v n -> SegTree v n -> Ordering
$c< :: forall (v :: * -> *) n.
Ord (v n) =>
SegTree v n -> SegTree v n -> Bool
< :: SegTree v n -> SegTree v n -> Bool
$c<= :: forall (v :: * -> *) n.
Ord (v n) =>
SegTree v n -> SegTree v n -> Bool
<= :: SegTree v n -> SegTree v n -> Bool
$c> :: forall (v :: * -> *) n.
Ord (v n) =>
SegTree v n -> SegTree v n -> Bool
> :: SegTree v n -> SegTree v n -> Bool
$c>= :: forall (v :: * -> *) n.
Ord (v n) =>
SegTree v n -> SegTree v n -> Bool
>= :: SegTree v n -> SegTree v n -> Bool
$cmax :: forall (v :: * -> *) n.
Ord (v n) =>
SegTree v n -> SegTree v n -> SegTree v n
max :: SegTree v n -> SegTree v n -> SegTree v n
$cmin :: forall (v :: * -> *) n.
Ord (v n) =>
SegTree v n -> SegTree v n -> SegTree v n
min :: SegTree v n -> SegTree v n -> SegTree v n
Ord, Int -> SegTree v n -> ShowS
[SegTree v n] -> ShowS
SegTree v n -> String
(Int -> SegTree v n -> ShowS)
-> (SegTree v n -> String)
-> ([SegTree v n] -> ShowS)
-> Show (SegTree v n)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (v :: * -> *) n. Show (v n) => Int -> SegTree v n -> ShowS
forall (v :: * -> *) n. Show (v n) => [SegTree v n] -> ShowS
forall (v :: * -> *) n. Show (v n) => SegTree v n -> String
$cshowsPrec :: forall (v :: * -> *) n. Show (v n) => Int -> SegTree v n -> ShowS
showsPrec :: Int -> SegTree v n -> ShowS
$cshow :: forall (v :: * -> *) n. Show (v n) => SegTree v n -> String
show :: SegTree v n -> String
$cshowList :: forall (v :: * -> *) n. Show (v n) => [SegTree v n] -> ShowS
showList :: [SegTree v n] -> ShowS
Show, Semigroup (SegTree v n)
SegTree v n
Semigroup (SegTree v n) =>
SegTree v n
-> (SegTree v n -> SegTree v n -> SegTree v n)
-> ([SegTree v n] -> SegTree v n)
-> Monoid (SegTree v n)
[SegTree v n] -> SegTree v n
SegTree v n -> SegTree v n -> SegTree v n
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall (v :: * -> *) n.
(Ord n, Floating n, Metric v) =>
Semigroup (SegTree v n)
forall (v :: * -> *) n.
(Ord n, Floating n, Metric v) =>
SegTree v n
forall (v :: * -> *) n.
(Ord n, Floating n, Metric v) =>
[SegTree v n] -> SegTree v n
forall (v :: * -> *) n.
(Ord n, Floating n, Metric v) =>
SegTree v n -> SegTree v n -> SegTree v n
$cmempty :: forall (v :: * -> *) n.
(Ord n, Floating n, Metric v) =>
SegTree v n
mempty :: SegTree v n
$cmappend :: forall (v :: * -> *) n.
(Ord n, Floating n, Metric v) =>
SegTree v n -> SegTree v n -> SegTree v n
mappend :: SegTree v n -> SegTree v n -> SegTree v n
$cmconcat :: forall (v :: * -> *) n.
(Ord n, Floating n, Metric v) =>
[SegTree v n] -> SegTree v n
mconcat :: [SegTree v n] -> SegTree v n
Monoid, Transformation (V (SegTree v n)) (N (SegTree v n))
-> SegTree v n -> SegTree v n
(Transformation (V (SegTree v n)) (N (SegTree v n))
 -> SegTree v n -> SegTree v n)
-> Transformable (SegTree v n)
forall t. (Transformation (V t) (N t) -> t -> t) -> Transformable t
forall (v :: * -> *) n.
(Floating n, Ord n, Metric v) =>
Transformation (V (SegTree v n)) (N (SegTree v n))
-> SegTree v n -> SegTree v n
$ctransform :: forall (v :: * -> *) n.
(Floating n, Ord n, Metric v) =>
Transformation (V (SegTree v n)) (N (SegTree v n))
-> SegTree v n -> SegTree v n
transform :: Transformation (V (SegTree v n)) (N (SegTree v n))
-> SegTree v n -> SegTree v n
Transformable, FT.Measured (SegMeasure v n))

-- Only derive the Semigroup instance for versions of base that
-- include Semigroup.  This is because the fingertree package has
-- similar CPP to only export a Semigroup instance for those versions
-- of base, so for GHC 7.10 and earlier we get a 'no instance found'
-- error when trying to derive the Semigroup instance for SegTree.  It
-- would also be possible to depend on the 'semigroups' package in
-- order to get the Semigroup class regardless of base version, but
-- presumably fingertree didn't want to add a dependency.
#if MIN_VERSION_base(4,9,0)
deriving instance (Ord n, Floating n, Metric v) => Semigroup (SegTree v n)
#endif

instance Wrapped (SegTree v n) where
  type Unwrapped (SegTree v n) = FingerTree (SegMeasure v n) (Segment Closed v n)
  _Wrapped' :: Iso' (SegTree v n) (Unwrapped (SegTree v n))
_Wrapped' = (SegTree v n -> FingerTree (SegMeasure v n) (Segment Closed v n))
-> (FingerTree (SegMeasure v n) (Segment Closed v n)
    -> SegTree v n)
-> Iso
     (SegTree v n)
     (SegTree v n)
     (FingerTree (SegMeasure v n) (Segment Closed v n))
     (FingerTree (SegMeasure v n) (Segment Closed v n))
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (\(SegTree FingerTree (SegMeasure v n) (Segment Closed v n)
x) -> FingerTree (SegMeasure v n) (Segment Closed v n)
x) FingerTree (SegMeasure v n) (Segment Closed v n) -> SegTree v n
forall (v :: * -> *) n.
FingerTree (SegMeasure v n) (Segment Closed v n) -> SegTree v n
SegTree
  {-# INLINE _Wrapped' #-}

instance (Metric v, OrderedField n, Metric u, OrderedField n')
  => Cons (SegTree v n) (SegTree u n') (Segment Closed v n) (Segment Closed u n') where
  _Cons :: Prism
  (SegTree v n)
  (SegTree u n')
  (Segment Closed v n, SegTree v n)
  (Segment Closed u n', SegTree u n')
_Cons = p (FingerTree (SegMeasure v n) (Segment Closed v n))
  (f (FingerTree (SegMeasure u n') (Segment Closed u n')))
-> p (SegTree v n) (f (SegTree u n'))
p (Unwrapped (SegTree v n)) (f (Unwrapped (SegTree u n')))
-> p (SegTree v n) (f (SegTree u n'))
forall s t. Rewrapping s t => Iso s t (Unwrapped s) (Unwrapped t)
Iso
  (SegTree v n)
  (SegTree u n')
  (Unwrapped (SegTree v n))
  (Unwrapped (SegTree u n'))
_Wrapped (p (FingerTree (SegMeasure v n) (Segment Closed v n))
   (f (FingerTree (SegMeasure u n') (Segment Closed u n')))
 -> p (SegTree v n) (f (SegTree u n')))
-> (p (Segment Closed v n, SegTree v n)
      (f (Segment Closed u n', SegTree u n'))
    -> p (FingerTree (SegMeasure v n) (Segment Closed v n))
         (f (FingerTree (SegMeasure u n') (Segment Closed u n'))))
-> p (Segment Closed v n, SegTree v n)
     (f (Segment Closed u n', SegTree u n'))
-> p (SegTree v n) (f (SegTree u n'))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p (Segment Closed v n,
   FingerTree (SegMeasure v n) (Segment Closed v n))
  (f (Segment Closed u n',
      FingerTree (SegMeasure u n') (Segment Closed u n')))
-> p (FingerTree (SegMeasure v n) (Segment Closed v n))
     (f (FingerTree (SegMeasure u n') (Segment Closed u n')))
forall s t a b. Cons s t a b => Prism s t (a, s) (b, t)
Prism
  (FingerTree (SegMeasure v n) (Segment Closed v n))
  (FingerTree (SegMeasure u n') (Segment Closed u n'))
  (Segment Closed v n,
   FingerTree (SegMeasure v n) (Segment Closed v n))
  (Segment Closed u n',
   FingerTree (SegMeasure u n') (Segment Closed u n'))
_Cons (p (Segment Closed v n,
    FingerTree (SegMeasure v n) (Segment Closed v n))
   (f (Segment Closed u n',
       FingerTree (SegMeasure u n') (Segment Closed u n')))
 -> p (FingerTree (SegMeasure v n) (Segment Closed v n))
      (f (FingerTree (SegMeasure u n') (Segment Closed u n'))))
-> (p (Segment Closed v n, SegTree v n)
      (f (Segment Closed u n', SegTree u n'))
    -> p (Segment Closed v n,
          FingerTree (SegMeasure v n) (Segment Closed v n))
         (f (Segment Closed u n',
             FingerTree (SegMeasure u n') (Segment Closed u n'))))
-> p (Segment Closed v n, SegTree v n)
     (f (Segment Closed u n', SegTree u n'))
-> p (FingerTree (SegMeasure v n) (Segment Closed v n))
     (f (FingerTree (SegMeasure u n') (Segment Closed u n')))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnIso
  (Segment Closed v n)
  (Segment Closed u n')
  (Segment Closed v n)
  (Segment Closed u n')
-> AnIso
     (FingerTree (SegMeasure v n) (Segment Closed v n))
     (FingerTree (SegMeasure u n') (Segment Closed u n'))
     (SegTree v n)
     (SegTree u n')
-> Iso
     (Segment Closed v n,
      FingerTree (SegMeasure v n) (Segment Closed v n))
     (Segment Closed u n',
      FingerTree (SegMeasure u n') (Segment Closed u n'))
     (Segment Closed v n, SegTree v n)
     (Segment Closed u n', SegTree u n')
forall (f :: * -> * -> *) (g :: * -> * -> *) s t a b s' t' a' b'.
(Bifunctor f, Bifunctor g) =>
AnIso s t a b
-> AnIso s' t' a' b' -> Iso (f s s') (g t t') (f a a') (g b b')
bimapping AnIso
  (Segment Closed v n)
  (Segment Closed u n')
  (Segment Closed v n)
  (Segment Closed u n')
forall a. a -> a
id AnIso
  (FingerTree (SegMeasure v n) (Segment Closed v n))
  (FingerTree (SegMeasure u n') (Segment Closed u n'))
  (SegTree v n)
  (SegTree u n')
Exchange
  (SegTree v n)
  (SegTree u n')
  (SegTree v n)
  (Identity (SegTree u n'))
-> Exchange
     (SegTree v n)
     (SegTree u n')
     (Unwrapped (SegTree v n))
     (Identity (Unwrapped (SegTree u n')))
forall s t. Rewrapping s t => Iso (Unwrapped t) (Unwrapped s) t s
Iso
  (Unwrapped (SegTree v n))
  (Unwrapped (SegTree u n'))
  (SegTree v n)
  (SegTree u n')
_Unwrapped
  {-# INLINE _Cons #-}

instance (Metric v, OrderedField n, Metric u, OrderedField n')
  => Snoc (SegTree v n) (SegTree u n') (Segment Closed v n) (Segment Closed u n') where
  _Snoc :: Prism
  (SegTree v n)
  (SegTree u n')
  (SegTree v n, Segment Closed v n)
  (SegTree u n', Segment Closed u n')
_Snoc = p (FingerTree (SegMeasure v n) (Segment Closed v n))
  (f (FingerTree (SegMeasure u n') (Segment Closed u n')))
-> p (SegTree v n) (f (SegTree u n'))
p (Unwrapped (SegTree v n)) (f (Unwrapped (SegTree u n')))
-> p (SegTree v n) (f (SegTree u n'))
forall s t. Rewrapping s t => Iso s t (Unwrapped s) (Unwrapped t)
Iso
  (SegTree v n)
  (SegTree u n')
  (Unwrapped (SegTree v n))
  (Unwrapped (SegTree u n'))
_Wrapped (p (FingerTree (SegMeasure v n) (Segment Closed v n))
   (f (FingerTree (SegMeasure u n') (Segment Closed u n')))
 -> p (SegTree v n) (f (SegTree u n')))
-> (p (SegTree v n, Segment Closed v n)
      (f (SegTree u n', Segment Closed u n'))
    -> p (FingerTree (SegMeasure v n) (Segment Closed v n))
         (f (FingerTree (SegMeasure u n') (Segment Closed u n'))))
-> p (SegTree v n, Segment Closed v n)
     (f (SegTree u n', Segment Closed u n'))
-> p (SegTree v n) (f (SegTree u n'))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p (FingerTree (SegMeasure v n) (Segment Closed v n),
   Segment Closed v n)
  (f (FingerTree (SegMeasure u n') (Segment Closed u n'),
      Segment Closed u n'))
-> p (FingerTree (SegMeasure v n) (Segment Closed v n))
     (f (FingerTree (SegMeasure u n') (Segment Closed u n')))
forall s t a b. Snoc s t a b => Prism s t (s, a) (t, b)
Prism
  (FingerTree (SegMeasure v n) (Segment Closed v n))
  (FingerTree (SegMeasure u n') (Segment Closed u n'))
  (FingerTree (SegMeasure v n) (Segment Closed v n),
   Segment Closed v n)
  (FingerTree (SegMeasure u n') (Segment Closed u n'),
   Segment Closed u n')
_Snoc (p (FingerTree (SegMeasure v n) (Segment Closed v n),
    Segment Closed v n)
   (f (FingerTree (SegMeasure u n') (Segment Closed u n'),
       Segment Closed u n'))
 -> p (FingerTree (SegMeasure v n) (Segment Closed v n))
      (f (FingerTree (SegMeasure u n') (Segment Closed u n'))))
-> (p (SegTree v n, Segment Closed v n)
      (f (SegTree u n', Segment Closed u n'))
    -> p (FingerTree (SegMeasure v n) (Segment Closed v n),
          Segment Closed v n)
         (f (FingerTree (SegMeasure u n') (Segment Closed u n'),
             Segment Closed u n')))
-> p (SegTree v n, Segment Closed v n)
     (f (SegTree u n', Segment Closed u n'))
-> p (FingerTree (SegMeasure v n) (Segment Closed v n))
     (f (FingerTree (SegMeasure u n') (Segment Closed u n')))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnIso
  (FingerTree (SegMeasure v n) (Segment Closed v n))
  (FingerTree (SegMeasure u n') (Segment Closed u n'))
  (SegTree v n)
  (SegTree u n')
-> AnIso
     (Segment Closed v n)
     (Segment Closed u n')
     (Segment Closed v n)
     (Segment Closed u n')
-> Iso
     (FingerTree (SegMeasure v n) (Segment Closed v n),
      Segment Closed v n)
     (FingerTree (SegMeasure u n') (Segment Closed u n'),
      Segment Closed u n')
     (SegTree v n, Segment Closed v n)
     (SegTree u n', Segment Closed u n')
forall (f :: * -> * -> *) (g :: * -> * -> *) s t a b s' t' a' b'.
(Bifunctor f, Bifunctor g) =>
AnIso s t a b
-> AnIso s' t' a' b' -> Iso (f s s') (g t t') (f a a') (g b b')
bimapping AnIso
  (FingerTree (SegMeasure v n) (Segment Closed v n))
  (FingerTree (SegMeasure u n') (Segment Closed u n'))
  (SegTree v n)
  (SegTree u n')
Exchange
  (SegTree v n)
  (SegTree u n')
  (SegTree v n)
  (Identity (SegTree u n'))
-> Exchange
     (SegTree v n)
     (SegTree u n')
     (Unwrapped (SegTree v n))
     (Identity (Unwrapped (SegTree u n')))
forall s t. Rewrapping s t => Iso (Unwrapped t) (Unwrapped s) t s
Iso
  (Unwrapped (SegTree v n))
  (Unwrapped (SegTree u n'))
  (SegTree v n)
  (SegTree u n')
_Unwrapped AnIso
  (Segment Closed v n)
  (Segment Closed u n')
  (Segment Closed v n)
  (Segment Closed u n')
forall a. a -> a
id
  {-# INLINE _Snoc #-}

instance Rewrapped (SegTree v n) (SegTree v' n')

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

type instance Codomain (SegTree v n) = v

instance (Metric v, OrderedField n, Real n)
    => Parametric (SegTree v n) where
  atParam :: SegTree v n
-> N (SegTree v n) -> Codomain (SegTree v n) (N (SegTree v n))
atParam SegTree v n
t N (SegTree v n)
p = SegTree v n -> v n
SegTree v n -> Codomain (SegTree v n) (N (SegTree v n))
forall n (v :: * -> *) t.
(OrderedField n, Metric v, Measured (SegMeasure v n) t) =>
t -> v n
offset (SegTree v n -> Codomain (SegTree v n) (N (SegTree v n)))
-> ((SegTree v n, SegTree v n) -> SegTree v n)
-> (SegTree v n, SegTree v n)
-> Codomain (SegTree v n) (N (SegTree v n))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SegTree v n, SegTree v n) -> SegTree v n
forall a b. (a, b) -> a
fst ((SegTree v n, SegTree v n)
 -> Codomain (SegTree v n) (N (SegTree v n)))
-> (SegTree v n, SegTree v n)
-> Codomain (SegTree v n) (N (SegTree v n))
forall a b. (a -> b) -> a -> b
$ SegTree v n -> N (SegTree v n) -> (SegTree v n, SegTree v n)
forall p. Sectionable p => p -> N p -> (p, p)
splitAtParam SegTree v n
t N (SegTree v n)
p

instance Num n => DomainBounds (SegTree v n)

instance (Metric v, OrderedField n, Real n)
    => EndValues (SegTree v n)

splitAtParam' :: (Metric v, OrderedField n, Real n)
              => SegTree v n -> n -> ((SegTree v n, SegTree v n), n -> n)
splitAtParam' :: forall (v :: * -> *) n.
(Metric v, OrderedField n, Real n) =>
SegTree v n -> n -> ((SegTree v n, SegTree v n), n -> n)
splitAtParam' (SegTree FingerTree (SegMeasure v n) (Segment Closed v n)
t) n
p
  | n
tSegs n -> n -> Bool
forall a. Eq a => a -> a -> Bool
== n
0 = ((SegTree v n
forall a. Monoid a => a
mempty       , SegTree v n
forall a. Monoid a => a
mempty       ), n -> n
forall a. a -> a
id)
  | Bool
otherwise  = ((FingerTree (SegMeasure v n) (Segment Closed v n) -> SegTree v n
forall (v :: * -> *) n.
FingerTree (SegMeasure v n) (Segment Closed v n) -> SegTree v n
SegTree FingerTree (SegMeasure v n) (Segment Closed v n)
treeL, FingerTree (SegMeasure v n) (Segment Closed v n) -> SegTree v n
forall (v :: * -> *) n.
FingerTree (SegMeasure v n) (Segment Closed v n) -> SegTree v n
SegTree FingerTree (SegMeasure v n) (Segment Closed v n)
treeR), n -> n
rescale)
  where
    tSegs :: n
tSegs  = FingerTree (SegMeasure v n) (Segment Closed v n) -> n
forall c (v :: * -> *) n a.
(Num c, Measured (SegMeasure v n) a) =>
a -> c
numSegs FingerTree (SegMeasure v n) (Segment Closed v n)
t
    splitParam :: n -> (n, n)
splitParam n
q | n
q n -> n -> Bool
forall a. Ord a => a -> a -> Bool
<  n
0    = (n
0        , n
q           n -> n -> n
forall a. Num a => a -> a -> a
* n
tSegs)
                 | n
q n -> n -> Bool
forall a. Ord a => a -> a -> Bool
>= n
1    = (n
tSegs n -> n -> n
forall a. Num a => a -> a -> a
- n
1, n
1 n -> n -> n
forall a. Num a => a -> a -> a
+ (n
q n -> n -> n
forall a. Num a => a -> a -> a
- n
1) n -> n -> n
forall a. Num a => a -> a -> a
* n
tSegs)
                 | Bool
otherwise = n -> (n, n)
forall {b}. Real b => b -> (b, b)
propFrac (n -> (n, n)) -> n -> (n, n)
forall a b. (a -> b) -> a -> b
$  n
q           n -> n -> n
forall a. Num a => a -> a -> a
* n
tSegs
      where propFrac :: b -> (b, b)
propFrac b
x = let m :: b
m = b -> b
forall a. Real a => a -> a
mod1 b
x in (b
x b -> b -> b
forall a. Num a => a -> a -> a
- b
m, b
m)
    (n
pSegs, n
pParam) = n -> (n, n)
splitParam n
p
    (FingerTree (SegMeasure v n) (Segment Closed v n)
before, FingerTree (SegMeasure v n) (Segment Closed v n)
-> ViewL (FingerTree (SegMeasure v n)) (Segment Closed v n)
forall v a.
Measured v a =>
FingerTree v a -> ViewL (FingerTree v) a
viewl -> Segment Closed v n
seg FT.:< FingerTree (SegMeasure v n) (Segment Closed v n)
after) = (SegMeasure v n -> Bool)
-> FingerTree (SegMeasure v n) (Segment Closed v n)
-> (FingerTree (SegMeasure v n) (Segment Closed v n),
    FingerTree (SegMeasure v n) (Segment Closed v n))
forall v a.
Measured v a =>
(v -> Bool) -> FingerTree v a -> (FingerTree v a, FingerTree v a)
FT.split ((n
pSegs n -> n -> Bool
forall a. Ord a => a -> a -> Bool
<) (n -> Bool) -> (SegMeasure v n -> n) -> SegMeasure v n -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SegMeasure v n -> n
forall c (v :: * -> *) n a.
(Num c, Measured (SegMeasure v n) a) =>
a -> c
numSegs) FingerTree (SegMeasure v n) (Segment Closed v n)
t
    (Segment Closed v n
segL, Segment Closed v n
segR) = Segment Closed v n
seg 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)
pParam
    (FingerTree (SegMeasure v n) (Segment Closed v n)
treeL, FingerTree (SegMeasure v n) (Segment Closed v n)
treeR) | n
pParam n -> n -> Bool
forall a. Eq a => a -> a -> Bool
== n
0 = (FingerTree (SegMeasure v n) (Segment Closed v n)
before        , Segment Closed v n
seg  Segment Closed v n
-> FingerTree (SegMeasure v n) (Segment Closed v n)
-> FingerTree (SegMeasure v n) (Segment Closed v n)
forall v a. Measured v a => a -> FingerTree v a -> FingerTree v a
<| FingerTree (SegMeasure v n) (Segment Closed v n)
after)
                   | n
pParam n -> n -> Bool
forall a. Eq a => a -> a -> Bool
== n
1 = (FingerTree (SegMeasure v n) (Segment Closed v n)
before FingerTree (SegMeasure v n) (Segment Closed v n)
-> Segment Closed v n
-> FingerTree (SegMeasure v n) (Segment Closed v n)
forall v a. Measured v a => FingerTree v a -> a -> FingerTree v a
|> Segment Closed v n
seg ,         FingerTree (SegMeasure v n) (Segment Closed v n)
after)
                   | Bool
otherwise   = (FingerTree (SegMeasure v n) (Segment Closed v n)
before FingerTree (SegMeasure v n) (Segment Closed v n)
-> Segment Closed v n
-> FingerTree (SegMeasure v n) (Segment Closed v n)
forall v a. Measured v a => FingerTree v a -> a -> FingerTree v a
|> Segment Closed v n
segL, Segment Closed v n
segR Segment Closed v n
-> FingerTree (SegMeasure v n) (Segment Closed v n)
-> FingerTree (SegMeasure v n) (Segment Closed v n)
forall v a. Measured v a => a -> FingerTree v a -> FingerTree v a
<| FingerTree (SegMeasure v n) (Segment Closed v n)
after)
    -- section uses rescale to find the new value of p1 after the split at p2
    rescale :: n -> n
rescale n
u | n
pSegs' n -> n -> Bool
forall a. Eq a => a -> a -> Bool
== n
uSegs = (n
uSegs n -> n -> n
forall a. Num a => a -> a -> a
+ n
uParam n -> n -> n
forall a. Fractional a => a -> a -> a
/ n
pParam' {-'1-}) n -> n -> n
forall a. Fractional a => a -> a -> a
/ (n
pSegs' n -> n -> n
forall a. Num a => a -> a -> a
+ n
1) {-'2-}
              | Bool
otherwise       = n
u n -> n -> n
forall a. Num a => a -> a -> a
* n
tSegs n -> n -> n
forall a. Fractional a => a -> a -> a
/ (n
pSegs' n -> n -> n
forall a. Num a => a -> a -> a
+ n
1) {-'3-}
      where
        -- param 0 on a segment is param 1 on the previous segment
        (n
pSegs', n
pParam') | n
pParam n -> n -> Bool
forall a. Eq a => a -> a -> Bool
== n
0 = (n
pSegsn -> n -> n
forall a. Num a => a -> a -> a
-n
1, n
1)
                          | Bool
otherwise   = (n
pSegs  , n
pParam)
        (n
uSegs , n
uParam ) = n -> (n, n)
splitParam n
u
        -- '1 (pParam ≠ 0 → pParam' = pParam) ∧ (pParam = 0 → pParam' = 1) → pParam' ≠ 0
        -- '2 uSegs ≥ 0 ∧ pSegs' = uSegs → pSegs' ≥ 0 → pSegs' + 1 > 0
        -- '3 pSegs' + 1 = 0 → pSegs' = -1 → pSegs = 0 ∧ pParam = 0 → p = 0
        --    → rescale is not called

instance (Metric v, OrderedField n, Real n) => Sectionable (SegTree v n) where
  splitAtParam :: SegTree v n -> N (SegTree v n) -> (SegTree v n, SegTree v n)
splitAtParam SegTree v n
tree N (SegTree v n)
p = ((SegTree v n, SegTree v n), n -> n) -> (SegTree v n, SegTree v n)
forall a b. (a, b) -> a
fst (((SegTree v n, SegTree v n), n -> n)
 -> (SegTree v n, SegTree v n))
-> ((SegTree v n, SegTree v n), n -> n)
-> (SegTree v n, SegTree v n)
forall a b. (a -> b) -> a -> b
$ SegTree v n -> n -> ((SegTree v n, SegTree v n), n -> n)
forall (v :: * -> *) n.
(Metric v, OrderedField n, Real n) =>
SegTree v n -> n -> ((SegTree v n, SegTree v n), n -> n)
splitAtParam' SegTree v n
tree n
N (SegTree v n)
p

  reverseDomain :: SegTree v n -> SegTree v n
reverseDomain (SegTree FingerTree (SegMeasure v n) (Segment Closed v n)
t) = FingerTree (SegMeasure v n) (Segment Closed v n) -> SegTree v n
forall (v :: * -> *) n.
FingerTree (SegMeasure v n) (Segment Closed v n) -> SegTree v n
SegTree (FingerTree (SegMeasure v n) (Segment Closed v n) -> SegTree v n)
-> FingerTree (SegMeasure v n) (Segment Closed v n) -> SegTree v n
forall a b. (a -> b) -> a -> b
$ FingerTree (SegMeasure v n) (Segment Closed v n)
-> FingerTree (SegMeasure v n) (Segment Closed v n)
forall v a. Measured v a => FingerTree v a -> FingerTree v a
FT.reverse FingerTree (SegMeasure v n) (Segment Closed v n)
t'
    where t' :: FingerTree (SegMeasure v n) (Segment Closed v n)
t' = (Segment Closed v n -> Segment Closed v n)
-> FingerTree (SegMeasure v n) (Segment Closed v n)
-> FingerTree (SegMeasure v n) (Segment Closed v n)
forall v1 a1 v2 a2.
(Measured v1 a1, Measured v2 a2) =>
(a1 -> a2) -> FingerTree v1 a1 -> FingerTree v2 a2
FT.fmap' Segment Closed v n -> Segment Closed v n
forall n (v :: * -> *).
(Num n, Additive v) =>
Segment Closed v n -> Segment Closed v n
reverseSegment FingerTree (SegMeasure v n) (Segment Closed v n)
t

  section :: SegTree v n -> N (SegTree v n) -> N (SegTree v n) -> SegTree v n
section SegTree v n
x N (SegTree v n)
p1 N (SegTree v n)
p2 | n
N (SegTree v n)
p2 n -> n -> Bool
forall a. Eq a => a -> a -> Bool
== n
0   = SegTree v n -> SegTree v n
forall p. Sectionable p => p -> p
reverseDomain (SegTree v n -> SegTree v n)
-> ((SegTree v n, SegTree v n) -> SegTree v n)
-> (SegTree v n, SegTree v n)
-> SegTree v n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SegTree v n, SegTree v n) -> SegTree v n
forall a b. (a, b) -> a
fst ((SegTree v n, SegTree v n) -> SegTree v n)
-> (SegTree v n, SegTree v n) -> SegTree v n
forall a b. (a -> b) -> a -> b
$ SegTree v n -> N (SegTree v n) -> (SegTree v n, SegTree v n)
forall p. Sectionable p => p -> N p -> (p, p)
splitAtParam SegTree v n
x N (SegTree v n)
p1
                  | n
N (SegTree v n)
p1 n -> n -> Bool
forall a. Ord a => a -> a -> Bool
<= n
N (SegTree v n)
p2  = let ((SegTree v n
a, SegTree v n
_), n -> n
rescale) = SegTree v n -> n -> ((SegTree v n, SegTree v n), n -> n)
forall (v :: * -> *) n.
(Metric v, OrderedField n, Real n) =>
SegTree v n -> n -> ((SegTree v n, SegTree v n), n -> n)
splitAtParam' SegTree v n
x n
N (SegTree v n)
p2
                                in  (SegTree v n, SegTree v n) -> SegTree v n
forall a b. (a, b) -> b
snd ((SegTree v n, SegTree v n) -> SegTree v n)
-> (SegTree v n, SegTree v n) -> SegTree v n
forall a b. (a -> b) -> a -> b
$ SegTree v n -> N (SegTree v n) -> (SegTree v n, SegTree v n)
forall p. Sectionable p => p -> N p -> (p, p)
splitAtParam SegTree v n
a (n -> n
rescale n
N (SegTree v n)
p1)
                  | Bool
otherwise = SegTree v n -> SegTree v n
forall p. Sectionable p => p -> p
reverseDomain (SegTree v n -> SegTree v n) -> SegTree v n -> SegTree v n
forall a b. (a -> b) -> a -> b
$ SegTree v n -> N (SegTree v n) -> N (SegTree v n) -> SegTree v n
forall p. Sectionable p => p -> N p -> N p -> p
section SegTree v n
x N (SegTree v n)
p2 N (SegTree v n)
p1

instance (Metric v, OrderedField n, Real n)
    => HasArcLength (SegTree v n) where
  arcLengthBounded :: N (SegTree v n) -> SegTree v n -> Interval (N (SegTree v n))
arcLengthBounded N (SegTree v n)
eps SegTree v n
t
    -- Use the cached value if it is accurate enough; otherwise fall
    -- back to recomputing a more accurate value
    | Interval n -> n
forall a. Num a => Interval a -> a
I.width Interval n
i n -> n -> Bool
forall a. Ord a => a -> a -> Bool
<= n
N (SegTree v n)
eps = Interval n
Interval (N (SegTree v n))
i
    | Bool
otherwise        = n -> Interval n
fun (n
N (SegTree v n)
eps n -> n -> n
forall a. Fractional a => a -> a -> a
/ SegTree v n -> n
forall c (v :: * -> *) n a.
(Num c, Measured (SegMeasure v n) a) =>
a -> c
numSegs SegTree v n
t)
    where
      i :: Interval n
i   = Interval n
-> (ArcLength n -> Interval n) -> SegTree v n -> Interval n
forall (v :: * -> *) n m t a.
(SegMeasure v n :>: m, Measured (SegMeasure v n) t) =>
a -> (m -> a) -> t -> a
trailMeasure (n -> Interval n
forall a. a -> Interval a
I.singleton n
0)
              ArcLength n -> Interval n
forall n. ArcLength n -> Interval n
getArcLengthCached
              SegTree v n
t
      fun :: n -> Interval n
fun = (n -> Interval n)
-> (ArcLength n -> n -> Interval n)
-> SegTree v n
-> n
-> Interval n
forall (v :: * -> *) n m t a.
(SegMeasure v n :>: m, Measured (SegMeasure v n) t) =>
a -> (m -> a) -> t -> a
trailMeasure (Interval n -> n -> Interval n
forall a b. a -> b -> a
const Interval n
0)
              ArcLength n -> n -> Interval n
forall n. ArcLength n -> n -> Interval n
getArcLengthFun
              SegTree v n
t

  arcLengthToParam :: N (SegTree v n)
-> SegTree v n -> N (SegTree v n) -> N (SegTree v n)
arcLengthToParam N (SegTree v n)
eps st :: SegTree v n
st@(SegTree FingerTree (SegMeasure v n) (Segment Closed v n)
t) N (SegTree v n)
l
    | n
N (SegTree v n)
l n -> n -> Bool
forall a. Ord a => a -> a -> Bool
< n
0        = case FingerTree (SegMeasure v n) (Segment Closed v n)
-> ViewL (FingerTree (SegMeasure v n)) (Segment Closed v n)
forall v a.
Measured v a =>
FingerTree v a -> ViewL (FingerTree v) a
FT.viewl FingerTree (SegMeasure v n) (Segment Closed v n)
t of
                       ViewL (FingerTree (SegMeasure v n)) (Segment Closed v n)
EmptyL   -> n
N (SegTree v n)
0
                       Segment Closed v n
seg FT.:< FingerTree (SegMeasure v n) (Segment Closed v n)
_ -> 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)
N (SegTree v n)
eps Segment Closed v n
seg N (Segment Closed v n)
N (SegTree v n)
l n -> n -> n
forall a. Fractional a => a -> a -> a
/ n
tSegs
    | n
N (SegTree v n)
l n -> n -> Bool
forall a. Ord a => a -> a -> Bool
>= n
N (SegTree v n)
totalAL = case FingerTree (SegMeasure v n) (Segment Closed v n)
-> ViewR (FingerTree (SegMeasure v n)) (Segment Closed v n)
forall v a.
Measured v a =>
FingerTree v a -> ViewR (FingerTree v) a
FT.viewr FingerTree (SegMeasure v n) (Segment Closed v n)
t of
                       ViewR (FingerTree (SegMeasure v n)) (Segment Closed v n)
EmptyR    -> n
N (SegTree v n)
0
                       FingerTree (SegMeasure v n) (Segment Closed v n)
t' FT.:> Segment Closed v n
seg ->
                         let p :: N (Segment Closed v n)
p = 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
N (SegTree v n)
epsn -> n -> n
forall a. Fractional a => a -> a -> a
/n
2) Segment Closed v n
seg
                                   (n
N (SegTree v n)
l n -> n -> n
forall a. Num a => a -> a -> a
- N (SegTree v n) -> SegTree v n -> N (SegTree v n)
forall p. HasArcLength p => N p -> p -> N p
arcLength (n
N (SegTree v n)
epsn -> n -> n
forall a. Fractional a => a -> a -> a
/n
2) (FingerTree (SegMeasure v n) (Segment Closed v n) -> SegTree v n
forall (v :: * -> *) n.
FingerTree (SegMeasure v n) (Segment Closed v n) -> SegTree v n
SegTree FingerTree (SegMeasure v n) (Segment Closed v n)
t'))
                         in  (n
N (Segment Closed v n)
p n -> n -> n
forall a. Num a => a -> a -> a
- n
1)n -> n -> n
forall a. Fractional a => a -> a -> a
/n
tSegs n -> n -> n
forall a. Num a => a -> a -> a
+ n
1
    | Bool
otherwise    = case FingerTree (SegMeasure v n) (Segment Closed v n)
-> ViewL (FingerTree (SegMeasure v n)) (Segment Closed v n)
forall v a.
Measured v a =>
FingerTree v a -> ViewL (FingerTree v) a
FT.viewl FingerTree (SegMeasure v n) (Segment Closed v n)
after of
                       ViewL (FingerTree (SegMeasure v n)) (Segment Closed v n)
EmptyL    -> n
N (SegTree v n)
0
                       Segment Closed v n
seg FT.:< FingerTree (SegMeasure v n) (Segment Closed v n)
_  ->
                         let p :: N (Segment Closed v n)
p = 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
N (SegTree v n)
epsn -> n -> n
forall a. Fractional a => a -> a -> a
/n
2) Segment Closed v n
seg
                                   (n
N (SegTree v n)
l n -> n -> n
forall a. Num a => a -> a -> a
- N (SegTree v n) -> SegTree v n -> N (SegTree v n)
forall p. HasArcLength p => N p -> p -> N p
arcLength (n
N (SegTree v n)
epsn -> n -> n
forall a. Fractional a => a -> a -> a
/n
2) (FingerTree (SegMeasure v n) (Segment Closed v n) -> SegTree v n
forall (v :: * -> *) n.
FingerTree (SegMeasure v n) (Segment Closed v n) -> SegTree v n
SegTree FingerTree (SegMeasure v n) (Segment Closed v n)
before))
                         in  (FingerTree (SegMeasure v n) (Segment Closed v n) -> n
forall c (v :: * -> *) n a.
(Num c, Measured (SegMeasure v n) a) =>
a -> c
numSegs FingerTree (SegMeasure v n) (Segment Closed v n)
before n -> n -> n
forall a. Num a => a -> a -> a
+ n
N (Segment Closed v n)
p) n -> n -> n
forall a. Fractional a => a -> a -> a
/ n
tSegs
    where
      totalAL :: N (SegTree v n)
totalAL         = N (SegTree v n) -> SegTree v n -> N (SegTree v n)
forall p. HasArcLength p => N p -> p -> N p
arcLength N (SegTree v n)
eps SegTree v n
st
      tSegs :: n
tSegs           = FingerTree (SegMeasure v n) (Segment Closed v n) -> n
forall c (v :: * -> *) n a.
(Num c, Measured (SegMeasure v n) a) =>
a -> c
numSegs FingerTree (SegMeasure v n) (Segment Closed v n)
t
      before, after :: FingerTree (SegMeasure v n) (Segment Closed v n)
      (FingerTree (SegMeasure v n) (Segment Closed v n)
before, FingerTree (SegMeasure v n) (Segment Closed v n)
after) =
        (SegMeasure v n -> Bool)
-> FingerTree (SegMeasure v n) (Segment Closed v n)
-> (FingerTree (SegMeasure v n) (Segment Closed v n),
    FingerTree (SegMeasure v n) (Segment Closed v n))
forall v a.
Measured v a =>
(v -> Bool) -> FingerTree v a -> (FingerTree v a, FingerTree v a)
FT.split ((N (SegTree v n) -> N (SegTree v n) -> Bool
forall a. Ord a => a -> a -> Bool
>= N (SegTree v n)
l)
                 (n -> Bool) -> (SegMeasure v n -> n) -> SegMeasure v n -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n -> (ArcLength n -> n) -> SegMeasure v n -> n
forall (v :: * -> *) n m t a.
(SegMeasure v n :>: m, Measured (SegMeasure v n) t) =>
a -> (m -> a) -> t -> a
trailMeasure
                 n
0
                 (Interval n -> n
forall a. Fractional a => Interval a -> a
I.midpoint (Interval n -> n)
-> (ArcLength n -> Interval n) -> ArcLength n -> n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n -> ArcLength n -> Interval n
forall n. (Num n, Ord n) => n -> ArcLength n -> Interval n
getArcLengthBounded n
N (SegTree v n)
eps))
                 FingerTree (SegMeasure v n) (Segment Closed v n)
t

-- | Given a default result (to be used in the case of an empty
--   trail), and a function to map a single measure to a result,
--   extract the given measure for a trail and use it to compute a
--   result.  Put another way, lift a function on a single measure
--   (along with a default value) to a function on an entire trail.
trailMeasure :: ( SegMeasure v n :>: m, FT.Measured (SegMeasure v n) t )
             => a -> (m -> a) -> t -> a
trailMeasure :: forall (v :: * -> *) n m t a.
(SegMeasure v n :>: m, Measured (SegMeasure v n) t) =>
a -> (m -> a) -> t -> a
trailMeasure a
d m -> a
f = a -> (m -> a) -> Maybe m -> a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe a
d m -> a
f (Maybe m -> a) -> (t -> Maybe m) -> t -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SegMeasure v n -> Maybe m
forall l a. (l :>: a) => l -> Maybe a
get (SegMeasure v n -> Maybe m)
-> (t -> SegMeasure v n) -> t -> Maybe m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> SegMeasure v n
forall v a. Measured v a => a -> v
FT.measure

-- | Compute the number of segments of anything measured by
--   'SegMeasure' (/e.g./ @SegMeasure@ itself, @Segment@, @SegTree@,
--   @Trail@s...)
numSegs :: (Num c, FT.Measured (SegMeasure v n) a)
        => a -> c
numSegs :: forall c (v :: * -> *) n a.
(Num c, Measured (SegMeasure v n) a) =>
a -> c
numSegs = Int -> c
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> c) -> (a -> Int) -> a -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> (SegCount -> Int) -> a -> Int
forall (v :: * -> *) n m t a.
(SegMeasure v n :>: m, Measured (SegMeasure v n) t) =>
a -> (m -> a) -> t -> a
trailMeasure Int
0 (Sum Int -> Int
forall a. Sum a -> a
getSum (Sum Int -> Int) -> (SegCount -> Sum Int) -> SegCount -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Unwrapped SegCount -> SegCount) -> SegCount -> Unwrapped SegCount
forall s. Wrapped s => (Unwrapped s -> s) -> s -> Unwrapped s
op Sum Int -> SegCount
Unwrapped SegCount -> SegCount
SegCount)

-- | Compute the total offset of anything measured by 'SegMeasure'.
offset :: ( OrderedField n, Metric v,
            FT.Measured (SegMeasure v n) t
          )
       => t -> v n
offset :: forall n (v :: * -> *) t.
(OrderedField n, Metric v, Measured (SegMeasure v n) t) =>
t -> v n
offset = v n -> (OffsetEnvelope v n -> v n) -> t -> v n
forall (v :: * -> *) n m t a.
(SegMeasure v n :>: m, Measured (SegMeasure v n) t) =>
a -> (m -> a) -> t -> a
trailMeasure v n
forall a. Num a => v a
forall (f :: * -> *) a. (Additive f, Num a) => f a
zero ((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)
-> (OffsetEnvelope v n -> TotalOffset v n)
-> OffsetEnvelope v n
-> v n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (TotalOffset v n) (OffsetEnvelope v n) (TotalOffset v n)
-> OffsetEnvelope v n -> TotalOffset v n
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (TotalOffset v n) (OffsetEnvelope v n) (TotalOffset v n)
forall (v :: * -> *) n (f :: * -> *).
Functor f =>
(TotalOffset v n -> f (TotalOffset v n))
-> OffsetEnvelope v n -> f (OffsetEnvelope v n)
oeOffset)

------------------------------------------------------------
--  Trails  ------------------------------------------------
------------------------------------------------------------

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

-- | Type tag for trails with distinct endpoints.
data Line

-- | Type tag for \"loopy\" trails which return to their starting
--   point.
data Loop

--------------------------------------------------
-- The Trail' type

-- | Intuitively, a trail is a single, continuous path through space.
--   However, a trail has no fixed starting point; it merely specifies
--   /how/ to move through space, not /where/.  For example, \"take
--   three steps forward, then turn right twenty degrees and take two
--   more steps\" is an intuitive analog of a trail; these
--   instructions specify a path through space from any given starting
--   location.  To be precise, trails are /translation-invariant/;
--   applying a translation to a trail has no effect.
--
--   A @'Located' Trail@, on the other hand, is a trail paired with
--   some concrete starting location (\"start at the big tree on the
--   corner, then take three steps forward, ...\").  See the
--   "Diagrams.Located" module for help working with 'Located' values.
--
--   Formally, the semantics of a trail is a continuous (though not
--   necessarily differentiable) function from the real interval [0,1]
--   to vectors in some vector space.  (In contrast, a 'Located' trail
--   is a continuous function from [0,1] to /points/ in some /affine/
--   space.)
--
--   There are two types of trails:
--
--   * A \"line\" (think of the \"train\", \"subway\", or \"bus\"
--     variety, rather than the \"straight\" variety...) is a trail
--     with two distinct endpoints.  Actually, a line can have the
--     same start and end points, but it is still /drawn/ as if it had
--     distinct endpoints: the two endpoints will have the appropriate
--     end caps, and the trail will not be filled.  Lines have a
--     @Monoid@ instance where @mappend@ corresponds to concatenation,
--     /i.e./ chaining one line after the other.
--
--   * A \"loop\" is required to end in the same place it starts (that
--     is, t(0) = t(1)).  Loops are filled and are drawn as one
--     continuous loop, with the appropriate join at the
--     start/endpoint rather than end caps.  Loops do not have a
--     @Monoid@ instance.
--
--   To convert between lines and loops, see 'glueLine',
--   'closeLine', and 'cutLoop'.
--
--   To construct trails, see 'emptyTrail', 'trailFromSegments',
--   'trailFromVertices', 'trailFromOffsets', and friends.  You can
--   also get any type of trail from any function which returns a
--   'TrailLike' (/e.g./ functions in "Diagrams.TwoD.Shapes", and many
--   others; see "Diagrams.TrailLike").
--
--   To extract information from trails, see 'withLine', 'isLoop',
--   'trailSegments', 'trailOffsets', 'trailVertices', and friends.

data Trail' l v n where
  Line :: SegTree v n                     -> Trail' Line v n
  Loop :: SegTree v n -> Segment Open v n -> Trail' Loop v n

-- | A generic eliminator for 'Trail'', taking functions specifying
--   what to do in the case of a line or a loop.
withTrail' :: (Trail' Line v n -> r) -> (Trail' Loop v n -> r) -> Trail' l v n -> r
withTrail' :: forall (v :: * -> *) n r l.
(Trail' Line v n -> r)
-> (Trail' Loop v n -> r) -> Trail' l v n -> r
withTrail' Trail' Line v n -> r
line Trail' Loop v n -> r
_    t :: Trail' l v n
t@(Line{}) = Trail' Line v n -> r
line Trail' l v n
Trail' Line v n
t
withTrail' Trail' Line v n -> r
_    Trail' Loop v n -> r
loop t :: Trail' l v n
t@(Loop{}) = Trail' Loop v n -> r
loop Trail' l v n
Trail' Loop v n
t

deriving instance Eq  (v n) => Eq   (Trail' l v n)
deriving instance Ord (v n) => Ord  (Trail' l v n)

instance Show (v n) => Show (Trail' l v n) where
  showsPrec :: Int -> Trail' l v n -> ShowS
showsPrec Int
d (Line (SegTree FingerTree (SegMeasure v n) (Segment Closed v n)
ft)) = 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
"lineFromSegments " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Segment Closed v n] -> ShowS
forall a. Show a => [a] -> ShowS
showList (FingerTree (SegMeasure v n) (Segment Closed v n)
-> [Segment Closed v n]
forall a. FingerTree (SegMeasure v n) a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList FingerTree (SegMeasure v n) (Segment Closed v n)
ft)

  showsPrec Int
d (Loop (SegTree FingerTree (SegMeasure v n) (Segment Closed v n)
ft) Segment Open v n
o) = 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
"loopFromSegments " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Segment Closed v n] -> ShowS
forall a. Show a => [a] -> ShowS
showList (FingerTree (SegMeasure v n) (Segment Closed v n)
-> [Segment Closed v n]
forall a. FingerTree (SegMeasure v n) a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList FingerTree (SegMeasure v n) (Segment Closed v n)
ft) 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 -> Segment Open v n -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Segment Open v n
o

type instance V (Trail' l v n) = v
type instance N (Trail' l v n) = n

type instance Codomain (Trail' l v n) = v

instance (OrderedField n, Metric v) => Semigroup (Trail' Line v n) where
  (Line SegTree v n
t1) <> :: Trail' Line v n -> Trail' Line v n -> Trail' Line v n
<> (Line SegTree v n
t2) = SegTree v n -> Trail' Line v n
forall (v :: * -> *) n. SegTree v n -> Trail' Line v n
Line (SegTree v n
t1 SegTree v n -> SegTree v n -> SegTree v n
forall a. Monoid a => a -> a -> a
`mappend` SegTree v n
t2)

-- | The empty trail is constantly the zero vector.  Trails are
--   composed via concatenation.  Note that only lines have a monoid
--   instance (and not loops).
instance (Metric v, OrderedField n) => Monoid (Trail' Line v n) where
  mempty :: Trail' Line v n
mempty  = Trail' Line v n
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Trail' Line v n
emptyLine
  mappend :: Trail' Line v n -> Trail' Line v n -> Trail' Line v n
mappend = Trail' Line v n -> Trail' Line v n -> Trail' Line v n
forall a. Semigroup a => a -> a -> a
(<>)

instance (Metric v, OrderedField n) => AsEmpty (Trail' Line v n) where
  _Empty :: Prism' (Trail' Line v n) ()
_Empty = Trail' Line v n
-> (Trail' Line v n -> Bool) -> Prism' (Trail' Line v n) ()
forall a. a -> (a -> Bool) -> Prism' a ()
nearly Trail' Line v n
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Trail' Line v n
emptyLine Trail' Line v n -> Bool
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Trail' Line v n -> Bool
isLineEmpty

instance (HasLinearMap v, Metric v, OrderedField n)
    => Transformable (Trail' l v n) where
  transform :: Transformation (V (Trail' l v n)) (N (Trail' l v n))
-> Trail' l v n -> Trail' l v n
transform Transformation (V (Trail' l v n)) (N (Trail' l v n))
tr (Line SegTree v n
t  ) = SegTree v n -> Trail' Line v n
forall (v :: * -> *) n. SegTree v n -> Trail' Line v n
Line (Transformation (V (SegTree v n)) (N (SegTree v n))
-> SegTree v n -> SegTree v n
forall t. Transformable t => Transformation (V t) (N t) -> t -> t
transform Transformation (V (Trail' l v n)) (N (Trail' l v n))
Transformation (V (SegTree v n)) (N (SegTree v n))
tr SegTree v n
t)
  transform Transformation (V (Trail' l v n)) (N (Trail' l v n))
tr (Loop SegTree v n
t Segment Open v n
s) = SegTree v n -> Segment Open v n -> Trail' Loop v n
forall (v :: * -> *) n.
SegTree v n -> Segment Open v n -> Trail' Loop v n
Loop (Transformation (V (SegTree v n)) (N (SegTree v n))
-> SegTree v n -> SegTree v n
forall t. Transformable t => Transformation (V t) (N t) -> t -> t
transform Transformation (V (Trail' l v n)) (N (Trail' l v n))
Transformation (V (SegTree v n)) (N (SegTree v n))
tr SegTree v n
t) (Transformation (V (Segment Open v n)) (N (Segment Open v n))
-> Segment Open v n -> Segment Open v n
forall t. Transformable t => Transformation (V t) (N t) -> t -> t
transform Transformation (V (Segment Open v n)) (N (Segment Open v n))
Transformation (V (Trail' l v n)) (N (Trail' l v n))
tr Segment Open v n
s)

-- | The envelope for a trail is based at the trail's start.
instance (Metric v, OrderedField n) => Enveloped (Trail' l v n) where
  getEnvelope :: Trail' l v n -> Envelope (V (Trail' l v n)) (N (Trail' l v n))
getEnvelope = (Trail' Line v n -> Envelope v n)
-> (Trail' Loop v n -> Envelope v n)
-> Trail' l v n
-> Envelope v n
forall (v :: * -> *) n r l.
(Trail' Line v n -> r)
-> (Trail' Loop v n -> r) -> Trail' l v n -> r
withTrail' Trail' Line v n -> Envelope v n
ftEnv (Trail' Line v n -> Envelope v n
ftEnv (Trail' Line v n -> Envelope v n)
-> (Trail' Loop v n -> Trail' Line v n)
-> Trail' Loop v n
-> Envelope v n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trail' Loop v n -> Trail' Line v n
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Trail' Loop v n -> Trail' Line v n
cutLoop)
    where
      ftEnv :: Trail' Line v n -> Envelope v n
      ftEnv :: Trail' Line v n -> Envelope v n
ftEnv (Line SegTree v n
t) = Envelope v n
-> (OffsetEnvelope v n -> Envelope v n)
-> SegTree v n
-> Envelope v n
forall (v :: * -> *) n m t a.
(SegMeasure v n :>: m, Measured (SegMeasure v n) t) =>
a -> (m -> a) -> t -> a
trailMeasure Envelope v n
forall a. Monoid a => a
mempty (Getting (Envelope v n) (OffsetEnvelope v n) (Envelope v n)
-> OffsetEnvelope v n -> Envelope v n
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Envelope v n) (OffsetEnvelope v n) (Envelope v n)
forall (v :: * -> *) n (f :: * -> *).
Functor f =>
(Envelope v n -> f (Envelope v n))
-> OffsetEnvelope v n -> f (OffsetEnvelope v n)
oeEnvelope) SegTree v n
t

instance (HasLinearMap v, Metric v, OrderedField n)
    => Renderable (Trail' o v n) NullBackend where
  render :: NullBackend
-> Trail' o v n
-> Render NullBackend (V (Trail' o v n)) (N (Trail' o v n))
render NullBackend
_ Trail' o v n
_ = Render NullBackend v n
Render NullBackend (V (Trail' o v n)) (N (Trail' o v n))
forall a. Monoid a => a
mempty

instance (Metric v, OrderedField n, Real n)
    => Parametric (Trail' l v n) where
  atParam :: Trail' l v n
-> N (Trail' l v n) -> Codomain (Trail' l v n) (N (Trail' l v n))
atParam Trail' l v n
t N (Trail' l v n)
p = (Trail' Line v n -> v n)
-> (Trail' Loop v n -> v n) -> Trail' l v n -> v n
forall (v :: * -> *) n r l.
(Trail' Line v n -> r)
-> (Trail' Loop v n -> r) -> Trail' l v n -> r
withTrail'
                  (\(Line SegTree v n
segT) -> SegTree v n
segT SegTree v n
-> N (SegTree v n) -> Codomain (SegTree v n) (N (SegTree v n))
forall p. Parametric p => p -> N p -> Codomain p (N p)
`atParam` N (Trail' l v n)
N (SegTree v n)
p)
                  (\Trail' Loop v n
l -> Trail' Loop v n -> Trail' Line v n
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Trail' Loop v n -> Trail' Line v n
cutLoop Trail' Loop v n
l Trail' Line v n
-> N (Trail' Line v n)
-> Codomain (Trail' Line v n) (N (Trail' Line v n))
forall p. Parametric p => p -> N p -> Codomain p (N p)
`atParam` n -> n
forall a. Real a => a -> a
mod1 n
N (Trail' l v n)
p)
                  Trail' l v n
t

instance (Parametric (GetSegment (Trail' c v n)), Additive v, Num n)
    => Parametric (Tangent (Trail' c v n)) where
  Tangent Trail' c v n
tr atParam :: Tangent (Trail' c v n)
-> N (Tangent (Trail' c v n))
-> Codomain (Tangent (Trail' c v n)) (N (Tangent (Trail' c v n)))
`atParam` N (Tangent (Trail' c v n))
p =
    case Trail' c v n -> GetSegment (Trail' c v n)
forall t. t -> GetSegment t
GetSegment Trail' c v n
tr GetSegment (Trail' c v n)
-> N (GetSegment (Trail' c v n))
-> Codomain
     (GetSegment (Trail' c v n)) (N (GetSegment (Trail' c v n)))
forall p. Parametric p => p -> N p -> Codomain p (N p)
`atParam` N (Tangent (Trail' c v n))
N (GetSegment (Trail' c v n))
p of
      GetSegmentCodomain Maybe (v n, Segment Closed v n, AnIso' n n)
Nothing                  -> v n
Codomain (Tangent (Trail' c v n)) (N (Tangent (Trail' c v n)))
forall a. Num a => v a
forall (f :: * -> *) a. (Additive f, Num a) => f a
zero
      GetSegmentCodomain (Just (v n
_, Segment Closed v n
seg, AnIso' n n
reparam)) -> Segment Closed v n -> Tangent (Segment Closed v n)
forall t. t -> Tangent t
Tangent Segment Closed v n
seg Tangent (Segment Closed v n)
-> N (Tangent (Segment Closed v n))
-> Codomain
     (Tangent (Segment Closed v n)) (N (Tangent (Segment Closed v n)))
forall p. Parametric p => p -> N p -> Codomain p (N p)
`atParam` (n
N (Tangent (Trail' c v n))
p n -> Getting n n n -> n
forall s a. s -> Getting a s a -> a
^. AnIso' n n -> Iso n n n n
forall s t a b. AnIso s t a b -> Iso s t a b
cloneIso AnIso' n n
reparam)

instance ( Parametric (GetSegment (Trail' c v n))
         , EndValues (GetSegment (Trail' c v n))
         , Additive v
         , Num n
         )
    => EndValues (Tangent (Trail' c v n)) where
  atStart :: Tangent (Trail' c v n)
-> Codomain (Tangent (Trail' c v n)) (N (Tangent (Trail' c v n)))
atStart (Tangent Trail' c v n
tr) =
    case GetSegment (Trail' c v n)
-> Codomain
     (GetSegment (Trail' c v n)) (N (GetSegment (Trail' c v n)))
forall p. EndValues p => p -> Codomain p (N p)
atStart (Trail' c v n -> GetSegment (Trail' c v n)
forall t. t -> GetSegment t
GetSegment Trail' c v n
tr) of
      GetSegmentCodomain Maybe (v n, Segment Closed v n, AnIso' n n)
Nothing            -> v n
Codomain (Tangent (Trail' c v n)) (N (Tangent (Trail' c v n)))
forall a. Num a => v a
forall (f :: * -> *) a. (Additive f, Num a) => f a
zero
      GetSegmentCodomain (Just (v n
_, Segment Closed v n
seg, AnIso' n n
_)) -> Tangent (Segment Closed v n)
-> Codomain
     (Tangent (Segment Closed v n)) (N (Tangent (Segment Closed v n)))
forall p. EndValues p => p -> Codomain p (N p)
atStart (Segment Closed v n -> Tangent (Segment Closed v n)
forall t. t -> Tangent t
Tangent Segment Closed v n
seg)
  atEnd :: Tangent (Trail' c v n)
-> Codomain (Tangent (Trail' c v n)) (N (Tangent (Trail' c v n)))
atEnd (Tangent Trail' c v n
tr) =
    case GetSegment (Trail' c v n)
-> Codomain
     (GetSegment (Trail' c v n)) (N (GetSegment (Trail' c v n)))
forall p. EndValues p => p -> Codomain p (N p)
atEnd (Trail' c v n -> GetSegment (Trail' c v n)
forall t. t -> GetSegment t
GetSegment Trail' c v n
tr) of
      GetSegmentCodomain Maybe (v n, Segment Closed v n, AnIso' n n)
Nothing            -> v n
Codomain (Tangent (Trail' c v n)) (N (Tangent (Trail' c v n)))
forall a. Num a => v a
forall (f :: * -> *) a. (Additive f, Num a) => f a
zero
      GetSegmentCodomain (Just (v n
_, Segment Closed v n
seg, AnIso' n n
_)) -> Tangent (Segment Closed v n)
-> Codomain
     (Tangent (Segment Closed v n)) (N (Tangent (Segment Closed v n)))
forall p. EndValues p => p -> Codomain p (N p)
atEnd (Segment Closed v n -> Tangent (Segment Closed v n)
forall t. t -> Tangent t
Tangent Segment Closed v n
seg)

instance (Metric v , OrderedField n, Real n)
    => Parametric (Tangent (Trail v n)) where
  Tangent Trail v n
tr atParam :: Tangent (Trail v n)
-> N (Tangent (Trail v n))
-> Codomain (Tangent (Trail v n)) (N (Tangent (Trail v n)))
`atParam` N (Tangent (Trail v n))
p
    = (Trail' Line v n -> v n)
-> (Trail' Loop v n -> v n) -> Trail v n -> v n
forall (v :: * -> *) n r.
(Trail' Line v n -> r) -> (Trail' Loop v n -> r) -> Trail v n -> r
withTrail
        ((Tangent (Trail' Line v n)
-> N (Tangent (Trail' Line v n))
-> Codomain
     (Tangent (Trail' Line v n)) (N (Tangent (Trail' Line v n)))
forall p. Parametric p => p -> N p -> Codomain p (N p)
`atParam` N (Tangent (Trail v n))
N (Tangent (Trail' Line v n))
p) (Tangent (Trail' Line v n) -> v n)
-> (Trail' Line v n -> Tangent (Trail' Line v n))
-> Trail' Line v n
-> v n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trail' Line v n -> Tangent (Trail' Line v n)
forall t. t -> Tangent t
Tangent)
        ((Tangent (Trail' Loop v n)
-> N (Tangent (Trail' Loop v n))
-> Codomain
     (Tangent (Trail' Loop v n)) (N (Tangent (Trail' Loop v n)))
forall p. Parametric p => p -> N p -> Codomain p (N p)
`atParam` N (Tangent (Trail v n))
N (Tangent (Trail' Loop v n))
p) (Tangent (Trail' Loop v n) -> v n)
-> (Trail' Loop v n -> Tangent (Trail' Loop v n))
-> Trail' Loop v n
-> v n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trail' Loop v n -> Tangent (Trail' Loop v n)
forall t. t -> Tangent t
Tangent)
        Trail v n
tr

instance (Metric v, OrderedField n, Real n)
    => EndValues (Tangent (Trail v n)) where
  atStart :: Tangent (Trail v n)
-> Codomain (Tangent (Trail v n)) (N (Tangent (Trail v n)))
atStart (Tangent Trail v n
tr) = (Trail' Line v n -> v n)
-> (Trail' Loop v n -> v n) -> Trail v n -> v n
forall (v :: * -> *) n r.
(Trail' Line v n -> r) -> (Trail' Loop v n -> r) -> Trail v n -> r
withTrail (Tangent (Trail' Line v n) -> v n
Tangent (Trail' Line v n)
-> Codomain
     (Tangent (Trail' Line v n)) (N (Tangent (Trail' Line v n)))
forall p. EndValues p => p -> Codomain p (N p)
atStart (Tangent (Trail' Line v n) -> v n)
-> (Trail' Line v n -> Tangent (Trail' Line v n))
-> Trail' Line v n
-> v n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trail' Line v n -> Tangent (Trail' Line v n)
forall t. t -> Tangent t
Tangent) (Tangent (Trail' Loop v n) -> v n
Tangent (Trail' Loop v n)
-> Codomain
     (Tangent (Trail' Loop v n)) (N (Tangent (Trail' Loop v n)))
forall p. EndValues p => p -> Codomain p (N p)
atStart (Tangent (Trail' Loop v n) -> v n)
-> (Trail' Loop v n -> Tangent (Trail' Loop v n))
-> Trail' Loop v n
-> v n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trail' Loop v n -> Tangent (Trail' Loop v n)
forall t. t -> Tangent t
Tangent) Trail v n
tr
  atEnd :: Tangent (Trail v n)
-> Codomain (Tangent (Trail v n)) (N (Tangent (Trail v n)))
atEnd   (Tangent Trail v n
tr) = (Trail' Line v n -> v n)
-> (Trail' Loop v n -> v n) -> Trail v n -> v n
forall (v :: * -> *) n r.
(Trail' Line v n -> r) -> (Trail' Loop v n -> r) -> Trail v n -> r
withTrail (Tangent (Trail' Line v n) -> v n
Tangent (Trail' Line v n)
-> Codomain
     (Tangent (Trail' Line v n)) (N (Tangent (Trail' Line v n)))
forall p. EndValues p => p -> Codomain p (N p)
atEnd   (Tangent (Trail' Line v n) -> v n)
-> (Trail' Line v n -> Tangent (Trail' Line v n))
-> Trail' Line v n
-> v n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trail' Line v n -> Tangent (Trail' Line v n)
forall t. t -> Tangent t
Tangent) (Tangent (Trail' Loop v n) -> v n
Tangent (Trail' Loop v n)
-> Codomain
     (Tangent (Trail' Loop v n)) (N (Tangent (Trail' Loop v n)))
forall p. EndValues p => p -> Codomain p (N p)
atEnd   (Tangent (Trail' Loop v n) -> v n)
-> (Trail' Loop v n -> Tangent (Trail' Loop v n))
-> Trail' Loop v n
-> v n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trail' Loop v n -> Tangent (Trail' Loop v n)
forall t. t -> Tangent t
Tangent) Trail v n
tr

-- | Compute the remainder mod 1.  Convenient for constructing loop
--   parameterizations that wrap around.
mod1 :: Real a => a -> a
mod1 :: forall a. Real a => a -> a
mod1 = (a -> a -> a
forall a. Real a => a -> a -> a
`mod'` a
1)

instance Num n => DomainBounds (Trail' l v n)

instance (Metric v, OrderedField n, Real n)
  => EndValues (Trail' l v n)

instance (Metric v, OrderedField n, Real n)
    => Sectionable (Trail' Line v n) where
  splitAtParam :: Trail' Line v n
-> N (Trail' Line v n) -> (Trail' Line v n, Trail' Line v n)
splitAtParam (Line SegTree v n
t) N (Trail' Line v n)
p = (SegTree v n -> Trail' Line v n
forall (v :: * -> *) n. SegTree v n -> Trail' Line v n
Line SegTree v n
t1, SegTree v n -> Trail' Line v n
forall (v :: * -> *) n. SegTree v n -> Trail' Line v n
Line SegTree v n
t2)
    where
      (SegTree v n
t1, SegTree v n
t2) = SegTree v n -> N (SegTree v n) -> (SegTree v n, SegTree v n)
forall p. Sectionable p => p -> N p -> (p, p)
splitAtParam SegTree v n
t N (Trail' Line v n)
N (SegTree v n)
p

  section :: Trail' Line v n
-> N (Trail' Line v n) -> N (Trail' Line v n) -> Trail' Line v n
section (Line SegTree v n
t) N (Trail' Line v n)
p1 N (Trail' Line v n)
p2 = SegTree v n -> Trail' Line v n
forall (v :: * -> *) n. SegTree v n -> Trail' Line v n
Line (SegTree v n -> N (SegTree v n) -> N (SegTree v n) -> SegTree v n
forall p. Sectionable p => p -> N p -> N p -> p
section SegTree v n
t N (Trail' Line v n)
N (SegTree v n)
p1 N (Trail' Line v n)
N (SegTree v n)
p2)

  reverseDomain :: Trail' Line v n -> Trail' Line v n
reverseDomain = Trail' Line v n -> Trail' Line v n
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Trail' Line v n -> Trail' Line v n
reverseLine

instance (Metric v, OrderedField n, Real n)
    => HasArcLength (Trail' l v n) where
  arcLengthBounded :: N (Trail' l v n) -> Trail' l v n -> Interval (N (Trail' l v n))
arcLengthBounded N (Trail' l v n)
eps =
    (Trail' Line v n -> Interval n)
-> (Trail' Loop v n -> Interval n) -> Trail' l v n -> Interval n
forall (v :: * -> *) n r l.
(Trail' Line v n -> r)
-> (Trail' Loop v n -> r) -> Trail' l v n -> r
withTrail'
      (\(Line SegTree v n
t) -> N (SegTree v n) -> SegTree v n -> Interval (N (SegTree v n))
forall p. HasArcLength p => N p -> p -> Interval (N p)
arcLengthBounded N (Trail' l v n)
N (SegTree v n)
eps SegTree v n
t)
      (N (Trail' Line v n)
-> Trail' Line v n -> Interval (N (Trail' Line v n))
forall p. HasArcLength p => N p -> p -> Interval (N p)
arcLengthBounded N (Trail' l v n)
N (Trail' Line v n)
eps (Trail' Line v n -> Interval n)
-> (Trail' Loop v n -> Trail' Line v n)
-> Trail' Loop v n
-> Interval n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trail' Loop v n -> Trail' Line v n
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Trail' Loop v n -> Trail' Line v n
cutLoop)

  arcLengthToParam :: N (Trail' l v n)
-> Trail' l v n -> N (Trail' l v n) -> N (Trail' l v n)
arcLengthToParam N (Trail' l v n)
eps Trail' l v n
tr N (Trail' l v n)
l =
    (Trail' Line v n -> n)
-> (Trail' Loop v n -> n) -> Trail' l v n -> n
forall (v :: * -> *) n r l.
(Trail' Line v n -> r)
-> (Trail' Loop v n -> r) -> Trail' l v n -> r
withTrail'
      (\(Line SegTree v n
t) -> N (SegTree v n)
-> SegTree v n -> N (SegTree v n) -> N (SegTree v n)
forall p. HasArcLength p => N p -> p -> N p -> N p
arcLengthToParam N (Trail' l v n)
N (SegTree v n)
eps SegTree v n
t N (Trail' l v n)
N (SegTree v n)
l)
      (\Trail' Loop v n
lp -> N (Trail' Line v n)
-> Trail' Line v n -> N (Trail' Line v n) -> N (Trail' Line v n)
forall p. HasArcLength p => N p -> p -> N p -> N p
arcLengthToParam N (Trail' l v n)
N (Trail' Line v n)
eps (Trail' Loop v n -> Trail' Line v n
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Trail' Loop v n -> Trail' Line v n
cutLoop Trail' Loop v n
lp) N (Trail' l v n)
N (Trail' Line v n)
l)
      Trail' l v n
tr

instance Rewrapped (Trail' Line v n) (Trail' Line v' n')
instance Wrapped (Trail' Line v n) where
  type Unwrapped (Trail' Line v n) = SegTree v n
  _Wrapped' :: Iso' (Trail' Line v n) (Unwrapped (Trail' Line v n))
_Wrapped' = (Trail' Line v n -> SegTree v n)
-> (SegTree v n -> Trail' Line v n)
-> Iso
     (Trail' Line v n) (Trail' Line v n) (SegTree v n) (SegTree v n)
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (\(Line SegTree v n
x) -> SegTree v n
x) SegTree v n -> Trail' Line v n
forall (v :: * -> *) n. SegTree v n -> Trail' Line v n
Line
  {-# INLINE _Wrapped' #-}

instance (Metric v, OrderedField n, Metric u, OrderedField n')
  => Cons (Trail' Line v n) (Trail' Line u n') (Segment Closed v n) (Segment Closed u n') where
  _Cons :: Prism
  (Trail' Line v n)
  (Trail' Line u n')
  (Segment Closed v n, Trail' Line v n)
  (Segment Closed u n', Trail' Line u n')
_Cons = p (Unwrapped (Trail' Line v n)) (f (Unwrapped (Trail' Line u n')))
-> p (Trail' Line v n) (f (Trail' Line u n'))
p (SegTree v n) (f (SegTree u n'))
-> p (Trail' Line v n) (f (Trail' Line u n'))
forall s t. Rewrapping s t => Iso s t (Unwrapped s) (Unwrapped t)
Iso
  (Trail' Line v n)
  (Trail' Line u n')
  (Unwrapped (Trail' Line v n))
  (Unwrapped (Trail' Line u n'))
_Wrapped (p (SegTree v n) (f (SegTree u n'))
 -> p (Trail' Line v n) (f (Trail' Line u n')))
-> (p (Segment Closed v n, Trail' Line v n)
      (f (Segment Closed u n', Trail' Line u n'))
    -> p (SegTree v n) (f (SegTree u n')))
-> p (Segment Closed v n, Trail' Line v n)
     (f (Segment Closed u n', Trail' Line u n'))
-> p (Trail' Line v n) (f (Trail' Line u n'))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p (Segment Closed v n, SegTree v n)
  (f (Segment Closed u n', SegTree u n'))
-> p (SegTree v n) (f (SegTree u n'))
forall s t a b. Cons s t a b => Prism s t (a, s) (b, t)
Prism
  (SegTree v n)
  (SegTree u n')
  (Segment Closed v n, SegTree v n)
  (Segment Closed u n', SegTree u n')
_Cons (p (Segment Closed v n, SegTree v n)
   (f (Segment Closed u n', SegTree u n'))
 -> p (SegTree v n) (f (SegTree u n')))
-> (p (Segment Closed v n, Trail' Line v n)
      (f (Segment Closed u n', Trail' Line u n'))
    -> p (Segment Closed v n, SegTree v n)
         (f (Segment Closed u n', SegTree u n')))
-> p (Segment Closed v n, Trail' Line v n)
     (f (Segment Closed u n', Trail' Line u n'))
-> p (SegTree v n) (f (SegTree u n'))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnIso
  (Segment Closed v n)
  (Segment Closed u n')
  (Segment Closed v n)
  (Segment Closed u n')
-> AnIso
     (SegTree v n) (SegTree u n') (Trail' Line v n) (Trail' Line u n')
-> Iso
     (Segment Closed v n, SegTree v n)
     (Segment Closed u n', SegTree u n')
     (Segment Closed v n, Trail' Line v n)
     (Segment Closed u n', Trail' Line u n')
forall (f :: * -> * -> *) (g :: * -> * -> *) s t a b s' t' a' b'.
(Bifunctor f, Bifunctor g) =>
AnIso s t a b
-> AnIso s' t' a' b' -> Iso (f s s') (g t t') (f a a') (g b b')
bimapping AnIso
  (Segment Closed v n)
  (Segment Closed u n')
  (Segment Closed v n)
  (Segment Closed u n')
forall a. a -> a
id Exchange
  (Trail' Line v n)
  (Trail' Line u n')
  (Trail' Line v n)
  (Identity (Trail' Line u n'))
-> Exchange
     (Trail' Line v n)
     (Trail' Line u n')
     (Unwrapped (Trail' Line v n))
     (Identity (Unwrapped (Trail' Line u n')))
AnIso
  (SegTree v n) (SegTree u n') (Trail' Line v n) (Trail' Line u n')
forall s t. Rewrapping s t => Iso (Unwrapped t) (Unwrapped s) t s
Iso
  (Unwrapped (Trail' Line v n))
  (Unwrapped (Trail' Line u n'))
  (Trail' Line v n)
  (Trail' Line u n')
_Unwrapped
  {-# INLINE _Cons #-}

instance (Metric v, OrderedField n, Metric u, OrderedField n')
  => Snoc (Trail' Line v n) (Trail' Line u n') (Segment Closed v n) (Segment Closed u n') where
  _Snoc :: Prism
  (Trail' Line v n)
  (Trail' Line u n')
  (Trail' Line v n, Segment Closed v n)
  (Trail' Line u n', Segment Closed u n')
_Snoc = p (Unwrapped (Trail' Line v n)) (f (Unwrapped (Trail' Line u n')))
-> p (Trail' Line v n) (f (Trail' Line u n'))
p (SegTree v n) (f (SegTree u n'))
-> p (Trail' Line v n) (f (Trail' Line u n'))
forall s t. Rewrapping s t => Iso s t (Unwrapped s) (Unwrapped t)
Iso
  (Trail' Line v n)
  (Trail' Line u n')
  (Unwrapped (Trail' Line v n))
  (Unwrapped (Trail' Line u n'))
_Wrapped (p (SegTree v n) (f (SegTree u n'))
 -> p (Trail' Line v n) (f (Trail' Line u n')))
-> (p (Trail' Line v n, Segment Closed v n)
      (f (Trail' Line u n', Segment Closed u n'))
    -> p (SegTree v n) (f (SegTree u n')))
-> p (Trail' Line v n, Segment Closed v n)
     (f (Trail' Line u n', Segment Closed u n'))
-> p (Trail' Line v n) (f (Trail' Line u n'))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p (SegTree v n, Segment Closed v n)
  (f (SegTree u n', Segment Closed u n'))
-> p (SegTree v n) (f (SegTree u n'))
forall s t a b. Snoc s t a b => Prism s t (s, a) (t, b)
Prism
  (SegTree v n)
  (SegTree u n')
  (SegTree v n, Segment Closed v n)
  (SegTree u n', Segment Closed u n')
_Snoc (p (SegTree v n, Segment Closed v n)
   (f (SegTree u n', Segment Closed u n'))
 -> p (SegTree v n) (f (SegTree u n')))
-> (p (Trail' Line v n, Segment Closed v n)
      (f (Trail' Line u n', Segment Closed u n'))
    -> p (SegTree v n, Segment Closed v n)
         (f (SegTree u n', Segment Closed u n')))
-> p (Trail' Line v n, Segment Closed v n)
     (f (Trail' Line u n', Segment Closed u n'))
-> p (SegTree v n) (f (SegTree u n'))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnIso
  (SegTree v n) (SegTree u n') (Trail' Line v n) (Trail' Line u n')
-> AnIso
     (Segment Closed v n)
     (Segment Closed u n')
     (Segment Closed v n)
     (Segment Closed u n')
-> Iso
     (SegTree v n, Segment Closed v n)
     (SegTree u n', Segment Closed u n')
     (Trail' Line v n, Segment Closed v n)
     (Trail' Line u n', Segment Closed u n')
forall (f :: * -> * -> *) (g :: * -> * -> *) s t a b s' t' a' b'.
(Bifunctor f, Bifunctor g) =>
AnIso s t a b
-> AnIso s' t' a' b' -> Iso (f s s') (g t t') (f a a') (g b b')
bimapping Exchange
  (Trail' Line v n)
  (Trail' Line u n')
  (Trail' Line v n)
  (Identity (Trail' Line u n'))
-> Exchange
     (Trail' Line v n)
     (Trail' Line u n')
     (Unwrapped (Trail' Line v n))
     (Identity (Unwrapped (Trail' Line u n')))
AnIso
  (SegTree v n) (SegTree u n') (Trail' Line v n) (Trail' Line u n')
forall s t. Rewrapping s t => Iso (Unwrapped t) (Unwrapped s) t s
Iso
  (Unwrapped (Trail' Line v n))
  (Unwrapped (Trail' Line u n'))
  (Trail' Line v n)
  (Trail' Line u n')
_Unwrapped AnIso
  (Segment Closed v n)
  (Segment Closed u n')
  (Segment Closed v n)
  (Segment Closed u n')
forall a. a -> a
id
  {-# INLINE _Snoc #-}

--------------------------------------------------
-- Extracting segments

-- | A newtype wrapper around trails which exists solely for its
--   'Parametric', 'DomainBounds' and 'EndValues' instances.  The idea
--   is that if @tr@ is a trail, you can write, /e.g./
--
--   @
--   getSegment tr `atParam` 0.6
--   @
--
--   or
--
--   @
--   atStart (getSegment tr)
--   @
--
--   to get the segment at parameter 0.6 or the first segment in the
--   trail, respectively.
--
--   The codomain for 'GetSegment', /i.e./ the result you get from
--   calling 'atParam', 'atStart', or 'atEnd', is
--   'GetSegmentCodomain', which is a newtype wrapper around @Maybe
--   (v, Segment Closed v, AnIso' n n)@.  @Nothing@ results if the
--   trail is empty; otherwise, you get:
--
--   * the offset from the start of the trail to the beginning of the
--     segment,
--
--   * the segment itself, and
--
--   * a reparameterization isomorphism: in the forward direction, it
--     translates from parameters on the whole trail to a parameters
--     on the segment.  Note that for technical reasons you have to
--     call 'cloneIso' on the @AnIso'@ value to get a real isomorphism
--     you can use.
newtype GetSegment t = GetSegment t

newtype GetSegmentCodomain v n =
  GetSegmentCodomain
    (Maybe ( v n                -- offset from trail start to segment start
           , Segment Closed v n -- the segment
           , AnIso' n n         -- reparameterization, trail <-> segment
           ))

-- | Create a 'GetSegment' wrapper around a trail, after which you can
--   call 'atParam', 'atStart', or 'atEnd' to extract a segment.
getSegment :: t -> GetSegment t
getSegment :: forall t. t -> GetSegment t
getSegment = t -> GetSegment t
forall t. t -> GetSegment t
GetSegment

type instance V (GetSegment t) = V t
type instance N (GetSegment t) = N t

type instance Codomain (GetSegment t) = GetSegmentCodomain (V t)

-- | Parameters less than 0 yield the first segment; parameters
--   greater than 1 yield the last.  A parameter exactly at the
--   junction of two segments yields the second segment (/i.e./ the
--   one with higher parameter values).
instance (Metric v, OrderedField n) => Parametric (GetSegment (Trail' Line v n)) where
  atParam :: GetSegment (Trail' Line v n)
-> N (GetSegment (Trail' Line v n))
-> Codomain
     (GetSegment (Trail' Line v n)) (N (GetSegment (Trail' Line v n)))
atParam (GetSegment (Line (SegTree FingerTree (SegMeasure v n) (Segment Closed v n)
ft))) N (GetSegment (Trail' Line v n))
p
    | n
N (GetSegment (Trail' Line v n))
p n -> n -> Bool
forall a. Ord a => a -> a -> Bool
<= n
0 = case FingerTree (SegMeasure v n) (Segment Closed v n)
-> ViewL (FingerTree (SegMeasure v n)) (Segment Closed v n)
forall v a.
Measured v a =>
FingerTree v a -> ViewL (FingerTree v) a
FT.viewl FingerTree (SegMeasure v n) (Segment Closed v n)
ft of
        ViewL (FingerTree (SegMeasure v n)) (Segment Closed v n)
EmptyL   -> Maybe (v n, Segment Closed v n, AnIso' n n)
-> GetSegmentCodomain v n
forall (v :: * -> *) n.
Maybe (v n, Segment Closed v n, AnIso' n n)
-> GetSegmentCodomain v n
GetSegmentCodomain Maybe (v n, Segment Closed v n, AnIso' n n)
forall a. Maybe a
Nothing
        Segment Closed v n
seg FT.:< FingerTree (SegMeasure v n) (Segment Closed v n)
_ -> Maybe (v n, Segment Closed v n, AnIso' n n)
-> GetSegmentCodomain v n
forall (v :: * -> *) n.
Maybe (v n, Segment Closed v n, AnIso' n n)
-> GetSegmentCodomain v n
GetSegmentCodomain (Maybe (v n, Segment Closed v n, AnIso' n n)
 -> GetSegmentCodomain v n)
-> Maybe (v n, Segment Closed v n, AnIso' n n)
-> GetSegmentCodomain v n
forall a b. (a -> b) -> a -> b
$ (v n, Segment Closed v n, AnIso' n n)
-> Maybe (v n, Segment Closed v n, AnIso' n n)
forall a. a -> Maybe a
Just (v n
forall a. Num a => v a
forall (f :: * -> *) a. (Additive f, Num a) => f a
zero, Segment Closed v n
seg, n -> AnIso' n n
reparam n
0)

    | n
N (GetSegment (Trail' Line v n))
p n -> n -> Bool
forall a. Ord a => a -> a -> Bool
>= n
1 = case FingerTree (SegMeasure v n) (Segment Closed v n)
-> ViewR (FingerTree (SegMeasure v n)) (Segment Closed v n)
forall v a.
Measured v a =>
FingerTree v a -> ViewR (FingerTree v) a
FT.viewr FingerTree (SegMeasure v n) (Segment Closed v n)
ft of
        ViewR (FingerTree (SegMeasure v n)) (Segment Closed v n)
EmptyR     -> Maybe (v n, Segment Closed v n, AnIso' n n)
-> GetSegmentCodomain v n
forall (v :: * -> *) n.
Maybe (v n, Segment Closed v n, AnIso' n n)
-> GetSegmentCodomain v n
GetSegmentCodomain Maybe (v n, Segment Closed v n, AnIso' n n)
forall a. Maybe a
Nothing
        FingerTree (SegMeasure v n) (Segment Closed v n)
ft' FT.:> Segment Closed v n
seg -> Maybe (v n, Segment Closed v n, AnIso' n n)
-> GetSegmentCodomain v n
forall (v :: * -> *) n.
Maybe (v n, Segment Closed v n, AnIso' n n)
-> GetSegmentCodomain v n
GetSegmentCodomain (Maybe (v n, Segment Closed v n, AnIso' n n)
 -> GetSegmentCodomain v n)
-> Maybe (v n, Segment Closed v n, AnIso' n n)
-> GetSegmentCodomain v n
forall a b. (a -> b) -> a -> b
$ (v n, Segment Closed v n, AnIso' n n)
-> Maybe (v n, Segment Closed v n, AnIso' n n)
forall a. a -> Maybe a
Just (FingerTree (SegMeasure v n) (Segment Closed v n) -> v n
forall n (v :: * -> *) t.
(OrderedField n, Metric v, Measured (SegMeasure v n) t) =>
t -> v n
offset FingerTree (SegMeasure v n) (Segment Closed v n)
ft', Segment Closed v n
seg, n -> AnIso' n n
reparam (n
nn -> n -> n
forall a. Num a => a -> a -> a
-n
1))

    | Bool
otherwise
    = let (FingerTree (SegMeasure v n) (Segment Closed v n)
before, FingerTree (SegMeasure v n) (Segment Closed v n)
after) = (SegMeasure v n -> Bool)
-> FingerTree (SegMeasure v n) (Segment Closed v n)
-> (FingerTree (SegMeasure v n) (Segment Closed v n),
    FingerTree (SegMeasure v n) (Segment Closed v n))
forall v a.
Measured v a =>
(v -> Bool) -> FingerTree v a -> (FingerTree v a, FingerTree v a)
FT.split ((n
N (GetSegment (Trail' Line v n))
pn -> n -> n
forall a. Num a => a -> a -> a
*n
n n -> n -> Bool
forall a. Ord a => a -> a -> Bool
<) (n -> Bool) -> (SegMeasure v n -> n) -> SegMeasure v n -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SegMeasure v n -> n
forall c (v :: * -> *) n a.
(Num c, Measured (SegMeasure v n) a) =>
a -> c
numSegs) FingerTree (SegMeasure v n) (Segment Closed v n)
ft
      in  case FingerTree (SegMeasure v n) (Segment Closed v n)
-> ViewL (FingerTree (SegMeasure v n)) (Segment Closed v n)
forall v a.
Measured v a =>
FingerTree v a -> ViewL (FingerTree v) a
FT.viewl FingerTree (SegMeasure v n) (Segment Closed v n)
after of
            ViewL (FingerTree (SegMeasure v n)) (Segment Closed v n)
EmptyL   -> Maybe (v n, Segment Closed v n, AnIso' n n)
-> GetSegmentCodomain v n
forall (v :: * -> *) n.
Maybe (v n, Segment Closed v n, AnIso' n n)
-> GetSegmentCodomain v n
GetSegmentCodomain Maybe (v n, Segment Closed v n, AnIso' n n)
forall a. Maybe a
Nothing
            Segment Closed v n
seg FT.:< FingerTree (SegMeasure v n) (Segment Closed v n)
_ -> Maybe (v n, Segment Closed v n, AnIso' n n)
-> GetSegmentCodomain v n
forall (v :: * -> *) n.
Maybe (v n, Segment Closed v n, AnIso' n n)
-> GetSegmentCodomain v n
GetSegmentCodomain (Maybe (v n, Segment Closed v n, AnIso' n n)
 -> GetSegmentCodomain v n)
-> Maybe (v n, Segment Closed v n, AnIso' n n)
-> GetSegmentCodomain v n
forall a b. (a -> b) -> a -> b
$ (v n, Segment Closed v n, AnIso' n n)
-> Maybe (v n, Segment Closed v n, AnIso' n n)
forall a. a -> Maybe a
Just (FingerTree (SegMeasure v n) (Segment Closed v n) -> v n
forall n (v :: * -> *) t.
(OrderedField n, Metric v, Measured (SegMeasure v n) t) =>
t -> v n
offset FingerTree (SegMeasure v n) (Segment Closed v n)
before, Segment Closed v n
seg, n -> AnIso' n n
reparam (FingerTree (SegMeasure v n) (Segment Closed v n) -> n
forall c (v :: * -> *) n a.
(Num c, Measured (SegMeasure v n) a) =>
a -> c
numSegs FingerTree (SegMeasure v n) (Segment Closed v n)
before))
    where
      n :: n
n = FingerTree (SegMeasure v n) (Segment Closed v n) -> n
forall c (v :: * -> *) n a.
(Num c, Measured (SegMeasure v n) a) =>
a -> c
numSegs FingerTree (SegMeasure v n) (Segment Closed v n)
ft
      reparam :: n -> AnIso' n n
reparam n
k = (n -> n) -> (n -> n) -> Iso n n n n
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (n -> n -> n
forall a. Num a => a -> a -> a
subtract n
k (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
n))
                      ((n -> n -> n
forall a. Fractional a => a -> a -> a
/n
n) (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
k))

-- | The parameterization for loops wraps around, /i.e./ parameters
--   are first reduced \"mod 1\".
instance (Metric v, OrderedField n, Real n) => Parametric (GetSegment (Trail' Loop v n)) where
  atParam :: GetSegment (Trail' Loop v n)
-> N (GetSegment (Trail' Loop v n))
-> Codomain
     (GetSegment (Trail' Loop v n)) (N (GetSegment (Trail' Loop v n)))
atParam (GetSegment Trail' Loop v n
l) N (GetSegment (Trail' Loop v n))
p = GetSegment (Trail' Line v n)
-> N (GetSegment (Trail' Line v n))
-> Codomain
     (GetSegment (Trail' Line v n)) (N (GetSegment (Trail' Line v n)))
forall p. Parametric p => p -> N p -> Codomain p (N p)
atParam (Trail' Line v n -> GetSegment (Trail' Line v n)
forall t. t -> GetSegment t
GetSegment (Trail' Loop v n -> Trail' Line v n
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Trail' Loop v n -> Trail' Line v n
cutLoop Trail' Loop v n
l)) (n -> n
forall a. Real a => a -> a
mod1 n
N (GetSegment (Trail' Loop v n))
p)

instance (Metric v, OrderedField n, Real n)
    => Parametric (GetSegment (Trail v n)) where
  atParam :: GetSegment (Trail v n)
-> N (GetSegment (Trail v n))
-> Codomain (GetSegment (Trail v n)) (N (GetSegment (Trail v n)))
atParam (GetSegment Trail v n
t) N (GetSegment (Trail v n))
p
    = (Trail' Line v n -> GetSegmentCodomain v n)
-> (Trail' Loop v n -> GetSegmentCodomain v n)
-> Trail v n
-> GetSegmentCodomain v n
forall (v :: * -> *) n r.
(Trail' Line v n -> r) -> (Trail' Loop v n -> r) -> Trail v n -> r
withTrail
      ((GetSegment (Trail' Line v n)
-> N (GetSegment (Trail' Line v n))
-> Codomain
     (GetSegment (Trail' Line v n)) (N (GetSegment (Trail' Line v n)))
forall p. Parametric p => p -> N p -> Codomain p (N p)
`atParam` N (GetSegment (Trail v n))
N (GetSegment (Trail' Line v n))
p) (GetSegment (Trail' Line v n) -> GetSegmentCodomain v n)
-> (Trail' Line v n -> GetSegment (Trail' Line v n))
-> Trail' Line v n
-> GetSegmentCodomain v n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trail' Line v n -> GetSegment (Trail' Line v n)
forall t. t -> GetSegment t
GetSegment)
      ((GetSegment (Trail' Loop v n)
-> N (GetSegment (Trail' Loop v n))
-> Codomain
     (GetSegment (Trail' Loop v n)) (N (GetSegment (Trail' Loop v n)))
forall p. Parametric p => p -> N p -> Codomain p (N p)
`atParam` N (GetSegment (Trail v n))
N (GetSegment (Trail' Loop v n))
p) (GetSegment (Trail' Loop v n) -> GetSegmentCodomain v n)
-> (Trail' Loop v n -> GetSegment (Trail' Loop v n))
-> Trail' Loop v n
-> GetSegmentCodomain v n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trail' Loop v n -> GetSegment (Trail' Loop v n)
forall t. t -> GetSegment t
GetSegment)
      Trail v n
t

instance DomainBounds t => DomainBounds (GetSegment t) where
  domainLower :: GetSegment t -> N (GetSegment t)
domainLower (GetSegment t
t) = t -> N t
forall p. DomainBounds p => p -> N p
domainLower t
t
  domainUpper :: GetSegment t -> N (GetSegment t)
domainUpper (GetSegment t
t) = t -> N t
forall p. DomainBounds p => p -> N p
domainUpper t
t

instance (Metric v, OrderedField n)
    => EndValues (GetSegment (Trail' Line v n)) where
  atStart :: GetSegment (Trail' Line v n)
-> Codomain
     (GetSegment (Trail' Line v n)) (N (GetSegment (Trail' Line v n)))
atStart (GetSegment (Line (SegTree FingerTree (SegMeasure v n) (Segment Closed v n)
ft)))
    = case FingerTree (SegMeasure v n) (Segment Closed v n)
-> ViewL (FingerTree (SegMeasure v n)) (Segment Closed v n)
forall v a.
Measured v a =>
FingerTree v a -> ViewL (FingerTree v) a
FT.viewl FingerTree (SegMeasure v n) (Segment Closed v n)
ft of
        ViewL (FingerTree (SegMeasure v n)) (Segment Closed v n)
EmptyL   -> Maybe (v n, Segment Closed v n, AnIso' n n)
-> GetSegmentCodomain v n
forall (v :: * -> *) n.
Maybe (v n, Segment Closed v n, AnIso' n n)
-> GetSegmentCodomain v n
GetSegmentCodomain Maybe (v n, Segment Closed v n, AnIso' n n)
forall a. Maybe a
Nothing
        Segment Closed v n
seg FT.:< FingerTree (SegMeasure v n) (Segment Closed v n)
_ ->
          let n :: n
n = FingerTree (SegMeasure v n) (Segment Closed v n) -> n
forall c (v :: * -> *) n a.
(Num c, Measured (SegMeasure v n) a) =>
a -> c
numSegs FingerTree (SegMeasure v n) (Segment Closed v n)
ft
          in  Maybe (v n, Segment Closed v n, AnIso' n n)
-> GetSegmentCodomain v n
forall (v :: * -> *) n.
Maybe (v n, Segment Closed v n, AnIso' n n)
-> GetSegmentCodomain v n
GetSegmentCodomain (Maybe (v n, Segment Closed v n, AnIso' n n)
 -> GetSegmentCodomain v n)
-> Maybe (v n, Segment Closed v n, AnIso' n n)
-> GetSegmentCodomain v n
forall a b. (a -> b) -> a -> b
$ (v n, Segment Closed v n, AnIso' n n)
-> Maybe (v n, Segment Closed v n, AnIso' n n)
forall a. a -> Maybe a
Just (v n
forall a. Num a => v a
forall (f :: * -> *) a. (Additive f, Num a) => f a
zero, Segment Closed v n
seg, (n -> n) -> (n -> n) -> Iso n n n n
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (n -> n -> n
forall a. Num a => a -> a -> a
*n
n) (n -> n -> n
forall a. Fractional a => a -> a -> a
/n
n))

  atEnd :: GetSegment (Trail' Line v n)
-> Codomain
     (GetSegment (Trail' Line v n)) (N (GetSegment (Trail' Line v n)))
atEnd (GetSegment (Line (SegTree FingerTree (SegMeasure v n) (Segment Closed v n)
ft)))
    = case FingerTree (SegMeasure v n) (Segment Closed v n)
-> ViewR (FingerTree (SegMeasure v n)) (Segment Closed v n)
forall v a.
Measured v a =>
FingerTree v a -> ViewR (FingerTree v) a
FT.viewr FingerTree (SegMeasure v n) (Segment Closed v n)
ft of
        ViewR (FingerTree (SegMeasure v n)) (Segment Closed v n)
EmptyR     -> Maybe (v n, Segment Closed v n, AnIso' n n)
-> GetSegmentCodomain v n
forall (v :: * -> *) n.
Maybe (v n, Segment Closed v n, AnIso' n n)
-> GetSegmentCodomain v n
GetSegmentCodomain Maybe (v n, Segment Closed v n, AnIso' n n)
forall a. Maybe a
Nothing
        FingerTree (SegMeasure v n) (Segment Closed v n)
ft' FT.:> Segment Closed v n
seg ->
          let n :: n
n = FingerTree (SegMeasure v n) (Segment Closed v n) -> n
forall c (v :: * -> *) n a.
(Num c, Measured (SegMeasure v n) a) =>
a -> c
numSegs FingerTree (SegMeasure v n) (Segment Closed v n)
ft
          in  Maybe (v n, Segment Closed v n, AnIso' n n)
-> GetSegmentCodomain v n
forall (v :: * -> *) n.
Maybe (v n, Segment Closed v n, AnIso' n n)
-> GetSegmentCodomain v n
GetSegmentCodomain (Maybe (v n, Segment Closed v n, AnIso' n n)
 -> GetSegmentCodomain v n)
-> Maybe (v n, Segment Closed v n, AnIso' n n)
-> GetSegmentCodomain v n
forall a b. (a -> b) -> a -> b
$
                (v n, Segment Closed v n, AnIso' n n)
-> Maybe (v n, Segment Closed v n, AnIso' n n)
forall a. a -> Maybe a
Just (FingerTree (SegMeasure v n) (Segment Closed v n) -> v n
forall n (v :: * -> *) t.
(OrderedField n, Metric v, Measured (SegMeasure v n) t) =>
t -> v n
offset FingerTree (SegMeasure v n) (Segment Closed v n)
ft', Segment Closed v n
seg, (n -> n) -> (n -> n) -> Iso n n n n
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (n -> n -> n
forall a. Num a => a -> a -> a
subtract (n
nn -> n -> n
forall a. Num a => a -> a -> a
-n
1) (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
n))
                                         ((n -> n -> n
forall a. Fractional a => a -> a -> a
/n
n) (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
nn -> n -> n
forall a. Num a => a -> a -> a
-n
1)))
                     )

instance (Metric v, OrderedField n, Real n)
    => EndValues (GetSegment (Trail' Loop v n)) where
  atStart :: GetSegment (Trail' Loop v n)
-> Codomain
     (GetSegment (Trail' Loop v n)) (N (GetSegment (Trail' Loop v n)))
atStart (GetSegment Trail' Loop v n
l) = GetSegment (Trail' Line v n)
-> Codomain
     (GetSegment (Trail' Line v n)) (N (GetSegment (Trail' Line v n)))
forall p. EndValues p => p -> Codomain p (N p)
atStart (Trail' Line v n -> GetSegment (Trail' Line v n)
forall t. t -> GetSegment t
GetSegment (Trail' Loop v n -> Trail' Line v n
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Trail' Loop v n -> Trail' Line v n
cutLoop Trail' Loop v n
l))
  atEnd :: GetSegment (Trail' Loop v n)
-> Codomain
     (GetSegment (Trail' Loop v n)) (N (GetSegment (Trail' Loop v n)))
atEnd   (GetSegment Trail' Loop v n
l) = GetSegment (Trail' Line v n)
-> Codomain
     (GetSegment (Trail' Line v n)) (N (GetSegment (Trail' Line v n)))
forall p. EndValues p => p -> Codomain p (N p)
atEnd   (Trail' Line v n -> GetSegment (Trail' Line v n)
forall t. t -> GetSegment t
GetSegment (Trail' Loop v n -> Trail' Line v n
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Trail' Loop v n -> Trail' Line v n
cutLoop Trail' Loop v n
l))

instance (Metric v, OrderedField n, Real n)
    => EndValues (GetSegment (Trail v n)) where
  atStart :: GetSegment (Trail v n)
-> Codomain (GetSegment (Trail v n)) (N (GetSegment (Trail v n)))
atStart (GetSegment Trail v n
t)
    = (Trail' Line v n -> GetSegmentCodomain v n)
-> (Trail' Loop v n -> GetSegmentCodomain v n)
-> Trail v n
-> GetSegmentCodomain v n
forall (v :: * -> *) n r.
(Trail' Line v n -> r) -> (Trail' Loop v n -> r) -> Trail v n -> r
withTrail
      (GetSegment (Trail' Line v n)
-> Codomain
     (GetSegment (Trail' Line v n)) (N (GetSegment (Trail' Line v n)))
GetSegment (Trail' Line v n) -> GetSegmentCodomain v n
forall p. EndValues p => p -> Codomain p (N p)
atStart (GetSegment (Trail' Line v n) -> GetSegmentCodomain v n)
-> (Trail' Line v n -> GetSegment (Trail' Line v n))
-> Trail' Line v n
-> GetSegmentCodomain v n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trail' Line v n -> GetSegment (Trail' Line v n)
forall t. t -> GetSegment t
GetSegment)
      (GetSegment (Trail' Loop v n)
-> Codomain
     (GetSegment (Trail' Loop v n)) (N (GetSegment (Trail' Loop v n)))
GetSegment (Trail' Loop v n) -> GetSegmentCodomain v n
forall p. EndValues p => p -> Codomain p (N p)
atStart (GetSegment (Trail' Loop v n) -> GetSegmentCodomain v n)
-> (Trail' Loop v n -> GetSegment (Trail' Loop v n))
-> Trail' Loop v n
-> GetSegmentCodomain v n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trail' Loop v n -> GetSegment (Trail' Loop v n)
forall t. t -> GetSegment t
GetSegment)
      Trail v n
t
  atEnd :: GetSegment (Trail v n)
-> Codomain (GetSegment (Trail v n)) (N (GetSegment (Trail v n)))
atEnd (GetSegment Trail v n
t)
    = (Trail' Line v n -> GetSegmentCodomain v n)
-> (Trail' Loop v n -> GetSegmentCodomain v n)
-> Trail v n
-> GetSegmentCodomain v n
forall (v :: * -> *) n r.
(Trail' Line v n -> r) -> (Trail' Loop v n -> r) -> Trail v n -> r
withTrail
      (GetSegment (Trail' Line v n)
-> Codomain
     (GetSegment (Trail' Line v n)) (N (GetSegment (Trail' Line v n)))
GetSegment (Trail' Line v n) -> GetSegmentCodomain v n
forall p. EndValues p => p -> Codomain p (N p)
atEnd (GetSegment (Trail' Line v n) -> GetSegmentCodomain v n)
-> (Trail' Line v n -> GetSegment (Trail' Line v n))
-> Trail' Line v n
-> GetSegmentCodomain v n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trail' Line v n -> GetSegment (Trail' Line v n)
forall t. t -> GetSegment t
GetSegment)
      (GetSegment (Trail' Loop v n)
-> Codomain
     (GetSegment (Trail' Loop v n)) (N (GetSegment (Trail' Loop v n)))
GetSegment (Trail' Loop v n) -> GetSegmentCodomain v n
forall p. EndValues p => p -> Codomain p (N p)
atEnd (GetSegment (Trail' Loop v n) -> GetSegmentCodomain v n)
-> (Trail' Loop v n -> GetSegment (Trail' Loop v n))
-> Trail' Loop v n
-> GetSegmentCodomain v n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trail' Loop v n -> GetSegment (Trail' Loop v n)
forall t. t -> GetSegment t
GetSegment)
      Trail v n
t

--------------------------------------------------
-- The Trail type

-- | @Trail@ is a wrapper around @Trail'@, hiding whether the
--   underlying @Trail'@ is a line or loop (though which it is can be
--   recovered; see /e.g./ 'withTrail').
data Trail v n where
  Trail :: Trail' l v n -> Trail v n

deriving instance Show (v n) => Show (Trail v n)

instance Eq (v n) => Eq (Trail v n) where
  Trail v n
t1 == :: Trail v n -> Trail v n -> Bool
== Trail v n
t2 =
    (Trail' Line v n -> Bool)
-> (Trail' Loop v n -> Bool) -> Trail v n -> Bool
forall (v :: * -> *) n r.
(Trail' Line v n -> r) -> (Trail' Loop v n -> r) -> Trail v n -> r
withTrail
      (\Trail' Line v n
ln1 -> (Trail' Line v n -> Bool)
-> (Trail' Loop v n -> Bool) -> Trail v n -> Bool
forall (v :: * -> *) n r.
(Trail' Line v n -> r) -> (Trail' Loop v n -> r) -> Trail v n -> r
withTrail (\Trail' Line v n
ln2 -> Trail' Line v n
ln1 Trail' Line v n -> Trail' Line v n -> Bool
forall a. Eq a => a -> a -> Bool
== Trail' Line v n
ln2) (Bool -> Trail' Loop v n -> Bool
forall a b. a -> b -> a
const Bool
False) Trail v n
t2)
      (\Trail' Loop v n
lp1 -> (Trail' Line v n -> Bool)
-> (Trail' Loop v n -> Bool) -> Trail v n -> Bool
forall (v :: * -> *) n r.
(Trail' Line v n -> r) -> (Trail' Loop v n -> r) -> Trail v n -> r
withTrail (Bool -> Trail' Line v n -> Bool
forall a b. a -> b -> a
const Bool
False) (\Trail' Loop v n
lp2 -> Trail' Loop v n
lp1 Trail' Loop v n -> Trail' Loop v n -> Bool
forall a. Eq a => a -> a -> Bool
== Trail' Loop v n
lp2) Trail v n
t2)
      Trail v n
t1

instance Ord (v n) => Ord (Trail v n) where
  compare :: Trail v n -> Trail v n -> Ordering
compare Trail v n
t1 Trail v n
t2 =
    (Trail' Line v n -> Ordering)
-> (Trail' Loop v n -> Ordering) -> Trail v n -> Ordering
forall (v :: * -> *) n r.
(Trail' Line v n -> r) -> (Trail' Loop v n -> r) -> Trail v n -> r
withTrail
      (\Trail' Line v n
ln1 -> (Trail' Line v n -> Ordering)
-> (Trail' Loop v n -> Ordering) -> Trail v n -> Ordering
forall (v :: * -> *) n r.
(Trail' Line v n -> r) -> (Trail' Loop v n -> r) -> Trail v n -> r
withTrail (Trail' Line v n -> Trail' Line v n -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Trail' Line v n
ln1) (Ordering -> Trail' Loop v n -> Ordering
forall a b. a -> b -> a
const Ordering
LT) Trail v n
t2)
      (\Trail' Loop v n
lp1 -> (Trail' Line v n -> Ordering)
-> (Trail' Loop v n -> Ordering) -> Trail v n -> Ordering
forall (v :: * -> *) n r.
(Trail' Line v n -> r) -> (Trail' Loop v n -> r) -> Trail v n -> r
withTrail (Ordering -> Trail' Line v n -> Ordering
forall a b. a -> b -> a
const Ordering
GT) (Trail' Loop v n -> Trail' Loop v n -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Trail' Loop v n
lp1) Trail v n
t2)
      Trail v n
t1

-- | Two @Trail@s are combined by first ensuring they are both lines
--   (using 'cutTrail' on loops) and then concatenating them.  The
--   result, in general, is a line.  However, there is a special case
--   for the empty line, which acts as the identity (so combining the
--   empty line with a loop results in a loop).
instance (OrderedField n, Metric v) => Semigroup (Trail v n) where
  (Trail (Line (SegTree FingerTree (SegMeasure v n) (Segment Closed v n)
ft))) <> :: Trail v n -> Trail v n -> Trail v n
<> Trail v n
t2 | FingerTree (SegMeasure v n) (Segment Closed v n) -> Bool
forall v a. FingerTree v a -> Bool
FT.null FingerTree (SegMeasure v n) (Segment Closed v n)
ft = Trail v n
t2
  Trail v n
t1 <> (Trail (Line (SegTree FingerTree (SegMeasure v n) (Segment Closed v n)
ft))) | FingerTree (SegMeasure v n) (Segment Closed v n) -> Bool
forall v a. FingerTree v a -> Bool
FT.null FingerTree (SegMeasure v n) (Segment Closed v n)
ft = Trail v n
t1
  Trail v n
t1 <> Trail v n
t2 = ((Trail' Line v n -> Trail v n) -> Trail v n -> Trail v n)
-> Trail v n -> (Trail' Line v n -> Trail v n) -> Trail v n
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Trail' Line v n -> Trail v n) -> Trail v n -> Trail v n
forall (v :: * -> *) n r.
(Metric v, OrderedField n) =>
(Trail' Line v n -> r) -> Trail v n -> r
withLine Trail v n
t1 ((Trail' Line v n -> Trail v n) -> Trail v n)
-> (Trail' Line v n -> Trail v n) -> Trail v n
forall a b. (a -> b) -> a -> b
$ \Trail' Line v n
l1 ->
             ((Trail' Line v n -> Trail v n) -> Trail v n -> Trail v n)
-> Trail v n -> (Trail' Line v n -> Trail v n) -> Trail v n
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Trail' Line v n -> Trail v n) -> Trail v n -> Trail v n
forall (v :: * -> *) n r.
(Metric v, OrderedField n) =>
(Trail' Line v n -> r) -> Trail v n -> r
withLine Trail v n
t2 ((Trail' Line v n -> Trail v n) -> Trail v n)
-> (Trail' Line v n -> Trail v n) -> Trail v n
forall a b. (a -> b) -> a -> b
$ \Trail' Line v n
l2 ->
             Trail' Line v n -> Trail v n
forall (v :: * -> *) n. Trail' Line v n -> Trail v n
wrapLine (Trail' Line v n
l1 Trail' Line v n -> Trail' Line v n -> Trail' Line v n
forall a. Semigroup a => a -> a -> a
<> Trail' Line v n
l2)

-- | @Trail@s are combined as described in the 'Semigroup' instance;
--   the empty line is the identity element, with special cases so
--   that combining the empty line with a loop results in the
--   unchanged loop (in all other cases loops will be cut).  Note that
--   this does, in fact, satisfy the monoid laws, though it is a bit
--   strange.  Mostly it is provided for convenience, so one can work
--   directly with @Trail@s instead of working with @Trail' Line@s and
--   then wrapping.
instance (Metric v, OrderedField n) => Monoid (Trail v n) where
  mempty :: Trail v n
mempty  = Trail' Line v n -> Trail v n
forall (v :: * -> *) n. Trail' Line v n -> Trail v n
wrapLine Trail' Line v n
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Trail' Line v n
emptyLine
  mappend :: Trail v n -> Trail v n -> Trail v n
mappend = Trail v n -> Trail v n -> Trail v n
forall a. Semigroup a => a -> a -> a
(<>)

instance (Metric v, OrderedField n) => AsEmpty (Trail v n) where
  _Empty :: Prism' (Trail v n) ()
_Empty = Trail v n -> (Trail v n -> Bool) -> Prism' (Trail v n) ()
forall a. a -> (a -> Bool) -> Prism' a ()
nearly Trail v n
forall (v :: * -> *) n. (Metric v, OrderedField n) => Trail v n
emptyTrail Trail v n -> Bool
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Trail v n -> Bool
isTrailEmpty

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

type instance Codomain (Trail v n) = v

instance (HasLinearMap v, Metric v, OrderedField n)
    => Transformable (Trail v n) where
  transform :: Transformation (V (Trail v n)) (N (Trail v n))
-> Trail v n -> Trail v n
transform Transformation (V (Trail v n)) (N (Trail v n))
t = (Trail' Line v n -> Trail' Line v n)
-> (Trail' Loop v n -> Trail' Loop v n) -> Trail v n -> Trail v n
forall (v :: * -> *) n l1 l2.
(Trail' Line v n -> Trail' l1 v n)
-> (Trail' Loop v n -> Trail' l2 v n) -> Trail v n -> Trail v n
onTrail (Transformation (V (Trail' Line v n)) (N (Trail' Line v n))
-> Trail' Line v n -> Trail' Line v n
forall t. Transformable t => Transformation (V t) (N t) -> t -> t
transform Transformation (V (Trail v n)) (N (Trail v n))
Transformation (V (Trail' Line v n)) (N (Trail' Line v n))
t) (Transformation (V (Trail' Loop v n)) (N (Trail' Loop v n))
-> Trail' Loop v n -> Trail' Loop v n
forall t. Transformable t => Transformation (V t) (N t) -> t -> t
transform Transformation (V (Trail v n)) (N (Trail v n))
Transformation (V (Trail' Loop v n)) (N (Trail' Loop v n))
t)

instance (Metric v, OrderedField n) => Enveloped (Trail v n) where
  getEnvelope :: Trail v n -> Envelope (V (Trail v n)) (N (Trail v n))
getEnvelope = (Trail' Line v n -> Envelope v n)
-> (Trail' Loop v n -> Envelope v n) -> Trail v n -> Envelope v n
forall (v :: * -> *) n r.
(Trail' Line v n -> r) -> (Trail' Loop v n -> r) -> Trail v n -> r
withTrail Trail' Line v n -> Envelope v n
Trail' Line v n
-> Envelope (V (Trail' Line v n)) (N (Trail' Line v n))
forall a. Enveloped a => a -> Envelope (V a) (N a)
getEnvelope Trail' Loop v n -> Envelope v n
Trail' Loop v n
-> Envelope (V (Trail' Loop v n)) (N (Trail' Loop v n))
forall a. Enveloped a => a -> Envelope (V a) (N a)
getEnvelope

instance (Metric v, OrderedField n, Real n)
    => Parametric (Trail v n) where
  atParam :: Trail v n -> N (Trail v n) -> Codomain (Trail v n) (N (Trail v n))
atParam Trail v n
t N (Trail v n)
p = (Trail' Line v n -> v n)
-> (Trail' Loop v n -> v n) -> Trail v n -> v n
forall (v :: * -> *) n r.
(Trail' Line v n -> r) -> (Trail' Loop v n -> r) -> Trail v n -> r
withTrail (Trail' Line v n
-> N (Trail' Line v n)
-> Codomain (Trail' Line v n) (N (Trail' Line v n))
forall p. Parametric p => p -> N p -> Codomain p (N p)
`atParam` N (Trail v n)
N (Trail' Line v n)
p) (Trail' Loop v n
-> N (Trail' Loop v n)
-> Codomain (Trail' Loop v n) (N (Trail' Loop v n))
forall p. Parametric p => p -> N p -> Codomain p (N p)
`atParam` N (Trail v n)
N (Trail' Loop v n)
p) Trail v n
t

instance Num n => DomainBounds (Trail v n)

instance (Metric v, OrderedField n, Real n) => EndValues (Trail v n)

-- | Note that there is no @Sectionable@ instance for @Trail' Loop@,
--   because it does not make sense (splitting a loop at a parameter
--   results in a single line, not two loops).  However, it's
--   convenient to have a @Sectionable@ instance for @Trail@; if the
--   @Trail@ contains a loop the loop will first be cut and then
--   @splitAtParam@ called on the resulting line.  This is
--   semantically a bit silly, so please don't rely on it. (*E.g.* if
--   this is really the behavior you want, consider first calling
--   'cutLoop' yourself.)
instance (Metric v, OrderedField n, Real n) => Sectionable (Trail v n) where
  splitAtParam :: Trail v n -> N (Trail v n) -> (Trail v n, Trail v n)
splitAtParam Trail v n
t N (Trail v n)
p = (Trail' Line v n -> (Trail v n, Trail v n))
-> Trail v n -> (Trail v n, Trail v n)
forall (v :: * -> *) n r.
(Metric v, OrderedField n) =>
(Trail' Line v n -> r) -> Trail v n -> r
withLine ((Trail' Line v n -> Trail v n
forall (v :: * -> *) n. Trail' Line v n -> Trail v n
wrapLine (Trail' Line v n -> Trail v n)
-> (Trail' Line v n -> Trail v n)
-> (Trail' Line v n, Trail' Line v n)
-> (Trail v n, Trail v n)
forall b c b' c'. (b -> c) -> (b' -> c') -> (b, b') -> (c, c')
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** Trail' Line v n -> Trail v n
forall (v :: * -> *) n. Trail' Line v n -> Trail v n
wrapLine) ((Trail' Line v n, Trail' Line v n) -> (Trail v n, Trail v n))
-> (Trail' Line v n -> (Trail' Line v n, Trail' Line v n))
-> Trail' Line v n
-> (Trail v n, Trail v n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Trail' Line v n
-> N (Trail' Line v n) -> (Trail' Line v n, Trail' Line v n)
forall p. Sectionable p => p -> N p -> (p, p)
`splitAtParam` N (Trail v n)
N (Trail' Line v n)
p)) Trail v n
t

  section :: Trail v n -> N (Trail v n) -> N (Trail v n) -> Trail v n
section Trail v n
t N (Trail v n)
p1 N (Trail v n)
p2 = (Trail' Line v n -> Trail v n) -> Trail v n -> Trail v n
forall (v :: * -> *) n r.
(Metric v, OrderedField n) =>
(Trail' Line v n -> r) -> Trail v n -> r
withLine (Trail' Line v n -> Trail v n
forall (v :: * -> *) n. Trail' Line v n -> Trail v n
wrapLine (Trail' Line v n -> Trail v n)
-> (Trail' Line v n -> Trail' Line v n)
-> Trail' Line v n
-> Trail v n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\Trail' Line v n
l -> Trail' Line v n
-> N (Trail' Line v n) -> N (Trail' Line v n) -> Trail' Line v n
forall p. Sectionable p => p -> N p -> N p -> p
section Trail' Line v n
l N (Trail v n)
N (Trail' Line v n)
p1 N (Trail v n)
N (Trail' Line v n)
p2)) Trail v n
t

  reverseDomain :: Trail v n -> Trail v n
reverseDomain = Trail v n -> Trail v n
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Trail v n -> Trail v n
reverseTrail

instance (Metric v, OrderedField n, Real n)
    => HasArcLength (Trail v n) where
  arcLengthBounded :: N (Trail v n) -> Trail v n -> Interval (N (Trail v n))
arcLengthBounded = (Trail' Line v n -> Interval n) -> Trail v n -> Interval n
forall (v :: * -> *) n r.
(Metric v, OrderedField n) =>
(Trail' Line v n -> r) -> Trail v n -> r
withLine ((Trail' Line v n -> Interval n) -> Trail v n -> Interval n)
-> (n -> Trail' Line v n -> Interval n)
-> n
-> Trail v n
-> Interval n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n -> Trail' Line v n -> Interval n
N (Trail' Line v n)
-> Trail' Line v n -> Interval (N (Trail' Line v n))
forall p. HasArcLength p => N p -> p -> Interval (N p)
arcLengthBounded
  arcLengthToParam :: N (Trail v n) -> Trail v n -> N (Trail v n) -> N (Trail v n)
arcLengthToParam N (Trail v n)
eps Trail v n
tr N (Trail v n)
al = (Trail' Line v n -> n) -> Trail v n -> n
forall (v :: * -> *) n r.
(Metric v, OrderedField n) =>
(Trail' Line v n -> r) -> Trail v n -> r
withLine (\Trail' Line v n
ln -> N (Trail' Line v n)
-> Trail' Line v n -> N (Trail' Line v n) -> N (Trail' Line v n)
forall p. HasArcLength p => N p -> p -> N p -> N p
arcLengthToParam N (Trail v n)
N (Trail' Line v n)
eps Trail' Line v n
ln N (Trail v n)
N (Trail' Line v n)
al) Trail v n
tr

-- lens instrances -----------------------------------------------------

-- | Prism onto a 'Line'.
_Line :: Prism' (Trail v n) (Trail' Line v n)
_Line :: forall (v :: * -> *) n (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p (Trail' Line v n) (f (Trail' Line v n))
-> p (Trail v n) (f (Trail v n))
_Line = p (Either (Trail' Line v n) (Trail' Loop v n))
  (f (Either (Trail' Line v n) (Trail' Loop v n)))
-> p (Trail v n) (f (Trail v n))
p (Unwrapped (Trail v n)) (f (Unwrapped (Trail v n)))
-> p (Trail v n) (f (Trail v n))
forall s. Wrapped s => Iso' s (Unwrapped s)
Iso' (Trail v n) (Unwrapped (Trail v n))
_Wrapped' (p (Either (Trail' Line v n) (Trail' Loop v n))
   (f (Either (Trail' Line v n) (Trail' Loop v n)))
 -> p (Trail v n) (f (Trail v n)))
-> (p (Trail' Line v n) (f (Trail' Line v n))
    -> p (Either (Trail' Line v n) (Trail' Loop v n))
         (f (Either (Trail' Line v n) (Trail' Loop v n))))
-> p (Trail' Line v n) (f (Trail' Line v n))
-> p (Trail v n) (f (Trail v n))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p (Trail' Line v n) (f (Trail' Line v n))
-> p (Either (Trail' Line v n) (Trail' Loop v n))
     (f (Either (Trail' Line v n) (Trail' Loop v n)))
forall a c b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Either a c) (f (Either b c))
_Left

-- | Prism onto a 'Loop'.
_Loop :: Prism' (Trail v n) (Trail' Loop v n)
_Loop :: forall (v :: * -> *) n (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p (Trail' Loop v n) (f (Trail' Loop v n))
-> p (Trail v n) (f (Trail v n))
_Loop = p (Either (Trail' Line v n) (Trail' Loop v n))
  (f (Either (Trail' Line v n) (Trail' Loop v n)))
-> p (Trail v n) (f (Trail v n))
p (Unwrapped (Trail v n)) (f (Unwrapped (Trail v n)))
-> p (Trail v n) (f (Trail v n))
forall s. Wrapped s => Iso' s (Unwrapped s)
Iso' (Trail v n) (Unwrapped (Trail v n))
_Wrapped' (p (Either (Trail' Line v n) (Trail' Loop v n))
   (f (Either (Trail' Line v n) (Trail' Loop v n)))
 -> p (Trail v n) (f (Trail v n)))
-> (p (Trail' Loop v n) (f (Trail' Loop v n))
    -> p (Either (Trail' Line v n) (Trail' Loop v n))
         (f (Either (Trail' Line v n) (Trail' Loop v n))))
-> p (Trail' Loop v n) (f (Trail' Loop v n))
-> p (Trail v n) (f (Trail v n))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p (Trail' Loop v n) (f (Trail' Loop v n))
-> p (Either (Trail' Line v n) (Trail' Loop v n))
     (f (Either (Trail' Line v n) (Trail' Loop v n)))
forall c a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Either c a) (f (Either c b))
_Right

-- | Prism onto a 'Located' 'Line'.
_LocLine :: Prism' (Located (Trail v n)) (Located (Trail' Line v n))
_LocLine :: forall (v :: * -> *) n (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p (Located (Trail' Line v n)) (f (Located (Trail' Line v n)))
-> p (Located (Trail v n)) (f (Located (Trail v n)))
_LocLine = (Located (Trail' Line v n) -> Located (Trail v n))
-> (Located (Trail v n) -> Maybe (Located (Trail' Line v n)))
-> forall {p :: * -> * -> *} {f :: * -> *}.
   (Choice p, Applicative f) =>
   p (Located (Trail' Line v n)) (f (Located (Trail' Line v n)))
   -> p (Located (Trail v n)) (f (Located (Trail v n)))
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' ((Trail' Line v n -> Trail v n)
-> Located (Trail' Line v n) -> Located (Trail v n)
forall a b. SameSpace a b => (a -> b) -> Located a -> Located b
mapLoc Trail' Line v n -> Trail v n
forall l (v :: * -> *) n. Trail' l v n -> Trail v n
Trail) ((Located (Trail v n) -> Maybe (Located (Trail' Line v n)))
 -> forall {p :: * -> * -> *} {f :: * -> *}.
    (Choice p, Applicative f) =>
    p (Located (Trail' Line v n)) (f (Located (Trail' Line v n)))
    -> p (Located (Trail v n)) (f (Located (Trail v n))))
-> (Located (Trail v n) -> Maybe (Located (Trail' Line v n)))
-> forall {p :: * -> * -> *} {f :: * -> *}.
   (Choice p, Applicative f) =>
   p (Located (Trail' Line v n)) (f (Located (Trail' Line v n)))
   -> p (Located (Trail v n)) (f (Located (Trail v n)))
forall a b. (a -> b) -> a -> b
$ (Trail v n -> Maybe (Trail' Line v n))
-> Located (Trail v n) -> Maybe (Located (Trail' Line v n))
forall a b. SameSpace a b => Lens (Located a) (Located b) a b
Lens
  (Located (Trail v n))
  (Located (Trail' Line v n))
  (Trail v n)
  (Trail' Line v n)
located (Getting (First (Trail' Line v n)) (Trail v n) (Trail' Line v n)
-> Trail v n -> Maybe (Trail' Line v n)
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview Getting (First (Trail' Line v n)) (Trail v n) (Trail' Line v n)
forall (v :: * -> *) n (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p (Trail' Line v n) (f (Trail' Line v n))
-> p (Trail v n) (f (Trail v n))
_Line)

-- | Prism onto a 'Located' 'Loop'.
_LocLoop :: Prism' (Located (Trail v n)) (Located (Trail' Loop v n))
_LocLoop :: forall (v :: * -> *) n (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p (Located (Trail' Loop v n)) (f (Located (Trail' Loop v n)))
-> p (Located (Trail v n)) (f (Located (Trail v n)))
_LocLoop = (Located (Trail' Loop v n) -> Located (Trail v n))
-> (Located (Trail v n) -> Maybe (Located (Trail' Loop v n)))
-> forall {p :: * -> * -> *} {f :: * -> *}.
   (Choice p, Applicative f) =>
   p (Located (Trail' Loop v n)) (f (Located (Trail' Loop v n)))
   -> p (Located (Trail v n)) (f (Located (Trail v n)))
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' ((Trail' Loop v n -> Trail v n)
-> Located (Trail' Loop v n) -> Located (Trail v n)
forall a b. SameSpace a b => (a -> b) -> Located a -> Located b
mapLoc Trail' Loop v n -> Trail v n
forall l (v :: * -> *) n. Trail' l v n -> Trail v n
Trail) ((Located (Trail v n) -> Maybe (Located (Trail' Loop v n)))
 -> forall {p :: * -> * -> *} {f :: * -> *}.
    (Choice p, Applicative f) =>
    p (Located (Trail' Loop v n)) (f (Located (Trail' Loop v n)))
    -> p (Located (Trail v n)) (f (Located (Trail v n))))
-> (Located (Trail v n) -> Maybe (Located (Trail' Loop v n)))
-> forall {p :: * -> * -> *} {f :: * -> *}.
   (Choice p, Applicative f) =>
   p (Located (Trail' Loop v n)) (f (Located (Trail' Loop v n)))
   -> p (Located (Trail v n)) (f (Located (Trail v n)))
forall a b. (a -> b) -> a -> b
$ (Trail v n -> Maybe (Trail' Loop v n))
-> Located (Trail v n) -> Maybe (Located (Trail' Loop v n))
forall a b. SameSpace a b => Lens (Located a) (Located b) a b
Lens
  (Located (Trail v n))
  (Located (Trail' Loop v n))
  (Trail v n)
  (Trail' Loop v n)
located (Getting (First (Trail' Loop v n)) (Trail v n) (Trail' Loop v n)
-> Trail v n -> Maybe (Trail' Loop v n)
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview Getting (First (Trail' Loop v n)) (Trail v n) (Trail' Loop v n)
forall (v :: * -> *) n (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p (Trail' Loop v n) (f (Trail' Loop v n))
-> p (Trail v n) (f (Trail v n))
_Loop)

instance Rewrapped (Trail v n) (Trail v' n')
instance Wrapped (Trail v n) where
  type Unwrapped (Trail v n) = Either (Trail' Line v n) (Trail' Loop v n)
  _Wrapped' :: Iso' (Trail v n) (Unwrapped (Trail v n))
_Wrapped' = (Trail v n -> Either (Trail' Line v n) (Trail' Loop v n))
-> (Either (Trail' Line v n) (Trail' Loop v n) -> Trail v n)
-> Iso
     (Trail v n)
     (Trail v n)
     (Either (Trail' Line v n) (Trail' Loop v n))
     (Either (Trail' Line v n) (Trail' Loop v n))
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso Trail v n -> Either (Trail' Line v n) (Trail' Loop v n)
getTrail ((Trail' Line v n -> Trail v n)
-> (Trail' Loop v n -> Trail v n)
-> Either (Trail' Line v n) (Trail' Loop v n)
-> Trail v n
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Trail' Line v n -> Trail v n
forall l (v :: * -> *) n. Trail' l v n -> Trail v n
Trail Trail' Loop v n -> Trail v n
forall l (v :: * -> *) n. Trail' l v n -> Trail v n
Trail)
    where
      getTrail :: Trail v n -> Either (Trail' Line v n) (Trail' Loop v n)
      getTrail :: Trail v n -> Either (Trail' Line v n) (Trail' Loop v n)
getTrail (Trail t :: Trail' l v n
t@(Line {})) = Trail' Line v n -> Either (Trail' Line v n) (Trail' Loop v n)
forall a b. a -> Either a b
Left Trail' l v n
Trail' Line v n
t
      getTrail (Trail t :: Trail' l v n
t@(Loop {})) = Trail' Loop v n -> Either (Trail' Line v n) (Trail' Loop v n)
forall a b. b -> Either a b
Right Trail' l v n
Trail' Loop v n
t

--------------------------------------------------
-- Constructors and eliminators for Trail

-- | A generic eliminator for 'Trail', taking functions specifying
--   what to do in the case of a line or a loop.
withTrail :: (Trail' Line v n -> r) -> (Trail' Loop v n -> r) -> Trail v n -> r
withTrail :: forall (v :: * -> *) n r.
(Trail' Line v n -> r) -> (Trail' Loop v n -> r) -> Trail v n -> r
withTrail Trail' Line v n -> r
line Trail' Loop v n -> r
loop (Trail Trail' l v n
t) = (Trail' Line v n -> r)
-> (Trail' Loop v n -> r) -> Trail' l v n -> r
forall (v :: * -> *) n r l.
(Trail' Line v n -> r)
-> (Trail' Loop v n -> r) -> Trail' l v n -> r
withTrail' Trail' Line v n -> r
line Trail' Loop v n -> r
loop Trail' l v n
t

-- | Modify a @Trail@, specifying two separate transformations for the
--   cases of a line or a loop.
onTrail :: (Trail' Line v n -> Trail' l1 v n) -> (Trail' Loop v n -> Trail' l2 v n)
        -> Trail v n -> Trail v n
onTrail :: forall (v :: * -> *) n l1 l2.
(Trail' Line v n -> Trail' l1 v n)
-> (Trail' Loop v n -> Trail' l2 v n) -> Trail v n -> Trail v n
onTrail Trail' Line v n -> Trail' l1 v n
o Trail' Loop v n -> Trail' l2 v n
c = (Trail' Line v n -> Trail v n)
-> (Trail' Loop v n -> Trail v n) -> Trail v n -> Trail v n
forall (v :: * -> *) n r.
(Trail' Line v n -> r) -> (Trail' Loop v n -> r) -> Trail v n -> r
withTrail (Trail' l1 v n -> Trail v n
forall l (v :: * -> *) n. Trail' l v n -> Trail v n
wrapTrail (Trail' l1 v n -> Trail v n)
-> (Trail' Line v n -> Trail' l1 v n)
-> Trail' Line v n
-> Trail v n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trail' Line v n -> Trail' l1 v n
o) (Trail' l2 v n -> Trail v n
forall l (v :: * -> *) n. Trail' l v n -> Trail v n
wrapTrail (Trail' l2 v n -> Trail v n)
-> (Trail' Loop v n -> Trail' l2 v n)
-> Trail' Loop v n
-> Trail v n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trail' Loop v n -> Trail' l2 v n
c)

-- | An eliminator for @Trail@ based on eliminating lines: if the
--   trail is a line, the given function is applied; if it is a loop, it
--   is first converted to a line with 'cutLoop'.  That is,
--
-- @
-- withLine f === 'withTrail' f (f . 'cutLoop')
-- @
withLine :: (Metric v, OrderedField n)
              => (Trail' Line v n -> r) -> Trail v n -> r
withLine :: forall (v :: * -> *) n r.
(Metric v, OrderedField n) =>
(Trail' Line v n -> r) -> Trail v n -> r
withLine Trail' Line v n -> r
f = (Trail' Line v n -> r) -> (Trail' Loop v n -> r) -> Trail v n -> r
forall (v :: * -> *) n r.
(Trail' Line v n -> r) -> (Trail' Loop v n -> r) -> Trail v n -> r
withTrail Trail' Line v n -> r
f (Trail' Line v n -> r
f (Trail' Line v n -> r)
-> (Trail' Loop v n -> Trail' Line v n) -> Trail' Loop v n -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trail' Loop v n -> Trail' Line v n
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Trail' Loop v n -> Trail' Line v n
cutLoop)

-- | Modify a @Trail@ by specifying a transformation on lines.  If the
--   trail is a line, the transformation will be applied directly.  If
--   it is a loop, it will first be cut using 'cutLoop', the
--   transformation applied, and then glued back into a loop with
--   'glueLine'.  That is,
--
--   @
--   onLine f === onTrail f (glueLine . f . cutLoop)
--   @
--
--   Note that there is no corresponding @onLoop@ function, because
--   there is no nice way in general to convert a line into a loop,
--   operate on it, and then convert back.
onLine :: (Metric v, OrderedField n)
       => (Trail' Line v n -> Trail' Line v n) -> Trail v n -> Trail v n
onLine :: forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
(Trail' Line v n -> Trail' Line v n) -> Trail v n -> Trail v n
onLine Trail' Line v n -> Trail' Line v n
f = (Trail' Line v n -> Trail' Line v n)
-> (Trail' Loop v n -> Trail' Loop v n) -> Trail v n -> Trail v n
forall (v :: * -> *) n l1 l2.
(Trail' Line v n -> Trail' l1 v n)
-> (Trail' Loop v n -> Trail' l2 v n) -> Trail v n -> Trail v n
onTrail Trail' Line v n -> Trail' Line v n
f (Trail' Line v n -> Trail' Loop v n
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Trail' Line v n -> Trail' Loop v n
glueLine (Trail' Line v n -> Trail' Loop v n)
-> (Trail' Loop v n -> Trail' Line v n)
-> Trail' Loop v n
-> Trail' Loop v n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trail' Line v n -> Trail' Line v n
f (Trail' Line v n -> Trail' Line v n)
-> (Trail' Loop v n -> Trail' Line v n)
-> Trail' Loop v n
-> Trail' Line v n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trail' Loop v n -> Trail' Line v n
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Trail' Loop v n -> Trail' Line v n
cutLoop)

-- | Convert a 'Trail'' into a 'Trail', hiding the type-level
--   distinction between lines and loops.
wrapTrail :: Trail' l v n -> Trail v n
wrapTrail :: forall l (v :: * -> *) n. Trail' l v n -> Trail v n
wrapTrail = Trail' l v n -> Trail v n
forall l (v :: * -> *) n. Trail' l v n -> Trail v n
Trail

-- | Convert a line into a 'Trail'.  This is the same as 'wrapTrail',
--   but with a more specific type, which can occasionally be
--   convenient for fixing the type of a polymorphic expression.
wrapLine :: Trail' Line v n -> Trail v n
wrapLine :: forall (v :: * -> *) n. Trail' Line v n -> Trail v n
wrapLine = Trail' Line v n -> Trail v n
forall l (v :: * -> *) n. Trail' l v n -> Trail v n
wrapTrail

-- | Convert a loop into a 'Trail'.  This is the same as 'wrapTrail',
--   but with a more specific type, which can occasionally be
--   convenient for fixing the type of a polymorphic expression.
wrapLoop :: Trail' Loop v n -> Trail v n
wrapLoop :: forall (v :: * -> *) n. Trail' Loop v n -> Trail v n
wrapLoop = Trail' Loop v n -> Trail v n
forall l (v :: * -> *) n. Trail' l v n -> Trail v n
wrapTrail

------------------------------------------------------------
--  Constructing trails  -----------------------------------
------------------------------------------------------------

-- | The empty line, which is the identity for concatenation of lines.
emptyLine :: (Metric v, OrderedField n) => Trail' Line v n
emptyLine :: forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Trail' Line v n
emptyLine = SegTree v n -> Trail' Line v n
forall (v :: * -> *) n. SegTree v n -> Trail' Line v n
Line SegTree v n
forall a. Monoid a => a
mempty

-- | A wrapped variant of 'emptyLine'.
emptyTrail :: (Metric v, OrderedField n) => Trail v n
emptyTrail :: forall (v :: * -> *) n. (Metric v, OrderedField n) => Trail v n
emptyTrail = Trail' Line v n -> Trail v n
forall (v :: * -> *) n. Trail' Line v n -> Trail v n
wrapLine Trail' Line v n
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Trail' Line v n
emptyLine

-- | Construct a line from a list of closed segments.
lineFromSegments :: (Metric v, OrderedField n)
                   => [Segment Closed v n] -> Trail' Line v n
lineFromSegments :: forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
[Segment Closed v n] -> Trail' Line v n
lineFromSegments = SegTree v n -> Trail' Line v n
forall (v :: * -> *) n. SegTree v n -> Trail' Line v n
Line (SegTree v n -> Trail' Line v n)
-> ([Segment Closed v n] -> SegTree v n)
-> [Segment Closed v n]
-> Trail' Line v n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FingerTree (SegMeasure v n) (Segment Closed v n) -> SegTree v n
forall (v :: * -> *) n.
FingerTree (SegMeasure v n) (Segment Closed v n) -> SegTree v n
SegTree (FingerTree (SegMeasure v n) (Segment Closed v n) -> SegTree v n)
-> ([Segment Closed v n]
    -> FingerTree (SegMeasure v n) (Segment Closed v n))
-> [Segment Closed v n]
-> SegTree v n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Segment Closed v n]
-> FingerTree (SegMeasure v n) (Segment Closed v n)
forall v a. Measured v a => [a] -> FingerTree v a
FT.fromList

-- | Construct a loop from a list of closed segments and an open segment
--   that completes the loop.
loopFromSegments :: (Metric v, OrderedField n)
                  => [Segment Closed v n] -> Segment Open v n -> Trail' Loop v n
loopFromSegments :: forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
[Segment Closed v n] -> Segment Open v n -> Trail' Loop v n
loopFromSegments [Segment Closed v n]
segs = SegTree v n -> Segment Open v n -> Trail' Loop v n
forall (v :: * -> *) n.
SegTree v n -> Segment Open v n -> Trail' Loop v n
Loop (FingerTree (SegMeasure v n) (Segment Closed v n) -> SegTree v n
forall (v :: * -> *) n.
FingerTree (SegMeasure v n) (Segment Closed v n) -> SegTree v n
SegTree ([Segment Closed v n]
-> FingerTree (SegMeasure v n) (Segment Closed v n)
forall v a. Measured v a => [a] -> FingerTree v a
FT.fromList [Segment Closed v n]
segs))

-- | @trailFromSegments === 'wrapTrail' . 'lineFromSegments'@, for
--   conveniently constructing a @Trail@ instead of a @Trail'@.
trailFromSegments :: (Metric v, OrderedField n)
                  => [Segment Closed v n] -> Trail v n
trailFromSegments :: forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
[Segment Closed v n] -> Trail v n
trailFromSegments = Trail' Line v n -> Trail v n
forall l (v :: * -> *) n. Trail' l v n -> Trail v n
wrapTrail (Trail' Line v n -> Trail v n)
-> ([Segment Closed v n] -> Trail' Line v n)
-> [Segment Closed v n]
-> Trail v n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Segment Closed v n] -> Trail' Line v n
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
[Segment Closed v n] -> Trail' Line v n
lineFromSegments

-- | Construct a line containing only linear segments from a list of
--   vectors, where each vector represents the offset from one vertex
--   to the next.  See also 'fromOffsets'.
--
--   <<diagrams/src_Diagrams_Trail_lineFromOffsetsEx.svg#diagram=lineFromOffsetsEx&width=300>>
--
--   > import Diagrams.Coordinates
--   > lineFromOffsetsEx = strokeLine $ lineFromOffsets [ 2 ^& 1, 2 ^& (-1), 2 ^& 0.5 ]
lineFromOffsets :: (Metric v, OrderedField n) => [v n] -> Trail' Line v n
lineFromOffsets :: forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
[v n] -> Trail' Line v n
lineFromOffsets = [Segment Closed v n] -> Trail' Line v n
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
[Segment Closed v n] -> Trail' Line v n
lineFromSegments ([Segment Closed v n] -> Trail' Line v n)
-> ([v n] -> [Segment Closed v n]) -> [v n] -> Trail' Line v n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (v n -> Segment Closed v n) -> [v n] -> [Segment Closed v n]
forall a b. (a -> b) -> [a] -> [b]
map v n -> Segment Closed v n
forall (v :: * -> *) n. v n -> Segment Closed v n
straight

-- | @trailFromOffsets === 'wrapTrail' . 'lineFromOffsets'@, for
--   conveniently constructing a @Trail@ instead of a @Trail' Line@.
trailFromOffsets :: (Metric v, OrderedField n) => [v n] -> Trail v n
trailFromOffsets :: forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
[v n] -> Trail v n
trailFromOffsets = Trail' Line v n -> Trail v n
forall l (v :: * -> *) n. Trail' l v n -> Trail v n
wrapTrail (Trail' Line v n -> Trail v n)
-> ([v n] -> Trail' Line v n) -> [v n] -> Trail v n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [v n] -> Trail' Line v n
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
[v n] -> Trail' Line v n
lineFromOffsets

-- | Construct a line containing only linear segments from a list of
--   vertices.  Note that only the relative offsets between the
--   vertices matters; the information about their absolute position
--   will be discarded.  That is, for all vectors @v@,
--
-- @
-- lineFromVertices === lineFromVertices . 'translate' v
-- @
--
--   If you want to retain the position information, you should
--   instead use the more general 'fromVertices' function to
--   construct, say, a @'Located' ('Trail'' 'Line' v)@ or a @'Located'
--   ('Trail' v)@.
--
--   <<diagrams/src_Diagrams_Trail_lineFromVerticesEx.svg#diagram=lineFromVerticesEx&width=300>>
--
--   > import Diagrams.Coordinates
--   > lineFromVerticesEx = pad 1.1 . centerXY . strokeLine
--   >   $ lineFromVertices [origin, 0 ^& 1, 1 ^& 2, 5 ^& 1]
lineFromVertices :: (Metric v, OrderedField n)
                   => [Point v n] -> Trail' Line v n
lineFromVertices :: forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
[Point v n] -> Trail' Line v n
lineFromVertices []  = Trail' Line v n
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Trail' Line v n
emptyLine
lineFromVertices [Point v n
_] = Trail' Line v n
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Trail' Line v n
emptyLine
lineFromVertices [Point v n]
ps  = [Segment Closed v n] -> Trail' Line v n
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
[Segment Closed v n] -> Trail' Line v n
lineFromSegments ([Segment Closed v n] -> Trail' Line v n)
-> ([v n] -> [Segment Closed v n]) -> [v n] -> Trail' Line v n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (v n -> Segment Closed v n) -> [v n] -> [Segment Closed v n]
forall a b. (a -> b) -> [a] -> [b]
map v n -> Segment Closed v n
forall (v :: * -> *) n. v n -> Segment Closed v n
straight ([v n] -> Trail' Line v n) -> [v n] -> Trail' Line v n
forall a b. (a -> b) -> a -> b
$ (Point v n -> Point v n -> v n)
-> [Point v n] -> [Point v n] -> [v n]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Point v n -> Point v n -> v n
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] -> [Point v n]
forall a. HasCallStack => [a] -> [a]
tail [Point v n]
ps) [Point v n]
ps


-- | @trailFromVertices === 'wrapTrail' . 'lineFromVertices'@, for
--   conveniently constructing a @Trail@ instead of a @Trail' Line@.
trailFromVertices :: (Metric v, OrderedField n)
                  => [Point v n] -> Trail v n
trailFromVertices :: forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
[Point v n] -> Trail v n
trailFromVertices = Trail' Line v n -> Trail v n
forall l (v :: * -> *) n. Trail' l v n -> Trail v n
wrapTrail (Trail' Line v n -> Trail v n)
-> ([Point v n] -> Trail' Line v n) -> [Point v n] -> Trail v n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Point v n] -> Trail' Line v n
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
[Point v n] -> Trail' Line v n
lineFromVertices

------------------------------------------------------------
--  Converting between lines and loops  --------------------
------------------------------------------------------------

-- | Make a line into a loop by \"gluing\" the endpoint to the
--   starting point.  In particular, the offset of the final segment
--   is modified so that it ends at the starting point of the entire
--   trail.  Typically, you would first construct a line which you
--   know happens to end where it starts, and then call 'glueLine' to
--   turn it into a loop.
--
--   <<diagrams/src_Diagrams_Trail_glueLineEx.svg#diagram=glueLineEx&width=500>>
--
--   > glueLineEx = pad 1.1 . hsep 1
--   >   $ [almostClosed # strokeLine, almostClosed # glueLine # strokeLoop]
--   >
--   > almostClosed :: Trail' Line V2 Double
--   > almostClosed = fromOffsets $ map r2 [(2, -1), (-3, -0.5), (-2, 1), (1, 0.5)]
--
--   @glueLine@ is left inverse to 'cutLoop', that is,
--
--   @
--   glueLine . cutLoop === id
--   @
glueLine :: (Metric v, OrderedField n) => Trail' Line v n -> Trail' Loop v n
glueLine :: forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Trail' Line v n -> Trail' Loop v n
glueLine (Line (SegTree FingerTree (SegMeasure v n) (Segment Closed v n)
t)) =
  case FingerTree (SegMeasure v n) (Segment Closed v n)
-> ViewR (FingerTree (SegMeasure v n)) (Segment Closed v n)
forall v a.
Measured v a =>
FingerTree v a -> ViewR (FingerTree v) a
FT.viewr FingerTree (SegMeasure v n) (Segment Closed v n)
t of
    ViewR (FingerTree (SegMeasure v n)) (Segment Closed v n)
FT.EmptyR           -> SegTree v n -> Segment Open v n -> Trail' Loop v n
forall (v :: * -> *) n.
SegTree v n -> Segment Open v n -> Trail' Loop v n
Loop SegTree v n
forall a. Monoid a => a
mempty (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)
    FingerTree (SegMeasure v n) (Segment Closed v n)
t' FT.:> Linear Offset Closed v n
_      -> SegTree v n -> Segment Open v n -> Trail' Loop v n
forall (v :: * -> *) n.
SegTree v n -> Segment Open v n -> Trail' Loop v n
Loop (FingerTree (SegMeasure v n) (Segment Closed v n) -> SegTree v n
forall (v :: * -> *) n.
FingerTree (SegMeasure v n) (Segment Closed v n) -> SegTree v n
SegTree FingerTree (SegMeasure v n) (Segment Closed v n)
t') (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)
    FingerTree (SegMeasure v n) (Segment Closed v n)
t' FT.:> Cubic v n
c1 v n
c2 Offset Closed v n
_ -> SegTree v n -> Segment Open v n -> Trail' Loop v n
forall (v :: * -> *) n.
SegTree v n -> Segment Open v n -> Trail' Loop v n
Loop (FingerTree (SegMeasure v n) (Segment Closed v n) -> SegTree v n
forall (v :: * -> *) n.
FingerTree (SegMeasure v n) (Segment Closed v n) -> SegTree v n
SegTree FingerTree (SegMeasure v n) (Segment Closed v n)
t') (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
c1 v n
c2 Offset Open v n
forall (v :: * -> *) n. Offset Open v n
OffsetOpen)

-- | @glueTrail@ is a variant of 'glueLine' which works on 'Trail's.
--   It performs 'glueLine' on lines and is the identity on loops.
glueTrail :: (Metric v, OrderedField n) => Trail v n -> Trail v n
glueTrail :: forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Trail v n -> Trail v n
glueTrail = (Trail' Line v n -> Trail' Loop v n)
-> (Trail' Loop v n -> Trail' Loop v n) -> Trail v n -> Trail v n
forall (v :: * -> *) n l1 l2.
(Trail' Line v n -> Trail' l1 v n)
-> (Trail' Loop v n -> Trail' l2 v n) -> Trail v n -> Trail v n
onTrail Trail' Line v n -> Trail' Loop v n
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Trail' Line v n -> Trail' Loop v n
glueLine Trail' Loop v n -> Trail' Loop v n
forall a. a -> a
id

-- | Make a line into a loop by adding a new linear segment from the
--   line's end to its start.
--
--   @closeLine@ does not have any particularly nice theoretical
--   properties, but can be useful /e.g./ when you want to make a
--   closed polygon out of a list of points where the initial point is
--   not repeated at the end.  To use 'glueLine', one would first have
--   to duplicate the initial vertex, like
--
-- @
-- 'glueLine' . 'lineFromVertices' $ ps ++ [head ps]
-- @
--
--   Using @closeLine@, however, one can simply
--
-- @
-- closeLine . lineFromVertices $ ps
-- @
--
--   <<diagrams/src_Diagrams_Trail_closeLineEx.svg#diagram=closeLineEx&width=500>>
--
--   > closeLineEx = pad 1.1 . centerXY . hcat' (with & sep .~ 1)
--   >   $ [almostClosed # strokeLine, almostClosed # closeLine # strokeLoop]
closeLine :: Trail' Line v n -> Trail' Loop v n
closeLine :: forall (v :: * -> *) n. Trail' Line v n -> Trail' Loop v n
closeLine (Line SegTree v n
t) = SegTree v n -> Segment Open v n -> Trail' Loop v n
forall (v :: * -> *) n.
SegTree v n -> Segment Open v n -> Trail' Loop v n
Loop SegTree v n
t (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)

-- | @closeTrail@ is a variant of 'closeLine' for 'Trail', which
--   performs 'closeLine' on lines and is the identity on loops.
closeTrail :: Trail v n -> Trail v n
closeTrail :: forall (v :: * -> *) n. Trail v n -> Trail v n
closeTrail = (Trail' Line v n -> Trail' Loop v n)
-> (Trail' Loop v n -> Trail' Loop v n) -> Trail v n -> Trail v n
forall (v :: * -> *) n l1 l2.
(Trail' Line v n -> Trail' l1 v n)
-> (Trail' Loop v n -> Trail' l2 v n) -> Trail v n -> Trail v n
onTrail Trail' Line v n -> Trail' Loop v n
forall (v :: * -> *) n. Trail' Line v n -> Trail' Loop v n
closeLine Trail' Loop v n -> Trail' Loop v n
forall a. a -> a
id

-- | Turn a loop into a line by \"cutting\" it at the common start/end
--   point, resulting in a line which just happens to start and end at
--   the same place.
--
--   @cutLoop@ is right inverse to 'glueLine', that is,
--
--   @
--   glueLine . cutLoop === id
--   @
cutLoop :: forall v n. (Metric v, OrderedField n)
         => Trail' Loop v n -> Trail' Line v n
cutLoop :: forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Trail' Loop v n -> Trail' Line v n
cutLoop (Loop (SegTree FingerTree (SegMeasure v n) (Segment Closed v n)
t) Segment Open v n
c) =
  case (FingerTree (SegMeasure v n) (Segment Closed v n) -> Bool
forall v a. FingerTree v a -> Bool
FT.null FingerTree (SegMeasure v n) (Segment Closed v n)
t, Segment Open v n
c) of
    (Bool
True, Linear Offset Open v n
OffsetOpen)      -> Trail' Line v n
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Trail' Line v n
emptyLine
    (Bool
_   , Linear Offset Open v n
OffsetOpen)      -> SegTree v n -> Trail' Line v n
forall (v :: * -> *) n. SegTree v n -> Trail' Line v n
Line (FingerTree (SegMeasure v n) (Segment Closed v n) -> SegTree v n
forall (v :: * -> *) n.
FingerTree (SegMeasure v n) (Segment Closed v n) -> SegTree v n
SegTree (FingerTree (SegMeasure v n) (Segment Closed v n)
t FingerTree (SegMeasure v n) (Segment Closed v n)
-> Segment Closed v n
-> FingerTree (SegMeasure v n) (Segment Closed v n)
forall v a. Measured v a => FingerTree v a -> a -> FingerTree v a
|> 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
off))
    (Bool
_   , Cubic v n
c1 v n
c2 Offset Open v n
OffsetOpen) -> SegTree v n -> Trail' Line v n
forall (v :: * -> *) n. SegTree v n -> Trail' Line v n
Line (FingerTree (SegMeasure v n) (Segment Closed v n) -> SegTree v n
forall (v :: * -> *) n.
FingerTree (SegMeasure v n) (Segment Closed v n) -> SegTree v n
SegTree (FingerTree (SegMeasure v n) (Segment Closed v n)
t FingerTree (SegMeasure v n) (Segment Closed v n)
-> Segment Closed v n
-> FingerTree (SegMeasure v n) (Segment Closed v n)
forall v a. Measured v a => FingerTree v a -> a -> FingerTree v a
|> 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 Offset Closed v n
off))
  where
    offV :: v n
    offV :: v n
offV = v n -> v n
forall (f :: * -> *) a. (Functor f, Num a) => f a -> f a
negated (v n -> v n)
-> (FingerTree (SegMeasure v n) (Segment Closed v n) -> v n)
-> FingerTree (SegMeasure v n) (Segment Closed v n)
-> v n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v n
-> (OffsetEnvelope v n -> v n)
-> FingerTree (SegMeasure v n) (Segment Closed v n)
-> v n
forall (v :: * -> *) n m t a.
(SegMeasure v n :>: m, Measured (SegMeasure v n) t) =>
a -> (m -> a) -> t -> a
trailMeasure v n
forall a. Num a => v a
forall (f :: * -> *) a. (Additive f, Num a) => f a
zero ((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)
-> (OffsetEnvelope v n -> TotalOffset v n)
-> OffsetEnvelope v n
-> v n
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Getting (TotalOffset v n) (OffsetEnvelope v n) (TotalOffset v n)
-> OffsetEnvelope v n -> TotalOffset v n
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (TotalOffset v n) (OffsetEnvelope v n) (TotalOffset v n)
forall (v :: * -> *) n (f :: * -> *).
Functor f =>
(TotalOffset v n -> f (TotalOffset v n))
-> OffsetEnvelope v n -> f (OffsetEnvelope v n)
oeOffset) (FingerTree (SegMeasure v n) (Segment Closed v n) -> v n)
-> FingerTree (SegMeasure v n) (Segment Closed v n) -> v n
forall a b. (a -> b) -> a -> b
$ FingerTree (SegMeasure v n) (Segment Closed v n)
t
    off :: Offset Closed v n
off = v n -> Offset Closed v n
forall (v :: * -> *) n. v n -> Offset Closed v n
OffsetClosed v n
offV

-- | @cutTrail@ is a variant of 'cutLoop' for 'Trail'; it is the is
--   the identity on lines and performs 'cutLoop' on loops.
cutTrail :: (Metric v, OrderedField n)
         => Trail v n -> Trail v n
cutTrail :: forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Trail v n -> Trail v n
cutTrail = (Trail' Line v n -> Trail' Line v n)
-> (Trail' Loop v n -> Trail' Line v n) -> Trail v n -> Trail v n
forall (v :: * -> *) n l1 l2.
(Trail' Line v n -> Trail' l1 v n)
-> (Trail' Loop v n -> Trail' l2 v n) -> Trail v n -> Trail v n
onTrail Trail' Line v n -> Trail' Line v n
forall a. a -> a
id Trail' Loop v n -> Trail' Line v n
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Trail' Loop v n -> Trail' Line v n
cutLoop

------------------------------------------------------------
--  Eliminating trails  ------------------------------------
------------------------------------------------------------

-- | Test whether a line is empty.
isLineEmpty :: (Metric v, OrderedField n) => Trail' Line v n -> Bool
isLineEmpty :: forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Trail' Line v n -> Bool
isLineEmpty (Line (SegTree FingerTree (SegMeasure v n) (Segment Closed v n)
t)) = FingerTree (SegMeasure v n) (Segment Closed v n) -> Bool
forall v a. FingerTree v a -> Bool
FT.null FingerTree (SegMeasure v n) (Segment Closed v n)
t

-- | Test whether a trail is empty.  Note that loops are never empty.
isTrailEmpty :: (Metric v, OrderedField n) => Trail v n -> Bool
isTrailEmpty :: forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Trail v n -> Bool
isTrailEmpty = (Trail' Line v n -> Bool)
-> (Trail' Loop v n -> Bool) -> Trail v n -> Bool
forall (v :: * -> *) n r.
(Trail' Line v n -> r) -> (Trail' Loop v n -> r) -> Trail v n -> r
withTrail Trail' Line v n -> Bool
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Trail' Line v n -> Bool
isLineEmpty (Bool -> Trail' Loop v n -> Bool
forall a b. a -> b -> a
const Bool
False)

-- | Determine whether a trail is a line.
isLine :: Trail v n -> Bool
isLine :: forall (v :: * -> *) n. Trail v n -> Bool
isLine = Bool -> Bool
not (Bool -> Bool) -> (Trail v n -> Bool) -> Trail v n -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trail v n -> Bool
forall (v :: * -> *) n. Trail v n -> Bool
isLoop

-- | Determine whether a trail is a loop.
isLoop :: Trail v n -> Bool
isLoop :: forall (v :: * -> *) n. Trail v n -> Bool
isLoop = (Trail' Line v n -> Bool)
-> (Trail' Loop v n -> Bool) -> Trail v n -> Bool
forall (v :: * -> *) n r.
(Trail' Line v n -> r) -> (Trail' Loop v n -> r) -> Trail v n -> r
withTrail (Bool -> Trail' Line v n -> Bool
forall a b. a -> b -> a
const Bool
False) (Bool -> Trail' Loop v n -> Bool
forall a b. a -> b -> a
const Bool
True)

-- | Extract the segments comprising a line.
lineSegments :: Trail' Line v n -> [Segment Closed v n]
lineSegments :: forall (v :: * -> *) n. Trail' Line v n -> [Segment Closed v n]
lineSegments (Line (SegTree FingerTree (SegMeasure v n) (Segment Closed v n)
t)) = FingerTree (SegMeasure v n) (Segment Closed v n)
-> [Segment Closed v n]
forall a. FingerTree (SegMeasure v n) a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList FingerTree (SegMeasure v n) (Segment Closed v n)
t

-- | Modify a line by applying a function to its list of segments.
onLineSegments
  :: (Metric v, OrderedField n)
  => ([Segment Closed v n] -> [Segment Closed v n])
  -> Trail' Line v n -> Trail' Line v n
onLineSegments :: forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
([Segment Closed v n] -> [Segment Closed v n])
-> Trail' Line v n -> Trail' Line v n
onLineSegments [Segment Closed v n] -> [Segment Closed v n]
f = [Segment Closed v n] -> Trail' Line v n
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
[Segment Closed v n] -> Trail' Line v n
lineFromSegments ([Segment Closed v n] -> Trail' Line v n)
-> (Trail' Line v n -> [Segment Closed v n])
-> Trail' Line v n
-> Trail' Line v n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Segment Closed v n] -> [Segment Closed v n]
f ([Segment Closed v n] -> [Segment Closed v n])
-> (Trail' Line v n -> [Segment Closed v n])
-> Trail' Line v n
-> [Segment Closed v n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trail' Line v n -> [Segment Closed v n]
forall (v :: * -> *) n. Trail' Line v n -> [Segment Closed v n]
lineSegments

-- | Extract the segments comprising a loop: a list of closed
--   segments, and one final open segment.
loopSegments :: Trail' Loop v n -> ([Segment Closed v n], Segment Open v n)
loopSegments :: forall (v :: * -> *) n.
Trail' Loop v n -> ([Segment Closed v n], Segment Open v n)
loopSegments (Loop (SegTree FingerTree (SegMeasure v n) (Segment Closed v n)
t) Segment Open v n
c) = (FingerTree (SegMeasure v n) (Segment Closed v n)
-> [Segment Closed v n]
forall a. FingerTree (SegMeasure v n) a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList FingerTree (SegMeasure v n) (Segment Closed v n)
t, Segment Open v n
c)

-- | Extract the segments of a trail.  If the trail is a loop it will
--   first have 'cutLoop' applied.
trailSegments :: (Metric v, OrderedField n)
              => Trail v n -> [Segment Closed v n]
trailSegments :: forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Trail v n -> [Segment Closed v n]
trailSegments = (Trail' Line v n -> [Segment Closed v n])
-> Trail v n -> [Segment Closed v n]
forall (v :: * -> *) n r.
(Metric v, OrderedField n) =>
(Trail' Line v n -> r) -> Trail v n -> r
withLine Trail' Line v n -> [Segment Closed v n]
forall (v :: * -> *) n. Trail' Line v n -> [Segment Closed v n]
lineSegments

-- | Extract the offsets of the segments of a trail.
trailOffsets :: (Metric v, OrderedField n) => Trail v n -> [v n]
trailOffsets :: forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Trail v n -> [v n]
trailOffsets = (Trail' Line v n -> [v n]) -> Trail v n -> [v n]
forall (v :: * -> *) n r.
(Metric v, OrderedField n) =>
(Trail' Line v n -> r) -> Trail v n -> r
withLine Trail' Line v n -> [v n]
forall (v :: * -> *) n. Trail' Line v n -> [v n]
lineOffsets

-- | Compute the offset from the start of a trail to the end.  Satisfies
--
--   @
--   trailOffset === sumV . trailOffsets
--   @
--
--   but is more efficient.
--
--   <<diagrams/src_Diagrams_Trail_trailOffsetEx.svg#diagram=trailOffsetEx&width=300>>
--
--   > trailOffsetEx = (strokeLine almostClosed <> showOffset) # centerXY # pad 1.1
--   >   where showOffset = fromOffsets [trailOffset (wrapLine almostClosed)]
--   >                    # strokeP # lc red
trailOffset :: (Metric v, OrderedField n) => Trail v n -> v n
trailOffset :: forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Trail v n -> v n
trailOffset = (Trail' Line v n -> v n) -> Trail v n -> v n
forall (v :: * -> *) n r.
(Metric v, OrderedField n) =>
(Trail' Line v n -> r) -> Trail v n -> r
withLine Trail' Line v n -> v n
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Trail' Line v n -> v n
lineOffset

-- | Extract the offsets of the segments of a line.
lineOffsets :: Trail' Line v n -> [v n]
lineOffsets :: forall (v :: * -> *) n. Trail' Line v n -> [v n]
lineOffsets = (Segment Closed v n -> v n) -> [Segment Closed v n] -> [v n]
forall a b. (a -> b) -> [a] -> [b]
map Segment Closed v n -> v n
forall (v :: * -> *) n. Segment Closed v n -> v n
segOffset ([Segment Closed v n] -> [v n])
-> (Trail' Line v n -> [Segment Closed v n])
-> Trail' Line v n
-> [v n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trail' Line v n -> [Segment Closed v n]
forall (v :: * -> *) n. Trail' Line v n -> [Segment Closed v n]
lineSegments

-- | Extract the offsets of the segments of a loop.
loopOffsets :: (Metric v, OrderedField n) => Trail' Loop v n -> [v n]
loopOffsets :: forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Trail' Loop v n -> [v n]
loopOffsets = Trail' Line v n -> [v n]
forall (v :: * -> *) n. Trail' Line v n -> [v n]
lineOffsets (Trail' Line v n -> [v n])
-> (Trail' Loop v n -> Trail' Line v n) -> Trail' Loop v n -> [v n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trail' Loop v n -> Trail' Line v n
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Trail' Loop v n -> Trail' Line v n
cutLoop

-- | Compute the offset from the start of a line to the end.  (Note,
--   there is no corresponding @loopOffset@ function because by
--   definition it would be constantly zero.)
lineOffset :: (Metric v, OrderedField n) => Trail' Line v n -> v n
lineOffset :: forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Trail' Line v n -> v n
lineOffset (Line SegTree v n
t) = v n -> (OffsetEnvelope v n -> v n) -> SegTree v n -> v n
forall (v :: * -> *) n m t a.
(SegMeasure v n :>: m, Measured (SegMeasure v n) t) =>
a -> (m -> a) -> t -> a
trailMeasure v n
forall a. Num a => v a
forall (f :: * -> *) a. (Additive f, Num a) => f a
zero ((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)
-> (OffsetEnvelope v n -> TotalOffset v n)
-> OffsetEnvelope v n
-> v n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (TotalOffset v n) (OffsetEnvelope v n) (TotalOffset v n)
-> OffsetEnvelope v n -> TotalOffset v n
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (TotalOffset v n) (OffsetEnvelope v n) (TotalOffset v n)
forall (v :: * -> *) n (f :: * -> *).
Functor f =>
(TotalOffset v n -> f (TotalOffset v n))
-> OffsetEnvelope v n -> f (OffsetEnvelope v n)
oeOffset) SegTree v n
t

-- | Extract the points of a concretely located trail, /i.e./ the points
--   where one segment ends and the next begins. Note that for loops,
--   the starting point will /not/ be repeated at the end.  If you
--   want this behavior, you can use 'cutTrail' to make the loop into
--   a line first, which happens to repeat the same point at the start
--   and end, /e.g./ with @trailPoints . mapLoc cutTrail@.
--
--   Note that it does not make sense to ask for the points of a
--   'Trail' by itself; if you want the points of a trail
--   with the first point at, say, the origin, you can use
--   @trailPoints . (\`at\` origin)@.
--
--   This function allows you "observe" the fact that trails are
--   implemented as lists of segments, which may be problematic if we
--   want to think of trails as parametric vector functions. This also
--   means that the behavior of this function may not be stable under
--   future changes to the implementation of trails.  For an
--   unproblematic version which only yields vertices at which there
--   is a sharp corner, excluding points where the trail is
--   differentiable, see 'trailVertices'.
--
--   This function is not re-exported from "Diagrams.Prelude"; to use
--   it, import "Diagrams.Trail".
trailPoints :: (Metric v, OrderedField n)
              => Located (Trail v n) -> [Point v n]
trailPoints :: forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Located (Trail v n) -> [Point v n]
trailPoints (Located (Trail v n)
-> (Point (V (Trail v n)) (N (Trail v n)), Trail v n)
forall a. Located a -> (Point (V a) (N a), a)
viewLoc -> (Point (V (Trail v n)) (N (Trail v n))
p,Trail v n
t))
  = (Trail' Line v n -> [Point v n])
-> (Trail' Loop v n -> [Point v n]) -> Trail v n -> [Point v n]
forall (v :: * -> *) n r.
(Trail' Line v n -> r) -> (Trail' Loop v n -> r) -> Trail v n -> r
withTrail (Located (Trail' Line v n) -> [Point v n]
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Located (Trail' Line v n) -> [Point v n]
linePoints (Located (Trail' Line v n) -> [Point v n])
-> (Trail' Line v n -> Located (Trail' Line v n))
-> Trail' Line v n
-> [Point v n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Trail' Line v n
-> Point (V (Trail' Line v n)) (N (Trail' Line v n))
-> Located (Trail' Line v n)
forall a. a -> Point (V a) (N a) -> Located a
`at` Point (V (Trail v n)) (N (Trail v n))
Point (V (Trail' Line v n)) (N (Trail' Line v n))
p)) (Located (Trail' Loop v n) -> [Point v n]
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Located (Trail' Loop v n) -> [Point v n]
loopPoints (Located (Trail' Loop v n) -> [Point v n])
-> (Trail' Loop v n -> Located (Trail' Loop v n))
-> Trail' Loop v n
-> [Point v n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Trail' Loop v n
-> Point (V (Trail' Loop v n)) (N (Trail' Loop v n))
-> Located (Trail' Loop v n)
forall a. a -> Point (V a) (N a) -> Located a
`at` Point (V (Trail v n)) (N (Trail v n))
Point (V (Trail' Loop v n)) (N (Trail' Loop v n))
p)) Trail v n
t

-- | Extract the segment join points of a concretely located line.  See
--   'trailPoints' for more information.
--
--   This function allows you "observe" the fact that lines are
--   implemented as lists of segments, which may be problematic if we
--   want to think of lines as parametric vector functions. This also
--   means that the behavior of this function may not be stable under
--   future changes to the implementation of trails.  For an
--   unproblematic version which only yields vertices at which there
--   is a sharp corner, excluding points where the trail is
--   differentiable, see 'lineVertices'.
--
--   This function is not re-exported from "Diagrams.Prelude"; to use
--   it, import "Diagrams.Trail".
linePoints :: (Metric v, OrderedField n)
             => Located (Trail' Line v n) -> [Point v n]
linePoints :: forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Located (Trail' Line v n) -> [Point v n]
linePoints (Located (Trail' Line v n)
-> (Point (V (Trail' Line v n)) (N (Trail' Line v n)),
    Trail' Line v n)
forall a. Located a -> (Point (V a) (N a), a)
viewLoc -> (Point (V (Trail' Line v n)) (N (Trail' Line v n))
p,Trail' Line v n
t))
  = Point v n -> [Segment Closed v n] -> [Point v n]
forall (v :: * -> *) n.
(Additive v, Num n) =>
Point v n -> [Segment Closed v n] -> [Point v n]
segmentPoints Point v n
Point (V (Trail' Line v n)) (N (Trail' Line v n))
p ([Segment Closed v n] -> [Point v n])
-> (Trail' Line v n -> [Segment Closed v n])
-> Trail' Line v n
-> [Point v n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trail' Line v n -> [Segment Closed v n]
forall (v :: * -> *) n. Trail' Line v n -> [Segment Closed v n]
lineSegments (Trail' Line v n -> [Point v n]) -> Trail' Line v n -> [Point v n]
forall a b. (a -> b) -> a -> b
$ Trail' Line v n
t

-- | Extract the segment join points of a concretely located loop.  Note that the
--   initial vertex is not repeated at the end.  See 'trailPoints' for
--   more information.
--
--   This function allows you "observe" the fact that lines are
--   implemented as lists of segments, which may be problematic if we
--   want to think of lines as parametric vector functions. This also
--   means that the behavior of this function may not be stable under
--   future changes to the implementation of trails.  For an
--   unproblematic version which only yields vertices at which there
--   is a sharp corner, excluding points where the trail is
--   differentiable, see 'lineVertices'.
--
--   This function is not re-exported from "Diagrams.Prelude"; to use
--   it, import "Diagrams.Trail".
loopPoints :: (Metric v, OrderedField n)
             => Located (Trail' Loop v n) -> [Point v n]
loopPoints :: forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Located (Trail' Loop v n) -> [Point v n]
loopPoints (Located (Trail' Loop v n)
-> (Point (V (Trail' Loop v n)) (N (Trail' Loop v n)),
    Trail' Loop v n)
forall a. Located a -> (Point (V a) (N a), a)
viewLoc -> (Point (V (Trail' Loop v n)) (N (Trail' Loop v n))
p,Trail' Loop v n
t))
  = Point v n -> [Segment Closed v n] -> [Point v n]
forall (v :: * -> *) n.
(Additive v, Num n) =>
Point v n -> [Segment Closed v n] -> [Point v n]
segmentPoints Point v n
Point (V (Trail' Loop v n)) (N (Trail' Loop v n))
p ([Segment Closed v n] -> [Point v n])
-> (Trail' Loop v n -> [Segment Closed v n])
-> Trail' Loop v n
-> [Point v n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Segment Closed v n], Segment Open v n) -> [Segment Closed v n]
forall a b. (a, b) -> a
fst (([Segment Closed v n], Segment Open v n) -> [Segment Closed v n])
-> (Trail' Loop v n -> ([Segment Closed v n], Segment Open v n))
-> Trail' Loop v n
-> [Segment Closed v n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trail' Loop v n -> ([Segment Closed v n], Segment Open v n)
forall (v :: * -> *) n.
Trail' Loop v n -> ([Segment Closed v n], Segment Open v n)
loopSegments (Trail' Loop v n -> [Point v n]) -> Trail' Loop v n -> [Point v n]
forall a b. (a -> b) -> a -> b
$ Trail' Loop v n
t

segmentPoints :: (Additive v, Num n) => Point v n -> [Segment Closed v n] -> [Point v n]
segmentPoints :: forall (v :: * -> *) n.
(Additive v, Num n) =>
Point v n -> [Segment Closed v n] -> [Point v n]
segmentPoints Point v n
p = (Point v n -> v n -> Point v n)
-> Point v n -> [v n] -> [Point v n]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl Point v n -> v n -> Point v n
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
(.+^) Point v n
p ([v n] -> [Point v n])
-> ([Segment Closed v n] -> [v n])
-> [Segment Closed v n]
-> [Point v n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Segment Closed v n -> v n) -> [Segment Closed v n] -> [v n]
forall a b. (a -> b) -> [a] -> [b]
map Segment Closed v n -> v n
forall (v :: * -> *) n. Segment Closed v n -> v n
segOffset

tolerance :: OrderedField a => a
tolerance :: forall a. OrderedField a => a
tolerance = a
10e-16

-- | Extract the vertices of a concretely located trail.  Here a /vertex/
--   is defined as a non-differentiable point on the trail, /i.e./ a
--   sharp corner.  (Vertices are thus a subset of the places where
--   segments join; if you want all joins between segments, see
--   'trailPoints'.)  The tolerance determines how close the tangents
--   of two segments must be at their endpoints to consider the
--   transition point to be differentiable.
--
--   Note that for loops, the starting vertex will /not/ be repeated
--   at the end.  If you want this behavior, you can use 'cutTrail' to
--   make the loop into a line first, which happens to repeat the same
--   vertex at the start and end, /e.g./ with @trailVertices . mapLoc
--   cutTrail@.
--
--   It does not make sense to ask for the vertices of a 'Trail' by
--   itself; if you want the vertices of a trail with the first vertex
--   at, say, the origin, you can use @trailVertices . (\`at\`
--   origin)@.
trailVertices' :: (Metric v, OrderedField n)
              => n ->  Located (Trail v n) -> [Point v n]
trailVertices' :: forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
n -> Located (Trail v n) -> [Point v n]
trailVertices' n
toler (Located (Trail v n)
-> (Point (V (Trail v n)) (N (Trail v n)), Trail v n)
forall a. Located a -> (Point (V a) (N a), a)
viewLoc -> (Point (V (Trail v n)) (N (Trail v n))
p,Trail v n
t))
  = (Trail' Line v n -> [Point v n])
-> (Trail' Loop v n -> [Point v n]) -> Trail v n -> [Point v n]
forall (v :: * -> *) n r.
(Trail' Line v n -> r) -> (Trail' Loop v n -> r) -> Trail v n -> r
withTrail (n -> Located (Trail' Line v n) -> [Point v n]
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
n -> Located (Trail' Line v n) -> [Point v n]
lineVertices' n
toler (Located (Trail' Line v n) -> [Point v n])
-> (Trail' Line v n -> Located (Trail' Line v n))
-> Trail' Line v n
-> [Point v n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Trail' Line v n
-> Point (V (Trail' Line v n)) (N (Trail' Line v n))
-> Located (Trail' Line v n)
forall a. a -> Point (V a) (N a) -> Located a
`at` Point (V (Trail v n)) (N (Trail v n))
Point (V (Trail' Line v n)) (N (Trail' Line v n))
p)) (n -> Located (Trail' Loop v n) -> [Point v n]
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
n -> Located (Trail' Loop v n) -> [Point v n]
loopVertices' n
toler (Located (Trail' Loop v n) -> [Point v n])
-> (Trail' Loop v n -> Located (Trail' Loop v n))
-> Trail' Loop v n
-> [Point v n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Trail' Loop v n
-> Point (V (Trail' Loop v n)) (N (Trail' Loop v n))
-> Located (Trail' Loop v n)
forall a. a -> Point (V a) (N a) -> Located a
`at` Point (V (Trail v n)) (N (Trail v n))
Point (V (Trail' Loop v n)) (N (Trail' Loop v n))
p)) Trail v n
t

-- | Like 'trailVertices'', with a default tolerance.
trailVertices :: (Metric v, OrderedField n)
              => Located (Trail v n) -> [Point v n]
trailVertices :: forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Located (Trail v n) -> [Point v n]
trailVertices = n -> Located (Trail v n) -> [Point v n]
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
n -> Located (Trail v n) -> [Point v n]
trailVertices' n
forall a. OrderedField a => a
tolerance

-- | Extract the vertices of a concretely located line.  See
--   'trailVertices' for more information.
lineVertices' :: (Metric v, OrderedField n)
             => n -> Located (Trail' Line v n) -> [Point v n]
lineVertices' :: forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
n -> Located (Trail' Line v n) -> [Point v n]
lineVertices' n
toler (Located (Trail' Line v n)
-> (Point (V (Trail' Line v n)) (N (Trail' Line v n)),
    Trail' Line v n)
forall a. Located a -> (Point (V a) (N a), a)
viewLoc -> (Point (V (Trail' Line v n)) (N (Trail' Line v n))
p,Trail' Line v n
t))
  = n -> Point v n -> [Segment Closed v n] -> [Point v n]
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
n -> Point v n -> [Segment Closed v n] -> [Point v n]
segmentVertices' n
toler Point v n
Point (V (Trail' Line v n)) (N (Trail' Line v n))
p ([Segment Closed v n] -> [Point v n])
-> (Trail' Line v n -> [Segment Closed v n])
-> Trail' Line v n
-> [Point v n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trail' Line v n -> [Segment Closed v n]
forall (v :: * -> *) n. Trail' Line v n -> [Segment Closed v n]
lineSegments (Trail' Line v n -> [Point v n]) -> Trail' Line v n -> [Point v n]
forall a b. (a -> b) -> a -> b
$ Trail' Line v n
t

-- | Like 'lineVertices'', with a default tolerance.
lineVertices :: (Metric v, OrderedField n)
             => Located (Trail' Line v n) -> [Point v n]
lineVertices :: forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Located (Trail' Line v n) -> [Point v n]
lineVertices = n -> Located (Trail' Line v n) -> [Point v n]
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
n -> Located (Trail' Line v n) -> [Point v n]
lineVertices' n
forall a. OrderedField a => a
tolerance

-- | Extract the vertices of a concretely located loop.  Note that the
--   initial vertex is not repeated at the end.  See 'trailVertices' for
--   more information.
loopVertices' :: (Metric v, OrderedField n)
             => n -> Located (Trail' Loop v n) -> [Point v n]
loopVertices' :: forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
n -> Located (Trail' Loop v n) -> [Point v n]
loopVertices' n
toler (Located (Trail' Loop v n)
-> (Point (V (Trail' Loop v n)) (N (Trail' Loop v n)),
    Trail' Loop v n)
forall a. Located a -> (Point (V a) (N a), a)
viewLoc -> (Point (V (Trail' Loop v n)) (N (Trail' Loop v n))
p,Trail' Loop v n
t))
  | [Segment Closed v n] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Segment Closed v n]
segs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 = if n
far n -> n -> Bool
forall a. Ord a => a -> a -> Bool
> n
toler  then [Point v n] -> [Point v n]
forall a. HasCallStack => [a] -> [a]
init [Point v n]
ps else [Point v n] -> [Point v n]
forall a. HasCallStack => [a] -> [a]
init ([Point v n] -> [Point v n])
-> ([Point v n] -> [Point v n]) -> [Point v n] -> [Point v n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Point v n] -> [Point v n]
forall a. Int -> [a] -> [a]
drop Int
1 ([Point v n] -> [Point v n]) -> [Point v n] -> [Point v n]
forall a b. (a -> b) -> a -> b
$ [Point v n]
ps
  | Bool
otherwise       = [Point v n]
ps
  where
    far :: n
far = v n -> n
forall a. Num a => v a -> a
forall (f :: * -> *) a. (Metric f, Num a) => f a -> a
quadrance ((v n -> v n
forall a. Floating a => v a -> v a
forall (f :: * -> *) a. (Metric f, Floating a) => f a -> f a
signorm (v n -> v n)
-> ([Segment Closed v n] -> v n) -> [Segment Closed v n] -> v n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Segment Closed v n -> v n
Segment Closed v n -> Vn (Segment Closed v n)
forall t. EndValues (Tangent t) => t -> Vn t
tangentAtStart (Segment Closed v n -> v n)
-> ([Segment Closed v n] -> Segment Closed v n)
-> [Segment Closed v n]
-> v n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Segment Closed v n] -> Segment Closed v n
forall a. HasCallStack => [a] -> a
head ([Segment Closed v n] -> v n) -> [Segment Closed v n] -> v n
forall a b. (a -> b) -> a -> b
$ [Segment Closed v n]
segs) 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 -> v n
forall a. Floating a => v a -> v a
forall (f :: * -> *) a. (Metric f, Floating a) => f a -> f a
signorm (v n -> v n)
-> ([Segment Closed v n] -> v n) -> [Segment Closed v n] -> v n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Segment Closed v n -> v n
Segment Closed v n -> Vn (Segment Closed v n)
forall t. EndValues (Tangent t) => t -> Vn t
tangentAtEnd   (Segment Closed v n -> v n)
-> ([Segment Closed v n] -> Segment Closed v n)
-> [Segment Closed v n]
-> v n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Segment Closed v n] -> Segment Closed v n
forall a. HasCallStack => [a] -> a
last ([Segment Closed v n] -> v n) -> [Segment Closed v n] -> v n
forall a b. (a -> b) -> a -> b
$ [Segment Closed v n]
segs))
    segs :: [Segment Closed v n]
segs = Trail' Line v n -> [Segment Closed v n]
forall (v :: * -> *) n. Trail' Line v n -> [Segment Closed v n]
lineSegments (Trail' Line v n -> [Segment Closed v n])
-> (Trail' Loop v n -> Trail' Line v n)
-> Trail' Loop v n
-> [Segment Closed v n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trail' Loop v n -> Trail' Line v n
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Trail' Loop v n -> Trail' Line v n
cutLoop (Trail' Loop v n -> [Segment Closed v n])
-> Trail' Loop v n -> [Segment Closed v n]
forall a b. (a -> b) -> a -> b
$ Trail' Loop v n
t
    ps :: [Point v n]
ps = n -> Point v n -> [Segment Closed v n] -> [Point v n]
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
n -> Point v n -> [Segment Closed v n] -> [Point v n]
segmentVertices' n
toler Point v n
Point (V (Trail' Loop v n)) (N (Trail' Loop v n))
p [Segment Closed v n]
segs

-- | Same as 'loopVertices'', with a default tolerance.
loopVertices :: (Metric v, OrderedField n)
             => Located (Trail' Loop v n) -> [Point v n]
loopVertices :: forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Located (Trail' Loop v n) -> [Point v n]
loopVertices = n -> Located (Trail' Loop v n) -> [Point v n]
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
n -> Located (Trail' Loop v n) -> [Point v n]
loopVertices' n
forall a. OrderedField a => a
tolerance

-- | The vertices of a list of segments laid end to end.
--   The start and end points are always included in the list of
--   vertices.  The other points connecting segments are included if
--   the slope at the end of a segment is not equal to the slope at
--   the beginning of the next.  The 'toler' parameter is used to
--   control how close the slopes need to be in order to declare them
--   equal.
segmentVertices' :: (Metric v, OrderedField n)
             => n -> Point v n -> [Segment Closed v n] -> [Point v n]
segmentVertices' :: forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
n -> Point v n -> [Segment Closed v n] -> [Point v n]
segmentVertices' n
toler Point v n
p [Segment Closed v n]
ts  =
  case [Point v n]
ps of
    (Point v n
x:Point v n
_:[Point v n]
_) -> Point v n
x Point v n -> [Point v n] -> [Point v n]
forall a. a -> [a] -> [a]
: [Point v n] -> [Bool] -> [Point v n]
forall a. [a] -> [Bool] -> [a]
select (Int -> [Point v n] -> [Point v n]
forall a. Int -> [a] -> [a]
drop Int
1 [Point v n]
ps) [Bool]
ds [Point v n] -> [Point v n] -> [Point v n]
forall a. [a] -> [a] -> [a]
++ [[Point v n] -> Point v n
forall a. HasCallStack => [a] -> a
last [Point v n]
ps]
    [Point v n]
_       -> [Point v n]
ps
    where
      ds :: [Bool]
ds = ((v n, v n) -> (v n, v n) -> Bool)
-> [(v n, v n)] -> [(v n, v n)] -> [Bool]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (v n, v n) -> (v n, v n) -> Bool
far [(v n, v n)]
tans (Int -> [(v n, v n)] -> [(v n, v n)]
forall a. Int -> [a] -> [a]
drop Int
1 [(v n, v n)]
tans)
      tans :: [(v n, v n)]
tans = [(v n -> v n
forall a. Floating a => v a -> v a
forall (f :: * -> *) a. (Metric f, Floating a) => f a -> f a
signorm (v n -> v n)
-> (Segment Closed v n -> v n) -> Segment Closed v n -> v n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Segment Closed v n -> v n
Segment Closed v n -> Vn (Segment Closed v n)
forall t. EndValues (Tangent t) => t -> Vn t
tangentAtStart (Segment Closed v n -> v n) -> Segment Closed v n -> v n
forall a b. (a -> b) -> a -> b
$ Segment Closed v n
s
              ,v n -> v n
forall a. Floating a => v a -> v a
forall (f :: * -> *) a. (Metric f, Floating a) => f a -> f a
signorm (v n -> v n)
-> (Segment Closed v n -> v n) -> Segment Closed v n -> v n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Segment Closed v n -> v n
Segment Closed v n -> Vn (Segment Closed v n)
forall t. EndValues (Tangent t) => t -> Vn t
tangentAtEnd   (Segment Closed v n -> v n) -> Segment Closed v n -> v n
forall a b. (a -> b) -> a -> b
$ Segment Closed v n
s) | Segment Closed v n
s <- [Segment Closed v n]
ts]
      ps :: [Point v n]
ps = (Point v n -> v n -> Point v n)
-> Point v n -> [v n] -> [Point v n]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl Point v n -> v n -> Point v n
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
(.+^) Point v n
p ([v n] -> [Point v n])
-> ([Segment Closed v n] -> [v n])
-> [Segment Closed v n]
-> [Point v n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Segment Closed v n -> v n) -> [Segment Closed v n] -> [v n]
forall a b. (a -> b) -> [a] -> [b]
map Segment Closed v n -> v n
forall (v :: * -> *) n. Segment Closed v n -> v n
segOffset ([Segment Closed v n] -> [Point v n])
-> [Segment Closed v n] -> [Point v n]
forall a b. (a -> b) -> a -> b
$ [Segment Closed v n]
ts
      far :: (v n, v n) -> (v n, v n) -> Bool
far (v n, v n)
p2 (v n, v n)
q2 = v n -> n
forall a. Num a => v a -> a
forall (f :: * -> *) a. (Metric f, Num a) => f a -> a
quadrance ((v n, v n) -> v n
forall a b. (a, b) -> b
snd (v n, v n)
p2 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, v n) -> v n
forall a b. (a, b) -> a
fst (v n, v n)
q2) n -> n -> Bool
forall a. Ord a => a -> a -> Bool
> n
toler

select :: [a] -> [Bool] -> [a]
select :: forall a. [a] -> [Bool] -> [a]
select [a]
xs [Bool]
bs = ((a, Bool) -> a) -> [(a, Bool)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a, Bool) -> a
forall a b. (a, b) -> a
fst ([(a, Bool)] -> [a]) -> [(a, Bool)] -> [a]
forall a b. (a -> b) -> a -> b
$ ((a, Bool) -> Bool) -> [(a, Bool)] -> [(a, Bool)]
forall a. (a -> Bool) -> [a] -> [a]
filter (a, Bool) -> Bool
forall a b. (a, b) -> b
snd ([a] -> [Bool] -> [(a, Bool)]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
xs [Bool]
bs)

-- | Convert a concretely located trail into a list of fixed segments.
--   'unfixTrail' is almost its left inverse.
fixTrail :: (Metric v, OrderedField n)
         => Located (Trail v n) -> [FixedSegment v n]
fixTrail :: forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Located (Trail v n) -> [FixedSegment v n]
fixTrail Located (Trail v n)
t = (Located (Segment Closed v n) -> FixedSegment v n)
-> [Located (Segment Closed v n)] -> [FixedSegment v n]
forall a b. (a -> b) -> [a] -> [b]
map Located (Segment Closed v n) -> FixedSegment v n
forall n (v :: * -> *).
(Num n, Additive v) =>
Located (Segment Closed v n) -> FixedSegment v n
mkFixedSeg (Located (Trail v n) -> [Located (Segment Closed v n)]
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Located (Trail v n) -> [Located (Segment Closed v n)]
trailLocSegments Located (Trail v n)
t)

-- | Convert a list of fixed segments into a located trail.  Note that
--   this may lose information: it throws away the locations of all
--   but the first @FixedSegment@.  This does not matter precisely
--   when each @FixedSegment@ begins where the previous one ends.
--
--   This is almost left inverse to 'fixTrail', that is, @unfixTrail
--   . fixTrail == id@, except for the fact that @unfixTrail@ will
--   never yield a @Loop@.  In the case of a loop, we instead have
--   @glueTrail . unfixTrail . fixTrail == id@.  On the other hand, it
--   is not the case that @fixTrail . unfixTrail == id@ since
--   @unfixTrail@ may lose information.
unfixTrail
  :: (Metric v, Ord n, Floating n)
  => [FixedSegment v n] -> Located (Trail v n)
unfixTrail :: forall (v :: * -> *) n.
(Metric v, Ord n, Floating n) =>
[FixedSegment v n] -> Located (Trail v n)
unfixTrail = ([Segment Closed v n] -> Trail v n)
-> Located [Segment Closed v n] -> Located (Trail v n)
forall a b. SameSpace a b => (a -> b) -> Located a -> Located b
mapLoc [Segment Closed v n] -> Trail v n
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
[Segment Closed v n] -> Trail v n
trailFromSegments (Located [Segment Closed v n] -> Located (Trail v n))
-> ([FixedSegment v n] -> Located [Segment Closed v n])
-> [FixedSegment v n]
-> Located (Trail v n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Located (Segment Closed v n)] -> Located [Segment Closed v n]
forall {a}.
(Additive (V a), Num (N a)) =>
[Located a] -> Located [a]
takeLoc ([Located (Segment Closed v n)] -> Located [Segment Closed v n])
-> ([FixedSegment v n] -> [Located (Segment Closed v n)])
-> [FixedSegment v n]
-> Located [Segment Closed v n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FixedSegment v n -> Located (Segment Closed v n))
-> [FixedSegment v n] -> [Located (Segment Closed v n)]
forall a b. (a -> b) -> [a] -> [b]
map FixedSegment v n -> Located (Segment Closed v n)
forall n (v :: * -> *).
(Num n, Additive v) =>
FixedSegment v n -> Located (Segment Closed v n)
fromFixedSeg
  where
    takeLoc :: [Located a] -> Located [a]
takeLoc []       = [] [a] -> Point (V [a]) (N [a]) -> Located [a]
forall a. a -> Point (V a) (N a) -> Located a
`at` Point (V a) (N a)
Point (V [a]) (N [a])
forall (f :: * -> *) a. (Additive f, Num a) => Point f a
origin
    takeLoc xs :: [Located a]
xs@(Located a
x:[Located a]
_) = (Located a -> a) -> [Located a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map Located a -> a
forall a. Located a -> a
unLoc [Located a]
xs [a] -> Point (V [a]) (N [a]) -> Located [a]
forall a. a -> Point (V a) (N a) -> Located a
`at` Located a -> Point (V a) (N a)
forall a. Located a -> Point (V a) (N a)
loc Located a
x

-- | Convert a concretely located trail into a list of located segments.
trailLocSegments :: (Metric v, OrderedField n)
                  => Located (Trail v n) -> [Located (Segment Closed v n)]
trailLocSegments :: forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Located (Trail v n) -> [Located (Segment Closed v n)]
trailLocSegments Located (Trail v n)
t = (Segment Closed v n -> Point v n -> Located (Segment Closed v n))
-> [Segment Closed v n]
-> [Point v n]
-> [Located (Segment Closed v n)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Segment Closed v n -> Point v n -> Located (Segment Closed v n)
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 (Trail v n -> [Segment Closed v n]
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Trail v n -> [Segment Closed v n]
trailSegments (Located (Trail v n) -> Trail v n
forall a. Located a -> a
unLoc Located (Trail v n)
t)) (Located (Trail v n) -> [Point v n]
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Located (Trail v n) -> [Point v n]
trailPoints Located (Trail v n)
t)

------------------------------------------------------------
--  Modifying trails  --------------------------------------
------------------------------------------------------------

-- | Reverse a trail.  Semantically, if a trail given by a function t
--   from [0,1] to vectors, then the reverse of t is given by t'(s) =
--   t(1-s).  @reverseTrail@ is an involution, that is,
--
--   @
--   reverseTrail . reverseTrail === id
--   @
reverseTrail :: (Metric v, OrderedField n) => Trail v n -> Trail v n
reverseTrail :: forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Trail v n -> Trail v n
reverseTrail = (Trail' Line v n -> Trail' Line v n)
-> (Trail' Loop v n -> Trail' Loop v n) -> Trail v n -> Trail v n
forall (v :: * -> *) n l1 l2.
(Trail' Line v n -> Trail' l1 v n)
-> (Trail' Loop v n -> Trail' l2 v n) -> Trail v n -> Trail v n
onTrail Trail' Line v n -> Trail' Line v n
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Trail' Line v n -> Trail' Line v n
reverseLine Trail' Loop v n -> Trail' Loop v n
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Trail' Loop v n -> Trail' Loop v n
reverseLoop

-- | Reverse a concretely located trail.  The endpoint of the original
--   trail becomes the starting point of the reversed trail, so the
--   original and reversed trails comprise exactly the same set of
--   points.  @reverseLocTrail@ is an involution, /i.e./
--
--   @
--   reverseLocTrail . reverseLocTrail === id
--   @
reverseLocTrail :: (Metric v, OrderedField n)
                => Located (Trail v n) -> Located (Trail v n)
reverseLocTrail :: forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Located (Trail v n) -> Located (Trail v n)
reverseLocTrail (Located (Trail v n)
-> (Point (V (Trail v n)) (N (Trail v n)), Trail v n)
forall a. Located a -> (Point (V a) (N a), a)
viewLoc -> (Point (V (Trail v n)) (N (Trail v n))
p, Trail v n
t)) = Trail v n -> Trail v n
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Trail v n -> Trail v n
reverseTrail Trail v n
t Trail v n
-> Point (V (Trail v n)) (N (Trail v n)) -> Located (Trail v n)
forall a. a -> Point (V a) (N a) -> Located a
`at` (Point v n
Point (V (Trail v n)) (N (Trail 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
.+^ Trail v n -> v n
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Trail v n -> v n
trailOffset Trail v n
t)

-- | Reverse a line.  See 'reverseTrail'.
reverseLine :: (Metric v, OrderedField n)
            => Trail' Line v n -> Trail' Line v n
reverseLine :: forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Trail' Line v n -> Trail' Line v n
reverseLine = ([Segment Closed v n] -> [Segment Closed v n])
-> Trail' Line v n -> Trail' Line v n
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
([Segment Closed v n] -> [Segment Closed v n])
-> Trail' Line v n -> Trail' Line v n
onLineSegments ([Segment Closed v n] -> [Segment Closed v n]
forall a. [a] -> [a]
reverse ([Segment Closed v n] -> [Segment Closed v n])
-> ([Segment Closed v n] -> [Segment Closed v n])
-> [Segment Closed v n]
-> [Segment Closed v n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Segment Closed v n -> Segment Closed v n)
-> [Segment Closed v n] -> [Segment Closed v n]
forall a b. (a -> b) -> [a] -> [b]
map 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 a concretely located line.  See 'reverseLocTrail'.
reverseLocLine :: (Metric v, OrderedField n)
               => Located (Trail' Line v n) -> Located (Trail' Line v n)
reverseLocLine :: forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Located (Trail' Line v n) -> Located (Trail' Line v n)
reverseLocLine (Located (Trail' Line v n)
-> (Point (V (Trail' Line v n)) (N (Trail' Line v n)),
    Trail' Line v n)
forall a. Located a -> (Point (V a) (N a), a)
viewLoc -> (Point (V (Trail' Line v n)) (N (Trail' Line v n))
p,Trail' Line v n
l)) = Trail' Line v n -> Trail' Line v n
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Trail' Line v n -> Trail' Line v n
reverseLine Trail' Line v n
l Trail' Line v n
-> Point (V (Trail' Line v n)) (N (Trail' Line v n))
-> Located (Trail' Line v n)
forall a. a -> Point (V a) (N a) -> Located a
`at` (Point v n
Point (V (Trail' Line v n)) (N (Trail' Line 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
.+^ Trail' Line v n -> v n
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Trail' Line v n -> v n
lineOffset Trail' Line v n
l)

-- | Reverse a loop.  See 'reverseTrail'.
reverseLoop :: (Metric v, OrderedField n)
            => Trail' Loop v n -> Trail' Loop v n
reverseLoop :: forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Trail' Loop v n -> Trail' Loop v n
reverseLoop = Trail' Line v n -> Trail' Loop v n
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Trail' Line v n -> Trail' Loop v n
glueLine (Trail' Line v n -> Trail' Loop v n)
-> (Trail' Loop v n -> Trail' Line v n)
-> Trail' Loop v n
-> Trail' Loop v n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trail' Line v n -> Trail' Line v n
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Trail' Line v n -> Trail' Line v n
reverseLine (Trail' Line v n -> Trail' Line v n)
-> (Trail' Loop v n -> Trail' Line v n)
-> Trail' Loop v n
-> Trail' Line v n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trail' Loop v n -> Trail' Line v n
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Trail' Loop v n -> Trail' Line v n
cutLoop

-- | Reverse a concretely located loop.  See 'reverseLocTrail'.  Note
--   that this is guaranteed to preserve the location.
reverseLocLoop :: (Metric v, OrderedField n)
               => Located (Trail' Loop v n) -> Located (Trail' Loop v n)
reverseLocLoop :: forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Located (Trail' Loop v n) -> Located (Trail' Loop v n)
reverseLocLoop = (Trail' Loop v n -> Trail' Loop v n)
-> Located (Trail' Loop v n) -> Located (Trail' Loop v n)
forall a b. SameSpace a b => (a -> b) -> Located a -> Located b
mapLoc Trail' Loop v n -> Trail' Loop v n
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Trail' Loop v n -> Trail' Loop v n
reverseLoop

-- | Same as 'reverseLine' or 'reverseLoop'.
instance (Metric v, OrderedField n) => Reversing (Trail' l v n) where
  reversing :: Trail' l v n -> Trail' l v n
reversing t :: Trail' l v n
t@(Line SegTree v n
_)   = ([Segment Closed v n] -> [Segment Closed v n])
-> Trail' Line v n -> Trail' Line v n
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
([Segment Closed v n] -> [Segment Closed v n])
-> Trail' Line v n -> Trail' Line v n
onLineSegments ([Segment Closed v n] -> [Segment Closed v n]
forall a. [a] -> [a]
reverse ([Segment Closed v n] -> [Segment Closed v n])
-> ([Segment Closed v n] -> [Segment Closed v n])
-> [Segment Closed v n]
-> [Segment Closed v n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Segment Closed v n -> Segment Closed v n)
-> [Segment Closed v n] -> [Segment Closed v n]
forall a b. (a -> b) -> [a] -> [b]
map Segment Closed v n -> Segment Closed v n
forall t. Reversing t => t -> t
reversing) Trail' l v n
Trail' Line v n
t
  reversing t :: Trail' l v n
t@(Loop SegTree v n
_ Segment Open v n
_) = Trail' Line v n -> Trail' l v n
Trail' Line v n -> Trail' Loop v n
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Trail' Line v n -> Trail' Loop v n
glueLine (Trail' Line v n -> Trail' l v n)
-> (Trail' l v n -> Trail' Line v n)
-> Trail' l v n
-> Trail' l v n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trail' Line v n -> Trail' Line v n
forall t. Reversing t => t -> t
reversing (Trail' Line v n -> Trail' Line v n)
-> (Trail' l v n -> Trail' Line v n)
-> Trail' l v n
-> Trail' Line v n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trail' l v n -> Trail' Line v n
Trail' Loop v n -> Trail' Line v n
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Trail' Loop v n -> Trail' Line v n
cutLoop (Trail' l v n -> Trail' l v n) -> Trail' l v n -> Trail' l v n
forall a b. (a -> b) -> a -> b
$ Trail' l v n
t

-- | Same as 'reverseTrail'.
instance (Metric v, OrderedField n) => Reversing (Trail v n) where
  reversing :: Trail v n -> Trail v n
reversing (Trail Trail' l v n
t) = Trail' l v n -> Trail v n
forall l (v :: * -> *) n. Trail' l v n -> Trail v n
Trail (Trail' l v n -> Trail' l v n
forall t. Reversing t => t -> t
reversing Trail' l v n
t)

-- | Same as 'reverseLocLine' or 'reverseLocLoop'.
instance (Metric v, OrderedField n) => Reversing (Located (Trail' l v n)) where
  reversing :: Located (Trail' l v n) -> Located (Trail' l v n)
reversing l :: Located (Trail' l v n)
l@(Loc Point (V (Trail' l v n)) (N (Trail' l v n))
_ Line {}) = Located (Trail' Line v n) -> Located (Trail' Line v n)
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Located (Trail' Line v n) -> Located (Trail' Line v n)
reverseLocLine Located (Trail' l v n)
Located (Trail' Line v n)
l
  reversing l :: Located (Trail' l v n)
l@(Loc Point (V (Trail' l v n)) (N (Trail' l v n))
_ Loop {}) = Located (Trail' Loop v n) -> Located (Trail' Loop v n)
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Located (Trail' Loop v n) -> Located (Trail' Loop v n)
reverseLocLoop Located (Trail' l v n)
Located (Trail' Loop v n)
l

-- | Same as 'reverseLocTrail'.
instance (Metric v, OrderedField n) => Reversing (Located (Trail v n)) where
  reversing :: Located (Trail v n) -> Located (Trail v n)
reversing = Located (Trail v n) -> Located (Trail v n)
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Located (Trail v n) -> Located (Trail v n)
reverseLocTrail

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

instance (Serialize (v n), OrderedField n, Metric v) => Serialize (Trail v n) where
  {-# INLINE get #-}
  get :: Get (Trail v n)
get = do
    Bool
isLine <- Get Bool
forall t. Serialize t => Get t
Serialize.get
    case Bool
isLine of
      Bool
True  -> do
        SegTree v n
segTree <- Get (SegTree v n)
forall t. Serialize t => Get t
Serialize.get
        Trail v n -> Get (Trail v n)
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (Trail' Line v n -> Trail v n
forall l (v :: * -> *) n. Trail' l v n -> Trail v n
Trail (SegTree v n -> Trail' Line v n
forall (v :: * -> *) n. SegTree v n -> Trail' Line v n
Line SegTree v n
segTree))
      Bool
False -> do
        SegTree v n
segTree <- Get (SegTree v n)
forall t. Serialize t => Get t
Serialize.get
        Segment Open v n
segment <- Get (Segment Open v n)
forall t. Serialize t => Get t
Serialize.get
        Trail v n -> Get (Trail v n)
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (Trail' Loop v n -> Trail v n
forall l (v :: * -> *) n. Trail' l v n -> Trail v n
Trail (SegTree v n -> Segment Open v n -> Trail' Loop v n
forall (v :: * -> *) n.
SegTree v n -> Segment Open v n -> Trail' Loop v n
Loop SegTree v n
segTree Segment Open v n
segment))

  {-# INLINE put #-}
  put :: Putter (Trail v n)
put (Trail (Line SegTree v n
segTree)) = do
    Putter Bool
forall t. Serialize t => Putter t
Serialize.put Bool
True
    Putter (SegTree v n)
forall t. Serialize t => Putter t
Serialize.put SegTree v n
segTree

  put (Trail (Loop SegTree v n
segTree Segment Open v n
segment)) = do
    Putter Bool
forall t. Serialize t => Putter t
Serialize.put Bool
False
    Putter (SegTree v n)
forall t. Serialize t => Putter t
Serialize.put SegTree v n
segTree
    Putter (Segment Open v n)
forall t. Serialize t => Putter t
Serialize.put Segment Open v n
segment

instance (OrderedField n, Metric v, Serialize (v n)) => Serialize (SegTree v n) where
  {-# INLINE put #-}
  put :: Putter (SegTree v n)
put (SegTree FingerTree (SegMeasure v n) (Segment Closed v n)
fingerTree) = Putter [Segment Closed v n]
forall t. Serialize t => Putter t
Serialize.put (FingerTree (SegMeasure v n) (Segment Closed v n)
-> [Segment Closed v n]
forall a. FingerTree (SegMeasure v n) a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList FingerTree (SegMeasure v n) (Segment Closed v n)
fingerTree)

  {-# INLINE get #-}
  get :: Get (SegTree v n)
get = do
    [Segment Closed v n]
fingerTree <- Get [Segment Closed v n]
forall t. Serialize t => Get t
Serialize.get
    SegTree v n -> Get (SegTree v n)
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (FingerTree (SegMeasure v n) (Segment Closed v n) -> SegTree v n
forall (v :: * -> *) n.
FingerTree (SegMeasure v n) (Segment Closed v n) -> SegTree v n
SegTree ([Segment Closed v n]
-> FingerTree (SegMeasure v n) (Segment Closed v n)
forall v a. Measured v a => [a] -> FingerTree v a
FT.fromList [Segment Closed v n]
fingerTree))