    {-# LANGUAGE FlexibleContexts      #-}
    {-# LANGUAGE FlexibleInstances     #-}
    {-# LANGUAGE MultiParamTypeClasses #-}
    {-# LANGUAGE TypeFamilies          #-}
    {-# LANGUAGE ViewPatterns          #-}
    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Diagrams.TwoD.Transform
    -- Copyright   :  (c) 2011 diagrams-lib team (see LICENSE)
    -- License     :  BSD-style (see LICENSE)
    -- Maintainer  :  diagrams-discuss@googlegroups.com
    --
    -- Transformations specific to two dimensions, with a few generic
    -- transformations (uniform scaling, translation) also re-exported for
    -- convenience.
    --
    -----------------------------------------------------------------------------

    module Diagrams.TwoD.Transform
           (
             -- * Rotation
             rotation, rotate, rotateBy

           , rotationAbout, rotateAbout

             -- * Scaling
           , scalingX, scaleX
           , scalingY, scaleY
           , scaling, scale

           , scaleToX, scaleToY
           , scaleUToX, scaleUToY

             -- * Translation
           , translationX, translateX
           , translationY, translateY
           , translation, translate

             -- * Reflection
           , reflectionX, reflectX
           , reflectionY, reflectY
           , reflectionAbout, reflectAbout

             -- * Shears
           , shearingX, shearX
           , shearingY, shearY

             -- * Scale invariance
           , ScaleInv(..), scaleInv, scaleInvPrim

             -- * component-wise
           , onBasis
           ) where

    import           Diagrams.Core
    import qualified Diagrams.Core.Transform as T

    import           Control.Newtype         (over)

    import           Diagrams.Coordinates
    import           Diagrams.Transform
    import           Diagrams.TwoD.Size      (height, width)
    import           Diagrams.TwoD.Types
    import           Diagrams.TwoD.Vector    (direction)

    import           Data.Semigroup

    import           Data.AffineSpace

    import           Control.Arrow           (first, second)

    -- Rotation ------------------------------------------------

    -- | Create a transformation which performs a rotation about the local
    --   origin by the given angle.  See also 'rotate'.
    rotation :: Angle a => a -> T2
    rotation ang = fromLinear r (linv r)
      where
        r            = rot theta <-> rot (-theta)
        Rad theta    = convertAngle ang
        rot th (coords -> x :& y) = (cos th * x - sin th * y) & (sin th * x + cos th * y)

    -- | Rotate about the local origin by the given angle. Positive angles
    --   correspond to counterclockwise rotation, negative to
    --   clockwise. The angle can be expressed using any type which is an
    --   instance of 'Angle'.  For example, @rotate (1\/4 ::
    --   'Turn')@, @rotate (tau\/4 :: 'Rad')@, and @rotate (90 ::
    --   'Deg')@ all represent the same transformation, namely, a
    --   counterclockwise rotation by a right angle.  To rotate about some
    --   point other than the local origin, see 'rotateAbout'.
    --
    --   Note that writing @rotate (1\/4)@, with no type annotation, will
    --   yield an error since GHC cannot figure out which sort of angle
    --   you want to use.  In this common situation you can use
    --   'rotateBy', which is specialized to take a 'Turn' argument.
    rotate :: (Transformable t, V t ~ R2, Angle a) => a -> t -> t
    rotate = transform . rotation

    -- | A synonym for 'rotate', specialized to only work with
    --   @Turn@ arguments; it can be more convenient to write
    --   @rotateBy (1\/4)@ than @'rotate' (1\/4 :: 'Turn')@.
    rotateBy :: (Transformable t, V t ~ R2) => Turn -> t -> t
    rotateBy = transform . rotation

    -- | @rotationAbout p@ is a rotation about the point @p@ (instead of
    --   around the local origin).
    rotationAbout :: Angle a => P2 -> a -> T2
    rotationAbout p angle = conjugate (translation (origin .-. p)) (rotation angle)

    -- | @rotateAbout p@ is like 'rotate', except it rotates around the
    --   point @p@ instead of around the local origin.
    rotateAbout :: (Transformable t, V t ~ R2, Angle a) => P2 -> a -> t -> t
    rotateAbout p angle = rotate angle `under` translation (origin .-. p)

    -- Scaling -------------------------------------------------

    -- | Construct a transformation which scales by the given factor in
    --   the x (horizontal) direction.
    scalingX :: Double -> T2
    scalingX c = fromLinear s s
      where s = (over r2 . first) (*c) <-> (over r2 . first) (/c)

    -- | Scale a diagram by the given factor in the x (horizontal)
    --   direction.  To scale uniformly, use 'scale'.
    scaleX :: (Transformable t, V t ~ R2) => Double -> t -> t
    scaleX = transform . scalingX

    -- | Construct a transformation which scales by the given factor in
    --   the y (vertical) direction.
    scalingY :: Double -> T2
    scalingY c = fromLinear s s
      where s = (over r2 . second) (*c) <-> (over r2 . second) (/c)

    -- | Scale a diagram by the given factor in the y (vertical)
    --   direction.  To scale uniformly, use 'scale'.
    scaleY :: (Transformable t, V t ~ R2) => Double -> t -> t
    scaleY = transform . scalingY

    -- | @scaleToX w@ scales a diagram in the x (horizontal) direction by
    --   whatever factor required to make its width @w@.  @scaleToX@
    --   should not be applied to diagrams with a width of 0, such as
    --   'vrule'.
    scaleToX :: (Enveloped t, Transformable t, V t ~ R2) => Double -> t -> t
    scaleToX w d = scaleX (w / width d) d

    -- | @scaleToY h@ scales a diagram in the y (vertical) direction by
    --   whatever factor required to make its height @h@.  @scaleToY@
    --   should not be applied to diagrams with a height of 0, such as
    --   'hrule'.
    scaleToY :: (Enveloped t, Transformable t, V t ~ R2) => Double -> t -> t
    scaleToY h d = scaleY (h / height d) d

    -- | @scaleUToX w@ scales a diagram /uniformly/ by whatever factor
    --   required to make its width @w@.  @scaleUToX@ should not be
    --   applied to diagrams with a width of 0, such as 'vrule'.
    scaleUToX :: (Enveloped t, Transformable t, V t ~ R2) => Double -> t -> t
    scaleUToX w d = scale (w / width d) d

    -- | @scaleUToY h@ scales a diagram /uniformly/ by whatever factor
    --   required to make its height @h@.  @scaleUToY@ should not be applied
    --   to diagrams with a height of 0, such as 'hrule'.
    scaleUToY :: (Enveloped t, Transformable t, V t ~ R2) => Double -> t -> t
    scaleUToY h d = scale (h / height d) d

    -- Translation ---------------------------------------------

    -- | Construct a transformation which translates by the given distance
    --   in the x (horizontal) direction.
    translationX :: Double -> T2
    translationX x = translation (x & 0)

    -- | Translate a diagram by the given distance in the x (horizontal)
    --   direction.
    translateX :: (Transformable t, V t ~ R2) => Double -> t -> t
    translateX = transform . translationX

    -- | Construct a transformation which translates by the given distance
    --   in the y (vertical) direction.
    translationY :: Double -> T2
    translationY y = translation (0 & y)

    -- | Translate a diagram by the given distance in the y (vertical)
    --   direction.
    translateY :: (Transformable t, V t ~ R2) => Double -> t -> t
    translateY = transform . translationY

    -- Reflection ----------------------------------------------

    -- | Construct a transformation which flips a diagram from left to
    --   right, i.e. sends the point (x,y) to (-x,y).
    reflectionX :: T2
    reflectionX = scalingX (-1)

    -- | Flip a diagram from left to right, i.e. send the point (x,y) to
    --   (-x,y).
    reflectX :: (Transformable t, V t ~ R2) => t -> t
    reflectX = transform reflectionX

    -- | Construct a transformation which flips a diagram from top to
    --   bottom, i.e. sends the point (x,y) to (x,-y).
    reflectionY :: T2
    reflectionY = scalingY (-1)

    -- | Flip a diagram from top to bottom, i.e. send the point (x,y) to
    --   (x,-y).
    reflectY :: (Transformable t, V t ~ R2) => t -> t
    reflectY = transform reflectionY

    -- | @reflectionAbout p v@ is a reflection in the line determined by
    --   the point @p@ and vector @v@.
    reflectionAbout :: P2 -> R2 -> T2
    reflectionAbout p v =
      conjugate (rotation (-direction v :: Rad) <> translation (origin .-. p))
                reflectionY

    -- | @reflectAbout p v@ reflects a diagram in the line determined by
    --   the point @p@ and the vector @v@.
    reflectAbout :: (Transformable t, V t ~ R2) => P2 -> R2 -> t -> t
    reflectAbout p v = transform (reflectionAbout p v)

    -- Shears --------------------------------------------------

    -- | @shearingX d@ is the linear transformation which is the identity on
    --   y coordinates and sends @(0,1)@ to @(d,1)@.
    shearingX :: Double -> T2
    shearingX d = fromLinear (over r2 (sh d)  <-> over r2 (sh (-d)))
                             (over r2 (sh' d) <-> over r2 (sh' (-d)))
      where sh  k (x, y) = (x+k*y, y)
            sh' k        = swap . sh k . swap
            swap (x,y) = (y,x)

    -- | @shearX d@ performs a shear in the x-direction which sends
    --   @(0,1)@ to @(d,1)@.
    shearX :: (Transformable t, V t ~ R2) => Double -> t -> t
    shearX = transform . shearingX

    -- | @shearingY d@ is the linear transformation which is the identity on
    --   x coordinates and sends @(1,0)@ to @(1,d)@.
    shearingY :: Double -> T2
    shearingY d = fromLinear (over r2 (sh d)  <-> over r2 (sh (-d)))
                             (over r2 (sh' d) <-> over r2 (sh' (-d)))
      where sh  k (x,y) = (x, y+k*x)
            sh' k       = swap . sh k . swap
            swap (x,y) = (y,x)

    -- | @shearY d@ performs a shear in the y-direction which sends
    --   @(1,0)@ to @(1,d)@.
    shearY :: (Transformable t, V t ~ R2) => Double -> t -> t
    shearY = transform . shearingY

    -- Scale invariance ----------------------------------------

    -- | 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
      { unScaleInv  :: t
      , scaleInvDir :: R2
      , scaleInvLoc :: P2
      }
      deriving (Show)

    -- | Create a scale-invariant object pointing in the given direction,
    --   located at the origin.
    scaleInv :: t -> R2 -> ScaleInv t
    scaleInv t d = ScaleInv t d origin

    type instance V (ScaleInv t) = R2

    instance (V t ~ R2, HasOrigin t) => HasOrigin (ScaleInv t) where
      moveOriginTo p (ScaleInv t v l) = ScaleInv (moveOriginTo p t) v (moveOriginTo p l)

    instance (V t ~ R2, Transformable t) => Transformable (ScaleInv t) where
      transform tr (ScaleInv t v l) = ScaleInv (trans . rot $ t) (rot v) l'
        where
          angle :: Rad
          angle = direction (transform tr v) - direction v
          rot :: (Transformable t, V t ~ R2) => t -> t
          rot = rotateAbout l angle
          l'  = transform tr l
          trans = translate (l' .-. l)

    -- This is how we handle freezing properly with ScaleInv wrappers.
    -- Normal transformations are applied ignoring scaling; "frozen"
    -- transformations (i.e. transformations applied after a freeze) are
    -- applied directly to the underlying object, scales and all.  We must
    -- take care to transform the reference point and direction vector
    -- appropriately.
    instance (V t ~ R2, Transformable t) => IsPrim (ScaleInv t) where
      transformWithFreeze t1 t2 s = ScaleInv t'' d'' origin''
        where
          -- first, apply t2 normally, i.e. ignoring scaling
          s'@(ScaleInv t' _ _)      = transform t2 s

          -- now apply t1 to get the new direction and origin
          (ScaleInv _ d'' origin'') = transform t1 s'

          -- but apply t1 directly to the underlying thing, scales and all.
          t''                       = transform t1 t'

    instance (Renderable t b, V t ~ R2) => Renderable (ScaleInv t) b where
      render b = render b . unScaleInv

    -- | 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 :: (Transformable t, Renderable t b, V t ~ R2, Monoid m)
                 => t -> R2 -> QDiagram b R2 m
    scaleInvPrim t d = mkQD (Prim $ scaleInv t d) mempty mempty mempty mempty

    -- | Get the matrix equivalent of the linear transform,
    --   (as a pair of columns) and the translation vector.  This
    --   is mostly useful for implementing backends.
    onBasis :: Transformation R2 -> ((R2, R2), R2)
    onBasis t = ((x, y), v)
      where ((x:y:[]), v) = T.onBasis t