    {-# LANGUAGE CPP                        #-}
    {-# LANGUAGE ConstraintKinds       #-}
    {-# LANGUAGE DeriveDataTypeable    #-}
    {-# LANGUAGE FlexibleContexts      #-}
    {-# LANGUAGE FlexibleInstances     #-}
    {-# LANGUAGE MultiParamTypeClasses #-}
    {-# LANGUAGE ScopedTypeVariables   #-}
    {-# LANGUAGE StandaloneDeriving    #-}
    {-# LANGUAGE TemplateHaskell       #-}
    {-# LANGUAGE TypeFamilies          #-}
    {-# LANGUAGE UndecidableInstances  #-}
    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Diagrams.TwoD.Transform.ScaleInv
    -- Copyright   :  (c) 2012-2013 diagrams-lib team (see LICENSE)
    -- License     :  BSD-style (see LICENSE)
    -- Maintainer  :  diagrams-discuss@googlegroups.com
    --
    -- Wrapper for creating scale-invariant objects in two dimensions.
    --
    -----------------------------------------------------------------------------

    module Diagrams.Transform.ScaleInv
        ( ScaleInv(..)
        , scaleInvObj, scaleInvDir, scaleInvLoc
        , scaleInv, scaleInvPrim)
        where

    import           Control.Lens            (makeLenses, view, (^.))
    #if __GLASGOW_HASKELL__ < 710
    import           Data.Semigroup
    #endif
    import           Data.Typeable

    import           Diagrams.Angle
    import           Diagrams.Core
    import           Diagrams.TwoD.Transform
    import           Diagrams.TwoD.Types

    import           Linear.Affine
    import           Linear.Vector

    -- | The @ScaleInv@ wrapper creates two-dimensional /scale-invariant/
    --   objects.  Intuitively, a scale-invariant object is affected by
    --   transformations like translations and rotations, but not by scales.
    --
    --   However, this is problematic when it comes to /non-uniform/
    --   scales (/e.g./ @scaleX 2 . scaleY 3@) since they can introduce a
    --   perceived rotational component.  The prototypical example is an
    --   arrowhead on the end of a path, which should be scale-invariant.
    --   However, applying a non-uniform scale to the path but not the
    --   arrowhead would leave the arrowhead pointing in the wrong
    --   direction.
    --
    --   Moreover, for objects whose local origin is not at the local
    --   origin of the parent diagram, any scale can result in a
    --   translational component as well.
    --
    --   The solution is to also store a point (indicating the location,
    --   /i.e./ the local origin) and a unit vector (indicating the
    --   /direction/) along with a scale-invariant object.  A
    --   transformation to be applied is decomposed into rotational and
    --   translational components as follows:
    --
    --   * The transformation is applied to the direction vector, and the
    --   difference in angle between the original direction vector and its
    --   image under the transformation determines the rotational
    --   component.  The rotation is applied with respect to the stored
    --   location, rather than the global origin.
    --
    --   * The vector from the location to the image of the location under
    --   the transformation determines the translational component.

    data ScaleInv t =
      ScaleInv
      { _scaleInvObj :: t
      , _scaleInvDir :: Vn t
      , _scaleInvLoc :: Point (V t) (N t)
      }
      deriving Typeable

    deriving instance (Show t, Show (Vn t)) => Show (ScaleInv t)

    makeLenses ''ScaleInv

    -- | Create a scale-invariant object pointing in the given direction,
    --   located at the origin.
    scaleInv :: (V t ~ v, N t ~ n, Additive v, Num n) => t -> v n -> ScaleInv t
    scaleInv t d = ScaleInv t d origin

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

    instance (V t ~ v, N t ~ n, Additive v, Num n, HasOrigin t) => HasOrigin (ScaleInv t) where
      moveOriginTo p (ScaleInv t v l) = ScaleInv (moveOriginTo p t) v (moveOriginTo p l)

    instance (V t ~ V2, N t ~ n, RealFloat n, Transformable t) => Transformable (ScaleInv t) where
      transform tr (ScaleInv t v l) = ScaleInv (trans . rot $ t) (rot v) l'
        where
          angle = transform tr v ^. _theta

          rot :: (V k ~ V t, N k ~ N t, Transformable k) => k -> k
          rot = rotateAround l angle

          l'  = transform tr l

          trans = translate (l' .-. l)

    {- Proof that the above satisfies the monoid action laws.

       1. transform mempty (ScaleInv t v l)
          = ScaleInv (trans . rot $ t) (rot v) l'
            { l'    = transform mempty l = l }
            { trans = translate (l' .-. l)
                    = translate (l .-. l)
                    = translate zeroV
                    = id
            }
            { rot   = rotateAround l angle
                    = rotateAround l (direction (transform mempty v) - direction v)
                    = rotateAround l (direction v - direction v)
                    = rotateAround l 0
                    = id
            }
          = ScaleInv t v l

      2. transform t1 (transform t2 (ScaleInv t v l))
         = let angle = direction (transform t2 v) - direction v
               rot   = rotateAround l angle
               l'    = transform t2 l
               trans = translate (l' .-. l)
           in
               transform t1 (ScaleInv (trans . rot $ t) (rot v) l')

         = let angle  = direction (transform t2 v) - direction v
               rot    = rotateAround l angle
               l'     = transform t2 l
               trans  = translate (l' .-. l)
               angle2 = direction (transform t1 (rot v)) - direction (rot v)
               rot2   = rotateAround l' angle2
               l'2    = transform t1 l'
               trans2 = translate (l'2 .-. l')
           in
               ScaleInv (trans2 . rot2 . trans . rot $ t) (rot2 . rot $ v) l'2

           { l'2 = transform t1 l'
                 = transform t1 (transform t2 l)
                 = transform (t1 <> t2) l
           }
           { trans2 = translate (l'2 .-. l')
                    = translate (transform (t1 <> t2) l .-. transform t2 l)
                    = translate (transform t1 l .-. l)
           }
           { rot v  = rotateAround l angle v
                    = rotate angle `under` translation (origin .-. l) $ v
                    = rotate angle v
           }
           { angle2 = direction (transform t1 (rot v)) - direction (rot v)
                    = direction (transform t1 (rotate angle v)) - direction (rotate angle v)
                    = direction (transform t1 (rotate angle v)) - direction v - angle
           }
           { rot2   = rotateAround l' angle2
                    = ???
           }

    -}

    instance (V t ~ V2, N t ~ n, RealFloat n, Renderable t b) => Renderable (ScaleInv t) b where
      render b = render b . view scaleInvObj

    -- | Create a diagram from a single scale-invariant primitive.  The
    --   vector argument specifies the direction in which the primitive is
    --   \"pointing\" (for the purpose of keeping it rotated correctly
    --   under non-uniform scaling).  The primitive is assumed to be
    --   \"located\" at the origin (for the purpose of translating it
    --   correctly under scaling).
    --
    --   Note that the resulting diagram will have an /empty/ envelope,
    --   trace, and query.  The reason is that the envelope, trace, and
    --   query cannot be cached---applying a transformation would cause
    --   the cached envelope, etc. to get \"out of sync\" with the
    --   scale-invariant object.  The intention, at any rate, is that
    --   scale-invariant things will be used only as \"decorations\" (/e.g./
    --   arrowheads) which should not affect the envelope, trace, and
    --   query.
    scaleInvPrim :: (V t ~ V2, N t ~ n, RealFloat n, Typeable t, Renderable t b, Monoid m)
                 => t -> V2 n -> QDiagram b (V t) (N t) m
    scaleInvPrim t d = mkQD (Prim $ scaleInv t d) mempty mempty mempty mempty