diagrams-core 0.3 → 0.4

raw patch · 13 files changed

+190/−117 lines, 13 filesdep +newtypedep ~basedep ~semigroupsdep ~vector-spacePVP ok

version bump matches the API change (PVP)

Dependencies added: newtype

Dependency ranges changed: base, semigroups, vector-space

API changes (from Hackage documentation)

Files

• CHANGES +6/−0
• LICENSE +1/−0
• README +17/−0
• diagrams-core.cabal +8/−7
• src/Graphics/Rendering/Diagrams.hs +8/−6
• src/Graphics/Rendering/Diagrams/Bounds.hs +4/−1
• src/Graphics/Rendering/Diagrams/Core.hs +52/−32
• src/Graphics/Rendering/Diagrams/HasOrigin.hs +7/−1
• src/Graphics/Rendering/Diagrams/Monoids.hs +28/−17
• src/Graphics/Rendering/Diagrams/Names.hs +47/−52
• src/Graphics/Rendering/Diagrams/Points.hs +7/−0
• src/Graphics/Rendering/Diagrams/Style.hs +4/−1
• src/Graphics/Rendering/Diagrams/V.hs +1/−0

@@ -18,3 +18,9 @@     - additional functions for querying information associated with names   * fix for issue #34 (fix behavior of setBounds)   * Transformable and HasOrigin instances for Transformations++0.4: 23 October 2011+  * improved documentation+  * a few new instances (Newtype Point, Boundable Point)+  * new functions (value, clearValue, resetValue) for working with+    alternate query monoids

@@ -3,6 +3,7 @@   Sam Griffin <sam.griffin@gmail.com>   Vilhelm Sjöberg <vilhelm.sjoberg@gmail.com>   Scott Walck <walck@lvc.edu>+  Ryan Yates <fryguybob@gmail.com>   Brent Yorgey <byorgey@cis.upenn.edu>  All rights reserved.

@@ -0,0 +1,17 @@+The core modules underlying diagrams, a Haskell embedded+domain-specific language for compositional, declarative drawing.  See++  http://projects.haskell.org/diagrams/++for more information about the project, including installation+instructions, tutorials, a user manual, a gallery of example images,+and links to the mailing list, IRC channel, developer wiki and bug+tracker.++The source repository is mirrored on both patch-tag (darcs) and github+(git):++  http://patch-tag.com/r/byorgey/diagrams-core+  https://github.com/byorgey/diagrams-core++Patches/pull requests welcome in either place.

@@ -1,5 +1,5 @@ Name:                diagrams-core-Version:             0.3+Version:             0.4 Synopsis:            Core libraries for diagrams EDSL Description:         The core modules underlying diagrams,                       an embedded domain-specific language @@ -12,8 +12,8 @@ Category:            Graphics Build-type:          Simple Cabal-version:       >=1.6-Extra-source-files:  CHANGES-Tested-with:         GHC == 6.12.3, GHC >= 7.0.2 && <= 7.0.3+Extra-source-files:  CHANGES, README+Tested-with:         GHC == 6.12.3, GHC >= 7.0.2 && <= 7.0.3, GHC == 7.2.1 Source-repository head   type:     darcs   location: http://patch-tag.com/r/byorgey/diagrams-core@@ -34,10 +34,11 @@                        Graphics.Rendering.Diagrams.Util,                        Graphics.Rendering.Diagrams.Core -  Build-depends:       base >= 4.2 && < 4.4,+  Build-depends:       base >= 4.2 && < 4.5,                        containers >= 0.3 && < 0.5,-                       semigroups >= 0.3.4 && < 0.6,-                       vector-space >= 0.7 && < 0.8,-                       MemoTrie >= 0.4.7 && < 0.5+                       semigroups >= 0.3.4 && < 0.9,+                       vector-space >= 0.7.7 && < 0.8,+                       MemoTrie >= 0.4.7 && < 0.5,+                       newtype >= 0.2 && < 0.3    hs-source-dirs:      src

@@ -46,7 +46,7 @@        , fromLinear           -- ** Some specific transformations-       , translation, translate, moveTo+       , translation, translate, moveTo, place        , scaling, scale           -- ** The Transformable class@@ -59,9 +59,9 @@           -- * Names -       , Atomic(..), AName-       , Name, toName-       , Qualifiable(..), (.>), (||>)+       , AName+       , Name, IsName(..)+       , Qualifiable(..), (.>)        , NameMap        , fromNames, fromNamesB        , rememberAs@@ -101,10 +101,12 @@        , AnnDiagram, mkAD, Diagram        , prims        , bounds, names, query, sample+       , value, resetValue, clearValue         , named, namePoint-       , withName, withAName-       , withNameB, withANameB+       , withName+       , withNameAll+       , withNames         , freeze, setBounds 

@@ -139,12 +139,15 @@ instance (Boundable b) => Boundable [b] where   getBounds = mconcat . map getBounds +instance (OrderedField (Scalar v), InnerSpace v) => Boundable (Point v) where+  getBounds p = moveTo p mempty+ ------------------------------------------------------------ --  Computing with bounds ------------------------------------------------------------  -- | Compute the vector from the local origin to a separating--- hyperplan in the given direction.+--   hyperplane in the given direction. boundaryV :: Boundable a => V a -> a -> V a boundaryV v a = appBounds (getBounds a) v *^ v 

@@ -48,6 +48,7 @@          -- ** Extracting information        , prims        , bounds, names, query, sample+       , value, resetValue, clearValue           -- ** Combining diagrams @@ -60,8 +61,9 @@          -- *** Names        , named        , namePoint-       , withName, withAName-       , withNameB, withANameB+       , withName+       , withNameAll+       , withNames           -- *** Other        , freeze@@ -100,8 +102,9 @@ import Data.VectorSpace import Data.AffineSpace ((.-.)) -import Data.Maybe (listToMaybe)+import Data.Maybe (listToMaybe, fromMaybe) import Data.Monoid+import qualified Data.Traversable as T import Control.Arrow (second, (&&&))  import Data.Typeable@@ -186,7 +189,7 @@  -- | Attach an atomic name to (the local origin of) a diagram. named :: forall v b n m.-         ( Atomic n+         ( IsName n          , HasLinearMap v, InnerSpace v, OrderedField (Scalar v), Monoid m)       => n -> AnnDiagram b v m -> AnnDiagram b v m named = namePoint (const origin &&& bounds)@@ -194,45 +197,43 @@ -- | Attach an atomic name to a certain point and bounding function, --   computed from the given diagram. namePoint :: forall v b n m.-         ( Atomic n+         ( IsName n          , HasLinearMap v, InnerSpace v, OrderedField (Scalar v), Monoid m)       => (AnnDiagram b v m -> (Point v, Bounds v)) -> n -> AnnDiagram b v m -> AnnDiagram b v m namePoint p n d = inAD (applyUpre . inj $ fromNamesB [(n,p d)]) d --- | Given a name and a diagram transformation indexed by a point,---   perform the transformation using the first point associated with---   (some qualification of) the name, or perform the identity+-- | Given a name and a diagram transformation indexed by a point and+--   a bounding function, perform the transformation using the most+--   recent (point, bounding function) pair associated with (some+--   qualification of) the name, or perform the identity --   transformation if the name does not exist.-withName :: ( AdditiveGroup (Scalar v), Floating (Scalar v)+withName :: ( IsName n, AdditiveGroup (Scalar v), Floating (Scalar v)             , InnerSpace v, HasLinearMap v)-         => Name -> (Point v -> AnnDiagram b v m -> AnnDiagram b v m)+         => n -> ((Point v, Bounds v) -> AnnDiagram b v m -> AnnDiagram b v m)          -> AnnDiagram b v m -> AnnDiagram b v m-withName n f d = maybe id (f . fst) (lookupN n (names d) >>= listToMaybe) d+withName n f d = maybe id f (lookupN (toName n) (names d) >>= listToMaybe) d --- | Like 'withName', but taking an atomic name as an argument.-withAName :: ( Atomic a, AdditiveGroup (Scalar v), Floating (Scalar v)-             , InnerSpace v, HasLinearMap v)-          => a -> (Point v -> AnnDiagram b v m -> AnnDiagram b v m)-          -> AnnDiagram b v m -> AnnDiagram b v m-withAName = withName . toName+-- | Given a name and a diagram transformation indexed by a list of+-- (point, bounding function) pairs, perform the transformation using+-- the collection of all pairs associated with (some qualification of)+-- the given name.+withNameAll :: ( IsName n, AdditiveGroup (Scalar v), Floating (Scalar v)+               , InnerSpace v, HasLinearMap v)+            => n -> ([(Point v, Bounds v)] -> AnnDiagram b v m -> AnnDiagram b v m)+            -> AnnDiagram b v m -> AnnDiagram b v m+withNameAll n f d = f (fromMaybe [] (lookupN (toName n) (names d))) d --- | Given a name and a diagram transformation indexed by a point and---   a bounding function, perform the transformation using the first---   (point, bounding function) pair associated with (some---   qualification of) the name, or perform the identity---   transformation if the name does not exist.-withNameB :: ( AdditiveGroup (Scalar v), Floating (Scalar v)+-- | Given a list of names and a diagram transformation indexed by a+--   list of (point,bounding function) pairs, perform the+--   transformation using the list of most recent pairs associated+--   with (some qualification of) each name.  Do nothing (the identity+--   transformation) if any of the names do not exist.+withNames :: ( IsName n, AdditiveGroup (Scalar v), Floating (Scalar v)              , InnerSpace v, HasLinearMap v)-          => Name -> (Point v -> Bounds v -> AnnDiagram b v m -> AnnDiagram b v m)+          => [n] -> ([(Point v, Bounds v)] -> AnnDiagram b v m -> AnnDiagram b v m)           -> AnnDiagram b v m -> AnnDiagram b v m-withNameB n f d = maybe id (uncurry f) (lookupN n (names d) >>= listToMaybe) d---- | Like 'withNameB', but taking an atomic name as an argument.-withANameB :: ( Atomic a, AdditiveGroup (Scalar v), Floating (Scalar v)-              , InnerSpace v, HasLinearMap v)-           => a -> (Point v -> Bounds v -> AnnDiagram b v m -> AnnDiagram b v m)-           -> AnnDiagram b v m -> AnnDiagram b v m-withANameB a = withNameB . toName $ a+withNames ns f d = maybe id f (T.sequence (map ((listToMaybe=<<) . ($nd) . lookupN . toName) ns)) d+  where nd = names d  -- | Get the query function associated with a diagram. query :: (HasLinearMap v, Monoid m) => AnnDiagram b v m -> Query v m@@ -241,6 +242,25 @@ -- | Sample a diagram's query function at a given point. sample :: (HasLinearMap v, Monoid m) => AnnDiagram b v m -> Point v -> m sample = runQuery . query++-- | Set the query value for 'True' points in a diagram (/i.e./ points+--   "inside" the diagram); 'False' points will be set to 'mempty'.+value :: Monoid m => m -> AnnDiagram b v Any -> AnnDiagram b v m+value m = fmap fromAny+  where fromAny (Any True)  = m+        fromAny (Any False) = mempty++-- | Reset the query values of a diagram to True/False: any values+--   equal to 'mempty' are set to 'False'; any other values are set to+--   'True'.+resetValue :: (Eq m, Monoid m) => AnnDiagram b v m -> AnnDiagram b v Any+resetValue = fmap toAny+  where toAny m | m == mempty = Any False+                | otherwise   = Any True++-- | Set all the query values of a diagram to 'False'.+clearValue :: AnnDiagram b v m -> AnnDiagram b v Any+clearValue = fmap (const (Any False))  -- | Create a diagram from a single primitive, along with a bounding --   region, name map, and query function.

@@ -15,7 +15,7 @@ -----------------------------------------------------------------------------  module Graphics.Rendering.Diagrams.HasOrigin-       ( HasOrigin(..), moveOriginBy, moveTo+       ( HasOrigin(..), moveOriginBy, moveTo, place        ) where  import Graphics.Rendering.Diagrams.V@@ -63,6 +63,12 @@ --   > moveTo (origin .^+ v) === translate v moveTo :: HasOrigin t => Point (V t) -> t -> t moveTo = moveOriginBy . (origin .-.)++-- | A flipped variant of 'moveTo', provided for convenience.  Useful+--   when writing a function which takes a point as an argument, such+--   as when using 'withName' and friends.+place :: HasOrigin t => t -> Point (V t) -> t+place = flip moveTo  instance VectorSpace v => HasOrigin (Point v) where   moveOriginTo (P u) p = p .-^ u

@@ -129,11 +129,11 @@ ------------------------------------------------------------  -- $forget--- Sometimes we want to be able to "forget" some information.  We+-- Sometimes we want to be able to \"forget\" some information.  We -- define two monoid transformers that allow forgetting information. -- @Forgetful@ introduces special values which cause anything to their--- right to be forgotten.  @Deletable@ introduces special "left and--- right bracket" elements which cause everything inside them to be+-- right to be forgotten.  @Deletable@ introduces special \"left and+-- right bracket\" elements which cause everything inside them to be -- forgotten.  @@ -147,6 +147,7 @@                  | Forgetful m   deriving Functor +-- | Project the wrapped value out of a `Forgetful` value. unForget :: Forgetful m -> m unForget (Normal m)    = m unForget (Forgetful m) = m@@ -174,28 +175,28 @@ type instance V (Forgetful m) = V m  -- | If @m@ is a 'Monoid', then @Deletable m@ (intuitively speaking)---   adds two distinguished new elements L and R, such that an---   occurrence of L \"deletes\" everything from it to the next R. For+--   adds two distinguished new elements @[@ and @]@, such that an+--   occurrence of [ \"deletes\" everything from it to the next ]. For --   example, -----   > abcLdefRgh == abcgh+--   > abc[def]gh == abcgh -- --   This is all you really need to know to /use/ @Deletable m@ --   values; to understand the actual implementation, read on. -- --   To properly deal with nesting and associativity we need to be---   able to assign meanings to things like @LL@, @RL@, and so on. (We---   cannot just define, say, @LL == L@, since then @(LL)R == LR ==---   id@ but @L(LR) == Lid == L@.)  Formally, elements of @Deletable---   m@ are triples of the form (r, m, l) representing words @R^r m---   L^l@.  When combining two triples (r1, m1, l1) and (r2, m2, l2)+--   able to assign meanings to things like @[[@, @][@, and so on. (We+--   cannot just define, say, @[[ == [@, since then @([[)] == [] ==+--   id@ but @[([]) == [id == [@.)  Formally, elements of @Deletable+--   m@ are triples of the form (r, m, l) representing words @]^r m+--   [^l@.  When combining two triples (r1, m1, l1) and (r2, m2, l2) --   there are three cases: -----   * If l1 == r2 then the Ls from the left and Rs from the right+--   * If l1 == r2 then the [s from the left and ]s from the right --     exactly cancel, and we are left with (r1, m1 \<\> m2, l2). -----   * If l1 < r2 then all of the Ls cancel with some of the Rs, but---     m1 is still inside the remaining Rs and is deleted, yielding (r1+--   * If l1 < r2 then all of the [s cancel with some of the ]s, but+--     m1 is still inside the remaining ]s and is deleted, yielding (r1 --     + r2 - l1, m2, l2) -- --   * The remaining case is symmetric with the second.@@ -205,9 +206,18 @@  type instance V (Deletable m) = V m +-- | Project the wrapped value out of a `Deletable` value. unDelete :: Deletable m -> m unDelete (Deletable _ m _) = m +-- | Inject a value into a `Deletable` wrapper.  Satisfies the+--   property+--+-- > unDelete . toDeletable === id+--+toDeletable :: m -> Deletable m+toDeletable m = Deletable 0 m 0+ instance Monoid m => Monoid (Deletable m) where   mempty = Deletable 0 mempty 0   (Deletable r1 m1 l1) `mappend` (Deletable r2 m2 l2)@@ -215,12 +225,13 @@     | l1 <  r2  = Deletable (r1 + r2 - l1) m2 l2     | otherwise = Deletable r1 m1 (l2 + l1 - r2) -toDeletable :: m -> Deletable m-toDeletable m = Deletable 0 m 0-+-- | A \"left bracket\", which causes everything between it and the+--   next right bracket to be deleted. deleteL :: Monoid m => Deletable m deleteL = Deletable 0 mempty 1 +-- | A \"right bracket\", denoting the end of the section that should+--   be deleted. deleteR :: Monoid m => Deletable m deleteR = Deletable 1 mempty 0 

@@ -25,14 +25,13 @@ module Graphics.Rendering.Diagrams.Names        (-- * Names         -- ** Atomic names-         Atomic(..)-       , AName(..)+         AName(..)          -- ** Names-       , Name(..), toName+       , Name(..), IsName(..), (.>)          -- ** Qualifiable-       , Qualifiable(..), (.>), (||>)+       , Qualifiable(..)           -- * Name maps @@ -52,6 +51,7 @@ import Graphics.Rendering.Diagrams.Points import Graphics.Rendering.Diagrams.Bounds import Graphics.Rendering.Diagrams.Transform+import Graphics.Rendering.Diagrams.Util  import Data.VectorSpace @@ -67,34 +67,34 @@ --  Names  ------------------------------------------------- ------------------------------------------------------------ --- | @Atomic@ types are those which can be used as names.  They must+-- | Class for those types which can be used as names.  They must --   support 'Typeable' (to facilitate extracting them from --   existential wrappers), 'Ord' (for comparison and efficient --   storage) and 'Show'.-class (Typeable a, Ord a, Show a) => Atomic a where-  toAName :: a -> AName-  toAName = AName+class (Typeable a, Ord a, Show a) => IsName a where+  toName :: a -> Name+  toName = Name . (:[]) . AName -instance Atomic ()-instance Atomic Bool-instance Atomic Char-instance Atomic Int-instance Atomic Float-instance Atomic Double-instance Atomic Integer-instance Atomic String-instance Atomic a => Atomic [a]-instance (Atomic a, Atomic b) => Atomic (a,b)-instance (Atomic a, Atomic b, Atomic c) => Atomic (a,b,c)+instance IsName ()+instance IsName Bool+instance IsName Char+instance IsName Int+instance IsName Float+instance IsName Double+instance IsName Integer+instance IsName String+instance IsName a => IsName [a]+instance (IsName a, IsName b) => IsName (a,b)+instance (IsName a, IsName b, IsName c) => IsName (a,b,c)  -- | Atomic names.  @AName@ is just an existential wrapper around---   'Atomic' values.+--   things which are 'Typeable', 'Ord' and 'Show'. data AName where-  AName :: Atomic a => a -> AName+  AName :: (Typeable a, Ord a, Show a) => a -> AName   deriving (Typeable) -instance Atomic AName where-  toAName = id+instance IsName AName where+  toName = Name . (:[])  instance Eq AName where   (AName a1) == (AName a2) =@@ -113,38 +113,32 @@  -- | A (qualified) name is a (possibly empty) sequence of atomic names. newtype Name = Name [AName]-  deriving (Eq, Ord, Monoid)+  deriving (Eq, Ord, Monoid, Typeable)  instance Show Name where-  show (Name ns) = intercalate " |> " $ map show ns+  show (Name ns) = intercalate " .> " $ map show ns --- | Convert an atomic name to a name.-toName :: Atomic a => a -> Name-toName = Name . (:[]) . toAName+instance IsName Name where+  toName = id +-- | Convenient operator for writing qualified names with atomic+--   components of different types.  Instead of writing @toName a1 \<\>+--   toName a2 \<\> toName a3@ you can just write @a1 .> a2 .> a3@.+(.>) :: (IsName a1, IsName a2) => a1 -> a2 -> Name+a1 .> a2 = toName a1 <> toName a2+ -- | Instances of 'Qualifiable' are things which can be qualified by---   prefixing them with an atomic name.+--   prefixing them with a name. class Qualifiable q where   -- | Qualify with the given name.-  (|>) :: Atomic a => a -> q -> q+  (|>) :: IsName a => a -> q -> q --- | Of course, names can be qualified.+-- | Of course, names can be qualified using @(.>)@. instance Qualifiable Name where-  a |> (Name as) = Name (toAName a : as)---- | Convenient operator for writing complete names in the form @a1 |>---   a2 |> a3 ||> a4@.  In particular, @a1 .> a2@ is equivalent to---   @a1 |> toName a2@.-(.>) :: (Atomic a1, Atomic a2) => a1 -> a2 -> Name-a1 .> a2 = a1 |> toName a2--infixr 2 |>-infixr 2 .>+  (|>) = (.>) --- | Qualify by an entire qualified name.  @(a1 |> a2 .> a3) ||> q@ is---   equivalent to @a1 |> a2 |> a3 |> q@.-(||>) :: Qualifiable q => Name -> q -> q-Name as ||> q = foldr (|>) q as+infixr 5 |>+infixr 5 .>  ------------------------------------------------------------ --  Name maps  ---------------------------------------------@@ -192,22 +186,22 @@  -- | Construct a 'NameMap' from a list of (name, point) pairs.  The --   bounding functions will be empty.-fromNames :: (AdditiveGroup (Scalar v), Ord (Scalar v), Atomic a)+fromNames :: (AdditiveGroup (Scalar v), Ord (Scalar v), IsName a)           => [(a, Point v)] -> NameMap v fromNames = NameMap . M.fromList . map (toName *** ((:[]) . (,mempty)))  -- | Construct a 'NameMap' from a list of associations between names --   and (point, bounds) pairs.-fromNamesB :: Atomic a => [(a, (Point v, Bounds v))] -> NameMap v+fromNamesB :: IsName a => [(a, (Point v, Bounds v))] -> NameMap v fromNamesB = NameMap . M.fromList . map (toName *** (return . second TransInv))  -- | Give a name to a point and bounding function.-rememberAs :: Name -> Point v -> Bounds v -> NameMap v -> NameMap v-rememberAs n p b (NameMap names) = NameMap $ M.insertWith (++) n [(p,TransInv b)] names+rememberAs :: IsName a => a -> Point v -> Bounds v -> NameMap v -> NameMap v+rememberAs n p b (NameMap names) = NameMap $ M.insertWith (++) (toName n) [(p,TransInv b)] names  -- | A name acts on a name map by qualifying every name in it. instance Action Name (NameMap v) where-  act = (||>)+  act = (|>)  -- | Names don't act on anything else. instance Action Name a@@ -219,11 +213,12 @@ --   and bounding regions associated with that name.  If no names --   match the given name exactly, return all the points associated --   with names of which the given name is a suffix.-lookupN :: Name -> NameMap v -> Maybe [(Point v, Bounds v)]-lookupN n (NameMap m)+lookupN :: IsName n => n -> NameMap v -> Maybe [(Point v, Bounds v)]+lookupN a (NameMap m)   = (fmap . map . second) unTransInv     (M.lookup n m `mplus`     (flatten . filter ((n `nameSuffixOf`) . fst) . M.assocs $ m))   where (Name n1) `nameSuffixOf` (Name n2) = n1 `isSuffixOf` n2         flatten [] = Nothing         flatten xs = Just . concatMap snd $ xs+        n = toName a

@@ -1,4 +1,6 @@ {-# LANGUAGE TypeFamilies+           , MultiParamTypeClasses+           , FlexibleInstances            , DeriveFunctor            , DeriveDataTypeable   #-}@@ -25,6 +27,7 @@  import Graphics.Rendering.Diagrams.V +import Control.Newtype import Data.Data (Data) import Data.Typeable (Typeable) @@ -41,6 +44,10 @@   deriving (Eq, Ord, Read, Show, Data, Typeable, Functor)  type instance V (Point v) = v++instance Newtype (Point v) v where+  pack = P+  unpack (P v) = v  -- | The origin of the vector space @v@. origin :: AdditiveGroup v => Point v

@@ -203,7 +203,10 @@   applyStyle = mappend  instance HasStyle a => HasStyle [a] where-  applyStyle = map . applyStyle+  applyStyle = fmap . applyStyle++instance HasStyle b => HasStyle (a -> b) where+  applyStyle = fmap . applyStyle  -- instance (HasStyle a, HasStyle b) => HasStyle (a,b) where --   applyStyle s = applyStyle s *** applyStyle s

@@ -28,6 +28,7 @@ --   associated vector space. type family V a :: * +type instance V (a -> b)  = V b type instance V [a]       = V a type instance V (Set a)   = V a type instance V (Map k a) = V a