Merge pull request #157 from diagrams/basis

added basis, generalized `centerXY` and `snugXY`
diagrams · Feb 13, 2014 · dd1c30e · dd1c30e
2 parents dad2704 + 2908213
commit dd1c30e
Show file tree

Hide file tree

Showing 3 changed files with 36 additions and 12 deletions.
diff --git a/src/Diagrams/Align.hs b/src/Diagrams/Align.hs
@@ -29,13 +29,14 @@ module Diagrams.Align
 
        , align
        , snug
-       , center
+       , centerV, center
        , snugBy
-       , snugCenter
+       , snugCenterV, snugCenter
 
        ) where
 
 import           Diagrams.Core
+import           Diagrams.Util    (applyAll)
 
 import           Data.AffineSpace (alerp, (.-.))
 import           Data.VectorSpace
@@ -140,15 +141,28 @@ snug :: (Fractional (Scalar (V a)), Alignable a, Traced a, HasOrigin a)
       => V a -> a -> a
 snug v = snugBy  v 1
 
--- | @center v@ centers an enveloped object along the direction of
+-- | @centerV v@ centers an enveloped object along the direction of
 --   @v@.
-center :: ( Alignable a, HasOrigin a, Num (Scalar (V a))
+centerV :: ( Alignable a, HasOrigin a, Num (Scalar (V a))
           , Fractional (Scalar (V a))) => V a -> a -> a
-center v = alignBy v 0
+centerV v = alignBy v 0
 
--- | Like @center@ using trace.
-snugCenter
+-- | @center@ centers an enveloped object along all of its basis vectors.
+center :: ( HasLinearMap (V a), Alignable a, HasOrigin a, Num (Scalar (V a)),
+             Fractional (Scalar (V a))) => a -> a
+center d = applyAll fs d
+  where
+    fs = map centerV basis
+
+-- | Like @centerV@ using trace.
+snugCenterV
   :: (Fractional (Scalar (V a)), Alignable a, Traced a, HasOrigin a)
    => V a -> a -> a
-snugCenter v = (alignBy' traceBoundary) v 0
+snugCenterV v = (alignBy' traceBoundary) v 0
 
+-- | Like @center@ using trace.
+snugCenter :: ( HasLinearMap (V a), Alignable a, HasOrigin a, Num (Scalar (V a)),
+                      Fractional (Scalar (V a)), Traced a) => a -> a
+snugCenter d = applyAll fs d
+  where
+    fs = map snugCenterV basis
diff --git a/src/Diagrams/Combinators.hs b/src/Diagrams/Combinators.hs
@@ -20,7 +20,7 @@ module Diagrams.Combinators
 
          withEnvelope, withTrace
        , phantom, strut
-       , pad
+       , pad, frame
        , extrudeEnvelope, intrudeEnvelope
 
          -- * Binary operations
@@ -41,7 +41,7 @@ import           Data.Typeable
 
 import           Control.Lens       (Lens', generateSignatures, lensField,
                                      lensRules, makeLensesWith, (%~), (&), (.~),
-                                     _Wrapping)
+                                     (^.), _Wrapping)
 import           Data.AdditiveGroup
 import           Data.AffineSpace   ((.+^))
 import           Data.Default.Class
@@ -100,6 +100,16 @@ pad :: ( Backend b v
     => Scalar v -> QDiagram b v m -> QDiagram b v m
 pad s d = withEnvelope (d # scale s) d
 
+-- | @frame s@ increases the envelope of a diagram by and absolute amount @s@,
+--   s is in the local units of the diagram. This function is similar to @pad@,
+--   only it takes an absolute quantity and pre-centering should not be
+--   necessary.
+frame :: ( Backend b v, InnerSpace v, OrderedField (Scalar v), Monoid' m)
+        => Scalar v -> QDiagram b v m -> QDiagram b v m
+frame s d = setEnvelope (onEnvelope t (d^.envelope)) d
+  where
+    t f = \x -> f x + s
+
 -- | @strut v@ is a diagram which produces no output, but with respect
 --   to alignment and envelope acts like a 1-dimensional segment
 --   oriented along the vector @v@, with local origin at its

diff --git a/src/Diagrams/TwoD/Align.hs b/src/Diagrams/TwoD/Align.hs
@@ -144,8 +144,8 @@ snugCenterY = snugBy unitY 0
 
 -- | Center along both the X- and Y-axes.
 centerXY :: (Alignable a, HasOrigin a, V a ~ R2) => a -> a
-centerXY = centerX . centerY
+centerXY = center
 
 snugCenterXY :: (Fractional (Scalar (V a)), Alignable a, Traced a,
       HasOrigin a, V a ~ R2) => a -> a
-snugCenterXY = snugCenterX . snugCenterY
+snugCenterXY = snugCenter