Add transformation isomorphisms.

And replace the old  function in favour of lenses  and the transform Isos.

src/Diagrams/Path.hs

@@ -61,8 +61,7 @@ module Diagrams.Path
        ) where
 
 import           Control.Arrow        ((***))
-import           Control.Lens         (Rewrapped, Wrapped (..), iso, mapped, op, over, view, (%~),
-                                       _Unwrapped', _Wrapped, Each (..), traversed)
+import           Control.Lens         hiding ((#), transform, at)
 import qualified Data.Foldable        as F
 import           Data.List            (partition)
 import           Data.Semigroup
@@ -77,7 +76,6 @@ import           Diagrams.Trail
 import           Diagrams.TrailLike
 import           Diagrams.Transform
 
-import           Linear.Affine
 import           Linear.Metric
 import           Linear.Vector
 
@@ -261,7 +259,7 @@ partitionPath p = (view _Unwrapped' *** view _Unwrapped') . partition p . op Pat
 -- | Scale a path using its centroid (see 'pathCentroid') as the base
 --   point for the scale.
 scalePath :: (HasLinearMap v, Metric v, OrderedField n) => n -> Path v n -> Path v n
-scalePath d p = (scale d `under` translation (origin .-. pathCentroid p)) p
+scalePath d p = under (movedFrom (pathCentroid p)) (scale d) p
 
 -- | Reverse all the component trails of a path.
 reversePath :: (Metric v, OrderedField n) => Path v n -> Path v n

src/Diagrams/ThreeD/Transform.hs

@@ -22,8 +22,9 @@ module Diagrams.ThreeD.Transform
        ( T3
 
          -- * Rotation
-        ,aboutX, aboutY, aboutZ
-       , rotationAbout, pointAt, pointAt'
+       , aboutX, aboutY, aboutZ
+       , rotationAbout, rotateAbout
+       , pointAt, pointAt'
 
        -- * Scaling
        , scalingX, scalingY, scalingZ
@@ -105,7 +106,7 @@ aboutY (view rad -> a) = fromOrthogonal r where
 --   passing through @p@.
 rotationAbout
   :: Floating n
-	=> Point V3 n         -- ^ origin of rotation
+  => Point V3 n         -- ^ origin of rotation
   -> Direction V3 n     -- ^ direction of rotation axis
   -> Angle n            -- ^ angle of rotation
   -> Transformation V3 n
@@ -120,6 +121,16 @@ rotationAbout (P t) d (view rad -> a)
            ^+^ cross w v ^* sin θ
            ^+^         w ^* ((w `dot` v) * (1 - cos θ))
 
+-- | @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 p d theta = transform (rotationAbout p d 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
@@ -187,8 +198,10 @@ reflectZ :: (InSpace v n t, R3 v, Transformable t) => t -> t
 reflectZ = transform reflectionZ
 
 -- | @reflectionAcross p v@ is a reflection across the plane through
---   the point @p@ and normal to vector @v@.
-reflectionAcross :: (Metric v, R3 v, Fractional n)
+--   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 p v =
   conjugate (translation (origin .-. p)) reflect
@@ -198,8 +211,9 @@ reflectionAcross p v =
       f u w   = w ^-^ 2 *^ project u w
 
 -- | @reflectAcross p v@ reflects a diagram across the plane though
---   the point @p@ and the vector @v@.
-reflectAcross :: (InSpace v n t, Metric v, R3 v, Fractional n, Transformable t)
+--   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 p v = transform (reflectionAcross p v)
 

src/Diagrams/Transform.hs

@@ -1,7 +1,10 @@
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE RankNTypes            #-}
+{-# LANGUAGE TypeFamilies          #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Diagrams.Transform
--- Copyright   :  (c) 2011-13 diagrams-lib team (see LICENSE)
+-- Copyright   :  (c) 2011-15 diagrams-lib team (see LICENSE)
 -- License     :  BSD-style (see LICENSE)
 -- Maintainer  :  diagrams-discuss@googlegroups.com
 --
@@ -11,7 +14,6 @@
 --
 -----------------------------------------------------------------------------
 
-{-# LANGUAGE TypeFamilies    #-}
 
 module Diagrams.Transform
     ( -- * Transformations
@@ -24,14 +26,15 @@ module Diagrams.Transform
     , translation, translate, moveTo, place, scaling, scale
 
       -- * Miscellaneous transformation-related utilities
-    , conjugate, under
+    , conjugate, underT, transformed, translated, movedTo, movedFrom
 
       -- * The HasOrigin class
 
     , HasOrigin(..), moveOriginBy
 
     ) where
 
+import           Control.Lens   hiding (transform)
 import           Data.Semigroup
 import           Diagrams.Core
 
@@ -42,7 +45,7 @@ import           Linear.Vector
 --   inverse of @t1@.
 conjugate :: (Additive v, Num n, Functor v)
           => Transformation v n -> Transformation v n -> Transformation v n
-conjugate t1 t2  = inv t1 <> t2 <> t1
+conjugate t1 t2 = inv t1 <> t2 <> t1
 
 -- | Carry out some transformation \"under\" another one: @f ``under``
 --   t@ first applies @t@, then @f@, then the inverse of @t@.  For
@@ -52,11 +55,66 @@ conjugate t1 t2  = inv t1 <> t2 <> t1
 --
 --   Note that
 --
---   @
---   (transform t2) `under` t1 == transform (conjugate t1 t2)
---   @
+-- @
+-- (transform t2) `under` t1 == transform (conjugate t1 t2)
+-- @
 --
 --   for all transformations @t1@ and @t2@.
-under :: (InSpace v n a, SameSpace a b, Num n, Functor v, Transformable a, Transformable b)
+underT :: (InSpace v n a, SameSpace a b, Transformable a, Transformable b)
       => (a -> b) -> Transformation v n -> a -> b
-f `under` t = transform (inv t) . f . transform t
+f `underT` t = transform (inv t) . f . transform 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 t = iso (transform $ inv t) (transform 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 p = iso (moveTo (negated p)) (moveTo 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 p = iso (moveOriginTo (negated p)) (moveOriginTo 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 = transformed . translation

src/Diagrams/Transform/Matrix.hs

@@ -34,13 +34,20 @@ mkMat t = distribute . tabulate $ apply t . unit . el
 mkMatHomo :: Num n => Transformation V3 n -> M44 n
 mkMatHomo t = mkTransformationMat (mkMat t) (transl t)
 
+-- | Make a 2D transformation from a 2x2 transform matrix and a
+--   translation vector. If the matrix is not invertable, 'Nothing' is
+--   returned.
 fromMat22 :: (Epsilon n, Floating n) => M22 n -> V2 n -> Maybe (T2 n)
 fromMat22 m v = flip (fromMatWithInv m) v <$> inv22 m
 
+-- | Make a 3D transformation from a 3x3 transform matrix and a
+--   translation vector. If the matrix is not invertable, 'Nothing' is
+--   returned.
 fromMat33 :: (Epsilon n, Floating n) => M33 n -> V3 n -> Maybe (T3 n)
 fromMat33 m v = flip (fromMatWithInv m) v <$> inv33 m
 
--- | Build a transform with a maxtrix along with its inverse.
+-- | Build a transform with a maxtrix along with its inverse (this is
+--   not checked).
 fromMatWithInv :: (Additive v, Distributive v, Foldable v, Num n)
   => v (v n) -- ^ matrix
   -> v (v n) -- ^ inverse
@@ -51,10 +58,13 @@ fromMatWithInv m m_ v =
                  ((*! distribute m) <-> (*! distribute m_))
                  v
 
--- are these useful?
+-- | Prism onto a 2D transformation from a 2x2 transform matrix and
+--   translation vector.
 mat22 :: (Epsilon n, Floating n) => Prism' (M22 n, V2 n) (T2 n)
 mat22 = prism' (mkMat &&& transl) (uncurry fromMat22)
 
+-- | Prism onto a 2D transformation from a 2x2 transform matrix and
+--   translation vector.
 mat33 :: (Epsilon n, Floating n) => Prism' (M33 n, V3 n) (T3 n)
 mat33 = prism' (mkMat &&& transl) (uncurry fromMat33)
 

src/Diagrams/TwoD/Transform.hs

@@ -1,13 +1,14 @@
 {-# LANGUAGE FlexibleContexts      #-}
 {-# LANGUAGE FlexibleInstances     #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE ViewPatterns          #-}
+{-# LANGUAGE RankNTypes            #-}
 {-# LANGUAGE TypeFamilies          #-}
 {-# LANGUAGE TypeOperators         #-}
+{-# LANGUAGE ViewPatterns          #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Diagrams.TwoD.Transform
--- Copyright   :  (c) 2011 diagrams-lib team (see LICENSE)
+-- Copyright   :  (c) 2011-2015 diagrams-lib team (see LICENSE)
 -- License     :  BSD-style (see LICENSE)
 -- Maintainer  :  diagrams-discuss@googlegroups.com
 --
@@ -21,7 +22,7 @@ module Diagrams.TwoD.Transform
        (
          T2
          -- * Rotation
-       , rotation, rotate, rotateBy
+       , rotation, rotate, rotateBy, rotated
 
        , rotationAround, rotateAround
        , rotationTo, rotateTo
@@ -58,7 +59,7 @@ import           Diagrams.Transform
 import           Diagrams.TwoD.Types
 import           Diagrams.TwoD.Vector
 
-import           Control.Lens            (review, view, (&), (*~), (.~), (//~))
+import           Control.Lens            hiding (at, transform)
 import           Data.Semigroup
 
 import           Linear.Affine
@@ -97,20 +98,35 @@ rotate = transform . rotation
 rotateBy :: (InSpace V2 n t, Transformable t, Floating n) => n -> t -> t
 rotateBy = transform . rotation . review 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 = transformed . rotation
+
 -- | @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 p angle = conjugate (translation (origin .-. p)) (rotation angle)
+rotationAround p theta =
+  conjugate (translation (origin .-. p)) (rotation 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 p angle = rotate angle `under` translation (origin .-. p)
+rotateAround :: (InSpace V2 n t, Transformable t, Floating n)
+             => P2 n -> Angle n -> t -> t
+rotateAround p theta = transform (rotationAround p theta)
 
--- | The rotation that aligns the x-axis with the given non-zero vector.
+-- | The rotation that aligns the x-axis with the given direction.
 rotationTo :: OrderedField n => Direction V2 n -> T2 n
 rotationTo (view _Dir -> V2 x y) = rotation (atan2A' y x)
--- could be done with Direction
 
 -- | Rotate around the local origin such that the x axis aligns with the
 --   given direction.
@@ -211,16 +227,17 @@ reflectionY = fromSymmetric $ (_y *~ (-1)) <-> (_y *~ (-1))
 reflectY :: (InSpace v n t, R2 v, Transformable t) => t -> t
 reflectY = transform reflectionY
 
--- | @reflectionAbout p v@ is a reflection in the line determined by
---   the point @p@ and vector @v@.
-reflectionAbout :: OrderedField n => P2 n -> V2 n -> T2 n
-reflectionAbout p v =
-  conjugate (rotationTo (direction $ negated v) <> translation (origin .-. p))
+-- | @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 p d =
+  conjugate (rotationTo d <> translation (origin .-. p))
             reflectionY
 
--- | @reflectAbout p v@ reflects a diagram in the line determined by
---   the point @p@ and the vector @v@.
-reflectAbout :: (InSpace V2 n t, OrderedField n, Transformable t) => P2 n -> V2 n -> t -> t
+-- | @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 p v = transform (reflectionAbout p v)
 
 -- Shears --------------------------------------------------