{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE TypeOperators         #-}
{-# LANGUAGE ViewPatterns          #-}

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

-----------------------------------------------------------------------------
-- |
-- Module      :  Diagrams.ThreeD.Transform
-- Copyright   :  (c) 2013 diagrams-lib team (see LICENSE)
-- License     :  BSD-style (see LICENSE)
-- Maintainer  :  diagrams-discuss@googlegroups.com
--
-- Transformations specific to three dimensions, with a few generic
-- transformations (uniform scaling, translation) also re-exported for
-- convenience.
--
-----------------------------------------------------------------------------

module Diagrams.ThreeD.Transform
       ( T3

         -- * Rotation
       , aboutX, aboutY, aboutZ
       , rotationAbout, rotateAbout
       , pointAt, pointAt'

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

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

         -- * Reflection
       , reflectionX, reflectX
       , reflectionY, reflectY
       , reflectionZ, reflectZ
       , reflectionAcross, reflectAcross

       ) where

import           Diagrams.Core
import           Diagrams.Core.Transform

import           Diagrams.Angle
import           Diagrams.Direction
import           Diagrams.Points
import           Diagrams.ThreeD.Types
import           Diagrams.Transform

import           Control.Lens            (view, (&), (*~), (.~), (//~))
import           Data.Semigroup
import           Diagrams.TwoD.Transform

import           Linear.Affine
import           Linear.Metric
import           Linear.V3               (cross)
import           Linear.Vector

-- | Create a transformation which rotates by the given angle about
--   a line parallel the Z axis passing through the local origin.
--   A positive angle brings positive x-values towards the positive-y axis.
--
--   The angle can be expressed using any type which is an
--   instance of 'Angle'.  For example, @aboutZ (1\/4 \@\@
--   'turn')@, @aboutZ (tau\/4 \@\@ 'rad')@, and @aboutZ (90 \@\@
--   'deg')@ all represent the same transformation, namely, a
--   counterclockwise rotation by a right angle.  For more general rotations,
--   see 'rotationAbout'.
--
--   Note that writing @aboutZ (1\/4)@, with no type annotation, will
--   yield an error since GHC cannot figure out which sort of angle
--   you want to use.
aboutZ :: Floating n => Angle n -> Transformation V3 n
aboutZ :: forall n. Floating n => Angle n -> Transformation V3 n
aboutZ (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall n. Iso' (Angle n) n
rad -> n
a) = forall (v :: * -> *) n.
(Additive v, Num n) =>
(v n :-: v n) -> Transformation v n
fromOrthogonal V3 n :-: V3 n
r where
  r :: V3 n :-: V3 n
r = forall {a}. Floating a => a -> V3 a -> V3 a
rot n
a forall u v. (u -> v) -> (v -> u) -> u :-: v
<-> forall {a}. Floating a => a -> V3 a -> V3 a
rot (-n
a)
  rot :: a -> V3 a -> V3 a
rot a
θ (V3 a
x a
y a
z) = forall a. a -> a -> a -> V3 a
V3 (forall a. Floating a => a -> a
cos a
θ forall a. Num a => a -> a -> a
* a
x forall a. Num a => a -> a -> a
- forall a. Floating a => a -> a
sin a
θ forall a. Num a => a -> a -> a
* a
y)
                        (forall a. Floating a => a -> a
sin a
θ forall a. Num a => a -> a -> a
* a
x forall a. Num a => a -> a -> a
+ forall a. Floating a => a -> a
cos a
θ forall a. Num a => a -> a -> a
* a
y)
                        a
z

-- | Like 'aboutZ', but rotates about the X axis, bringing positive y-values
-- towards the positive z-axis.
aboutX :: Floating n => Angle n -> Transformation V3 n
aboutX :: forall n. Floating n => Angle n -> Transformation V3 n
aboutX (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall n. Iso' (Angle n) n
rad -> n
a) = forall (v :: * -> *) n.
(Additive v, Num n) =>
(v n :-: v n) -> Transformation v n
fromOrthogonal V3 n :-: V3 n
r where
  r :: V3 n :-: V3 n
r = forall {a}. Floating a => a -> V3 a -> V3 a
rot n
a forall u v. (u -> v) -> (v -> u) -> u :-: v
<-> forall {a}. Floating a => a -> V3 a -> V3 a
rot (-n
a)
  rot :: a -> V3 a -> V3 a
rot a
θ (V3 a
x a
y a
z) = forall a. a -> a -> a -> V3 a
V3 a
x
                        (forall a. Floating a => a -> a
cos a
θ forall a. Num a => a -> a -> a
* a
y forall a. Num a => a -> a -> a
- forall a. Floating a => a -> a
sin a
θ forall a. Num a => a -> a -> a
* a
z)
                        (forall a. Floating a => a -> a
sin a
θ forall a. Num a => a -> a -> a
* a
y forall a. Num a => a -> a -> a
+ forall a. Floating a => a -> a
cos a
θ forall a. Num a => a -> a -> a
* a
z)

-- | Like 'aboutZ', but rotates about the Y axis, bringing postive
-- x-values towards the negative z-axis.
aboutY :: Floating n => Angle n -> Transformation V3 n
aboutY :: forall n. Floating n => Angle n -> Transformation V3 n
aboutY (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall n. Iso' (Angle n) n
rad -> n
a) = forall (v :: * -> *) n.
(Additive v, Num n) =>
(v n :-: v n) -> Transformation v n
fromOrthogonal V3 n :-: V3 n
r where
  r :: V3 n :-: V3 n
r = forall {a}. Floating a => a -> V3 a -> V3 a
rot n
a forall u v. (u -> v) -> (v -> u) -> u :-: v
<-> forall {a}. Floating a => a -> V3 a -> V3 a
rot (-n
a)
  rot :: a -> V3 a -> V3 a
rot a
θ (V3 a
x a
y a
z) = forall a. a -> a -> a -> V3 a
V3 (forall a. Floating a => a -> a
cos a
θ forall a. Num a => a -> a -> a
* a
x forall a. Num a => a -> a -> a
+ forall a. Floating a => a -> a
sin a
θ forall a. Num a => a -> a -> a
* a
z)
                        a
y
                        (-forall a. Floating a => a -> a
sin a
θ forall a. Num a => a -> a -> a
* a
x forall a. Num a => a -> a -> a
+ forall a. Floating a => a -> a
cos a
θ forall a. Num a => a -> a -> a
* a
z)

-- | @rotationAbout p d a@ is a rotation about a line parallel to @d@
--   passing through @p@.
rotationAbout
  :: Floating n
  => Point V3 n         -- ^ origin of rotation
  -> Direction V3 n     -- ^ direction of rotation axis
  -> Angle n            -- ^ angle of rotation
  -> Transformation V3 n
rotationAbout :: forall n.
Floating n =>
Point V3 n -> Direction V3 n -> Angle n -> Transformation V3 n
rotationAbout (P V3 n
t) Direction V3 n
d (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall n. Iso' (Angle n) n
rad -> n
a)
  = forall a. Monoid a => [a] -> a
mconcat [forall (v :: * -> *) n. v n -> Transformation v n
translation (forall (f :: * -> *) a. (Functor f, Num a) => f a -> f a
negated V3 n
t),
             forall (v :: * -> *) n.
(Additive v, Num n) =>
(v n :-: v n) -> Transformation v n
fromOrthogonal V3 n :-: V3 n
r,
             forall (v :: * -> *) n. v n -> Transformation v n
translation V3 n
t] where
    r :: V3 n :-: V3 n
r = n -> V3 n -> V3 n
rot n
a forall u v. (u -> v) -> (v -> u) -> u :-: v
<-> n -> V3 n -> V3 n
rot (-n
a)
    w :: V3 n
w = forall (v :: * -> *) n.
(Metric v, Floating n) =>
Direction v n -> v n
fromDirection Direction V3 n
d

    rot :: n -> V3 n -> V3 n
rot n
θ V3 n
v =          V3 n
v forall (f :: * -> *) a. (Functor f, Num a) => f a -> a -> f a
^* forall a. Floating a => a -> a
cos n
θ
           forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^+^ forall a. Num a => V3 a -> V3 a -> V3 a
cross V3 n
w V3 n
v forall (f :: * -> *) a. (Functor f, Num a) => f a -> a -> f a
^* forall a. Floating a => a -> a
sin n
θ
           forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^+^         V3 n
w forall (f :: * -> *) a. (Functor f, Num a) => f a -> a -> f a
^* ((V3 n
w forall (f :: * -> *) a. (Metric f, Num a) => f a -> f a -> a
`dot` V3 n
v) forall a. Num a => a -> a -> a
* (n
1 forall a. Num a => a -> a -> a
- forall a. Floating a => a -> a
cos n
θ))

-- | @rotationAbout p d a@ is a rotation about a line parallel to @d@
--   passing through @p@.
rotateAbout
  :: (InSpace V3 n t, Floating n, Transformable t)
  => Point V3 n         -- ^ origin of rotation
  -> Direction V3 n     -- ^ direction of rotation axis
  -> Angle n            -- ^ angle of rotation
  -> t -> t
rotateAbout :: forall n t.
(InSpace V3 n t, Floating n, Transformable t) =>
Point V3 n -> Direction V3 n -> Angle n -> t -> t
rotateAbout Point V3 n
p Direction V3 n
d Angle n
theta = forall t. Transformable t => Transformation (V t) (N t) -> t -> t
transform (forall n.
Floating n =>
Point V3 n -> Direction V3 n -> Angle n -> Transformation V3 n
rotationAbout Point V3 n
p Direction V3 n
d Angle n
theta)

-- | @pointAt about initial final@ produces a rotation which brings
-- the direction @initial@ to point in the direction @final@ by first
-- panning around @about@, then tilting about the axis perpendicular
-- to @about@ and @final@.  In particular, if this can be accomplished
-- without tilting, it will be, otherwise if only tilting is
-- necessary, no panning will occur.  The tilt will always be between
-- ± 1/4 turn.
pointAt :: (Floating n, Ord n)
        => Direction V3 n -> Direction V3 n -> Direction V3 n
        -> Transformation V3 n
pointAt :: forall n.
(Floating n, Ord n) =>
Direction V3 n
-> Direction V3 n -> Direction V3 n -> Transformation V3 n
pointAt Direction V3 n
a Direction V3 n
i Direction V3 n
f = forall n.
(Floating n, Ord n) =>
V3 n -> V3 n -> V3 n -> Transformation V3 n
pointAt' (forall (v :: * -> *) n.
(Metric v, Floating n) =>
Direction v n -> v n
fromDirection Direction V3 n
a) (forall (v :: * -> *) n.
(Metric v, Floating n) =>
Direction v n -> v n
fromDirection Direction V3 n
i) (forall (v :: * -> *) n.
(Metric v, Floating n) =>
Direction v n -> v n
fromDirection Direction V3 n
f)

-- | pointAt' has the same behavior as 'pointAt', but takes vectors
-- instead of directions.
pointAt' :: (Floating n, Ord n) => V3 n -> V3 n -> V3 n -> Transformation V3 n
pointAt' :: forall n.
(Floating n, Ord n) =>
V3 n -> V3 n -> V3 n -> Transformation V3 n
pointAt' V3 n
about V3 n
initial V3 n
final = forall n.
(Floating n, Ord n) =>
V3 n -> V3 n -> V3 n -> Transformation V3 n
pointAtUnit (forall (f :: * -> *) a. (Metric f, Floating a) => f a -> f a
signorm V3 n
about) (forall (f :: * -> *) a. (Metric f, Floating a) => f a -> f a
signorm V3 n
initial) (forall (f :: * -> *) a. (Metric f, Floating a) => f a -> f a
signorm V3 n
final)

-- | pointAtUnit has the same behavior as @pointAt@, but takes unit vectors.
pointAtUnit :: (Floating n, Ord n) => V3 n -> V3 n -> V3 n -> Transformation V3 n
pointAtUnit :: forall n.
(Floating n, Ord n) =>
V3 n -> V3 n -> V3 n -> Transformation V3 n
pointAtUnit V3 n
about V3 n
initial V3 n
final = Transformation V3 n
tilt forall a. Semigroup a => a -> a -> a
<> Transformation V3 n
pan where
  -- rotating u by (signedAngle rel u v) about rel gives a vector in the direction of v
  signedAngle :: V3 a -> V3 a -> V3 a -> Angle a
signedAngle V3 a
rel V3 a
u V3 a
v = forall a. Num a => a -> a
signum (forall a. Num a => V3 a -> V3 a -> V3 a
cross V3 a
u V3 a
v forall (f :: * -> *) a. (Metric f, Num a) => f a -> f a -> a
`dot` V3 a
rel) forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ forall (v :: * -> *) n.
(Metric v, Floating n, Ord n) =>
v n -> v n -> Angle n
angleBetween V3 a
u V3 a
v
  inPanPlaneF :: V3 n
inPanPlaneF = V3 n
final forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^-^ forall (v :: * -> *) a.
(Metric v, Fractional a) =>
v a -> v a -> v a
project V3 n
about V3 n
final
  inPanPlaneI :: V3 n
inPanPlaneI = V3 n
initial forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^-^ forall (v :: * -> *) a.
(Metric v, Fractional a) =>
v a -> v a -> v a
project V3 n
about V3 n
initial
  panAngle :: Angle n
panAngle    = forall {a}. (Floating a, Ord a) => V3 a -> V3 a -> V3 a -> Angle a
signedAngle V3 n
about V3 n
inPanPlaneI V3 n
inPanPlaneF
  pan :: Transformation V3 n
pan         = forall n.
Floating n =>
Point V3 n -> Direction V3 n -> Angle n -> Transformation V3 n
rotationAbout forall (f :: * -> *) a. (Additive f, Num a) => Point f a
origin (forall (v :: * -> *) n. v n -> Direction v n
direction V3 n
about) Angle n
panAngle
  tiltAngle :: Angle n
tiltAngle   = forall {a}. (Floating a, Ord a) => V3 a -> V3 a -> V3 a -> Angle a
signedAngle V3 n
tiltAxis (forall t. Transformable t => Transformation (V t) (N t) -> t -> t
transform Transformation V3 n
pan V3 n
initial) V3 n
final
  tiltAxis :: V3 n
tiltAxis    = forall a. Num a => V3 a -> V3 a -> V3 a
cross V3 n
final V3 n
about
  tilt :: Transformation V3 n
tilt        = forall n.
Floating n =>
Point V3 n -> Direction V3 n -> Angle n -> Transformation V3 n
rotationAbout forall (f :: * -> *) a. (Additive f, Num a) => Point f a
origin (forall (v :: * -> *) n. v n -> Direction v n
direction V3 n
tiltAxis) Angle n
tiltAngle

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

-- | Construct a transformation which scales by the given factor in
--   the z direction.
scalingZ :: (Additive v, R3 v, Fractional n) => n -> Transformation v n
scalingZ :: forall (v :: * -> *) n.
(Additive v, R3 v, Fractional n) =>
n -> Transformation v n
scalingZ n
c = forall (v :: * -> *) n.
(Additive v, Num n) =>
(v n :-: v n) -> Transformation v n
fromSymmetric forall a b. (a -> b) -> a -> b
$ (forall (t :: * -> *) a. R3 t => Lens' (t a) a
_z forall a s t. Num a => ASetter s t a a -> a -> s -> t
*~ n
c) forall u v. (u -> v) -> (v -> u) -> u :-: v
<-> (forall (t :: * -> *) a. R3 t => Lens' (t a) a
_z forall a s t. Fractional a => ASetter s t a a -> a -> s -> t
//~ n
c)

-- | Scale a diagram by the given factor in the z direction.  To scale
-- uniformly, use 'scale'.
scaleZ :: (InSpace v n t, R3 v, Fractional n, Transformable t) => n -> t -> t
scaleZ :: forall (v :: * -> *) n t.
(InSpace v n t, R3 v, Fractional n, Transformable t) =>
n -> t -> t
scaleZ = forall t. Transformable t => Transformation (V t) (N t) -> t -> t
transform forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (v :: * -> *) n.
(Additive v, R3 v, Fractional n) =>
n -> Transformation v n
scalingZ

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

-- | Construct a transformation which translates by the given distance
--   in the z direction.
translationZ :: (Additive v, R3 v, Num n) => n -> Transformation v n
translationZ :: forall (v :: * -> *) n.
(Additive v, R3 v, Num n) =>
n -> Transformation v n
translationZ n
z = forall (v :: * -> *) n. v n -> Transformation v n
translation (forall (f :: * -> *) a. (Additive f, Num a) => f a
zero forall a b. a -> (a -> b) -> b
& forall (t :: * -> *) a. R3 t => Lens' (t a) a
_z forall s t a b. ASetter s t a b -> b -> s -> t
.~ n
z)

-- | Translate a diagram by the given distance in the y
--   direction.
translateZ :: (InSpace v n t, R3 v, Transformable t) => n -> t -> t
translateZ :: forall (v :: * -> *) n t.
(InSpace v n t, R3 v, Transformable t) =>
n -> t -> t
translateZ = forall t. Transformable t => Transformation (V t) (N t) -> t -> t
transform forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (v :: * -> *) n.
(Additive v, R3 v, Num n) =>
n -> Transformation v n
translationZ

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

-- | Construct a transformation which flips a diagram across z=0,
-- i.e. sends the point (x,y,z) to (x,y,-z).
reflectionZ :: (Additive v, R3 v, Num n) => Transformation v n
reflectionZ :: forall (v :: * -> *) n.
(Additive v, R3 v, Num n) =>
Transformation v n
reflectionZ = forall (v :: * -> *) n.
(Additive v, Num n) =>
(v n :-: v n) -> Transformation v n
fromSymmetric forall a b. (a -> b) -> a -> b
$ (forall (t :: * -> *) a. R3 t => Lens' (t a) a
_z forall a s t. Num a => ASetter s t a a -> a -> s -> t
*~ (-n
1)) forall u v. (u -> v) -> (v -> u) -> u :-: v
<-> (forall (t :: * -> *) a. R3 t => Lens' (t a) a
_z forall a s t. Num a => ASetter s t a a -> a -> s -> t
*~ (-n
1))

-- | Flip a diagram across z=0, i.e. send the point (x,y,z) to
-- (x,y,-z).
reflectZ :: (InSpace v n t, R3 v, Transformable t) => t -> t
reflectZ :: forall (v :: * -> *) n t.
(InSpace v n t, R3 v, Transformable t) =>
t -> t
reflectZ = forall t. Transformable t => Transformation (V t) (N t) -> t -> t
transform forall (v :: * -> *) n.
(Additive v, R3 v, Num n) =>
Transformation v n
reflectionZ

-- | @reflectionAcross p v@ is a reflection across the plane through
--   the point @p@ and normal to vector @v@. This also works as a 2D
--   transform where @v@ is the normal to the line passing through point
--   @p@.
reflectionAcross :: (Metric v, Fractional n)
  => Point v n -> v n -> Transformation v n
reflectionAcross :: forall (v :: * -> *) n.
(Metric v, Fractional n) =>
Point v n -> v n -> Transformation v n
reflectionAcross Point v n
p v n
v =
  forall (v :: * -> *) n.
(Additive v, Num n) =>
Transformation v n -> Transformation v n -> Transformation v n
conjugate (forall (v :: * -> *) n. v n -> Transformation v n
translation (forall (f :: * -> *) a. (Additive f, Num a) => Point f a
origin forall (p :: * -> *) a. (Affine p, Num a) => p a -> p a -> Diff p a
.-. Point v n
p)) Transformation v n
reflect
    where
      reflect :: Transformation v n
reflect = forall (v :: * -> *) n.
(Additive v, Num n) =>
(v n :-: v n) -> (v n :-: v n) -> Transformation v n
fromLinear v n :-: v n
t (forall u v. (u :-: v) -> v :-: u
linv v n :-: v n
t)
      t :: v n :-: v n
t       = forall (v :: * -> *) a.
(Metric v, Fractional a) =>
v a -> v a -> v a
f v n
v forall u v. (u -> v) -> (v -> u) -> u :-: v
<-> forall (v :: * -> *) a.
(Metric v, Fractional a) =>
v a -> v a -> v a
f (forall (f :: * -> *) a. (Functor f, Num a) => f a -> f a
negated v n
v)
      f :: f a -> f a -> f a
f f a
u f a
w   = f a
w forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^-^ a
2 forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ forall (v :: * -> *) a.
(Metric v, Fractional a) =>
v a -> v a -> v a
project f a
u f a
w

-- | @reflectAcross p v@ reflects a diagram across the plane though
--   the point @p@ and the vector @v@. This also works as a 2D transform
--   where @v@ is the normal to the line passing through point @p@.
reflectAcross :: (InSpace v n t, Metric v, Fractional n, Transformable t)
  => Point v n -> v n -> t -> t
reflectAcross :: forall (v :: * -> *) n t.
(InSpace v n t, Metric v, Fractional n, Transformable t) =>
Point v n -> v n -> t -> t
reflectAcross Point v n
p v n
v = forall t. Transformable t => Transformation (V t) (N t) -> t -> t
transform (forall (v :: * -> *) n.
(Metric v, Fractional n) =>
Point v n -> v n -> Transformation v n
reflectionAcross Point v n
p v n
v)