content: {-# 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 = SortedList . sort
  
  -- | Project the (guaranteed sorted) list out of a 'SortedList'
  --   wrapper.
  getSortedList :: SortedList a -> [a]
  getSortedList (SortedList as) = 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 f = unsafeOnSortedList (sort . f)
  
  -- | Apply an /order-preserving/ list function to a 'SortedList'.  No
  --   sorts or checks are done.
  unsafeOnSortedList :: ([a] -> [b]) -> SortedList a -> SortedList b
  unsafeOnSortedList f (SortedList as) = SortedList (f 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 (SortedList as) (SortedList bs) = SortedList (merge' as bs)
    where
      merge' xs []         = xs
      merge' [] ys         = ys
      merge' (x:xs) (y:ys) =
        if x <= y
          then x : merge' xs (y:ys)
          else y : merge' (x:xs) ys
  
  -- | 'SortedList' forms a semigroup with 'merge' as composition.
  instance Ord a => Semigroup (SortedList a) where
    (<>) = merge
  
  -- | 'SortedList' forms a monoid with 'merge' and the empty list.
  instance Ord a => Monoid (SortedList a) where
    mappend = (<>)
    mempty = 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 { 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 appTrace Trace
  
  instance Rewrapped (Trace v n) (Trace v' n')
  
  mkTrace :: (Point v n -> v n -> SortedList n) -> Trace v n
  mkTrace = 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 (P u) = _Wrapping' Trace %~ \f p -> f (p .+^ u)
  
  instance Show (Trace v n) where
    show _ = "<trace>"
  
  ------------------------------------------------------------
  --  Transforming traces  -----------------------------------
  ------------------------------------------------------------
  
  instance (Additive v, Num n) => Transformable (Trace v n) where
    transform t = _Wrapped %~ \f p v -> f (papply (inv t) p) (apply (inv t) 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 = 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 = const mempty
  
  instance Traced t => Traced (TransInv t) where
    getTrace = getTrace . op TransInv
  
  instance (Traced a, Traced b, SameSpace a b) => Traced (a,b) where
    getTrace (x,y) = getTrace x <> getTrace y
  
  instance (Traced b) => Traced [b] where
    getTrace = mconcat . map getTrace
  
  instance (Traced b) => Traced (M.Map k b) where
    getTrace = mconcat . map getTrace . M.elems
  
  instance (Traced b) => Traced (S.Set b) where
    getTrace = mconcat . map getTrace . 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 p v a = case getSortedList $ op Trace (getTrace a) p v of
                   (s:_) -> Just (s *^ v)
                   []    -> 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 p v a = (p .+^) <$> traceV p v 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 p = traceV p . 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 p v a = (p .+^) <$> maxTraceV p v 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 a = Trace $ \p v -> unsafeOnSortedList (dropWhile (<0)) $ appTrace (getTrace a) p 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 p v a = case getSortedList $ op Trace (getRayTrace a) p v of
                   (s:_) -> Just (s *^ v)
                   []    -> 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 p v a = (p .+^) <$> rayTraceV p v 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 p v a =
    case getSortedList $ op Trace (getRayTrace a) p v of
      [] -> Nothing
      xs -> Just (last xs *^ 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 p v a = (p .+^) <$> maxRayTraceV p v 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])
  