{-# 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 = forall a. [a] -> SortedList a
SortedList forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a b. ([a] -> [b]) -> SortedList a -> SortedList b
unsafeOnSortedList (forall a. Ord a => [a] -> [a]
sort 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) = 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) = forall a. [a] -> SortedList a
SortedList (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 forall a. Ord a => a -> a -> Bool
<= a
y
        then a
x forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
merge' [a]
xs (a
yforall a. a -> [a] -> [a]
:[a]
ys)
        else a
y forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
merge' (a
xforall 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
(<>) = 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 = forall a. Semigroup a => a -> a -> a
(<>)
  mempty :: SortedList a
mempty = 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' = forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso forall (v :: * -> *) n.
Trace v n -> Point v n -> v n -> SortedList n
appTrace 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 = 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) = forall s. Wrapped s => (Unwrapped s -> s) -> Iso' s (Unwrapped s)
_Wrapping' forall (v :: * -> *) n.
(Point v n -> v n -> SortedList n) -> Trace v n
Trace 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 forall (p :: * -> *) a. (Affine p, Num a) => p a -> Diff p a -> p a
.+^ 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 = forall s t. Rewrapping s t => Iso s t (Unwrapped s) (Unwrapped t)
_Wrapped 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 (forall (v :: * -> *) n.
(Additive v, Num n) =>
Transformation v n -> Point v n -> Point v n
papply (forall (v :: * -> *) n.
(Functor v, Num n) =>
Transformation v n -> Transformation v n
inv Transformation (V (Trace v n)) (N (Trace v n))
t) Point v n
p) (forall (v :: * -> *) n. Transformation v n -> v n -> v n
apply (forall (v :: * -> *) n.
(Functor v, Num n) =>
Transformation v n -> Transformation v n
inv 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 = 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 = forall a b. a -> b -> a
const forall a. Monoid a => a
mempty

instance Traced t => Traced (TransInv t) where
  getTrace :: TransInv t -> Trace (V (TransInv t)) (N (TransInv t))
getTrace = forall a. Traced a => a -> Trace (V a) (N a)
getTrace forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. Wrapped s => (Unwrapped s -> s) -> s -> Unwrapped s
op 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) = forall a. Traced a => a -> Trace (V a) (N a)
getTrace a
x forall a. Semigroup a => a -> a -> a
<> 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 = forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map 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 = forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. Traced a => a -> Trace (V a) (N a)
getTrace forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. Traced a => a -> Trace (V a) (N a)
getTrace forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall a. SortedList a -> [a]
getSortedList forall a b. (a -> b) -> a -> b
$ forall s. Wrapped s => (Unwrapped s -> s) -> s -> Unwrapped s
op forall (v :: * -> *) n.
(Point v n -> v n -> SortedList n) -> Trace v n
Trace (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]
_) -> forall a. a -> Maybe a
Just (n
s forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ V a n
v)
                 []    -> 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 forall (p :: * -> *) a. (Affine p, Num a) => p a -> Diff p a -> p a
.+^) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 = 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall (p :: * -> *) a. (Affine p, Num a) => p a -> Diff p a -> p a
.+^) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 = forall (v :: * -> *) n.
(Point v n -> v n -> SortedList n) -> Trace v n
Trace forall a b. (a -> b) -> a -> b
$ \Point (V a) n
p V a n
v -> forall a b. ([a] -> [b]) -> SortedList a -> SortedList b
unsafeOnSortedList (forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Ord a => a -> a -> Bool
<n
0)) forall a b. (a -> b) -> a -> b
$ forall (v :: * -> *) n.
Trace v n -> Point v n -> v n -> SortedList n
appTrace (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 forall a. SortedList a -> [a]
getSortedList forall a b. (a -> b) -> a -> b
$ forall s. Wrapped s => (Unwrapped s -> s) -> s -> Unwrapped s
op forall (v :: * -> *) n.
(Point v n -> v n -> SortedList n) -> Trace v n
Trace (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]
_) -> forall a. a -> Maybe a
Just (n
s forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ V a n
v)
                 []    -> 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 forall (p :: * -> *) a. (Affine p, Num a) => p a -> Diff p a -> p a
.+^) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 forall a. SortedList a -> [a]
getSortedList forall a b. (a -> b) -> a -> b
$ forall s. Wrapped s => (Unwrapped s -> s) -> s -> Unwrapped s
op forall (v :: * -> *) n.
(Point v n -> v n -> SortedList n) -> Trace v n
Trace (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
    [] -> forall a. Maybe a
Nothing
    [n]
xs -> forall a. a -> Maybe a
Just (forall a. [a] -> a
last [n]
xs 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 forall (p :: * -> *) a. (Affine p, Num a) => p a -> Diff p a -> p a
.+^) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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])