{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} ----------------------------------------------------------------------------- -- | -- Module : Diagrams.Align -- Copyright : (c) 2011-2013 diagrams-lib team (see LICENSE) -- License : BSD-style (see LICENSE) -- Maintainer : diagrams-discuss@googlegroups.com -- -- The /alignment/ of an object refers to the position of its local -- origin with respect to its envelope. This module defines the -- 'Alignable' class for things which can be aligned, as well as a -- default implementation in terms of 'HasOrigin' and 'Enveloped', -- along with several utility methods for alignment. -- ----------------------------------------------------------------------------- module Diagrams.Align ( -- * Alignable class Alignable(..) , alignBy'Default , envelopeBoundary , traceBoundary -- * General alignment functions , align , snug , centerV, center , snugBy , snugCenterV, snugCenter ) where import Diagrams.Core import Diagrams.Util (applyAll) import Data.AffineSpace (alerp, (.-.)) import Data.VectorSpace import Data.Maybe (fromMaybe) import Data.Ord (comparing) import qualified Data.Map as M import qualified Data.Set as S import qualified Data.Foldable as F -- | Class of things which can be aligned. class Alignable a where -- | @alignBy v d a@ moves the origin of @a@ along the vector -- @v@. If @d = 1@, the origin is moved to the edge of the -- boundary in the direction of @v@; if @d = -1@, it moves to the -- edge of the boundary in the direction of the negation of @v@. -- Other values of @d@ interpolate linearly (so for example, @d = -- 0@ centers the origin along the direction of @v@). alignBy' :: ( HasOrigin a, AdditiveGroup (V a), Num (Scalar (V a)) , Fractional (Scalar (V a))) => (V a -> a -> Point (V a)) -> V a -> Scalar (V a) -> a -> a alignBy' = alignBy'Default defaultBoundary :: V a -> a -> Point (V a) alignBy :: (HasOrigin a, Num (Scalar (V a)), Fractional (Scalar (V a))) => V a -> Scalar (V a) -> a -> a alignBy = alignBy' defaultBoundary -- | Default implementation of 'alignBy' for types with 'HasOrigin' -- and 'AdditiveGroup' instances. alignBy'Default :: ( HasOrigin a, AdditiveGroup (V a), Num (Scalar (V a)) , Fractional (Scalar (V a))) => (V a -> a -> Point (V a)) -> V a -> Scalar (V a) -> a -> a alignBy'Default boundary v d a = moveOriginTo (alerp (boundary (negateV v) a) (boundary v a) ((d + 1) / 2)) a -- | Some standard functions which can be used as the `boundary` argument to -- `alignBy'`. envelopeBoundary :: Enveloped a => V a -> a -> Point (V a) envelopeBoundary = envelopeP traceBoundary :: Traced a => V a -> a -> Point (V a) traceBoundary v a = fromMaybe origin (maxTraceP origin v a) combineBoundaries :: (F.Foldable f, InnerSpace (V a), Ord (Scalar (V a))) => (V a -> a -> Point (V a)) -> (V a -> f a -> Point (V a)) combineBoundaries b v fa = b v \$ F.maximumBy (comparing (magnitudeSq . (.-. origin) . b v)) fa instance (InnerSpace v, OrderedField (Scalar v)) => Alignable (Envelope v) where defaultBoundary = envelopeBoundary instance (InnerSpace v, OrderedField (Scalar v)) => Alignable (Trace v) where defaultBoundary = traceBoundary instance (InnerSpace (V b), Ord (Scalar (V b)), Alignable b) => Alignable [b] where defaultBoundary = combineBoundaries defaultBoundary instance (InnerSpace (V b), Ord (Scalar (V b)), Alignable b) => Alignable (S.Set b) where defaultBoundary = combineBoundaries defaultBoundary instance (InnerSpace (V b), Ord (Scalar (V b)), Alignable b) => Alignable (M.Map k b) where defaultBoundary = combineBoundaries defaultBoundary instance ( HasLinearMap v, InnerSpace v, OrderedField (Scalar v) , Monoid' m ) => Alignable (QDiagram b v m) where defaultBoundary = envelopeBoundary -- | Although the 'alignBy' method for the @(b -> a)@ instance is -- sensible, there is no good implementation for -- 'defaultBoundary'. Instead, we provide a total method, but one that -- is not sensible. This should not present a serious problem as long -- as your use of 'Alignable' happens through 'alignBy'. instance (HasOrigin a, Alignable a) => Alignable (b -> a) where alignBy v d f b = alignBy v d (f b) defaultBoundary _ _ = origin -- | @align v@ aligns an enveloped object along the edge in the -- direction of @v@. That is, it moves the local origin in the -- direction of @v@ until it is on the edge of the envelope. (Note -- that if the local origin is outside the envelope to begin with, -- it may have to move \"backwards\".) align :: ( Alignable a, HasOrigin a, Num (Scalar (V a)) , Fractional (Scalar (V a))) => V a -> a -> a align v = alignBy v 1 -- | Version of @alignBy@ specialized to use @traceBoundary@ snugBy :: (Alignable a, Traced a, HasOrigin a, Num (Scalar (V a)), Fractional (Scalar (V a))) => V a -> Scalar (V a) -> a -> a snugBy = alignBy' traceBoundary -- | Like align but uses trace. snug :: (Fractional (Scalar (V a)), Alignable a, Traced a, HasOrigin a) => V a -> a -> a snug v = snugBy v 1 -- | @centerV v@ centers an enveloped object along the direction of -- @v@. centerV :: ( Alignable a, HasOrigin a, Num (Scalar (V a)) , Fractional (Scalar (V a))) => V a -> a -> a centerV v = alignBy v 0 -- | @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 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