{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes            #-}
{-# LANGUAGE TypeFamilies          #-}

{-# OPTIONS_GHC -fno-warn-unused-imports #-}
  -- for Data.Semigroup

-----------------------------------------------------------------------------
-- |
-- Module      :  Diagrams.Transform
-- Copyright   :  (c) 2011-15 diagrams-lib team (see LICENSE)
-- License     :  BSD-style (see LICENSE)
-- Maintainer  :  diagrams-discuss@googlegroups.com
--
-- Affine transformations, parameterized by any vector space.  For
-- transformations on particular vector spaces, see /e.g./
-- "Diagrams.TwoD.Transform".
--
-----------------------------------------------------------------------------


module Diagrams.Transform
    ( -- * Transformations
      Transformation, inv, transl, apply, papply

      -- * The Transformable class
    , Transformable(..)

      -- * Some specific transformations
    , translation, translate, moveTo, place, scaling, scale

      -- * Miscellaneous transformation-related utilities
    , conjugate, underT, transformed, translated, movedTo, movedFrom

      -- * The HasOrigin class

    , HasOrigin(..), moveOriginBy

    ) where

import           Control.Lens   hiding (transform)
import           Data.Semigroup
import           Diagrams.Core

import           Linear.Vector

-- | Conjugate one transformation by another. @conjugate t1 t2@ is the
--   transformation which performs first @t1@, then @t2@, then the
--   inverse of @t1@.
conjugate :: (Additive v, Num n)
          => Transformation v n -> Transformation v n -> Transformation v n
conjugate :: forall (v :: * -> *) n.
(Additive v, Num n) =>
Transformation v n -> Transformation v n -> Transformation v n
conjugate Transformation v n
t1 Transformation v n
t2 = forall (v :: * -> *) n.
(Functor v, Num n) =>
Transformation v n -> Transformation v n
inv Transformation v n
t1 forall a. Semigroup a => a -> a -> a
<> Transformation v n
t2 forall a. Semigroup a => a -> a -> a
<> Transformation v n
t1

-- | Carry out some transformation \"under\" another one: @f ``underT``
--   t@ first applies @t@, then @f@, then the inverse of @t@.  For
--   example, @'scaleX' 2 ``underT`` 'rotation' (-1/8 \@\@ Turn)@
--   is the transformation which scales by a factor of 2 along the
--   diagonal line y = x.
--
--   Note that
--
-- @
-- (transform t2) `underT` t1 == transform (conjugate t1 t2)
-- @
--
--   for all transformations @t1@ and @t2@.
--
--   See also the isomorphisms like 'transformed', 'movedTo',
--   'movedFrom', and 'translated'.
underT :: (InSpace v n a, SameSpace a b, Transformable a, Transformable b)
      => (a -> b) -> Transformation v n -> a -> b
a -> b
f underT :: forall (v :: * -> *) n a b.
(InSpace v n a, SameSpace a b, Transformable a, Transformable b) =>
(a -> b) -> Transformation v n -> a -> b
`underT` Transformation v n
t = forall t. Transformable t => Transformation (V t) (N t) -> t -> t
transform (forall (v :: * -> *) n.
(Functor v, Num n) =>
Transformation v n -> Transformation v n
inv Transformation v n
t) forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Transformable t => Transformation (V t) (N t) -> t -> t
transform Transformation v n
t

-- | Use a 'Transformation' to make an 'Iso' between an object
--   transformed and untransformed. This is useful for carrying out
--   functions 'under' another transform:
--
-- @
-- under (transformed t) f               == transform (inv t) . f . transform t
-- under (transformed t1) (transform t2) == transform (conjugate t1 t2)
-- transformed t ## a                    == transform t a
-- a ^. transformed t                    == transform (inv t) a
-- @
transformed :: (InSpace v n a, SameSpace a b, Transformable a, Transformable b)
            => Transformation v n -> Iso a b a b
transformed :: forall (v :: * -> *) n a b.
(InSpace v n a, SameSpace a b, Transformable a, Transformable b) =>
Transformation v n -> Iso a b a b
transformed Transformation v n
t = forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (forall t. Transformable t => Transformation (V t) (N t) -> t -> t
transform forall a b. (a -> b) -> a -> b
$ forall (v :: * -> *) n.
(Functor v, Num n) =>
Transformation v n -> Transformation v n
inv Transformation v n
t) (forall t. Transformable t => Transformation (V t) (N t) -> t -> t
transform Transformation v n
t)

-- | Use a 'Point' to make an 'Iso' between an object
--   moved to and from that point:
--
-- @
-- under (movedTo p) f == moveTo (-p) . f . moveTo p
-- over (movedTo p) f  == moveTo p . f . moveTo (-p)
-- movedTo p           == from (movedFrom p)
-- movedTo p ## a      == moveTo p a
-- a ^. movedTo p      == moveOriginTo p a
-- @
movedTo :: (InSpace v n a, SameSpace a b, HasOrigin a, HasOrigin b)
        => Point v n -> Iso a b a b
movedTo :: forall (v :: * -> *) n a b.
(InSpace v n a, SameSpace a b, HasOrigin a, HasOrigin b) =>
Point v n -> Iso a b a b
movedTo Point v n
p = forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (forall (v :: * -> *) n t.
(InSpace v n t, HasOrigin t) =>
Point v n -> t -> t
moveTo (forall (f :: * -> *) a. (Functor f, Num a) => f a -> f a
negated Point v n
p)) (forall (v :: * -> *) n t.
(InSpace v n t, HasOrigin t) =>
Point v n -> t -> t
moveTo Point v n
p)

-- | Use a 'Transformation' to make an 'Iso' between an object
--   transformed and untransformed. We have
--
-- @
-- under (movedFrom p) f == moveTo p . f . moveTo (-p)
-- movedFrom p           == from (movedTo p)
-- movedFrom p ## a      == moveOriginTo p a
-- a ^. movedFrom p      == moveTo p a
-- over (movedFrom p) f  == moveTo (-p) . f . moveTo p
-- @
movedFrom :: (InSpace v n a, SameSpace a b, HasOrigin a, HasOrigin b)
          => Point v n -> Iso a b a b
movedFrom :: forall (v :: * -> *) n a b.
(InSpace v n a, SameSpace a b, HasOrigin a, HasOrigin b) =>
Point v n -> Iso a b a b
movedFrom Point v n
p = forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (forall t. HasOrigin t => Point (V t) (N t) -> t -> t
moveOriginTo (forall (f :: * -> *) a. (Functor f, Num a) => f a -> f a
negated Point v n
p)) (forall t. HasOrigin t => Point (V t) (N t) -> t -> t
moveOriginTo Point v n
p)

-- | Use a vector to make an 'Iso' between an object translated and
--   untranslated.
--
-- @
-- under (translated v) f == translate (-v) . f . translate v
-- translated v ## a      == translate v a
-- a ^. translated v      == translate (-v) a
-- over (translated v) f  == translate v . f . translate (-v)
-- @
translated :: (InSpace v n a, SameSpace a b, Transformable a, Transformable b)
           => v n -> Iso a b a b
translated :: forall (v :: * -> *) n a b.
(InSpace v n a, SameSpace a b, Transformable a, Transformable b) =>
v n -> Iso a b a b
translated v n
v = forall (v :: * -> *) n a b.
(InSpace v n a, SameSpace a b, Transformable a, Transformable b) =>
Transformation v n -> Iso a b a b
transformed forall a b. (a -> b) -> a -> b
$ forall (v :: * -> *) n. v n -> Transformation v n
translation v n
v