content: {-# LANGUAGE CPP                        #-}
  {-# LANGUAGE ConstraintKinds            #-}
  {-# LANGUAGE FlexibleContexts           #-}
  {-# LANGUAGE FlexibleInstances          #-}
  {-# LANGUAGE GeneralizedNewtypeDeriving #-}
  {-# LANGUAGE MultiParamTypeClasses      #-}
  {-# LANGUAGE RankNTypes                 #-}
  {-# LANGUAGE StandaloneDeriving         #-}
  {-# LANGUAGE TypeFamilies               #-}
  {-# LANGUAGE TypeOperators              #-}
  {-# LANGUAGE UndecidableInstances       #-}
  -----------------------------------------------------------------------------
  -- |
  -- Module      :  Diagrams.Core.Envelope
  -- Copyright   :  (c) 2011 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 @Diagrams.Core.Envelope@ module defines a data type and type class for
  -- \"envelopes\", aka functional bounding regions.
  --
  -----------------------------------------------------------------------------
  
  module Diagrams.Core.Envelope
         ( -- * Envelopes
           Envelope(..)
  
         , appEnvelope
         , onEnvelope
         , mkEnvelope
         , pointEnvelope
  
         , Enveloped(..)
  
           -- * Utility functions
         , diameter
         , radius
         , extent
         , size
         , envelopeVMay
         , envelopeV
         , envelopePMay
         , envelopeP
         , envelopeSMay
         , envelopeS
  
           -- * Miscellaneous
         , OrderedField
         ) where
  
  #if __GLASGOW_HASKELL__ < 710
  import           Control.Applicative     ((<$>))
  #endif
  import           Control.Lens            (Rewrapped, Wrapped (..), iso, mapped,
                                            op, over, (&), (.~), _Wrapping')
  import           Data.Functor.Rep
  import qualified Data.Map                as M
  import           Data.Maybe              (fromMaybe)
  import           Data.Semigroup
  import qualified Data.Set                as S
  
  import           Diagrams.Core.HasOrigin
  import           Diagrams.Core.Points
  import           Diagrams.Core.Transform
  import           Diagrams.Core.V
  
  import           Linear.Metric
  import           Linear.Vector
  
  
  ------------------------------------------------------------
  --  Envelopes  ---------------------------------------------
  ------------------------------------------------------------
  
  -- | Every diagram comes equipped with an /envelope/.  What is an envelope?
  --
  --   Consider first the idea of a /bounding box/. A bounding box
  --   expresses the distance to a bounding plane in every direction
  --   parallel to an axis.  That is, a bounding box can be thought of
  --   as the intersection of a collection of half-planes, two
  --   perpendicular to each axis.
  --
  --   More generally, the intersection of half-planes in /every/
  --   direction would give a tight \"bounding region\", or convex hull.
  --   However, representing such a thing intensionally would be
  --   impossible; hence bounding boxes are often used as an
  --   approximation.
  --
  --   An envelope is an /extensional/ representation of such a
  --   \"bounding region\".  Instead of storing some sort of direct
  --   representation, we store a /function/ which takes a direction as
  --   input and gives a distance to a bounding half-plane as output.
  --   The important point is that envelopes can be composed, and
  --   transformed by any affine transformation.
  --
  --   Formally, given a vector @v@, the envelope computes a scalar @s@ such
  --   that
  --
  --     * for every point @u@ inside the diagram,
  --       if the projection of @(u - origin)@ onto @v@ is @s' *^ v@, then @s' <= s@.
  --
  --     * @s@ is the smallest such scalar.
  --
  --   There is also a special \"empty envelope\".
  --
  --   The idea for envelopes came from
  --   Sebastian Setzer; see
  --   <http://byorgey.wordpress.com/2009/10/28/collecting-attributes/#comment-2030>.  See also Brent Yorgey, /Monoids: Theme and Variations/, published in the 2012 Haskell Symposium: <http://ozark.hendrix.edu/~yorgey/pub/monoid-pearl.pdf>; video: <http://www.youtube.com/watch?v=X-8NCkD2vOw>.
  newtype Envelope v n = Envelope (Maybe (v n -> Max n))
  
  instance Wrapped (Envelope v n) where
    type Unwrapped (Envelope v n) = Maybe (v n -> Max n)
    _Wrapped' = iso (\(Envelope e) -> e) Envelope
  
  instance Rewrapped (Envelope v n) (Envelope v' n')
  
  -- | \"Apply\" an envelope by turning it into a function.  @Nothing@
  --   is returned iff the envelope is empty.
  appEnvelope :: Envelope v n -> Maybe (v n -> n)
  appEnvelope (Envelope e) = (getMax .) <$> e
  
  -- | A convenient way to transform an envelope, by specifying a
  --   transformation on the underlying @v n -> n@ function.  The empty
  --   envelope is unaffected.
  onEnvelope :: ((v n -> n) -> v n -> n) -> Envelope v n -> Envelope v n
  onEnvelope t = over (_Wrapping' Envelope . mapped) ((Max .) . t . (getMax .))
  
  -- | Create an envelope from a @v n -> n@ function.
  mkEnvelope :: (v n -> n) -> Envelope v n
  mkEnvelope = Envelope . Just . (Max .)
  
  -- | Create a point envelope for the given point.  A point envelope
  --   has distance zero to a bounding hyperplane in every direction.
  --   Note this is /not/ the same as the empty envelope.
  pointEnvelope :: (Fractional n, Metric v) => Point v n -> Envelope v n
  pointEnvelope p = moveTo p (mkEnvelope $ const 0)
  
  -- | Envelopes form a semigroup with pointwise maximum as composition.
  --   Hence, if @e1@ is the envelope for diagram @d1@, and
  --   @e2@ is the envelope for @d2@, then @e1 \`mappend\` e2@
  --   is the envelope for @d1 \`atop\` d2@.
  deriving instance Ord n => Semigroup (Envelope v n)
  
  -- | The special empty envelope is the identity for the
  --   'Monoid' instance.
  deriving instance Ord n => Monoid (Envelope v n)
  
  type instance V (Envelope v n) = v
  type instance N (Envelope v n) = n
  
  instance Show (Envelope v n) where
    show _ = "<envelope>"
  
  ------------------------------------------------------------
  --  Transforming envelopes  --------------------------------
  ------------------------------------------------------------
  
  -- | The local origin of an envelope is the point with respect to
  --   which bounding queries are made, /i.e./ the point from which the
  --   input vectors are taken to originate.
  instance (Metric v, Fractional n) => HasOrigin (Envelope v n) where
    moveOriginTo (P u) = onEnvelope $ \oldEnv v -> oldEnv v - ((u ^/ (v `dot` v)) `dot` v)
    -- For a detailed explanation of this code, see note
    -- [Transforming Envelopes] below.
  
  instance (Metric v, Floating n) => Transformable (Envelope v n) where
    transform t = moveOriginTo (P . negated . transl $ t) . onEnvelope g
      where
  
        -- For a detailed explanation of this code, see note
        -- [Transforming Envelopes] below.
        g f v = f v' / (v' `dot` vi)
          where
            v' = signorm $ lapp (transp t) v
            vi = apply (inv t) v
  
  {-
  
  Note [Transforming Envelopes]
  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  
  We are given an envelope for some object, and want to apply an affine
  transformation, such that the new envelope will be the envelope for
  the transformed object.  The HasOrigin instance handles the
  translational component; the rest of the code in the Transformable
  instance handles the linear component.
  
  See <<diagrams/EnvHasOrigin.png>>.
  
  To implement moveOriginTo, we need to move the "base point" from which
  envelope queries are made.  We are given the old envelope @oldEnv@ (a
  function from vectors to scalars), a vector @u@ from the old origin to
  the new origin, and a query vector @v@ which we imagine to emanate
  from the new origin.  If we query the old envelope with v, it will
  find the correct perpendicular hyperplane, but the reported distance
  may be wrong (it will only be correct if the origin was moved in a
  direction perpendicular to v).  The part that needs to be subtracted
  is just the projection of u onto v, which is given by (u.v)/(v.v) *^
  v.  In fact envelopes return not a distance or vector, but a scalar
  which is taken to be a multiple of the query vector, so the scalar we
  need to subtract is just (u.v)/(v.v).
  
  We now consider how to apply a linear transformation to an envelope.
  Recall that an envelope is a function that takes a vector and returns
  a scaling factor s such that scaling the vector by s will produce a
  vector to the minimum separating hyperplane.  (So if given a unit
  vector as input, the output will be simply the distance to the minimum
  separating hyperplane.)
  
  We are given a linear transformation t and must produce a new envelope
  function.  Given an input vector v, the "obvious" thing to do is to
  transform v back into the original coordinate system using the inverse
  of t, apply the original envelope, and then adjust the resulting
  scalar according to how much the transformation scales v.
  
  However, this does not work, since linear transformations do not
  preserve angles.  Thus, in particular, given the query vector v and
  the perpendicular separating hyperplane H which we wish to find, t^-1
  v and t^-1 H are not necessarily perpendicular anymore.  So if we
  query the envelope with t^-1 v we will get information about the
  distance to some separating hyperplane, which when mapped forward
  through t will no longer be perpendicular to v.
  
  However, it turns out that if v and w are perpendicular, then t^-1 v
  will be perpendicular to t^T w, that is, the *transpose* of t (when
  considered as a matrix) applied to w.  The proof is simple. Recall
  that v and w are perpendicular if and only if v . w = v^T w = 0.  Thus,
  
    (t^-1 v) . (t^T w) = (t^-1 v)^T (t^T w) = v^T t^-T t^T w = v^T w = 0.
  
  Now to explain this code:
  
        g f v = f v' / (v' `dot` vi)
          where
            v' = signorm $ lapp (transp t) v
            vi = apply (inv t) v
  
  In our case, our new envelope function (transformed by t) will be
  given a query vector v, and we suppose v is perpendicular to the
  separating hyperplane H.  Instead of querying the old envelope
  function f with t^-1 v, we query it with t^T v (after normalizing),
  since that vector will be perpendicular to t^-1 H.
  
  Finally, to scale the resulting value correctly, we divide by (t^T v
  . t^-1 v); I forget why.  Perhaps I will come back later and complete
  this explanation.
  
  -}
  
  ------------------------------------------------------------
  --  Enveloped class
  ------------------------------------------------------------
  
  -- | When dealing with envelopes we often want scalars to be an
  --   ordered field (i.e. support all four arithmetic operations and be
  --   totally ordered) so we introduce this constraint as a convenient
  --   shorthand.
  type OrderedField s = (Floating s, Ord s)
  
  -- | @Enveloped@ abstracts over things which have an envelope.
  class (Metric (V a), OrderedField (N a)) => Enveloped a where
  
    -- | Compute the envelope of an object.  For types with an intrinsic
    --   notion of \"local origin\", the envelope will be based there.
    --   Other types (e.g. 'Trail') may have some other default
    --   reference point at which the envelope will be based; their
    --   instances should document what it is.
    getEnvelope :: a -> Envelope (V a) (N a)
  
  instance (Metric v, OrderedField n) => Enveloped (Envelope v n) where
    getEnvelope = id
  
  instance (OrderedField n, Metric v) => Enveloped (Point v n) where
    getEnvelope p = moveTo p . mkEnvelope $ const 0
  
  instance Enveloped t => Enveloped (TransInv t) where
    getEnvelope = getEnvelope . op TransInv
  
  instance (Enveloped a, Enveloped b, V a ~ V b, N a ~ N b) => Enveloped (a,b) where
    getEnvelope (x,y) = getEnvelope x <> getEnvelope y
  
  instance Enveloped b => Enveloped [b] where
    getEnvelope = mconcat . map getEnvelope
  
  instance Enveloped b => Enveloped (M.Map k b) where
    getEnvelope = mconcat . map getEnvelope . M.elems
  
  instance Enveloped b => Enveloped (S.Set b) where
    getEnvelope = mconcat . map getEnvelope . S.elems
  
  ------------------------------------------------------------
  --  Computing with envelopes
  ------------------------------------------------------------
  
  -- | Compute the vector from the local origin to a separating
  --   hyperplane in the given direction, or @Nothing@ for the empty
  --   envelope.
  envelopeVMay :: Enveloped a => Vn a -> a -> Maybe (Vn a)
  envelopeVMay v = fmap ((*^ v) . ($ v)) . appEnvelope . getEnvelope
  
  -- | Compute the vector from the local origin to a separating
  --   hyperplane in the given direction.  Returns the zero vector for
  --   the empty envelope.
  envelopeV :: Enveloped a => Vn a -> a -> Vn a
  envelopeV v = fromMaybe zero . envelopeVMay v
  
  -- | Compute the point on a separating hyperplane in the given
  --   direction, or @Nothing@ for the empty envelope.
  envelopePMay :: (V a ~ v, N a ~ n, Enveloped a) => v n -> a -> Maybe (Point v n)
  envelopePMay v = fmap P . envelopeVMay v
  
  -- | Compute the point on a separating hyperplane in the given
  --   direction.  Returns the origin for the empty envelope.
  envelopeP :: (V a ~ v, N a ~ n, Enveloped a) => v n -> a -> Point v n
  envelopeP v = P . envelopeV v
  
  -- | Equivalent to the norm of 'envelopeVMay':
  --
  --   @ envelopeSMay v x == fmap norm (envelopeVMay v x) @
  --
  --   (other than differences in rounding error)
  --
  --   Note that the 'envelopeVMay' / 'envelopePMay' functions above should be
  --   preferred, as this requires a call to norm.  However, it is more
  --   efficient than calling norm on the results of those functions.
  envelopeSMay :: (V a ~ v, N a ~ n, Enveloped a) => v n -> a -> Maybe n
  envelopeSMay v = fmap ((* norm v) . ($ v)) . appEnvelope . getEnvelope
  
  -- | Equivalent to the norm of 'envelopeV':
  --
  --   @ envelopeS v x == norm (envelopeV v x) @
  --
  --   (other than differences in rounding error)
  --
  --   Note that the 'envelopeV' / 'envelopeP' functions above should be
  --   preferred, as this requires a call to norm. However, it is more
  --   efficient than calling norm on the results of those functions.
  envelopeS :: (V a ~ v, N a ~ n, Enveloped a) => v n -> a -> n
  envelopeS v = fromMaybe 0 . envelopeSMay v
  
  -- | Compute the diameter of a enveloped object along a particular
  --   vector.  Returns zero for the empty envelope.
  diameter :: (V a ~ v, N a ~ n, Enveloped a) => v n -> a -> n
  diameter v a = maybe 0 (\(lo,hi) -> (hi - lo) * norm v) (extent v a)
  
  -- | Compute the \"radius\" (1\/2 the diameter) of an enveloped object
  --   along a particular vector.
  radius :: (V a ~ v, N a ~ n, Enveloped a) => v n -> a -> n
  radius v = (0.5*) . diameter v
  
  -- | Compute the range of an enveloped object along a certain
  --   direction.  Returns a pair of scalars @(lo,hi)@ such that the
  --   object extends from @(lo *^ v)@ to @(hi *^ v)@. Returns @Nothing@
  --   for objects with an empty envelope.
  extent :: (V a ~ v, N a ~ n, Enveloped a) => v n -> a -> Maybe (n, n)
  extent v a = (\f -> (-f (negated v), f v)) <$> (appEnvelope . getEnvelope $ a)
  
  -- | The smallest positive /axis-parallel/ vector that bounds the
  --   envelope of an object.
  size :: (V a ~ v, N a ~ n, Enveloped a, HasBasis v) => a -> v n
  size d = tabulate $ \(E l) -> diameter (zero & l .~ 1) d
  