Merge pull request #59 from diagrams/units2

Rework units

.travis.yml

@@ -7,13 +7,13 @@ env:
     - GHCVER=7.4.2
     - GHCVER=7.6.3
     - GHCVER=7.8.1
+    - GHCVER=head
   global:
     - CABALVER=1.18
 
 matrix:
   allow_failures:
     - env: GHCVER=head
-    - env: GHCVER=7.8.1
 
 
 before_install:

CHANGES.markdown

@@ -1,3 +1,40 @@
+1.1.0.1 (19 March 2014)
+----------------------
+
+    - Allow lens-4.1
+
+1.1 (8 March 2014)
+------------------
+
+* **New features**
+
+    - New `basis` function
+	- New `determinant` function for computing the determinant of a
+      `Transformation`
+    - Add `Typeable` constraint on `Prim`s, making it possible to
+      extract things back out of a `Prim` wrapper using `cast`
+	- Raw `Trace`s now return a *sorted list* of intersections,
+      instead of only the smallest.  This is used to implement a new
+      family of functions `rayTraceV`, `rayTraceP`, `maxRayTraceV`,
+      `maxRayTraceP`, which work similarly to the parallel versions
+      without `Ray`, but return the first intersection in the
+      *positive* direction from the given point, rather than the
+      smallest in absolute terms.
+    - New `Annotation` type and corresponding `applyAnnotation`
+      function, for attaching uninterpreted annotations at specific
+      points in a diagram tree.  Currently this is used for
+      hyperlinks; more annotation types will be added in the future.
+
+* **Dependency/version changes**
+
+    - Require `lens-4.0`
+	- Allow `vector-space-points-0.2`
+
+* **Bug fixes**
+
+    - Looking up a subdiagram by name now results in a diagram which
+      still has that name (#43)
+
 1.0.0.1 (27 November 2013)
 --------------------------
 

LICENSE

@@ -1,6 +1,7 @@
-Copyright (c) 2011-2013 diagrams-core team:
+Copyright (c) 2011-2014 diagrams-core team:
 
   Daniel Bergey <bergey@alum.mit.edu>
+  Tad Doxsee <doxsee@pacbell.net>
   Conal Elliott <conal@conal.net>
   Sam Griffin <sam.griffin@gmail.com>
   Chris Mears <chris@cmears.id.au>

diagrams-core.cabal

@@ -1,5 +1,5 @@
 Name:                diagrams-core
-Version:             1.0
+Version:             1.1
 Synopsis:            Core libraries for diagrams EDSL
 Description:         The core modules underlying diagrams,
                      an embedded domain-specific language
@@ -15,7 +15,7 @@ Build-type:          Simple
 Cabal-version:       >=1.10
 Extra-source-files:  CHANGES.markdown, README.markdown, diagrams/*.svg
 extra-doc-files:     diagrams/*.svg
-Tested-with:         GHC == 7.4.2, GHC == 7.6.1
+Tested-with:         GHC == 7.4.2, GHC == 7.6.3, GHC == 7.8.1
 Source-repository head
   type:     git
   location: git://github.com/diagrams/diagrams-core.git
@@ -39,13 +39,12 @@ Library
                        containers >= 0.4.2 && < 0.6,
                        semigroups >= 0.8.4 && < 0.13,
                        vector-space >= 0.8.4 && < 0.9,
-                       vector-space-points >= 0.1 && < 0.2,
+                       vector-space-points >= 0.1 && < 0.3,
                        MemoTrie >= 0.4.7 && < 0.7,
                        newtype >= 0.2 && < 0.3,
                        monoid-extras >= 0.3 && < 0.4,
                        dual-tree >= 0.2 && < 0.3,
-                       lens >= 4.0 && < 4.1
-
+                       lens >= 4.0 && < 4.2
   hs-source-dirs:      src
 
   Other-extensions:    DeriveDataTypeable

src/Diagrams/Core.hs

@@ -29,11 +29,13 @@ module Diagrams.Core
          -- * Points
 
        , Point, origin, (*.)
+       , _relative
 
          -- * Transformations
 
          -- ** Utilities
        , basis
+       , dimension
        , determinant
 
          -- ** Invertible linear transformations
@@ -49,6 +51,7 @@ module Diagrams.Core
          -- ** Some specific transformations
        , translation, translate, moveTo, place
        , scaling, scale
+       , avgScale
 
          -- ** The Transformable class
 
@@ -75,11 +78,11 @@ module Diagrams.Core
          -- * Attributes and styles
 
        , AttributeClass
-       , Attribute, mkAttr, mkTAttr, unwrapAttr
+       , Attribute, mkAttr, mkTAttr, mkGTAttr, unwrapAttr
 
        , Style, HasStyle(..)
        , getAttr, combineAttr
-       , applyAttr, applyTAttr
+       , applyAttr, applyTAttr, applyGTAttr
 
          -- * Envelopes
 
@@ -129,6 +132,8 @@ module Diagrams.Core
        , withNames
        , localize
 
+       , href
+
        , setEnvelope, setTrace
 
        , atop

src/Diagrams/Core/Compile.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE FlexibleContexts    #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeOperators       #-}
 
@@ -23,30 +24,30 @@ module Diagrams.Core.Compile
 
   , toDTree
   , fromDTree
+  , toOutput
   )
   where
 
+import           Data.Data
 import qualified Data.List.NonEmpty      as NEL
 import           Data.Maybe              (fromMaybe)
 import           Data.Monoid.Coproduct
 import           Data.Monoid.MList
 import           Data.Semigroup
 import           Data.Tree
 import           Data.Tree.DUAL
+import           Data.VectorSpace
+import           Diagrams.Core.Envelope  (OrderedField, diameter)
 import           Diagrams.Core.Style
 import           Diagrams.Core.Transform
 import           Diagrams.Core.Types
 
 emptyDTree :: Tree (DNode b v a)
 emptyDTree = Node DEmpty []
 
-onStyle :: forall v. HasLinearMap v => (Style v -> Style v) -> DownAnnots v -> DownAnnots v
-onStyle f = alt (fmap (mapR f :: Transformation v :+: Style v -> Transformation v :+: Style v))
-
 -- | Convert a @QDiagram@ into a raw tree.
-toDTree :: HasLinearMap v =>
-             (Style v -> Style v) -> QDiagram b v m -> Maybe (DTree b v ())
-toDTree f (QD qd)
+toDTree :: HasLinearMap v => QDiagram b v m -> Maybe (DTree b v Annotation)
+toDTree (QD qd)
   = foldDUAL
 
       -- Prims at the leaves.  We ignore the accumulated d-annotations
@@ -62,7 +63,7 @@ toDTree f (QD qd)
                -- the continuation, convert the result to a DTree, and
                -- splice it in, adding a DDelay node to mark the point
                -- of the splice.
-               (Node DDelay . (:[]) . fromMaybe emptyDTree . toDTree f . ($ onStyle f d))
+               (Node DDelay . (:[]) . fromMaybe emptyDTree . toDTree . ($ d))
       )
 
       -- u-only leaves --> empty DTree. We don't care about the
@@ -84,7 +85,7 @@ toDTree f (QD qd)
                  Option Nothing   -> t
                  Option (Just d') ->
                    let (tr,sty) = untangle d'
-                   in  Node (DStyle $ f sty) [Node (DTransform tr) [t]]
+                   in  Node (DStyle sty) [Node (DTransform tr) [t]]
       )
 
       -- Internal a-annotations.
@@ -94,10 +95,10 @@ toDTree f (QD qd)
 -- | Convert a @DTree@ to an @RTree@ which can be used dirctly by backends.
 --   A @DTree@ includes nodes of type @DTransform (Transformation v)@;
 --   in the @RTree@ transform is pushed down until it reaches a primitive node.
-fromDTree :: HasLinearMap v => DTree b v () -> RTree b v ()
+fromDTree :: HasLinearMap v => DTree b v Annotation -> RTree b v Annotation
 fromDTree = fromDTree' mempty
   where
-    fromDTree' :: HasLinearMap v => Transformation v -> DTree b v () -> RTree b v ()
+    fromDTree' :: HasLinearMap v => Transformation v -> DTree b v Annotation -> RTree b v Annotation
     -- We put the accumulated transformation (accTr) and the prim
     -- into an RPrim node.
     fromDTree' accTr (Node (DPrim p) _)
@@ -112,21 +113,61 @@ fromDTree = fromDTree' mempty
     fromDTree' accTr (Node (DTransform tr) ts)
       = Node REmpty (fmap (fromDTree' (accTr <> tr)) ts)
 
+    fromDTree' accTr (Node (DAnnot a) ts)
+      = Node (RAnnot a) (fmap (fromDTree' accTr) ts)
+
     -- Drop accumulated transformations upon encountering a DDelay
     -- node --- the tree unfolded beneath it already took into account
     -- any transformation at this point.
     fromDTree' _ (Node DDelay ts)
       = Node REmpty (fmap (fromDTree' mempty) ts)
 
-    -- DAnnot and DEmpty nodes become REmpties, in the future my want to
-    -- handle DAnnots separately if they are used, again accTr flows through.
+    -- DEmpty nodes become REmpties, again accTr flows through.
     fromDTree' accTr (Node _ ts)
       = Node REmpty (fmap (fromDTree' accTr) ts)
 
 -- | Compile a @QDiagram@ into an 'RTree', rewriting styles with the
--- given function along the way.  Suitable for use by backends when
--- implementing 'renderData'.  Styles must be rewritten before
--- converting to RTree in case a DelayedLeaf uses a modified
--- Attribute.
-toRTree :: HasLinearMap v => (Style v -> Style v) -> QDiagram b v m -> RTree b v ()
-toRTree f = fromDTree . fromMaybe (Node DEmpty []) . toDTree f
+--   given function along the way.  Suitable for use by backends when
+--   implementing 'renderData'.  The first argument is the
+--   transformation used to convert the diagram from local to output
+--   units.
+toRTree
+  :: (HasLinearMap v, InnerSpace v, Data (Scalar v), OrderedField (Scalar v), Monoid m, Semigroup m)
+  => Transformation v -> QDiagram b v m -> RTree b v Annotation
+toRTree globalToOutput d
+  = (fmap . onRStyle) (toOutput gToO nToO)
+  . fromDTree
+  . fromMaybe (Node DEmpty [])
+  . toDTree
+  $ d
+  where
+    gToO = avgScale globalToOutput
+
+    -- Scaling factor from normalized units to output units: nth root
+    -- of product of diameters along each basis direction.  Note at
+    -- this point the diagram has already had the globalToOutput
+    -- transformation applied, so output = global = local units.
+    nToO = product (map (\v -> diameter v d) basis) ** (1 / fromIntegral (dimension d))
+
+-- | Apply a style transformation on 'RStyle' nodes; the identity for
+--   other 'RNode's.
+onRStyle :: (Style v -> Style v) -> (RNode b v a -> RNode b v a)
+onRStyle f (RStyle s) = RStyle (f s)
+onRStyle _ n          = n
+
+-- | Convert all 'Measure' values to 'Output' units.  The arguments
+--   are, respectively, the scaling factor from global units to output
+--   units, and from normalized units to output units.  It is assumed
+--   that local units are identical to output units (which will be the
+--   case if all transformations have been fully pushed down and
+--   applied).
+toOutput
+  :: forall v. (Data (Scalar v), Num (Scalar v))
+  => Scalar v -> Scalar v -> Style v -> Style v
+toOutput globalToOutput normToOutput = gmapAttrs convert
+  where
+    convert :: Measure (Scalar v) -> Measure (Scalar v)
+    convert m@(Output _)   = m
+    convert (Local s)      = Output s
+    convert (Global s)     = Output (globalToOutput * s)
+    convert (Normalized s) = Output (normToOutput * s)

src/Diagrams/Core/Envelope.hs

@@ -3,9 +3,9 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE MultiParamTypeClasses      #-}
 {-# LANGUAGE StandaloneDeriving         #-}
+{-# LANGUAGE TemplateHaskell            #-}
 {-# LANGUAGE TypeFamilies               #-}
 {-# LANGUAGE UndecidableInstances       #-}
-{-# LANGUAGE TemplateHaskell            #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Graphics.Rendering.Diagrams.Envelope
@@ -36,15 +36,16 @@ module Diagrams.Core.Envelope
          -- * Utility functions
        , diameter
        , radius
+       , extent
        , envelopeVMay, envelopeV, envelopePMay, envelopeP, envelopeSMay, envelopeS
 
          -- * Miscellaneous
        , OrderedField
        ) where
 
 import           Control.Applicative     ((<$>))
-import           Control.Lens (Wrapped(..), Rewrapped, iso, over, mapped
-                              , _Wrapping', op)
+import           Control.Lens            (Rewrapped, Wrapped (..), iso, mapped,
+                                          op, over, _Wrapping')
 import qualified Data.Map                as M
 import           Data.Maybe              (fromMaybe)
 import           Data.Semigroup
@@ -255,11 +256,16 @@ envelopeS v = fromMaybe 0 . envelopeSMay v
 -- | Compute the diameter of a enveloped object along a particular
 --   vector.  Returns zero for the empty envelope.
 diameter :: Enveloped a => V a -> a -> Scalar (V a)
-diameter v a = case appEnvelope $ getEnvelope a of
-  (Just env) -> (env v + env (negateV v)) * magnitude v
-  Nothing -> 0
+diameter v a = maybe 0 (\(lo,hi) -> (hi - lo) * magnitude v) (extent v a)
 
 -- | Compute the \"radius\" (1\/2 the diameter) of an enveloped object
 --   along a particular vector.
 radius :: Enveloped a => V a -> a -> Scalar (V a)
 radius v = (0.5*) . diameter v
+
+-- | Compute the range of an enveloped object along a certain
+--   direction.  Returns a pair of scalars @(lo,hi)@ such that the
+--   object extends from @(lo *^ v)@ to @(hi *^ v)@. Returns @Nothing@
+--   for objects with an empty envelope.
+extent :: Enveloped a => V a -> a -> Maybe (Scalar (V a), Scalar (V a))
+extent v a = (\f -> (-f (negateV v), f v)) <$> (appEnvelope . getEnvelope $ a)

src/Diagrams/Core/Points.hs

@@ -1,5 +1,7 @@
-{-# LANGUAGE TypeFamilies
-  #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE TypeFamilies #-}
+
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Diagrams.Core.Points
@@ -15,14 +17,24 @@ module Diagrams.Core.Points
        ( -- * Points
 
          Point(..), origin, (*.)
+       , _relative
 
        ) where
 
--- We just import from Data.AffineSpace.Point (defined in the
+-- We import from Data.AffineSpace.Point (defined in the
 -- vector-space-points package) and re-export.  We also define an
 -- instance of V for Point here.
+
+import Control.Lens (Iso', iso)
+
 import Data.AffineSpace.Point
+import Data.AffineSpace
 
 import Diagrams.Core.V
 
-type instance V (Point v) = v
+type instance V (Point v) = v
+
+-- | An isomorphism between points and vectors, given a reference
+-- point.  This is provided for defining new lenses on points.
+_relative :: AffineSpace (Point v) => Point v -> Iso' (Point v) v
+_relative p0 = iso (.-. p0) (p0 .+^)