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

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

-----------------------------------------------------------------------------
-- |
-- Module      :  Diagrams.TwoD.Transform
-- Copyright   :  (c) 2011-2015 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
       (
         T2
         -- * Rotation
       , rotation, rotate, rotateBy, rotated
       , rotationAround, rotateAround
       , rotationTo, rotateTo

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

       , scaleToX, scaleToY
       , scaleUToX, scaleUToY

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

         -- * Conformal affine maps
       , scalingRotationTo, scaleRotateTo

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

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

       ) where

import           Diagrams.Angle
import           Diagrams.Core
import           Diagrams.Core.Transform
import           Diagrams.Direction
import           Diagrams.Transform
import           Diagrams.Transform.Matrix
import           Diagrams.TwoD.Types
import           Diagrams.TwoD.Vector

import           Control.Lens              hiding (at, transform)
import           Data.Semigroup

import           Linear.Affine
import           Linear.Metric
import           Linear.V2
import           Linear.Vector

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

-- For the definitions of 'rotation' and 'rotate', see Diagrams.Angle.

-- | A synonym for 'rotate', interpreting its argument in units of
-- turns; it can be more convenient to write @rotateBy (1\/4)@ than
-- @'rotate' (1\/4 \@\@ 'turn')@.
rotateBy :: (InSpace V2 n t, Transformable t, Floating n) => n -> t -> t
rotateBy :: forall n t.
(InSpace V2 n t, Transformable t, Floating n) =>
n -> t -> t
rotateBy = forall t. Transformable t => Transformation (V t) (N t) -> t -> t
transform forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Floating n => Angle n -> Transformation V2 n
rotation forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review forall n. Floating n => Iso' (Angle n) n
turn

-- | Use an 'Angle' to make an 'Iso' between an object
--   rotated and unrotated. This us useful for performing actions
--   'under' a rotation:
--
-- @
-- under (rotated t) f = rotate (negated t) . f . rotate t
-- rotated t ## a      = rotate t a
-- a ^. rotated t      = rotate (-t) a
-- over (rotated t) f  = rotate t . f . rotate (negated t)
-- @
rotated :: (InSpace V2 n a, Floating n, SameSpace a b, Transformable a, Transformable b)
        => Angle n -> Iso a b a b
rotated :: forall n a b.
(InSpace V2 n a, Floating n, SameSpace a b, Transformable a,
 Transformable b) =>
Angle n -> Iso a b a b
rotated Angle n
a = 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 n. Floating n => Angle n -> Transformation V2 n
rotation Angle n
a

-- | @rotationAbout p@ is a rotation about the point @p@ (instead of
--   around the local origin).
rotationAround :: Floating n => P2 n -> Angle n -> T2 n
rotationAround :: forall n. Floating n => P2 n -> Angle n -> T2 n
rotationAround P2 n
p Angle n
theta =
  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
.-. P2 n
p)) (forall n. Floating n => Angle n -> Transformation V2 n
rotation Angle n
theta)

-- | @rotateAbout p@ is like 'rotate', except it rotates around the
--   point @p@ instead of around the local origin.
rotateAround :: (InSpace V2 n t, Transformable t, Floating n)
             => P2 n -> Angle n -> t -> t
rotateAround :: forall n t.
(InSpace V2 n t, Transformable t, Floating n) =>
P2 n -> Angle n -> t -> t
rotateAround P2 n
p Angle n
theta = forall t. Transformable t => Transformation (V t) (N t) -> t -> t
transform (forall n. Floating n => P2 n -> Angle n -> T2 n
rotationAround P2 n
p Angle n
theta)

-- | The rotation that aligns the x-axis with the given direction.
rotationTo :: OrderedField n => Direction V2 n -> T2 n
rotationTo :: forall n. OrderedField n => Direction V2 n -> T2 n
rotationTo (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall (v :: * -> *) n. Iso' (Direction v n) (v n)
_Dir -> V2 n
x n
y) = forall n. Floating n => Angle n -> Transformation V2 n
rotation (forall n. OrderedField n => n -> n -> Angle n
atan2A' n
y n
x)

-- | Rotate around the local origin such that the x axis aligns with the
--   given direction.
rotateTo :: (InSpace V2 n t, OrderedField n, Transformable t) => Direction V2 n -> t -> t
rotateTo :: forall n t.
(InSpace V2 n t, OrderedField n, Transformable t) =>
Direction V2 n -> t -> t
rotateTo = forall t. Transformable t => Transformation (V t) (N t) -> t -> t
transform forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. OrderedField n => Direction V2 n -> T2 n
rotationTo

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

-- | Construct a transformation which scales by the given factor in
--   the x (horizontal) direction.
scalingX :: (Additive v, R1 v, Fractional n) => n -> Transformation v n
scalingX :: forall (v :: * -> *) n.
(Additive v, R1 v, Fractional n) =>
n -> Transformation v n
scalingX 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. R1 t => Lens' (t a) a
_x 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. R1 t => Lens' (t a) a
_x 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 x (horizontal)
--   direction.  To scale uniformly, use 'scale'.
scaleX :: (InSpace v n t, R2 v, Fractional n, Transformable t) => n -> t -> t
scaleX :: forall (v :: * -> *) n t.
(InSpace v n t, R2 v, Fractional n, Transformable t) =>
n -> t -> t
scaleX = 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, R1 v, Fractional n) =>
n -> Transformation v n
scalingX

-- | Construct a transformation which scales by the given factor in
--   the y (vertical) direction.
scalingY :: (Additive v, R2 v, Fractional n) => n -> Transformation v n
scalingY :: forall (v :: * -> *) n.
(Additive v, R2 v, Fractional n) =>
n -> Transformation v n
scalingY 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. R2 t => Lens' (t a) a
_y 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. R2 t => Lens' (t a) a
_y 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 y (vertical)
--   direction.  To scale uniformly, use 'scale'.
scaleY :: (InSpace v n t, R2 v, Fractional n, Transformable t)
  => n -> t -> t
scaleY :: forall (v :: * -> *) n t.
(InSpace v n t, R2 v, Fractional n, Transformable t) =>
n -> t -> t
scaleY = 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, R2 v, Fractional n) =>
n -> Transformation v n
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 :: (InSpace v n t, R2 v, Enveloped t, Transformable t) => n -> t -> t
scaleToX :: forall (v :: * -> *) n t.
(InSpace v n t, R2 v, Enveloped t, Transformable t) =>
n -> t -> t
scaleToX n
w t
d = forall (v :: * -> *) n t.
(InSpace v n t, R2 v, Fractional n, Transformable t) =>
n -> t -> t
scaleX (n
w forall a. Fractional a => a -> a -> a
/ forall a (v :: * -> *) n.
(V a ~ v, N a ~ n, Enveloped a) =>
v n -> a -> n
diameter forall (v :: * -> *) n. (R1 v, Additive v, Num n) => v n
unitX t
d) t
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 :: (InSpace v n t, R2 v, Enveloped t, Transformable t) => n -> t -> t
scaleToY :: forall (v :: * -> *) n t.
(InSpace v n t, R2 v, Enveloped t, Transformable t) =>
n -> t -> t
scaleToY n
h t
d = forall (v :: * -> *) n t.
(InSpace v n t, R2 v, Fractional n, Transformable t) =>
n -> t -> t
scaleY (n
h forall a. Fractional a => a -> a -> a
/ forall a (v :: * -> *) n.
(V a ~ v, N a ~ n, Enveloped a) =>
v n -> a -> n
diameter forall (v :: * -> *) n. (R2 v, Additive v, Num n) => v n
unitY t
d) t
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 :: (InSpace v n t, R1 v, Enveloped t, Transformable t) => n -> t -> t
scaleUToX :: forall (v :: * -> *) n t.
(InSpace v n t, R1 v, Enveloped t, Transformable t) =>
n -> t -> t
scaleUToX n
w t
d = forall (v :: * -> *) n a.
(InSpace v n a, Eq n, Fractional n, Transformable a) =>
n -> a -> a
scale (n
w forall a. Fractional a => a -> a -> a
/ forall a (v :: * -> *) n.
(V a ~ v, N a ~ n, Enveloped a) =>
v n -> a -> n
diameter forall (v :: * -> *) n. (R1 v, Additive v, Num n) => v n
unitX t
d) t
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 :: (InSpace v n t, R2 v, Enveloped t, Transformable t) => n -> t -> t
scaleUToY :: forall (v :: * -> *) n t.
(InSpace v n t, R2 v, Enveloped t, Transformable t) =>
n -> t -> t
scaleUToY n
h t
d = forall (v :: * -> *) n a.
(InSpace v n a, Eq n, Fractional n, Transformable a) =>
n -> a -> a
scale (n
h forall a. Fractional a => a -> a -> a
/ forall a (v :: * -> *) n.
(V a ~ v, N a ~ n, Enveloped a) =>
v n -> a -> n
diameter forall (v :: * -> *) n. (R2 v, Additive v, Num n) => v n
unitY t
d) t
d

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

-- | Construct a transformation which translates by the given distance
--   in the x (horizontal) direction.
translationX :: (Additive v, R1 v, Num n) => n -> Transformation v n
translationX :: forall (v :: * -> *) n.
(Additive v, R1 v, Num n) =>
n -> Transformation v n
translationX n
x = 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. R1 t => Lens' (t a) a
_x forall s t a b. ASetter s t a b -> b -> s -> t
.~ n
x)

-- | Translate a diagram by the given distance in the x (horizontal)
--   direction.
translateX :: (InSpace v n t, R1 v, Transformable t) => n -> t -> t
translateX :: forall (v :: * -> *) n t.
(InSpace v n t, R1 v, Transformable t) =>
n -> t -> t
translateX = 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, R1 v, Num n) =>
n -> Transformation v n
translationX

-- | Construct a transformation which translates by the given distance
--   in the y (vertical) direction.
translationY :: (Additive v, R2 v, Num n) => n -> Transformation v n
translationY :: forall (v :: * -> *) n.
(Additive v, R2 v, Num n) =>
n -> Transformation v n
translationY n
y = 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. R2 t => Lens' (t a) a
_y forall s t a b. ASetter s t a b -> b -> s -> t
.~ n
y)

-- | Translate a diagram by the given distance in the y (vertical)
--   direction.
translateY :: (InSpace v n t, R2 v, Transformable t)
  => n -> t -> t
translateY :: forall (v :: * -> *) n t.
(InSpace v n t, R2 v, Transformable t) =>
n -> t -> t
translateY = 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, R2 v, Num n) =>
n -> Transformation v n
translationY

-- Conformal affine maps -----------------------------------

-- | The angle-preserving linear map that aligns the x-axis unit vector
--   with the given vector.  See also 'scaleRotateTo'.
scalingRotationTo :: (Floating n) => V2 n -> T2 n
scalingRotationTo :: forall n. Floating n => V2 n -> T2 n
scalingRotationTo V2 n
v = forall (v :: * -> *) n.
(Additive v, Distributive v, Foldable v, Num n) =>
v (v n) -> v (v n) -> v n -> Transformation v n
fromMatWithInv (forall {a}. Num a => V2 a -> V2 (V2 a)
conf V2 n
v) (forall {a}. Num a => V2 a -> V2 (V2 a)
conf V2 n
w) forall (f :: * -> *) a. (Additive f, Num a) => f a
zero
  where
    w :: V2 n
w = forall (v :: * -> *) n t.
(InSpace v n t, R2 v, Transformable t) =>
t -> t
reflectY (V2 n
v forall (f :: * -> *) a.
(Functor f, Fractional a) =>
f a -> a -> f a
^/ forall (f :: * -> *) a. (Metric f, Num a) => f a -> a
quadrance V2 n
v)
    conf :: V2 a -> V2 (V2 a)
conf (V2 a
a a
b) = (forall a. a -> a -> V2 a
V2 (forall a. a -> a -> V2 a
V2 a
a (-a
b)) (forall a. a -> a -> V2 a
V2 a
b a
a))

-- | Rotate and uniformly scale around the local origin such that the
--   x-axis aligns with the given vector.  This satisfies the equation
--
-- @
-- scaleRotateTo v = rotateTo (dir v) . scale (norm v)
-- @
--
-- up to floating point rounding errors, but is more accurate and
-- performant since it avoids cancellable uses of trigonometric functions.
scaleRotateTo :: (InSpace V2 n t, Transformable t, Floating n)
              => V2 n -> t -> t
scaleRotateTo :: forall n t.
(InSpace V2 n t, Transformable t, Floating n) =>
V2 n -> t -> t
scaleRotateTo = forall t. Transformable t => Transformation (V t) (N t) -> t -> t
transform forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Floating n => V2 n -> T2 n
scalingRotationTo

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

-- | Construct a transformation which flips a diagram from left to
--   right, i.e. sends the point (x,y) to (-x,y).
reflectionX :: (Additive v, R1 v, Num n) => Transformation v n
reflectionX :: forall (v :: * -> *) n.
(Additive v, R1 v, Num n) =>
Transformation v n
reflectionX = 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. R1 t => Lens' (t a) a
_x 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. R1 t => Lens' (t a) a
_x forall a s t. Num a => ASetter s t a a -> a -> s -> t
*~ (-n
1))

-- | Flip a diagram from left to right, i.e. send the point (x,y) to
--   (-x,y).
reflectX :: (InSpace v n t, R1 v, Transformable t) => t -> t
reflectX :: forall (v :: * -> *) n t.
(InSpace v n t, R1 v, Transformable t) =>
t -> t
reflectX = forall t. Transformable t => Transformation (V t) (N t) -> t -> t
transform forall (v :: * -> *) n.
(Additive v, R1 v, Num n) =>
Transformation v n
reflectionX

-- | Construct a transformation which flips a diagram from top to
--   bottom, i.e. sends the point (x,y) to (x,-y).
reflectionY :: (Additive v, R2 v, Num n) => Transformation v n
reflectionY :: forall (v :: * -> *) n.
(Additive v, R2 v, Num n) =>
Transformation v n
reflectionY = 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. R2 t => Lens' (t a) a
_y 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. R2 t => Lens' (t a) a
_y forall a s t. Num a => ASetter s t a a -> a -> s -> t
*~ (-n
1))

-- | Flip a diagram from top to bottom, i.e. send the point (x,y) to
--   (x,-y).
reflectY :: (InSpace v n t, R2 v, Transformable t) => t -> t
reflectY :: forall (v :: * -> *) n t.
(InSpace v n t, R2 v, Transformable t) =>
t -> t
reflectY = forall t. Transformable t => Transformation (V t) (N t) -> t -> t
transform forall (v :: * -> *) n.
(Additive v, R2 v, Num n) =>
Transformation v n
reflectionY

-- | Construct a transformation which flips the diagram about x=y, i.e.
--   sends the point (x,y) to (y,x).
reflectionXY :: (Additive v, R2 v, Num n) => Transformation v n
reflectionXY :: forall (v :: * -> *) n.
(Additive v, R2 v, Num n) =>
Transformation v n
reflectionXY = 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. R2 t => Lens' (t a) (V2 a)
_xy forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall (t :: * -> *) a. R2 t => Lens' (t a) (V2 a)
_yx) forall u v. (u -> v) -> (v -> u) -> u :-: v
<-> (forall (t :: * -> *) a. R2 t => Lens' (t a) (V2 a)
_xy forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall (t :: * -> *) a. R2 t => Lens' (t a) (V2 a)
_yx)

-- | Flips the diagram about x=y, i.e. send the point (x,y) to (y,x).
reflectXY :: (InSpace v n t, R2 v, Transformable t) => t -> t
reflectXY :: forall (v :: * -> *) n t.
(InSpace v n t, R2 v, Transformable t) =>
t -> t
reflectXY = forall t. Transformable t => Transformation (V t) (N t) -> t -> t
transform forall (v :: * -> *) n.
(Additive v, R2 v, Num n) =>
Transformation v n
reflectionXY

-- | @reflectionAbout p d@ is a reflection in the line determined by
--   the point @p@ and direction @d@.
reflectionAbout :: OrderedField n => P2 n -> Direction V2 n -> T2 n
reflectionAbout :: forall n. OrderedField n => P2 n -> Direction V2 n -> T2 n
reflectionAbout P2 n
p Direction V2 n
d =
  forall (v :: * -> *) n.
(Additive v, Num n) =>
Transformation v n -> Transformation v n -> Transformation v n
conjugate (forall n. OrderedField n => Direction V2 n -> T2 n
rotationTo (forall (v :: * -> *) n t.
(InSpace v n t, R2 v, Transformable t) =>
t -> t
reflectY Direction V2 n
d) forall a. Semigroup a => a -> a -> a
<> 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
.-. P2 n
p))
            forall (v :: * -> *) n.
(Additive v, R2 v, Num n) =>
Transformation v n
reflectionY




-- | @reflectAbout p d@ reflects a diagram in the line determined by
--   the point @p@ and direction @d@.
reflectAbout :: (InSpace V2 n t, OrderedField n, Transformable t)
             => P2 n -> Direction V2 n -> t -> t
reflectAbout :: forall n t.
(InSpace V2 n t, OrderedField n, Transformable t) =>
P2 n -> Direction V2 n -> t -> t
reflectAbout P2 n
p Direction V2 n
v = forall t. Transformable t => Transformation (V t) (N t) -> t -> t
transform (forall n. OrderedField n => P2 n -> Direction V2 n -> T2 n
reflectionAbout P2 n
p Direction V2 n
v)

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

-- auxiliary functions for shearingX/shearingY
sh :: (n -> n -> n -> n) -> (n -> n -> n -> n) -> n -> V2 n -> V2 n
sh :: forall n.
(n -> n -> n -> n) -> (n -> n -> n -> n) -> n -> V2 n -> V2 n
sh n -> n -> n -> n
f n -> n -> n -> n
g n
k (V2 n
x n
y) = forall a. a -> a -> V2 a
V2 (n -> n -> n -> n
f n
k n
x n
y) (n -> n -> n -> n
g n
k n
x n
y)

sh' :: (n -> n -> n -> n) -> (n -> n -> n -> n) -> n -> V2 n -> V2 n
sh' :: forall n.
(n -> n -> n -> n) -> (n -> n -> n -> n) -> n -> V2 n -> V2 n
sh' n -> n -> n -> n
f n -> n -> n -> n
g n
k = forall n. V2 n -> V2 n
swap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n.
(n -> n -> n -> n) -> (n -> n -> n -> n) -> n -> V2 n -> V2 n
sh n -> n -> n -> n
f n -> n -> n -> n
g n
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. V2 n -> V2 n
swap

swap :: V2 n -> V2 n
swap :: forall n. V2 n -> V2 n
swap (V2 n
x n
y) = forall a. a -> a -> V2 a
V2 n
y n
x
{-# INLINE swap #-}

-- | @shearingX d@ is the linear transformation which is the identity on
--   y coordinates and sends @(0,1)@ to @(d,1)@.
shearingX :: Num n => n -> T2 n
shearingX :: forall n. Num n => n -> T2 n
shearingX n
d = forall (v :: * -> *) n.
(Additive v, Num n) =>
(v n :-: v n) -> (v n :-: v n) -> Transformation v n
fromLinear (forall n.
(n -> n -> n -> n) -> (n -> n -> n -> n) -> n -> V2 n -> V2 n
sh forall {a}. Num a => a -> a -> a -> a
f forall {p} {p} {p}. p -> p -> p -> p
g n
d  forall u v. (u -> v) -> (v -> u) -> u :-: v
<-> forall n.
(n -> n -> n -> n) -> (n -> n -> n -> n) -> n -> V2 n -> V2 n
sh forall {a}. Num a => a -> a -> a -> a
f forall {p} {p} {p}. p -> p -> p -> p
g (-n
d))
                         (forall n.
(n -> n -> n -> n) -> (n -> n -> n -> n) -> n -> V2 n -> V2 n
sh' forall {a}. Num a => a -> a -> a -> a
f forall {p} {p} {p}. p -> p -> p -> p
g n
d forall u v. (u -> v) -> (v -> u) -> u :-: v
<-> forall n.
(n -> n -> n -> n) -> (n -> n -> n -> n) -> n -> V2 n -> V2 n
sh' forall {a}. Num a => a -> a -> a -> a
f forall {p} {p} {p}. p -> p -> p -> p
g (-n
d))
  where
    f :: a -> a -> a -> a
f a
k a
x a
y = a
x forall a. Num a => a -> a -> a
+ a
kforall a. Num a => a -> a -> a
*a
y
    g :: p -> p -> p -> p
g p
_ p
_ p
y = p
y

-- | @shearX d@ performs a shear in the x-direction which sends
--   @(0,1)@ to @(d,1)@.
shearX :: (InSpace V2 n t, Transformable t) => n -> t -> t
shearX :: forall n t. (InSpace V2 n t, Transformable t) => n -> t -> t
shearX = forall t. Transformable t => Transformation (V t) (N t) -> t -> t
transform forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Num n => n -> T2 n
shearingX

-- | @shearingY d@ is the linear transformation which is the identity on
--   x coordinates and sends @(1,0)@ to @(1,d)@.
shearingY :: Num n => n -> T2 n
shearingY :: forall n. Num n => n -> T2 n
shearingY n
d = forall (v :: * -> *) n.
(Additive v, Num n) =>
(v n :-: v n) -> (v n :-: v n) -> Transformation v n
fromLinear (forall n.
(n -> n -> n -> n) -> (n -> n -> n -> n) -> n -> V2 n -> V2 n
sh forall {p} {p} {p}. p -> p -> p -> p
f forall {a}. Num a => a -> a -> a -> a
g n
d  forall u v. (u -> v) -> (v -> u) -> u :-: v
<-> forall n.
(n -> n -> n -> n) -> (n -> n -> n -> n) -> n -> V2 n -> V2 n
sh forall {p} {p} {p}. p -> p -> p -> p
f forall {a}. Num a => a -> a -> a -> a
g (-n
d))
                         (forall n.
(n -> n -> n -> n) -> (n -> n -> n -> n) -> n -> V2 n -> V2 n
sh' forall {p} {p} {p}. p -> p -> p -> p
f forall {a}. Num a => a -> a -> a -> a
g n
d forall u v. (u -> v) -> (v -> u) -> u :-: v
<-> forall n.
(n -> n -> n -> n) -> (n -> n -> n -> n) -> n -> V2 n -> V2 n
sh' forall {p} {p} {p}. p -> p -> p -> p
f forall {a}. Num a => a -> a -> a -> a
g (-n
d))
        where
          f :: p -> p -> p -> p
f p
_ p
x p
_ = p
x
          g :: a -> a -> a -> a
g a
k a
x a
y = a
y forall a. Num a => a -> a -> a
+ a
kforall a. Num a => a -> a -> a
*a
x

-- | @shearY d@ performs a shear in the y-direction which sends
--   @(1,0)@ to @(1,d)@.
shearY :: (InSpace V2 n t, Transformable t) => n -> t -> t
shearY :: forall n t. (InSpace V2 n t, Transformable t) => n -> t -> t
shearY = forall t. Transformable t => Transformation (V t) (N t) -> t -> t
transform forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Num n => n -> T2 n
shearingY