{-# 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 = Transformation (V t) (N t) -> t -> t
Transformation V2 n -> t -> t
forall t. Transformable t => Transformation (V t) (N t) -> t -> t
transform (Transformation V2 n -> t -> t)
-> (n -> Transformation V2 n) -> n -> t -> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Angle n -> Transformation V2 n
forall n. Floating n => Angle n -> Transformation V2 n
rotation (Angle n -> Transformation V2 n)
-> (n -> Angle n) -> n -> Transformation V2 n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AReview (Angle n) n -> n -> Angle n
forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review AReview (Angle n) n
forall n. Floating n => Iso' (Angle n) 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 = Transformation V2 n -> Iso a b a b
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 V2 n -> Iso a b a b)
-> Transformation V2 n -> Iso a b a b
forall a b. (a -> b) -> a -> b
$ Angle n -> Transformation V2 n
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 =
  Transformation V2 n -> Transformation V2 n -> Transformation V2 n
forall (v :: * -> *) n.
(Additive v, Num n) =>
Transformation v n -> Transformation v n -> Transformation v n
conjugate (V2 n -> Transformation V2 n
forall (v :: * -> *) n. v n -> Transformation v n
translation (P2 n
forall (f :: * -> *) a. (Additive f, Num a) => Point f a
origin P2 n -> P2 n -> Diff (Point V2) n
forall a. Num a => Point V2 a -> Point V2 a -> Diff (Point V2) a
forall (p :: * -> *) a. (Affine p, Num a) => p a -> p a -> Diff p a
.-. P2 n
p)) (Angle n -> Transformation V2 n
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 = Transformation (V t) (N t) -> t -> t
forall t. Transformable t => Transformation (V t) (N t) -> t -> t
transform (P2 n -> Angle n -> T2 n
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 (Getting (V2 n) (Direction V2 n) (V2 n) -> Direction V2 n -> V2 n
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (V2 n) (Direction V2 n) (V2 n)
forall (v :: * -> *) n (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p (v n) (f (v n)) -> p (Direction v n) (f (Direction v n))
_Dir -> V2 n
x n
y) = Angle n -> Transformation V2 n
forall n. Floating n => Angle n -> Transformation V2 n
rotation (n -> n -> Angle n
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 = Transformation (V t) (N t) -> t -> t
Transformation V2 n -> t -> t
forall t. Transformable t => Transformation (V t) (N t) -> t -> t
transform (Transformation V2 n -> t -> t)
-> (Direction V2 n -> Transformation V2 n)
-> Direction V2 n
-> t
-> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Direction V2 n -> Transformation V2 n
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 = (v n :-: v n) -> Transformation v n
forall (v :: * -> *) n.
(Additive v, Num n) =>
(v n :-: v n) -> Transformation v n
fromSymmetric ((v n :-: v n) -> Transformation v n)
-> (v n :-: v n) -> Transformation v n
forall a b. (a -> b) -> a -> b
$ ((n -> Identity n) -> v n -> Identity (v n)
forall a. Lens' (v a) a
forall (t :: * -> *) a. R1 t => Lens' (t a) a
_x ((n -> Identity n) -> v n -> Identity (v n)) -> n -> v n -> v n
forall a s t. Num a => ASetter s t a a -> a -> s -> t
*~ n
c) (v n -> v n) -> (v n -> v n) -> v n :-: v n
forall u v. (u -> v) -> (v -> u) -> u :-: v
<-> ((n -> Identity n) -> v n -> Identity (v n)
forall a. Lens' (v a) a
forall (t :: * -> *) a. R1 t => Lens' (t a) a
_x ((n -> Identity n) -> v n -> Identity (v n)) -> n -> v n -> v n
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 = Transformation v n -> t -> t
Transformation (V t) (N t) -> t -> t
forall t. Transformable t => Transformation (V t) (N t) -> t -> t
transform (Transformation v n -> t -> t)
-> (n -> Transformation v n) -> n -> t -> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n -> Transformation v n
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 = (v n :-: v n) -> Transformation v n
forall (v :: * -> *) n.
(Additive v, Num n) =>
(v n :-: v n) -> Transformation v n
fromSymmetric ((v n :-: v n) -> Transformation v n)
-> (v n :-: v n) -> Transformation v n
forall a b. (a -> b) -> a -> b
$ ((n -> Identity n) -> v n -> Identity (v n)
forall a. Lens' (v a) a
forall (t :: * -> *) a. R2 t => Lens' (t a) a
_y ((n -> Identity n) -> v n -> Identity (v n)) -> n -> v n -> v n
forall a s t. Num a => ASetter s t a a -> a -> s -> t
*~ n
c) (v n -> v n) -> (v n -> v n) -> v n :-: v n
forall u v. (u -> v) -> (v -> u) -> u :-: v
<-> ((n -> Identity n) -> v n -> Identity (v n)
forall a. Lens' (v a) a
forall (t :: * -> *) a. R2 t => Lens' (t a) a
_y ((n -> Identity n) -> v n -> Identity (v n)) -> n -> v n -> v n
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 = Transformation v n -> t -> t
Transformation (V t) (N t) -> t -> t
forall t. Transformable t => Transformation (V t) (N t) -> t -> t
transform (Transformation v n -> t -> t)
-> (n -> Transformation v n) -> n -> t -> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n -> Transformation v n
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 = n -> t -> t
forall (v :: * -> *) n t.
(InSpace v n t, R2 v, Fractional n, Transformable t) =>
n -> t -> t
scaleX (n
w n -> n -> n
forall a. Fractional a => a -> a -> a
/ v n -> t -> n
forall a (v :: * -> *) n.
(V a ~ v, N a ~ n, Enveloped a) =>
v n -> a -> n
diameter v n
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 = n -> t -> t
forall (v :: * -> *) n t.
(InSpace v n t, R2 v, Fractional n, Transformable t) =>
n -> t -> t
scaleY (n
h n -> n -> n
forall a. Fractional a => a -> a -> a
/ v n -> t -> n
forall a (v :: * -> *) n.
(V a ~ v, N a ~ n, Enveloped a) =>
v n -> a -> n
diameter v n
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 = n -> t -> t
forall (v :: * -> *) n a.
(InSpace v n a, Eq n, Fractional n, Transformable a) =>
n -> a -> a
scale (n
w n -> n -> n
forall a. Fractional a => a -> a -> a
/ v n -> t -> n
forall a (v :: * -> *) n.
(V a ~ v, N a ~ n, Enveloped a) =>
v n -> a -> n
diameter v n
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 = n -> t -> t
forall (v :: * -> *) n a.
(InSpace v n a, Eq n, Fractional n, Transformable a) =>
n -> a -> a
scale (n
h n -> n -> n
forall a. Fractional a => a -> a -> a
/ v n -> t -> n
forall a (v :: * -> *) n.
(V a ~ v, N a ~ n, Enveloped a) =>
v n -> a -> n
diameter v n
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 = v n -> Transformation v n
forall (v :: * -> *) n. v n -> Transformation v n
translation (v n
forall a. Num a => v a
forall (f :: * -> *) a. (Additive f, Num a) => f a
zero v n -> (v n -> v n) -> v n
forall a b. a -> (a -> b) -> b
& (n -> Identity n) -> v n -> Identity (v n)
forall a. Lens' (v a) a
forall (t :: * -> *) a. R1 t => Lens' (t a) a
_x ((n -> Identity n) -> v n -> Identity (v n)) -> n -> v n -> v n
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 = Transformation v n -> t -> t
Transformation (V t) (N t) -> t -> t
forall t. Transformable t => Transformation (V t) (N t) -> t -> t
transform (Transformation v n -> t -> t)
-> (n -> Transformation v n) -> n -> t -> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n -> Transformation v n
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 = v n -> Transformation v n
forall (v :: * -> *) n. v n -> Transformation v n
translation (v n
forall a. Num a => v a
forall (f :: * -> *) a. (Additive f, Num a) => f a
zero v n -> (v n -> v n) -> v n
forall a b. a -> (a -> b) -> b
& (n -> Identity n) -> v n -> Identity (v n)
forall a. Lens' (v a) a
forall (t :: * -> *) a. R2 t => Lens' (t a) a
_y ((n -> Identity n) -> v n -> Identity (v n)) -> n -> v n -> v n
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 = Transformation v n -> t -> t
Transformation (V t) (N t) -> t -> t
forall t. Transformable t => Transformation (V t) (N t) -> t -> t
transform (Transformation v n -> t -> t)
-> (n -> Transformation v n) -> n -> t -> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n -> Transformation v n
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 = V2 (V2 n) -> V2 (V2 n) -> V2 n -> Transformation V2 n
forall (v :: * -> *) n.
(Additive v, Distributive v, Foldable v, Num n) =>
v (v n) -> v (v n) -> v n -> Transformation v n
fromMatWithInv (V2 n -> V2 (V2 n)
forall {a}. Num a => V2 a -> V2 (V2 a)
conf V2 n
v) (V2 n -> V2 (V2 n)
forall {a}. Num a => V2 a -> V2 (V2 a)
conf V2 n
w) V2 n
forall a. Num a => V2 a
forall (f :: * -> *) a. (Additive f, Num a) => f a
zero
  where
    w :: V2 n
w = V2 n -> V2 n
forall (v :: * -> *) n t.
(InSpace v n t, R2 v, Transformable t) =>
t -> t
reflectY (V2 n
v V2 n -> n -> V2 n
forall (f :: * -> *) a.
(Functor f, Fractional a) =>
f a -> a -> f a
^/ V2 n -> n
forall a. Num a => V2 a -> 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) = (V2 a -> V2 a -> V2 (V2 a)
forall a. a -> a -> V2 a
V2 (a -> a -> V2 a
forall a. a -> a -> V2 a
V2 a
a (-a
b)) (a -> a -> V2 a
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 = Transformation (V t) (N t) -> t -> t
Transformation V2 n -> t -> t
forall t. Transformable t => Transformation (V t) (N t) -> t -> t
transform (Transformation V2 n -> t -> t)
-> (V2 n -> Transformation V2 n) -> V2 n -> t -> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. V2 n -> Transformation V2 n
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 = (v n :-: v n) -> Transformation v n
forall (v :: * -> *) n.
(Additive v, Num n) =>
(v n :-: v n) -> Transformation v n
fromSymmetric ((v n :-: v n) -> Transformation v n)
-> (v n :-: v n) -> Transformation v n
forall a b. (a -> b) -> a -> b
$ ((n -> Identity n) -> v n -> Identity (v n)
forall a. Lens' (v a) a
forall (t :: * -> *) a. R1 t => Lens' (t a) a
_x ((n -> Identity n) -> v n -> Identity (v n)) -> n -> v n -> v n
forall a s t. Num a => ASetter s t a a -> a -> s -> t
*~ (-n
1)) (v n -> v n) -> (v n -> v n) -> v n :-: v n
forall u v. (u -> v) -> (v -> u) -> u :-: v
<-> ((n -> Identity n) -> v n -> Identity (v n)
forall a. Lens' (v a) a
forall (t :: * -> *) a. R1 t => Lens' (t a) a
_x ((n -> Identity n) -> v n -> Identity (v n)) -> n -> v n -> v n
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 = Transformation (V t) (N t) -> t -> t
forall t. Transformable t => Transformation (V t) (N t) -> t -> t
transform Transformation v n
Transformation (V t) (N t)
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 = (v n :-: v n) -> Transformation v n
forall (v :: * -> *) n.
(Additive v, Num n) =>
(v n :-: v n) -> Transformation v n
fromSymmetric ((v n :-: v n) -> Transformation v n)
-> (v n :-: v n) -> Transformation v n
forall a b. (a -> b) -> a -> b
$ ((n -> Identity n) -> v n -> Identity (v n)
forall a. Lens' (v a) a
forall (t :: * -> *) a. R2 t => Lens' (t a) a
_y ((n -> Identity n) -> v n -> Identity (v n)) -> n -> v n -> v n
forall a s t. Num a => ASetter s t a a -> a -> s -> t
*~ (-n
1)) (v n -> v n) -> (v n -> v n) -> v n :-: v n
forall u v. (u -> v) -> (v -> u) -> u :-: v
<-> ((n -> Identity n) -> v n -> Identity (v n)
forall a. Lens' (v a) a
forall (t :: * -> *) a. R2 t => Lens' (t a) a
_y ((n -> Identity n) -> v n -> Identity (v n)) -> n -> v n -> v n
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 = Transformation (V t) (N t) -> t -> t
forall t. Transformable t => Transformation (V t) (N t) -> t -> t
transform Transformation v n
Transformation (V t) (N t)
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 = (v n :-: v n) -> Transformation v n
forall (v :: * -> *) n.
(Additive v, Num n) =>
(v n :-: v n) -> Transformation v n
fromSymmetric ((v n :-: v n) -> Transformation v n)
-> (v n :-: v n) -> Transformation v n
forall a b. (a -> b) -> a -> b
$ ((V2 n -> Identity (V2 n)) -> v n -> Identity (v n)
forall a. Lens' (v a) (V2 a)
forall (t :: * -> *) a. R2 t => Lens' (t a) (V2 a)
_xy ((V2 n -> Identity (V2 n)) -> v n -> Identity (v n))
-> (V2 n -> V2 n) -> v n -> v n
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Getting (V2 n) (V2 n) (V2 n) -> V2 n -> V2 n
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (V2 n) (V2 n) (V2 n)
Lens' (V2 n) (V2 n)
forall (t :: * -> *) a. R2 t => Lens' (t a) (V2 a)
_yx) (v n -> v n) -> (v n -> v n) -> v n :-: v n
forall u v. (u -> v) -> (v -> u) -> u :-: v
<-> ((V2 n -> Identity (V2 n)) -> v n -> Identity (v n)
forall a. Lens' (v a) (V2 a)
forall (t :: * -> *) a. R2 t => Lens' (t a) (V2 a)
_xy ((V2 n -> Identity (V2 n)) -> v n -> Identity (v n))
-> (V2 n -> V2 n) -> v n -> v n
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Getting (V2 n) (V2 n) (V2 n) -> V2 n -> V2 n
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (V2 n) (V2 n) (V2 n)
Lens' (V2 n) (V2 n)
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 = Transformation (V t) (N t) -> t -> t
forall t. Transformable t => Transformation (V t) (N t) -> t -> t
transform Transformation v n
Transformation (V t) (N t)
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 =
  Transformation V2 n -> Transformation V2 n -> Transformation V2 n
forall (v :: * -> *) n.
(Additive v, Num n) =>
Transformation v n -> Transformation v n -> Transformation v n
conjugate (Direction V2 n -> Transformation V2 n
forall n. OrderedField n => Direction V2 n -> T2 n
rotationTo (Direction V2 n -> Direction V2 n
forall (v :: * -> *) n t.
(InSpace v n t, R2 v, Transformable t) =>
t -> t
reflectY Direction V2 n
d) Transformation V2 n -> Transformation V2 n -> Transformation V2 n
forall a. Semigroup a => a -> a -> a
<> V2 n -> Transformation V2 n
forall (v :: * -> *) n. v n -> Transformation v n
translation (P2 n
forall (f :: * -> *) a. (Additive f, Num a) => Point f a
origin P2 n -> P2 n -> Diff (Point V2) n
forall a. Num a => Point V2 a -> Point V2 a -> Diff (Point V2) a
forall (p :: * -> *) a. (Affine p, Num a) => p a -> p a -> Diff p a
.-. P2 n
p))
            Transformation V2 n
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 = Transformation (V t) (N t) -> t -> t
forall t. Transformable t => Transformation (V t) (N t) -> t -> t
transform (P2 n -> Direction V2 n -> T2 n
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) = n -> n -> V2 n
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 = V2 n -> V2 n
forall n. V2 n -> V2 n
swap (V2 n -> V2 n) -> (V2 n -> V2 n) -> V2 n -> V2 n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (n -> n -> n -> n) -> (n -> n -> n -> n) -> n -> V2 n -> V2 n
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 -> V2 n) -> (V2 n -> V2 n) -> V2 n -> V2 n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. V2 n -> V2 n
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) = n -> n -> V2 n
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 = (V2 n :-: V2 n) -> (V2 n :-: V2 n) -> Transformation V2 n
forall (v :: * -> *) n.
(Additive v, Num n) =>
(v n :-: v n) -> (v n :-: v n) -> Transformation v n
fromLinear ((n -> n -> n -> n) -> (n -> n -> n -> n) -> n -> V2 n -> V2 n
forall n.
(n -> n -> n -> n) -> (n -> n -> n -> n) -> n -> V2 n -> V2 n
sh n -> n -> n -> n
forall {a}. Num a => a -> a -> a -> a
f n -> n -> n -> n
forall {p} {p} {p}. p -> p -> p -> p
g n
d  (V2 n -> V2 n) -> (V2 n -> V2 n) -> V2 n :-: V2 n
forall u v. (u -> v) -> (v -> u) -> u :-: v
<-> (n -> n -> n -> n) -> (n -> n -> n -> n) -> n -> V2 n -> V2 n
forall n.
(n -> n -> n -> n) -> (n -> n -> n -> n) -> n -> V2 n -> V2 n
sh n -> n -> n -> n
forall {a}. Num a => a -> a -> a -> a
f n -> n -> n -> n
forall {p} {p} {p}. p -> p -> p -> p
g (-n
d))
                         ((n -> n -> n -> n) -> (n -> n -> n -> n) -> n -> V2 n -> V2 n
forall n.
(n -> n -> n -> n) -> (n -> n -> n -> n) -> n -> V2 n -> V2 n
sh' n -> n -> n -> n
forall {a}. Num a => a -> a -> a -> a
f n -> n -> n -> n
forall {p} {p} {p}. p -> p -> p -> p
g n
d (V2 n -> V2 n) -> (V2 n -> V2 n) -> V2 n :-: V2 n
forall u v. (u -> v) -> (v -> u) -> u :-: v
<-> (n -> n -> n -> n) -> (n -> n -> n -> n) -> n -> V2 n -> V2 n
forall n.
(n -> n -> n -> n) -> (n -> n -> n -> n) -> n -> V2 n -> V2 n
sh' n -> n -> n -> n
forall {a}. Num a => a -> a -> a -> a
f n -> n -> n -> n
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 a -> a -> a
forall a. Num a => a -> a -> a
+ a
ka -> a -> a
forall 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 = Transformation (V t) (N t) -> t -> t
Transformation V2 n -> t -> t
forall t. Transformable t => Transformation (V t) (N t) -> t -> t
transform (Transformation V2 n -> t -> t)
-> (n -> Transformation V2 n) -> n -> t -> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n -> Transformation V2 n
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 = (V2 n :-: V2 n) -> (V2 n :-: V2 n) -> Transformation V2 n
forall (v :: * -> *) n.
(Additive v, Num n) =>
(v n :-: v n) -> (v n :-: v n) -> Transformation v n
fromLinear ((n -> n -> n -> n) -> (n -> n -> n -> n) -> n -> V2 n -> V2 n
forall n.
(n -> n -> n -> n) -> (n -> n -> n -> n) -> n -> V2 n -> V2 n
sh n -> n -> n -> n
forall {p} {p} {p}. p -> p -> p -> p
f n -> n -> n -> n
forall {a}. Num a => a -> a -> a -> a
g n
d  (V2 n -> V2 n) -> (V2 n -> V2 n) -> V2 n :-: V2 n
forall u v. (u -> v) -> (v -> u) -> u :-: v
<-> (n -> n -> n -> n) -> (n -> n -> n -> n) -> n -> V2 n -> V2 n
forall n.
(n -> n -> n -> n) -> (n -> n -> n -> n) -> n -> V2 n -> V2 n
sh n -> n -> n -> n
forall {p} {p} {p}. p -> p -> p -> p
f n -> n -> n -> n
forall {a}. Num a => a -> a -> a -> a
g (-n
d))
                         ((n -> n -> n -> n) -> (n -> n -> n -> n) -> n -> V2 n -> V2 n
forall n.
(n -> n -> n -> n) -> (n -> n -> n -> n) -> n -> V2 n -> V2 n
sh' n -> n -> n -> n
forall {p} {p} {p}. p -> p -> p -> p
f n -> n -> n -> n
forall {a}. Num a => a -> a -> a -> a
g n
d (V2 n -> V2 n) -> (V2 n -> V2 n) -> V2 n :-: V2 n
forall u v. (u -> v) -> (v -> u) -> u :-: v
<-> (n -> n -> n -> n) -> (n -> n -> n -> n) -> n -> V2 n -> V2 n
forall n.
(n -> n -> n -> n) -> (n -> n -> n -> n) -> n -> V2 n -> V2 n
sh' n -> n -> n -> n
forall {p} {p} {p}. p -> p -> p -> p
f n -> n -> n -> n
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 a -> a -> a
forall a. Num a => a -> a -> a
+ a
ka -> a -> a
forall 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 = Transformation (V t) (N t) -> t -> t
Transformation V2 n -> t -> t
forall t. Transformable t => Transformation (V t) (N t) -> t -> t
transform (Transformation V2 n -> t -> t)
-> (n -> Transformation V2 n) -> n -> t -> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n -> Transformation V2 n
forall n. Num n => n -> T2 n
shearingY