    {-# LANGUAGE CPP                        #-}
    {-# LANGUAGE ConstraintKinds            #-}
    {-# LANGUAGE FlexibleContexts           #-}
    {-# LANGUAGE FlexibleInstances          #-}
    {-# LANGUAGE GeneralizedNewtypeDeriving #-}
    {-# LANGUAGE MultiParamTypeClasses      #-}
    {-# LANGUAGE StandaloneDeriving         #-}
    {-# LANGUAGE TypeFamilies               #-}
    {-# LANGUAGE TypeOperators              #-}
    {-# LANGUAGE UndecidableInstances       #-}

    {-# OPTIONS_GHC -fno-warn-unused-imports #-}
      -- for Data.Semigroup import, which becomes redundant under GHC 8.4

    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Diagrams.Core.Trace
    -- Copyright   :  (c) 2012-2015 diagrams-core team (see LICENSE)
    -- License     :  BSD-style (see LICENSE)
    -- Maintainer  :  diagrams-discuss@googlegroups.com
    --
    -- @diagrams-core@ defines the core library of primitives
    -- forming the basis of an embedded domain-specific language for
    -- describing and rendering diagrams.
    --
    -- The @Trace@ module defines a data type and type class for
    -- \"traces\", aka functional boundaries, essentially corresponding to
    -- embedding a raytracer with each diagram.
    --
    -----------------------------------------------------------------------------

    module Diagrams.Core.Trace
           ( -- * SortedList
             SortedList
           , mkSortedList, getSortedList, onSortedList, unsafeOnSortedList

             -- * Traces
           , Trace(Trace)

           , appTrace
           , mkTrace

             -- * Traced class

           , Traced(..)

             -- * Computing with traces

           , traceV, traceP
           , maxTraceV, maxTraceP
           , getRayTrace
           , rayTraceV, rayTraceP
           , maxRayTraceV, maxRayTraceP

           ) where

    #if __GLASGOW_HASKELL__ < 710
    import           Control.Applicative
    #endif
    import           Control.Lens
    import           Data.List               (sort)
    import qualified Data.Map                as M
    import           Data.Semigroup
    import qualified Data.Set                as S

    import           Diagrams.Core.HasOrigin
    import           Diagrams.Core.Transform
    import           Diagrams.Core.V

    import           Linear.Affine
    import           Linear.Vector

    ------------------------------------------------------------
    --  SortedList  --------------------------------------------
    ------------------------------------------------------------

    -- Traces return sorted lists of intersections, so we define a newtype
    -- wrapper to represent sorted lists.

    -- | A newtype wrapper around a list which maintains the invariant
    --   that the list is sorted.  The constructor is not exported; use
    --   the smart constructor 'mkSortedList' (which sorts the given list)
    --   instead.
    newtype SortedList a = SortedList [a]

    -- | A smart constructor for the 'SortedList' type, which sorts the
    --   input to ensure the 'SortedList' invariant.
    mkSortedList :: Ord a => [a] -> SortedList a
    mkSortedList :: forall a. Ord a => [a] -> SortedList a
    mkSortedList = [a] -> SortedList a
    forall a. [a] -> SortedList a
    SortedList ([a] -> SortedList a) -> ([a] -> [a]) -> [a] -> SortedList a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [a] -> [a]
    forall a. Ord a => [a] -> [a]
    sort

    -- | Project the (guaranteed sorted) list out of a 'SortedList'
    --   wrapper.
    getSortedList :: SortedList a -> [a]
    getSortedList :: forall a. SortedList a -> [a]
    getSortedList (SortedList [a]
    as) = [a]
    as

    -- | Apply a list function to a 'SortedList'.  The function need not
    --   result in a sorted list; the result will be sorted before being
    --   rewrapped as a 'SortedList'.
    onSortedList :: Ord b => ([a] -> [b]) -> SortedList a -> SortedList b
    onSortedList :: forall b a. Ord b => ([a] -> [b]) -> SortedList a -> SortedList b
    onSortedList [a] -> [b]
    f = ([a] -> [b]) -> SortedList a -> SortedList b
    forall a b. ([a] -> [b]) -> SortedList a -> SortedList b
    unsafeOnSortedList ([b] -> [b]
    forall a. Ord a => [a] -> [a]
    sort ([b] -> [b]) -> ([a] -> [b]) -> [a] -> [b]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [a] -> [b]
    f)

    -- | Apply an /order-preserving/ list function to a 'SortedList'.  No
    --   sorts or checks are done.
    unsafeOnSortedList :: ([a] -> [b]) -> SortedList a -> SortedList b
    unsafeOnSortedList :: forall a b. ([a] -> [b]) -> SortedList a -> SortedList b
    unsafeOnSortedList [a] -> [b]
    f (SortedList [a]
    as) = [b] -> SortedList b
    forall a. [a] -> SortedList a
    SortedList ([a] -> [b]
    f [a]
    as)

    -- | Merge two sorted lists.  The result is the sorted list containing
    --   all the elements of both input lists (with duplicates).
    merge :: Ord a => SortedList a -> SortedList a -> SortedList a
    merge :: forall a. Ord a => SortedList a -> SortedList a -> SortedList a
    merge (SortedList [a]
    as) (SortedList [a]
    bs) = [a] -> SortedList a
    forall a. [a] -> SortedList a
    SortedList ([a] -> [a] -> [a]
    forall {a}. Ord a => [a] -> [a] -> [a]
    merge' [a]
    as [a]
    bs)
      where
        merge' :: [a] -> [a] -> [a]
    merge' [a]
    xs []         = [a]
    xs
        merge' [] [a]
    ys         = [a]
    ys
        merge' (a
    x:[a]
    xs) (a
    y:[a]
    ys) =
          if a
    x a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    <= a
    y
            then a
    x a -> [a] -> [a]
    forall a. a -> [a] -> [a]
    : [a] -> [a] -> [a]
    merge' [a]
    xs (a
    ya -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :[a]
    ys)
            else a
    y a -> [a] -> [a]
    forall a. a -> [a] -> [a]
    : [a] -> [a] -> [a]
    merge' (a
    xa -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :[a]
    xs) [a]
    ys

    -- | 'SortedList' forms a semigroup with 'merge' as composition.
    instance Ord a => Semigroup (SortedList a) where
      <> :: SortedList a -> SortedList a -> SortedList a
    (<>) = SortedList a -> SortedList a -> SortedList a
    forall a. Ord a => SortedList a -> SortedList a -> SortedList a
    merge

    -- | 'SortedList' forms a monoid with 'merge' and the empty list.
    instance Ord a => Monoid (SortedList a) where
      mappend :: SortedList a -> SortedList a -> SortedList a
    mappend = SortedList a -> SortedList a -> SortedList a
    forall a. Semigroup a => a -> a -> a
    (<>)
      mempty :: SortedList a
    mempty = [a] -> SortedList a
    forall a. [a] -> SortedList a
    SortedList []

    ------------------------------------------------------------
    --  Trace  -------------------------------------------------
    ------------------------------------------------------------

    -- > traceEx = mkTraceDia def

    -- | Every diagram comes equipped with a /trace/.  Intuitively, the
    --   trace for a diagram is like a raytracer: given a line
    --   (represented as a base point and a direction vector), the trace
    --   computes a sorted list of signed distances from the base point to
    --   all intersections of the line with the boundary of the
    --   diagram.
    --
    --   Note that the outputs are not absolute distances, but multipliers
    --   relative to the input vector.  That is, if the base point is @p@
    --   and direction vector is @v@, and one of the output scalars is
    --   @s@, then there is an intersection at the point @p .+^ (s *^ v)@.
    --
    --   <<diagrams/src_Diagrams_Core_Trace_traceEx.svg#diagram=traceEx&width=200>>

    newtype Trace v n = Trace { forall (v :: * -> *) n.
    Trace v n -> Point v n -> v n -> SortedList n
    appTrace :: Point v n -> v n -> SortedList n }

    instance Wrapped (Trace v n) where
      type Unwrapped (Trace v n) = Point v n -> v n -> SortedList n
      _Wrapped' :: Iso' (Trace v n) (Unwrapped (Trace v n))
    _Wrapped' = (Trace v n -> Point v n -> v n -> SortedList n)
    -> ((Point v n -> v n -> SortedList n) -> Trace v n)
    -> Iso
         (Trace v n)
         (Trace v n)
         (Point v n -> v n -> SortedList n)
         (Point v n -> v n -> SortedList n)
    forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
    iso Trace v n -> Point v n -> v n -> SortedList n
    forall (v :: * -> *) n.
    Trace v n -> Point v n -> v n -> SortedList n
    appTrace (Point v n -> v n -> SortedList n) -> Trace v n
    forall (v :: * -> *) n.
    (Point v n -> v n -> SortedList n) -> Trace v n
    Trace

    instance Rewrapped (Trace v n) (Trace v' n')

    mkTrace :: (Point v n -> v n -> SortedList n) -> Trace v n
    mkTrace :: forall (v :: * -> *) n.
    (Point v n -> v n -> SortedList n) -> Trace v n
    mkTrace = (Point v n -> v n -> SortedList n) -> Trace v n
    forall (v :: * -> *) n.
    (Point v n -> v n -> SortedList n) -> Trace v n
    Trace

    -- | Traces form a semigroup with pointwise minimum as composition.
    --   Hence, if @t1@ is the trace for diagram @d1@, and
    --   @e2@ is the trace for @d2@, then @e1 \`mappend\` e2@
    --   is the trace for @d1 \`atop\` d2@.

    deriving instance (Ord n) => Semigroup (Trace v n)

    deriving instance (Ord n) => Monoid (Trace v n)

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

    instance (Additive v, Num n) => HasOrigin (Trace v n) where
      moveOriginTo :: Point (V (Trace v n)) (N (Trace v n)) -> Trace v n -> Trace v n
    moveOriginTo (P V (Trace v n) (N (Trace v n))
    u) = (Unwrapped (Trace v n) -> Trace v n)
    -> Iso' (Trace v n) (Unwrapped (Trace v n))
    forall s. Wrapped s => (Unwrapped s -> s) -> Iso' s (Unwrapped s)
    _Wrapping' Unwrapped (Trace v n) -> Trace v n
    (Point v n -> v n -> SortedList n) -> Trace v n
    forall (v :: * -> *) n.
    (Point v n -> v n -> SortedList n) -> Trace v n
    Trace (((Point v n -> v n -> SortedList n)
      -> Identity (Point v n -> v n -> SortedList n))
     -> Trace v n -> Identity (Trace v n))
    -> ((Point v n -> v n -> SortedList n)
        -> Point v n -> v n -> SortedList n)
    -> Trace v n
    -> Trace v n
    forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
    %~ \Point v n -> v n -> SortedList n
    f Point v n
    p -> Point v n -> v n -> SortedList n
    f (Point 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
    .+^ Diff (Point v) n
    V (Trace v n) (N (Trace v n))
    u)

    instance Show (Trace v n) where
      show :: Trace v n -> String
    show Trace v n
    _ = String
    "<trace>"

    ------------------------------------------------------------
    --  Transforming traces  -----------------------------------
    ------------------------------------------------------------

    instance (Additive v, Num n) => Transformable (Trace v n) where
      transform :: Transformation (V (Trace v n)) (N (Trace v n))
    -> Trace v n -> Trace v n
    transform Transformation (V (Trace v n)) (N (Trace v n))
    t = (Unwrapped (Trace v n) -> Identity (Unwrapped (Trace v n)))
    -> Trace v n -> Identity (Trace v n)
    ((Point v n -> v n -> SortedList n)
     -> Identity (Point v n -> v n -> SortedList n))
    -> Trace v n -> Identity (Trace v n)
    forall s t. Rewrapping s t => Iso s t (Unwrapped s) (Unwrapped t)
    Iso
      (Trace v n)
      (Trace v n)
      (Unwrapped (Trace v n))
      (Unwrapped (Trace v n))
    _Wrapped (((Point v n -> v n -> SortedList n)
      -> Identity (Point v n -> v n -> SortedList n))
     -> Trace v n -> Identity (Trace v n))
    -> ((Point v n -> v n -> SortedList n)
        -> Point v n -> v n -> SortedList n)
    -> Trace v n
    -> Trace v n
    forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
    %~ \Point v n -> v n -> SortedList n
    f Point v n
    p v n
    v -> Point v n -> v n -> SortedList n
    f (Transformation v n -> Point v n -> Point v n
    forall (v :: * -> *) n.
    (Additive v, Num n) =>
    Transformation v n -> Point v n -> Point v n
    papply (Transformation v n -> Transformation v n
    forall (v :: * -> *) n.
    (Functor v, Num n) =>
    Transformation v n -> Transformation v n
    inv Transformation v n
    Transformation (V (Trace v n)) (N (Trace v n))
    t) Point v n
    p) (Transformation v n -> v n -> v n
    forall (v :: * -> *) n. Transformation v n -> v n -> v n
    apply (Transformation v n -> Transformation v n
    forall (v :: * -> *) n.
    (Functor v, Num n) =>
    Transformation v n -> Transformation v n
    inv Transformation v n
    Transformation (V (Trace v n)) (N (Trace v n))
    t) v n
    v)

    ------------------------------------------------------------
    --  Traced class  ------------------------------------------
    ------------------------------------------------------------

    -- | @Traced@ abstracts over things which have a trace.
    class (Additive (V a), Ord (N a)) => Traced a where

      -- | Compute the trace of an object.
      getTrace :: a -> Trace (V a) (N a)

    instance (Additive v, Ord n) => Traced (Trace v n) where
      getTrace :: Trace v n -> Trace (V (Trace v n)) (N (Trace v n))
    getTrace = Trace v n -> Trace v n
    Trace v n -> Trace (V (Trace v n)) (N (Trace v n))
    forall a. a -> a
    id

    -- | The trace of a single point is the empty trace, /i.e./ the one
    --   which returns no intersection points for every query.  Arguably
    --   it should return a single finite distance for vectors aimed
    --   directly at the given point, but due to floating-point inaccuracy
    --   this is problematic.  Note that the envelope for a single point
    --   is /not/ the empty envelope (see "Diagrams.Core.Envelope").
    instance (Additive v, Ord n) => Traced (Point v n) where
      getTrace :: Point v n -> Trace (V (Point v n)) (N (Point v n))
    getTrace = Trace v n -> Point v n -> Trace v n
    forall a b. a -> b -> a
    const Trace v n
    forall a. Monoid a => a
    mempty

    instance Traced t => Traced (TransInv t) where
      getTrace :: TransInv t -> Trace (V (TransInv t)) (N (TransInv t))
    getTrace = t -> Trace (V t) (N t)
    forall a. Traced a => a -> Trace (V a) (N a)
    getTrace (t -> Trace (V t) (N t))
    -> (TransInv t -> t) -> TransInv t -> Trace (V t) (N t)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Unwrapped (TransInv t) -> TransInv t)
    -> TransInv t -> Unwrapped (TransInv t)
    forall s. Wrapped s => (Unwrapped s -> s) -> s -> Unwrapped s
    op t -> TransInv t
    Unwrapped (TransInv t) -> TransInv t
    forall t. t -> TransInv t
    TransInv

    instance (Traced a, Traced b, SameSpace a b) => Traced (a,b) where
      getTrace :: (a, b) -> Trace (V (a, b)) (N (a, b))
    getTrace (a
    x,b
    y) = a -> Trace (V a) (N a)
    forall a. Traced a => a -> Trace (V a) (N a)
    getTrace a
    x Trace (V b) (N b) -> Trace (V b) (N b) -> Trace (V b) (N b)
    forall a. Semigroup a => a -> a -> a
    <> b -> Trace (V b) (N b)
    forall a. Traced a => a -> Trace (V a) (N a)
    getTrace b
    y

    instance (Traced b) => Traced [b] where
      getTrace :: [b] -> Trace (V [b]) (N [b])
    getTrace = [Trace (V b) (N b)] -> Trace (V b) (N b)
    forall a. Monoid a => [a] -> a
    mconcat ([Trace (V b) (N b)] -> Trace (V b) (N b))
    -> ([b] -> [Trace (V b) (N b)]) -> [b] -> Trace (V b) (N b)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (b -> Trace (V b) (N b)) -> [b] -> [Trace (V b) (N b)]
    forall a b. (a -> b) -> [a] -> [b]
    map b -> Trace (V b) (N b)
    forall a. Traced a => a -> Trace (V a) (N a)
    getTrace

    instance (Traced b) => Traced (M.Map k b) where
      getTrace :: Map k b -> Trace (V (Map k b)) (N (Map k b))
    getTrace = [Trace (V b) (N b)] -> Trace (V b) (N b)
    forall a. Monoid a => [a] -> a
    mconcat ([Trace (V b) (N b)] -> Trace (V b) (N b))
    -> (Map k b -> [Trace (V b) (N b)]) -> Map k b -> Trace (V b) (N b)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (b -> Trace (V b) (N b)) -> [b] -> [Trace (V b) (N b)]
    forall a b. (a -> b) -> [a] -> [b]
    map b -> Trace (V b) (N b)
    forall a. Traced a => a -> Trace (V a) (N a)
    getTrace ([b] -> [Trace (V b) (N b)])
    -> (Map k b -> [b]) -> Map k b -> [Trace (V b) (N b)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Map k b -> [b]
    forall k a. Map k a -> [a]
    M.elems

    instance (Traced b) => Traced (S.Set b) where
      getTrace :: Set b -> Trace (V (Set b)) (N (Set b))
    getTrace = [Trace (V b) (N b)] -> Trace (V b) (N b)
    forall a. Monoid a => [a] -> a
    mconcat ([Trace (V b) (N b)] -> Trace (V b) (N b))
    -> (Set b -> [Trace (V b) (N b)]) -> Set b -> Trace (V b) (N b)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (b -> Trace (V b) (N b)) -> [b] -> [Trace (V b) (N b)]
    forall a b. (a -> b) -> [a] -> [b]
    map b -> Trace (V b) (N b)
    forall a. Traced a => a -> Trace (V a) (N a)
    getTrace ([b] -> [Trace (V b) (N b)])
    -> (Set b -> [b]) -> Set b -> [Trace (V b) (N b)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Set b -> [b]
    forall a. Set a -> [a]
    S.elems

    ------------------------------------------------------------
    --  Computing with traces  ---------------------------------
    ------------------------------------------------------------

    -- | Compute the vector from the given point @p@ to the \"smallest\"
    --   boundary intersection along the given vector @v@.  The
    --   \"smallest\" boundary intersection is defined as the one given by
    --   @p .+^ (s *^ v)@ for the smallest (most negative) value of
    --   @s@. Return @Nothing@ if there is no intersection.  See also
    --   'traceP'.
    --
    --   See also 'rayTraceV' which uses the smallest /positive/
    --   intersection, which is often more intuitive behavior.
    --
    --   <<diagrams/src_Diagrams_Core_Trace_traceVEx.svg#diagram=traceVEx&width=600>>
    traceV :: (n ~ N a, Num n, Traced a) => Point (V a) n -> V a n -> a -> Maybe (V a n)
    traceV :: forall n a.
    (n ~ N a, Num n, Traced a) =>
    Point (V a) n -> V a n -> a -> Maybe (V a n)
    traceV Point (V a) n
    p V a n
    v a
    a = case SortedList n -> [n]
    forall a. SortedList a -> [a]
    getSortedList (SortedList n -> [n]) -> SortedList n -> [n]
    forall a b. (a -> b) -> a -> b
    $ (Unwrapped (Trace (V a) n) -> Trace (V a) n)
    -> Trace (V a) n -> Unwrapped (Trace (V a) n)
    forall s. Wrapped s => (Unwrapped s -> s) -> s -> Unwrapped s
    op Unwrapped (Trace (V a) n) -> Trace (V a) n
    (Point (V a) n -> V a n -> SortedList n) -> Trace (V a) n
    forall (v :: * -> *) n.
    (Point v n -> v n -> SortedList n) -> Trace v n
    Trace (a -> Trace (V a) (N a)
    forall a. Traced a => a -> Trace (V a) (N a)
    getTrace a
    a) Point (V a) n
    p V a n
    v of
                     (n
    s:[n]
    _) -> V a n -> Maybe (V a n)
    forall a. a -> Maybe a
    Just (n
    s n -> V a n -> V a n
    forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
    *^ V a n
    v)
                     []    -> Maybe (V a n)
    forall a. Maybe a
    Nothing

    -- > traceVEx = mkTraceDiasABC def { drawV = True, sFilter = take 1 }

    -- | Compute the \"smallest\" boundary point along the line determined
    --   by the given point @p@ and vector @v@.  The \"smallest\" boundary
    --   point is defined as the one given by @p .+^ (s *^ v)@ for
    --   the smallest (most negative) value of @s@. Return @Nothing@ if
    --   there is no such boundary point.  See also 'traceV'.
    --
    --   See also 'rayTraceP' which uses the smallest /positive/
    --   intersection, which is often more intuitive behavior.
    --
    --   <<diagrams/src_Diagrams_Core_Trace_tracePEx.svg#diagram=tracePEx&width=600>>
    traceP :: (n ~ N a, Traced a, Num n) => Point (V a) n -> V a n -> a -> Maybe (Point (V a) n)
    traceP :: forall n a.
    (n ~ N a, Traced a, Num n) =>
    Point (V a) n -> V a n -> a -> Maybe (Point (V a) n)
    traceP Point (V a) n
    p V a n
    v a
    a = (Point (V a) n
    p Point (V a) n -> Diff (Point (V a)) n -> Point (V a) n
    forall a.
    Num a =>
    Point (V a) a -> Diff (Point (V a)) a -> Point (V a) a
    forall (p :: * -> *) a. (Affine p, Num a) => p a -> Diff p a -> p a
    .+^) (V a n -> Point (V a) n) -> Maybe (V a n) -> Maybe (Point (V a) n)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Point (V a) n -> V a n -> a -> Maybe (V a n)
    forall n a.
    (n ~ N a, Num n, Traced a) =>
    Point (V a) n -> V a n -> a -> Maybe (V a n)
    traceV Point (V a) n
    p V a n
    v a
    a

    -- > tracePEx = mkTraceDiasABC def { sFilter = take 1 }

    -- | Like 'traceV', but computes a vector to the \"largest\" boundary
    --   point instead of the smallest. (Note, however, the \"largest\"
    --   boundary point may still be in the opposite direction from the
    --   given vector, if all the boundary points are, as in the third
    --   example shown below.)
    --
    --   <<diagrams/src_Diagrams_Core_Trace_maxTraceVEx.svg#diagram=maxTraceVEx&width=600>>
    maxTraceV :: (n ~ N a, Num n, Traced a) => Point (V a) n -> V a n -> a -> Maybe (V a n)
    maxTraceV :: forall n a.
    (n ~ N a, Num n, Traced a) =>
    Point (V a) n -> V a n -> a -> Maybe (V a n)
    maxTraceV Point (V a) n
    p = Point (V a) n -> V a n -> a -> Maybe (V a n)
    forall n a.
    (n ~ N a, Num n, Traced a) =>
    Point (V a) n -> V a n -> a -> Maybe (V a n)
    traceV Point (V a) n
    p (V a n -> a -> Maybe (V a n))
    -> (V a n -> V a n) -> V a n -> a -> Maybe (V a n)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . V a n -> V a n
    forall (f :: * -> *) a. (Functor f, Num a) => f a -> f a
    negated

    -- > maxTraceVEx = mkTraceDiasABC def { drawV = True, sFilter = dropAllBut1 }

    -- | Like 'traceP', but computes the \"largest\" boundary point
    --   instead of the smallest. (Note, however, the \"largest\" boundary
    --   point may still be in the opposite direction from the given
    --   vector, if all the boundary points are.)
    --
    --   <<diagrams/src_Diagrams_Core_Trace_maxTracePEx.svg#diagram=maxTracePEx&width=600>>
    maxTraceP :: (n ~ N a, Num n, Traced a) => Point (V a) n -> V a n -> a -> Maybe (Point (V a) n)
    maxTraceP :: forall n a.
    (n ~ N a, Num n, Traced a) =>
    Point (V a) n -> V a n -> a -> Maybe (Point (V a) n)
    maxTraceP Point (V a) n
    p V a n
    v a
    a = (Point (V a) n
    p Point (V a) n -> Diff (Point (V a)) n -> Point (V a) n
    forall a.
    Num a =>
    Point (V a) a -> Diff (Point (V a)) a -> Point (V a) a
    forall (p :: * -> *) a. (Affine p, Num a) => p a -> Diff p a -> p a
    .+^) (V a n -> Point (V a) n) -> Maybe (V a n) -> Maybe (Point (V a) n)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Point (V a) n -> V a n -> a -> Maybe (V a n)
    forall n a.
    (n ~ N a, Num n, Traced a) =>
    Point (V a) n -> V a n -> a -> Maybe (V a n)
    maxTraceV Point (V a) n
    p V a n
    v a
    a

    -- > maxTracePEx = mkTraceDiasABC def { sFilter = dropAllBut1 }

    -- | Get a modified 'Trace' for an object which only returns positive
    --   boundary points, /i.e./ those boundary points given by a positive
    --   scalar multiple of the direction vector.  Note, this property
    --   will be destroyed if the resulting 'Trace' is translated at all.
    getRayTrace :: (n ~ N a, Traced a, Num n) => a -> Trace (V a) n
    getRayTrace :: forall n a. (n ~ N a, Traced a, Num n) => a -> Trace (V a) n
    getRayTrace a
    a = (Point (V a) n -> V a n -> SortedList n) -> Trace (V a) n
    forall (v :: * -> *) n.
    (Point v n -> v n -> SortedList n) -> Trace v n
    Trace ((Point (V a) n -> V a n -> SortedList n) -> Trace (V a) n)
    -> (Point (V a) n -> V a n -> SortedList n) -> Trace (V a) n
    forall a b. (a -> b) -> a -> b
    $ \Point (V a) n
    p V a n
    v -> ([n] -> [n]) -> SortedList n -> SortedList n
    forall a b. ([a] -> [b]) -> SortedList a -> SortedList b
    unsafeOnSortedList ((n -> Bool) -> [n] -> [n]
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile (n -> n -> Bool
    forall a. Ord a => a -> a -> Bool
    <n
    0)) (SortedList n -> SortedList n) -> SortedList n -> SortedList n
    forall a b. (a -> b) -> a -> b
    $ Trace (V a) n -> Point (V a) n -> V a n -> SortedList n
    forall (v :: * -> *) n.
    Trace v n -> Point v n -> v n -> SortedList n
    appTrace (a -> Trace (V a) (N a)
    forall a. Traced a => a -> Trace (V a) (N a)
    getTrace a
    a) Point (V a) n
    p V a n
    v

    -- | Compute the vector from the given point to the closest boundary
    --   point of the given object in the given direction, or @Nothing@ if
    --   there is no such boundary point (as in the third example
    --   below). Note that unlike 'traceV', only /positive/ boundary
    --   points are considered, /i.e./ boundary points corresponding to a
    --   positive scalar multiple of the direction vector.  This is
    --   intuitively the \"usual\" behavior of a raytracer, which only
    --   considers intersections \"in front of\" the camera.  Compare the
    --   second example diagram below with the second example shown for
    --   'traceV'.
    --
    --   <<diagrams/src_Diagrams_Core_Trace_rayTraceVEx.svg#diagram=rayTraceVEx&width=600>>
    rayTraceV :: (n ~ N a, Traced a, Num n)
               => Point (V a) n -> V a n -> a -> Maybe (V a n)
    rayTraceV :: forall n a.
    (n ~ N a, Traced a, Num n) =>
    Point (V a) n -> V a n -> a -> Maybe (V a n)
    rayTraceV Point (V a) n
    p V a n
    v a
    a = case SortedList n -> [n]
    forall a. SortedList a -> [a]
    getSortedList (SortedList n -> [n]) -> SortedList n -> [n]
    forall a b. (a -> b) -> a -> b
    $ (Unwrapped (Trace (V a) n) -> Trace (V a) n)
    -> Trace (V a) n -> Unwrapped (Trace (V a) n)
    forall s. Wrapped s => (Unwrapped s -> s) -> s -> Unwrapped s
    op Unwrapped (Trace (V a) n) -> Trace (V a) n
    (Point (V a) n -> V a n -> SortedList n) -> Trace (V a) n
    forall (v :: * -> *) n.
    (Point v n -> v n -> SortedList n) -> Trace v n
    Trace (a -> Trace (V a) n
    forall n a. (n ~ N a, Traced a, Num n) => a -> Trace (V a) n
    getRayTrace a
    a) Point (V a) n
    p V a n
    v of
                     (n
    s:[n]
    _) -> V a n -> Maybe (V a n)
    forall a. a -> Maybe a
    Just (n
    s n -> V a n -> V a n
    forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
    *^ V a n
    v)
                     []    -> Maybe (V a n)
    forall a. Maybe a
    Nothing

    -- > rayTraceVEx = mkTraceDiasABC def { drawV = True, sFilter = take 1 . filter (>0) }

    -- | Compute the boundary point on an object which is closest to the
    --   given base point in the given direction, or @Nothing@ if there is
    --   no such boundary point. Note that unlike 'traceP', only /positive/
    --   boundary points are considered, /i.e./ boundary points
    --   corresponding to a positive scalar multiple of the direction
    --   vector.  This is intuitively the \"usual\" behavior of a raytracer,
    --   which only considers intersection points \"in front of\" the
    --   camera.
    --
    --   <<diagrams/src_Diagrams_Core_Trace_rayTracePEx.svg#diagram=rayTracePEx&width=600>>
    rayTraceP :: (n ~ N a, Traced a, Num n)
               => Point (V a) n -> V a n -> a -> Maybe (Point (V a) n)
    rayTraceP :: forall n a.
    (n ~ N a, Traced a, Num n) =>
    Point (V a) n -> V a n -> a -> Maybe (Point (V a) n)
    rayTraceP Point (V a) n
    p V a n
    v a
    a = (Point (V a) n
    p Point (V a) n -> Diff (Point (V a)) n -> Point (V a) n
    forall a.
    Num a =>
    Point (V a) a -> Diff (Point (V a)) a -> Point (V a) a
    forall (p :: * -> *) a. (Affine p, Num a) => p a -> Diff p a -> p a
    .+^) (V a n -> Point (V a) n) -> Maybe (V a n) -> Maybe (Point (V a) n)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Point (V a) n -> V a n -> a -> Maybe (V a n)
    forall n a.
    (n ~ N a, Traced a, Num n) =>
    Point (V a) n -> V a n -> a -> Maybe (V a n)
    rayTraceV Point (V a) n
    p V a n
    v a
    a

    -- > rayTracePEx = mkTraceDiasABC def { sFilter = take 1 . filter (>0) }

    -- | Like 'rayTraceV', but computes a vector to the \"largest\"
    --   boundary point instead of the smallest.  Considers only
    --   /positive/ boundary points.
    --
    --   <<diagrams/src_Diagrams_Core_Trace_maxRayTraceVEx.svg#diagram=maxRayTraceVEx&width=600>>
    maxRayTraceV :: (n ~ N a, Traced a, Num n)
                  => Point (V a) n -> V a n -> a -> Maybe (V a n)
    maxRayTraceV :: forall n a.
    (n ~ N a, Traced a, Num n) =>
    Point (V a) n -> V a n -> a -> Maybe (V a n)
    maxRayTraceV Point (V a) n
    p V a n
    v a
    a =
      case SortedList n -> [n]
    forall a. SortedList a -> [a]
    getSortedList (SortedList n -> [n]) -> SortedList n -> [n]
    forall a b. (a -> b) -> a -> b
    $ (Unwrapped (Trace (V a) n) -> Trace (V a) n)
    -> Trace (V a) n -> Unwrapped (Trace (V a) n)
    forall s. Wrapped s => (Unwrapped s -> s) -> s -> Unwrapped s
    op Unwrapped (Trace (V a) n) -> Trace (V a) n
    (Point (V a) n -> V a n -> SortedList n) -> Trace (V a) n
    forall (v :: * -> *) n.
    (Point v n -> v n -> SortedList n) -> Trace v n
    Trace (a -> Trace (V a) n
    forall n a. (n ~ N a, Traced a, Num n) => a -> Trace (V a) n
    getRayTrace a
    a) Point (V a) n
    p V a n
    v of
        [] -> Maybe (V a n)
    forall a. Maybe a
    Nothing
        [n]
    xs -> V a n -> Maybe (V a n)
    forall a. a -> Maybe a
    Just ([n] -> n
    forall a. HasCallStack => [a] -> a
    last [n]
    xs n -> V a n -> V a n
    forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
    *^ V a n
    v)

    -- > maxRayTraceVEx = mkTraceDiasABC def { drawV = True, sFilter = dropAllBut1 . filter (>0) }

    -- | Like 'rayTraceP', but computes the \"largest\" boundary point
    --   instead of the smallest.  Considers only /positive/ boundary
    --   points.
    --
    --   <<diagrams/src_Diagrams_Core_Trace_maxRayTracePEx.svg#diagram=maxRayTracePEx&width=600>>
    maxRayTraceP :: (n ~ N a, Traced a, Num n)
                  => Point (V a) n -> V a n -> a -> Maybe (Point (V a) n)
    maxRayTraceP :: forall n a.
    (n ~ N a, Traced a, Num n) =>
    Point (V a) n -> V a n -> a -> Maybe (Point (V a) n)
    maxRayTraceP Point (V a) n
    p V a n
    v a
    a = (Point (V a) n
    p Point (V a) n -> Diff (Point (V a)) n -> Point (V a) n
    forall a.
    Num a =>
    Point (V a) a -> Diff (Point (V a)) a -> Point (V a) a
    forall (p :: * -> *) a. (Affine p, Num a) => p a -> Diff p a -> p a
    .+^) (V a n -> Point (V a) n) -> Maybe (V a n) -> Maybe (Point (V a) n)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Point (V a) n -> V a n -> a -> Maybe (V a n)
    forall n a.
    (n ~ N a, Traced a, Num n) =>
    Point (V a) n -> V a n -> a -> Maybe (V a n)
    maxRayTraceV Point (V a) n
    p V a n
    v a
    a

    -- > maxRayTracePEx = mkTraceDiasABC def { sFilter = dropAllBut1 . filter (>0) }

    ------------------------------------------------------------
    -- Drawing trace diagrams
    ------------------------------------------------------------

    -- > import Data.Default.Class
    -- > import Control.Lens ((^.))
    -- > import Data.Maybe (fromMaybe)
    -- >
    -- > thingyT :: Trail V2 Double
    -- > thingyT =
    -- >   fromOffsets
    -- >     [ 3 *^ unitX, 3 *^ unitY, 2 *^ unit_X, 1 *^ unit_Y
    -- >     , 1 *^ unitX, 1 *^ unit_Y, 2 *^ unit_X, 1 *^ unit_Y ]
    -- >
    -- > thingy = strokeTrail thingyT
    -- >
    -- > data TraceDiaOpts
    -- >   = TDO { traceShape :: Diagram B
    -- >         , basePt     :: P2 Double
    -- >         , dirV       :: V2 Double
    -- >         , sFilter    :: [Double] -> [Double]
    -- >         , drawV      :: Bool
    -- >         }
    -- >
    -- > instance Default TraceDiaOpts where
    -- >   def = TDO { traceShape = thingy
    -- >             , basePt     = pointB
    -- >             , dirV       = 0.3 ^& 0.5
    -- >             , sFilter    = id
    -- >             , drawV      = False
    -- >             }
    -- >
    -- > pointA = 1 ^& (-1.5)
    -- > pointB = 1 ^& 1.2
    -- > pointC = 2.5 ^& 3.5
    -- >
    -- > dot' = circle 0.05 # lw none
    -- >
    -- > mkTraceDia :: TraceDiaOpts -> Diagram B
    -- > mkTraceDia tdo = mconcat
    -- >   [ mconcat $ map (place (dot' # fc red)) pts
    -- >   , if drawV tdo then resultArrow else mempty
    -- >   , arrowAt (basePt tdo) (dirV tdo) # lc blue
    -- >   , dot' # fc blue # moveTo (basePt tdo)
    -- >   , traceLine (basePt tdo) maxPosPt
    -- >   , traceLine (basePt tdo) minNegPt
    -- >   , traceShape tdo
    -- >   ]
    -- >   # centerXY # pad 1.1
    -- >   where
    -- >     ss  = sFilter tdo . getSortedList
    -- >         $ appTrace (traceShape tdo ^. trace) (basePt tdo) (dirV tdo)
    -- >     pts = map mkPt ss
    -- >     mkPt s = basePt tdo .+^ (s *^ dirV tdo)
    -- >     maxPosPt = (mkPt <$>) . safeLast $ filter (>0) ss
    -- >     minNegPt = (mkPt <$>) . safeHead $ filter (<0) ss
    -- >     minPt = (mkPt <$>) . safeHead $ ss
    -- >     resultArrow = fromMaybe mempty (arrowBetween (basePt tdo) <$> minPt)
    -- >       # lc green
    -- >
    -- > safeLast [] = Nothing
    -- > safeLast xs = Just $ last xs
    -- > safeHead [] = Nothing
    -- > safeHead (x:_) = Just x
    -- > dropAllBut1 [] = []
    -- > dropAllBut1 xs = [last xs]
    -- >
    -- > traceLine _ Nothing = mempty
    -- > traceLine p (Just q) = (p ~~ q) # dashingG [0.1,0.1] 0
    -- >
    -- > mkTraceDias :: [TraceDiaOpts] -> Diagram B
    -- > mkTraceDias = hcat' (with & sep .~ 1) . map mkTraceDia
    -- >
    -- > mkTraceDiasABC :: TraceDiaOpts -> Diagram B
    -- > mkTraceDiasABC tdo = mkTraceDias (map (\p -> tdo { basePt = p }) [pointA, pointB, pointC])