diff --git a/CHANGES.markdown b/CHANGES.markdown --- a/CHANGES.markdown +++ b/CHANGES.markdown @@ -1,3 +1,34 @@ +0.7: 9 August 2013 +------------------ + +* **New features** + + - new function `onBasis`, to extract the matrix equivalent of a `Transformation` + - `SubMap`s are now `Deletable` + - new function `localize` for hiding/deleting names from scope + - new `IsPrim` class, containing `transformWithFreeze` function. + This is primarily intended to support scale-invariant primitives + (*e.g.* arrowheads) but may be useful for other stuff as well. + The default implementation of `renderDia` now uses + `transformWithFreeze`. + - optimized `Transformable` instance for `TransInv` + +* **New instances** + + - `Eq`, `Ord`, `Enveloped`, `Traced`, and `Qualifiable` instances + for `TransInv` + + - `Transformable` instance for functions, which acts by conjugation + +* **API changes** + + - `named` and `namePoint` have moved to the `diagrams-lib` package. + +* **Dependency/version changes** + + - allow `base-4.7` + - upgrade to `monoid-extras-0.3` + 0.6.0.2: 5 March 2013 --------------------- @@ -21,7 +52,7 @@ See [`Diagrams.Core.Types`](https://github.com/diagrams/diagrams-core/blob/27b275f45cad514caefcd3035e4e261f1b4adf6f/src/Diagrams/Core/Types.hs#L493). - + - Traces: in addition to an envelope, each diagram now stores a "trace", which is like an embedded raytracer: given any ray (represented by a base point and a vector), the trace computes @@ -37,8 +68,8 @@ module naming scheme in the rest of the diagrams universe. In particular: - `Graphics.Rendering.Diagrams` --> `Diagrams.Core` - `Grahpics.Rendering.Diagrams.Core` --> `Diagrams.Core.Types` + `Graphics.Rendering.Diagrams` --> `Diagrams.Core` + `Grahpics.Rendering.Diagrams.Core` --> `Diagrams.Core.Types` `Graphics.Rendering.Diagrams.*` --> `Diagrams.Core.*` - `Graphics.Rendering.Diagrams.UDTree` has been split out into a diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,7 +1,10 @@ -Copyright (c) 2011-2012 diagrams-core team: - +Copyright (c) 2011-2013 diagrams-core team: + + Daniel Bergey + Conal Elliott Sam Griffin Vilhelm Sjöberg + Michael Sloan Scott Walck Ryan Yates Brent Yorgey diff --git a/diagrams-core.cabal b/diagrams-core.cabal --- a/diagrams-core.cabal +++ b/diagrams-core.cabal @@ -1,5 +1,5 @@ Name: diagrams-core -Version: 0.6.0.2 +Version: 0.7 Synopsis: Core libraries for diagrams EDSL Description: The core modules underlying diagrams, an embedded domain-specific language @@ -14,7 +14,7 @@ Build-type: Simple Cabal-version: >=1.10 Extra-source-files: CHANGES.markdown, README.markdown -Tested-with: GHC == 7.0.4, GHC == 7.2.1, GHC == 7.4.2, GHC == 7.6.1 +Tested-with: GHC == 7.4.2, GHC == 7.6.1 Source-repository head type: git location: git://github.com/diagrams/diagrams-core.git @@ -33,14 +33,14 @@ Diagrams.Core.V, Diagrams.Core.Query - Build-depends: base >= 4.2 && < 4.7, + Build-depends: base >= 4.2 && < 4.8, containers >= 0.3 && < 0.6, semigroups >= 0.3.4 && < 0.10, vector-space >= 0.8.4 && < 0.9, vector-space-points >= 0.1 && < 0.2, MemoTrie >= 0.4.7 && < 0.7, newtype >= 0.2 && < 0.3, - monoid-extras >= 0.2 && < 0.3, + monoid-extras >= 0.3 && < 0.4, dual-tree >= 0.1 && < 0.2 hs-source-dirs: src diff --git a/src/Diagrams/Core.hs b/src/Diagrams/Core.hs --- a/src/Diagrams/Core.hs +++ b/src/Diagrams/Core.hs @@ -107,7 +107,7 @@ -- * Primtives - , Prim(..), nullPrim + , Prim(..), IsPrim(..), nullPrim -- * Diagrams @@ -116,10 +116,11 @@ , envelope, trace, subMap, names, query, sample , value, resetValue, clearValue - , named, nameSub, namePoint + , nameSub , withName , withNameAll , withNames + , localize , freeze, setEnvelope, setTrace @@ -150,16 +151,16 @@ ) where -import Diagrams.Core.Types -import Diagrams.Core.Envelope -import Diagrams.Core.HasOrigin -import Diagrams.Core.Juxtapose -import Diagrams.Core.Names -import Diagrams.Core.Points -import Diagrams.Core.Query -import Diagrams.Core.Style -import Diagrams.Core.Trace -import Diagrams.Core.Transform -import Diagrams.Core.V +import Diagrams.Core.Envelope +import Diagrams.Core.HasOrigin +import Diagrams.Core.Juxtapose +import Diagrams.Core.Names +import Diagrams.Core.Points +import Diagrams.Core.Query +import Diagrams.Core.Style +import Diagrams.Core.Trace +import Diagrams.Core.Transform +import Diagrams.Core.Types +import Diagrams.Core.V -import Data.Monoid.WithSemigroup (Monoid') +import Data.Monoid.WithSemigroup (Monoid') diff --git a/src/Diagrams/Core/Envelope.hs b/src/Diagrams/Core/Envelope.hs --- a/src/Diagrams/Core/Envelope.hs +++ b/src/Diagrams/Core/Envelope.hs @@ -1,11 +1,10 @@ -{-# LANGUAGE TypeFamilies - , FlexibleInstances - , FlexibleContexts - , UndecidableInstances - , GeneralizedNewtypeDeriving - , StandaloneDeriving - , MultiParamTypeClasses - #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} ----------------------------------------------------------------------------- -- | -- Module : Graphics.Rendering.Diagrams.Envelope @@ -43,13 +42,13 @@ , OrderedField ) where -import Control.Applicative ((<$>)) -import qualified Data.Map as M -import Data.Maybe (fromMaybe) +import Control.Applicative ((<$>)) +import qualified Data.Map as M +import Data.Maybe (fromMaybe) import Data.Semigroup -import qualified Data.Set as S +import qualified Data.Set as S -import Data.AffineSpace ((.+^), (.-^)) +import Data.AffineSpace ((.+^), (.-^)) import Data.VectorSpace import Diagrams.Core.HasOrigin @@ -184,6 +183,9 @@ instance (OrderedField (Scalar v), InnerSpace v) => Enveloped (Point v) where getEnvelope p = moveTo p . mkEnvelope $ const zeroV + +instance Enveloped t => Enveloped (TransInv t) where + getEnvelope = getEnvelope . unTransInv instance (Enveloped a, Enveloped b, V a ~ V b) => Enveloped (a,b) where getEnvelope (x,y) = getEnvelope x <> getEnvelope y diff --git a/src/Diagrams/Core/Names.hs b/src/Diagrams/Core/Names.hs --- a/src/Diagrams/Core/Names.hs +++ b/src/Diagrams/Core/Names.hs @@ -1,9 +1,9 @@ +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE TypeSynonymInstances #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE OverlappingInstances #-} +{-# LANGUAGE OverlappingInstances #-} +{-# LANGUAGE TypeSynonymInstances #-} ----------------------------------------------------------------------------- -- | -- Module : Diagrams.Core.Names @@ -12,7 +12,7 @@ -- Maintainer : diagrams-discuss@googlegroups.com -- -- This module defines a type of names which can be used for referring --- to locations within diagrams, and related types. +-- to subdiagrams, and related types. -- ----------------------------------------------------------------------------- @@ -29,10 +29,12 @@ ) where -import Data.List ( intercalate ) -import Data.Semigroup -import Data.Typeable +import Data.List (intercalate) +import Data.Semigroup +import Data.Typeable +import Diagrams.Core.Transform + ------------------------------------------------------------ -- Names ------------------------------------------------- ------------------------------------------------------------ @@ -106,6 +108,9 @@ -- | Of course, names can be qualified using @(.>)@. instance Qualifiable Name where (|>) = (.>) + +instance Qualifiable a => Qualifiable (TransInv a) where + (|>) n = TransInv . (|>) n . unTransInv infixr 5 |> infixr 5 .> diff --git a/src/Diagrams/Core/Trace.hs b/src/Diagrams/Core/Trace.hs --- a/src/Diagrams/Core/Trace.hs +++ b/src/Diagrams/Core/Trace.hs @@ -1,8 +1,8 @@ -{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} ----------------------------------------------------------------------------- -- | @@ -11,7 +11,7 @@ -- License : BSD-style (see LICENSE) -- Maintainer : diagrams-discuss@googlegroups.com -- --- "Diagrams" defines the core library of primitives +-- @diagrams-core@ defines the core library of primitives -- forming the basis of an embedded domain-specific language for -- describing and rendering diagrams. -- @@ -40,12 +40,12 @@ ) where import Control.Applicative -import qualified Data.Map as M +import qualified Data.Map as M import Data.Semigroup -import qualified Data.Set as S +import qualified Data.Set as S import Data.AffineSpace -import Data.Monoid.PosInf +import Data.Monoid.Inf import Data.VectorSpace import Diagrams.Core.HasOrigin @@ -57,22 +57,22 @@ -- Trace ------------------------------------------------- ------------------------------------------------------------ --- | Every diagram comes equipped with a *trace*. Intuitively, the +-- | Every diagram comes equipped with a /trace/. Intuitively, the -- trace for a diagram is like a raytracer: given a line --- (represented as a base point + direction), the trace computes the --- distance from the base point along the line to the first +-- (represented as a base point and a direction), the trace computes +-- the distance from the base point along the line to the first -- intersection with the diagram. The distance can be negative if -- the intersection is in the opposite direction from the base -- point, or infinite if the ray never intersects the diagram. --- Note: to obtain the distance to the *furthest* intersection --- instead of the *closest*, just negate the direction vector and +-- Note: to obtain the distance to the /furthest/ intersection +-- instead of the /closest/, just negate the direction vector and -- then negate the result. -- -- Note that the output should actually be interpreted not as an -- absolute distance, but as a multiplier relative to the input -- vector. That is, if the input vector is @v@ and the returned -- scalar is @s@, the distance from the base point to the --- intersection is given by @s *^ magnitude v@. +-- intersection is given by @s * magnitude v@. newtype Trace v = Trace { appTrace :: Point v -> v -> PosInf (Scalar v) } @@ -126,11 +126,14 @@ -- should return a finite distance for vectors aimed directly at the -- given point and infinity for everything else, but due to -- floating-point inaccuracy this is problematic. Note that the --- envelope for a single point is *not* the empty envelope (see +-- envelope for a single point is /not/ the empty envelope (see -- "Diagrams.Core.Envelope"). instance (Ord (Scalar v), VectorSpace v) => Traced (Point v) where getTrace p = mempty +instance Traced t => Traced (TransInv t) where + getTrace = getTrace . unTransInv + instance (Traced a, Traced b, V a ~ V b) => Traced (a,b) where getTrace (x,y) = getTrace x <> getTrace y @@ -153,7 +156,7 @@ traceV :: Traced a => Point (V a) -> V a -> a -> Maybe (V a) traceV p v a = case appTrace (getTrace a) p v of Finite s -> Just (s *^ v) - PosInfty -> Nothing + Infinity -> Nothing -- | Given a base point and direction, compute the closest point on -- the boundary of the given object, or @Nothing@ if there is no diff --git a/src/Diagrams/Core/Transform.hs b/src/Diagrams/Core/Transform.hs --- a/src/Diagrams/Core/Transform.hs +++ b/src/Diagrams/Core/Transform.hs @@ -6,6 +6,7 @@ , MultiParamTypeClasses , GeneralizedNewtypeDeriving , TypeSynonymInstances + , ScopedTypeVariables #-} ----------------------------------------------------------------------------- @@ -37,6 +38,7 @@ , apply , papply , fromLinear + , onBasis -- * The Transformable class @@ -179,6 +181,20 @@ fromLinear :: AdditiveGroup v => (v :-: v) -> (v :-: v) -> Transformation v fromLinear l1 l2 = Transformation l1 l2 zeroV +-- | Get the matrix equivalent of the linear transform, +-- (as a list of columns) and the translation vector. This +-- is mostly useful for implementing backends. +onBasis :: forall v. HasLinearMap v => Transformation v -> ([v], v) +onBasis t = (vmat, tr) + where tr :: v + tr = transl t + basis :: [Basis v] + basis = map fst (decompose tr) + es :: [v] + es = map basisValue basis + vmat :: [v] + vmat = map (apply t) es + ------------------------------------------------------------ -- The Transformable class ------------------------------- ------------------------------------------------------------ @@ -213,6 +229,18 @@ , transform t z ) +-- Transform functions by conjugation. That is, reverse-transform argument and +-- forward-transform result. Intuition: If someone shrinks you, you see your +-- environment enlarged. If you rotate right, you see your environment +-- rotating left. Etc. This technique was used extensively in Pan for modular +-- construction of image filters. Works well for curried functions, since all +-- arguments get inversely transformed. + +instance ( HasBasis (V b), HasTrie (Basis (V b)) + , Transformable a, Transformable b, V b ~ V a) => + Transformable (a -> b) where + transform tr f = transform tr . f . transform (inv tr) + instance Transformable t => Transformable [t] where transform = map . transform @@ -243,7 +271,7 @@ -- transformations will no longer affect things wrapped in -- @TransInv@. newtype TransInv t = TransInv { unTransInv :: t } - deriving (Show, Semigroup, Monoid) + deriving (Eq, Ord, Show, Semigroup, Monoid) type instance V (TransInv t) = V t @@ -251,7 +279,8 @@ moveOriginTo = const id instance Transformable t => Transformable (TransInv t) where - transform tr (TransInv t) = TransInv (translate (negateV (transl tr)) . transform tr $ t) + transform (Transformation a a' _) (TransInv t) + = TransInv (transform (Transformation a a' zeroV) t) ------------------------------------------------------------ -- Generic transformations ------------------------------- diff --git a/src/Diagrams/Core/Types.hs b/src/Diagrams/Core/Types.hs --- a/src/Diagrams/Core/Types.hs +++ b/src/Diagrams/Core/Types.hs @@ -1,17 +1,16 @@ -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE ExistentialQuantification #-} -{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE EmptyDataDecls #-} +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE OverlappingInstances #-} -{-# LANGUAGE UndecidableInstances #-} -{-# LANGUAGE TupleSections #-} -{-# LANGUAGE EmptyDataDecls #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} ----------------------------------------------------------------------------- -- | @@ -59,12 +58,11 @@ -- ** Modifying diagrams -- *** Names - , named , nameSub - , namePoint , withName , withNameAll , withNames + , localize -- *** Other , freeze @@ -87,7 +85,7 @@ -- * Primtives -- $prim - , Prim(..), nullPrim + , Prim(..), IsPrim(..), nullPrim -- * Backends @@ -104,16 +102,16 @@ ) where -import Control.Applicative ((<$>), (<*>)) -import Control.Arrow (first, second, (***)) -import Control.Monad (mplus) +import Control.Applicative ((<$>), (<*>)) +import Control.Arrow (first, second, (***)) +import Control.Monad (mplus) import Control.Newtype -import Data.AffineSpace ((.-.)) -import Data.List (isSuffixOf) -import qualified Data.Map as M -import Data.Maybe (listToMaybe, fromMaybe) +import Data.AffineSpace ((.-.)) +import Data.List (isSuffixOf) +import qualified Data.Map as M +import Data.Maybe (fromMaybe, listToMaybe) import Data.Semigroup -import qualified Data.Traversable as T +import qualified Data.Traversable as T import Data.Typeable import Data.VectorSpace @@ -123,7 +121,7 @@ import Data.Monoid.MList import Data.Monoid.Split import Data.Monoid.WithSemigroup -import qualified Data.Tree.DUAL as D +import qualified Data.Tree.DUAL as D import Diagrams.Core.Envelope import Diagrams.Core.HasOrigin @@ -160,7 +158,7 @@ -- * query functions (see "Diagrams.Core.Query") type UpAnnots b v m = Deletable (Envelope v) ::: Deletable (Trace v) - ::: SubMap b v m + ::: Deletable (SubMap b v m) ::: Query v m ::: () @@ -265,32 +263,18 @@ -- | Get the subdiagram map (/i.e./ an association from names to -- subdiagrams) of a diagram. subMap :: QDiagram b v m -> SubMap b v m -subMap = getU' . unQD +subMap = unDelete . getU' . unQD -- | Get a list of names of subdiagrams and their locations. names :: HasLinearMap v => QDiagram b v m -> [(Name, [Point v])] names = (map . second . map) location . M.assocs . unpack . subMap --- | Attach an atomic name to a diagram. -named :: ( IsName n - , HasLinearMap v, InnerSpace v, OrderedField (Scalar v), Semigroup m) - => n -> QDiagram b v m -> QDiagram b v m -named = nameSub mkSubdiagram - --- | Attach an atomic name to a certain point (which may be computed --- from the given diagram), treated as a subdiagram with no content --- and a point envelope. -namePoint :: ( IsName n - , HasLinearMap v, InnerSpace v, OrderedField (Scalar v), Semigroup m) - => (QDiagram b v m -> Point v) -> n -> QDiagram b v m -> QDiagram b v m -namePoint p = nameSub (subPoint . p) - -- | Attach an atomic name to a certain subdiagram, computed from the -- given diagram. nameSub :: ( IsName n , HasLinearMap v, InnerSpace v, OrderedField (Scalar v), Semigroup m) => (QDiagram b v m -> Subdiagram b v m) -> n -> QDiagram b v m -> QDiagram b v m -nameSub s n d = over QD (D.applyUpre . inj $ fromNames [(n,s d)]) d +nameSub s n d = over QD (D.applyUpre . inj . toDeletable $ fromNames [(n,s d)]) d -- | Given a name and a diagram transformation indexed by a -- subdiagram, perform the transformation using the most recent @@ -321,6 +305,17 @@ withNames ns f d = maybe id f (T.sequence (map ((listToMaybe=<<) . ($nd) . lookupSub . toName) ns)) d where nd = subMap d +-- | \"Localize\" a diagram by hiding all the names, so they are no +-- longer visible to the outside. +localize :: forall b v m. ( HasLinearMap v, InnerSpace v, OrderedField (Scalar v) + , Semigroup m + ) + => QDiagram b v m -> QDiagram b v m +localize = over QD ( D.applyUpre (inj (deleteL :: Deletable (SubMap b v m))) + . D.applyUpost (inj (deleteR :: Deletable (SubMap b v m))) + ) + + -- | Get the query function associated with a diagram. query :: Monoid m => QDiagram b v m -> Query v m query = getU' . unQD @@ -351,7 +346,8 @@ -- | Create a diagram from a single primitive, along with an envelope, -- trace, subdiagram map, and query function. mkQD :: Prim b v -> Envelope v -> Trace v -> SubMap b v m -> Query v m -> QDiagram b v m -mkQD p e t n q = QD $ D.leaf (toDeletable e *: toDeletable t *: n *: q *: ()) p +mkQD p e t n q + = QD $ D.leaf (toDeletable e *: toDeletable t *: toDeletable n *: q *: ()) p ------------------------------------------------------------ -- Instances @@ -395,7 +391,7 @@ instance Functor (QDiagram b v) where fmap f = (over QD . D.mapU . second . second) - ( (first . fmap . fmap) f + ( (first . fmap . fmap . fmap) f . (second . first . fmap . fmap) f ) @@ -624,9 +620,15 @@ instance Action Name (SubMap b v m) where act = (|>) --- | Names don't act on anything else. -instance Action Name a +instance Action Name a => Action Name (Deletable a) where + act n (Deletable l a r) = Deletable l (act n a) r +-- Names do not act on other things. + +instance Action Name (Query v m) +instance Action Name (Envelope v) +instance Action Name (Trace v) + -- | Look for the given name in a name map, returning a list of -- subdiagrams associated with that name. If no names match the -- given name exactly, return all the subdiagrams associated with @@ -651,13 +653,25 @@ -- the collection of primitives a given backend knows how to render is -- determined by instances of 'Renderable'. +-- | A type class for primitive things which know how to handle being +-- transformed by both a normal transformation and a \"frozen\" +-- transformation. The default implementation simply applies both. +-- At the moment, 'ScaleInv' is the only type with a non-default +-- instance of 'IsPrim'. +class Transformable p => IsPrim p where + transformWithFreeze :: Transformation (V p) -> Transformation (V p) -> p -> p + transformWithFreeze t1 t2 = transform (t1 <> t2) + -- | A value of type @Prim b v@ is an opaque (existentially quantified) -- primitive which backend @b@ knows how to render in vector space @v@. data Prim b v where - Prim :: Renderable p b => p -> Prim b (V p) + Prim :: (IsPrim p, Renderable p b) => p -> Prim b (V p) type instance V (Prim b v) = v +instance HasLinearMap v => IsPrim (Prim b v) where + transformWithFreeze t1 t2 (Prim p) = Prim $ transformWithFreeze t1 t2 p + -- | The 'Transformable' instance for 'Prim' just pushes calls to -- 'transform' down through the 'Prim' constructor. instance HasLinearMap v => Transformable (Prim b v) where @@ -673,6 +687,8 @@ type instance (V (NullPrim v)) = v +instance HasLinearMap v => IsPrim (NullPrim v) + instance HasLinearMap v => Transformable (NullPrim v) where transform _ _ = NullPrim @@ -751,7 +767,7 @@ = withStyle b s mempty (render b (transform t p)) renderOne (p, (t1 :| t2, s)) - = withStyle b s t1 (render b (transform (t1 <> t2) p)) + = withStyle b s t1 (render b (transformWithFreeze t1 t2 p)) -- See Note [backend token]