diagrams-lib 0.2 → 0.3

raw patch · 21 files changed

+800/−159 lines, 21 filesdep +newtypedep ~diagrams-corePVP ok

version bump matches the API change (PVP)

Dependencies added: newtype

Dependency ranges changed: diagrams-core

API changes (from Hackage documentation)

Files

• CHANGES +19/−0
• diagrams-lib.cabal +10/−5
• src/Diagrams/Align.hs +12/−9
• src/Diagrams/Backend/Show.hs +7/−7
• src/Diagrams/Combinators.hs +14/−13
• src/Diagrams/Path.hs +67/−40
• src/Diagrams/ThreeD/Shapes.hs +41/−0
• src/Diagrams/ThreeD/Types.hs +43/−0
• src/Diagrams/TwoD.hs +29/−8
• src/Diagrams/TwoD/Adjust.hs +82/−0
• src/Diagrams/TwoD/Align.hs +2/−2
• src/Diagrams/TwoD/Arc.hs +3/−1
• src/Diagrams/TwoD/Combinators.hs +4/−2
• src/Diagrams/TwoD/Ellipse.hs +21/−13
• src/Diagrams/TwoD/Image.hs +75/−0
• src/Diagrams/TwoD/Model.hs +30/−5
• src/Diagrams/TwoD/Path.hs +83/−13
• src/Diagrams/TwoD/Shapes.hs +39/−40
• src/Diagrams/TwoD/Text.hs +195/−0
• src/Diagrams/TwoD/Types.hs +1/−1
• src/Diagrams/TwoD/Util.hs +23/−0

@@ -28,3 +28,22 @@   * Fixes and updates:     + withBounds now properly uses the new bounds instead of just combining       them with the old++0.3: 18 June 2011++  * New features:+    + new customizable stroke' function which lets you assign names to+      path vertices+    + circle and square functions now take a size argument+    + function for adjusting 2D diagrams to requested size abstracted+      from cairo backend+    + generalize PathLike class to include an instance for diagrams,+      and collapse things like polygon/polygonPath into a single+      polymorphic function+    + basic text support+    + basic support for external images+    + very sketchy initial proof-of-concept library of 3D primitives.+      See also http://patch-tag.com/r/byorgey/diagrams-povray.++  * Bug fixes:+    + Issue 32 (mempty not behaving correctly within concatenations)

@@ -1,5 +1,5 @@ Name:                diagrams-lib-Version:             0.2+Version:             0.3 Synopsis:            Embedded domain-specific language for declarative graphics Description:         Diagrams is a flexible, extensible EDSL for creating                      graphics of many types.  Graphics can be created@@ -12,8 +12,7 @@ License:             BSD3 License-file:        LICENSE Author:              Brent Yorgey-Maintainer:          byorgey@cis.upenn.edu-Stability:           Experimental+Maintainer:          diagrams-discuss@googlegroups.com Category:            Graphics Build-type:          Simple Cabal-version:       >=1.6@@ -44,14 +43,20 @@                        Diagrams.TwoD.Shapes,                        Diagrams.TwoD.Util,                        Diagrams.TwoD.Model,+                       Diagrams.TwoD.Text,+                       Diagrams.TwoD.Image,+                       Diagrams.TwoD.Adjust,+                       Diagrams.ThreeD.Types,+                       Diagrams.ThreeD.Shapes,                        Diagrams.Util,                        Diagrams.Backend.Show   Build-depends:       base >= 4.2 && < 4.4,                        containers >= 0.3 && < 0.5,                        semigroups >= 0.3.4 && < 0.6,-                       diagrams-core >= 0.2 && < 0.3,+                       diagrams-core >= 0.3 && < 0.4,                        vector-space >= 0.7 && < 0.8,                        colour >= 2.3.1 && < 2.4,                        data-default >= 0.2 && < 0.3,-                       pretty >= 1.0.1.2 && < 1.1+                       pretty >= 1.0.1.2 && < 1.1,+                       newtype >= 0.2 && < 0.3   Hs-source-dirs:      src

@@ -1,5 +1,6 @@ {-# LANGUAGE TypeFamilies            , FlexibleContexts+           , UndecidableInstances   #-}  -----------------------------------------------------------------------------@@ -16,7 +17,8 @@ -----------------------------------------------------------------------------  module Diagrams.Align-       ( align, alignBy+       ( -- * Generic alignment functions+         align, alignBy        , center        ) where @@ -34,16 +36,17 @@ align v a = moveOriginTo (boundary v a) a  --- XXX need a better, more intuitive description of alignBy---- | @align v d a@ moves the origin of @a@ to a distance of @d*r@ from---   the center along @v@, where @r@ is the radius along @v@.  Hence---   @align v 0@ centers along @v@, and @align v 1@ moves the origin---   in the direction of @v@ to the very edge of the bounding region.-alignBy :: (HasOrigin a, Boundable a) => V a -> Rational -> a -> a+-- | @align v d a@ moves the origin of @a@ along the vector @v@. If @d+--   = 1@, the origin is moved to the boundary in the direction of+--   @v@; if @d = -1@, it moves to 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, Boundable a, Num (Scalar (V a)))+        => V a -> Scalar (V a) -> a -> a alignBy v d a = moveOriginTo (alerp (boundary (negateV v) a)                                     (boundary v a)-                                    ((fromRational d + 1) / 2))+                                    ((d + 1) / 2))                              a  -- | @center v@ centers a boundable object along the direction of @v@.

@@ -24,7 +24,7 @@  import Data.Basis -import Text.PrettyPrint (Doc, empty, ($+$), parens, hsep, text, nest)+import Text.PrettyPrint (Doc, empty, ($+$), parens, hsep, nest) import qualified Text.PrettyPrint as PP  import Data.List (transpose)@@ -64,18 +64,18 @@  renderMat :: Show a => [[a]] -> Doc renderMat = PP.vcat . map renderRow . transpose-  where renderRow = parens . hsep . map (text . show)+  where renderRow = parens . hsep . map (PP.text . show)  instance Renderable Ellipse ShowBackend where-  render _ (Ellipse t) = SR $ text "Ellipse (" $+$+  render _ (Ellipse t) = SR $ PP.text "Ellipse (" $+$                                 nest 2 (renderTransf t) $+$-                              text ")"+                              PP.text ")"  instance (Show v, HasLinearMap v) => Renderable (Segment v) ShowBackend where-  render _ s = SR $ text (show s)+  render _ s = SR $ PP.text (show s)  instance (Show v, HasLinearMap v) => Renderable (Trail v) ShowBackend where-  render _ t = SR $ text (show t)+  render _ t = SR $ PP.text (show t)  instance (Ord v, Show v, HasLinearMap v) => Renderable (Path v) ShowBackend where-  render _ p = SR $ text (show p)+  render _ p = SR $ PP.text (show p)

@@ -43,8 +43,8 @@ import Data.AffineSpace ((.-.)) import Data.VectorSpace +import Data.List (foldl') import Data.Monoid-import Data.List  import Data.Default @@ -57,7 +57,7 @@ --   bounding region. withBounds :: (Backend b (V a), Boundable a, Monoid m)            => a -> AnnDiagram b (V a) m -> AnnDiagram b (V a) m-withBounds b = setBounds (getBounds b)+withBounds = setBounds . getBounds  -- | @phantom x@ produces a \"phantom\" diagram, which has the same --   bounding region as @x@ but produces no output.@@ -232,17 +232,18 @@ --   superimposing). cat' :: (HasOrigin a, Boundable a, Qualifiable a, Monoid a)      => V a -> CatOpts (V a) -> [a] -> a-cat' _ (CatOpts { catMethod = Cat }) []     = mempty-cat' _ (CatOpts { catMethod = Cat }) [d]    = (0::Integer) |> d-cat' v (CatOpts { catMethod = Cat, sep = s }) (d:ds) =-  foldl' (\d1 d2 ->-           d1 <> (moveOriginBy (origin .-. boundary v d1)-                  . moveOriginBy (withLength s (negateV v))-                  . align (negateV v)-                  $ d2)-         )-         ((0::Integer) |> d)-         (zipWith (|>) [1::Integer ..] ds)+cat' _ (CatOpts { catMethod = Cat }) []              = mempty+cat' _ (CatOpts { catMethod = Cat }) [d]             = (0::Integer) |> d+cat' v (CatOpts { catMethod = Cat, sep = s }) (x:xs) =+    foldl' (\d2 d1 ->+             d1 <> (moveOriginBy (origin .-. boundary v d1)+                    . moveOriginBy (withLength s (negateV v))+                    $ d2)+           )+           d+           ds+  where (d:ds) = reverse (zipWith (|>) [0::Integer ..] (x:xs'))+        xs' = map (align (negateV v)) xs  cat' v (CatOpts { catMethod = Distrib, sep = s }) ds =   decorateTrail (fromOffsets (repeat (withLength s v))) ds

@@ -1,9 +1,11 @@ {-# LANGUAGE TypeFamilies+           , MultiParamTypeClasses            , FlexibleInstances            , FlexibleContexts            , DeriveFunctor            , GeneralizedNewtypeDeriving            , UndecidableInstances+           , ScopedTypeVariables   #-} ----------------------------------------------------------------------------- -- |@@ -22,9 +24,13 @@        (          -- * Constructing path-like things -         PathLike(..), fromOffsets, fromVertices+         PathLike(..), fromOffsets, fromVertices, segmentsFromVertices        , pathLikeFromTrail +         -- * Closeable things++       , Closeable(..)+          -- * Trails         , Trail(..)@@ -53,6 +59,7 @@         , explodeTrail        , explodePath+       , (~~)         ) where @@ -64,6 +71,7 @@ import Data.VectorSpace import Data.AffineSpace +import Control.Newtype import Data.Monoid import qualified Data.Foldable as F @@ -76,35 +84,60 @@ ------------------------------------------------------------  -- | Type class for path-like things, which must be monoids.---   Instances include 'Trail's and 'Path's.+--   Instances include 'Trail's, 'Path's, and two-dimensional 'Diagram's. class (Monoid p, VectorSpace (V p)) => PathLike p where -  -- | Set the starting point of the path-like thing.  Some path-like-  --   things (e.g. 'Trail's) may ignore this operation.-  setStart   :: Point (V p) -> p -> p--  -- | Construct a path-like thing from a list of 'Segment's.-  fromSegments :: [Segment (V p)] -> p--  -- | \"Close\" a path-like thing, by implicitly connecting the-  --   endpoint(s) back to the starting point(s).-  close :: p -> p+  pathLike :: Point (V p)      -- ^ The starting point of the+                               --   path.  Some path-like things+                               --   (e.g. 'Trail's) may ignore this.+           -> Bool             -- ^ Should the path be closed?+           -> [Segment (V p)]  -- ^ Segments of the path.+           -> p -  -- | \"Open\" a path-like thing.-  open  :: p -> p+-- | Construct an open path-like thing with the origin as a starting+--   point.+fromSegments :: PathLike p => [Segment (V p)] -> p+fromSegments = pathLike origin False --- | Construct a path-like thing of linear segments from a list of---   offsets.+-- | Construct an open path-like thing of linear segments from a list+--   of offsets.  The starting point is the origin. fromOffsets :: PathLike p => [V p] -> p-fromOffsets = fromSegments . map Linear+fromOffsets = pathLike origin False . map Linear  -- | Construct a path-like thing of linear segments from a list of---   vertices, with the first vertex as the starting point.+--   vertices, with the first vertex as the starting point.  The first+--   argument specifies whether the path should be closed. fromVertices :: PathLike p => [Point (V p)] -> p fromVertices []         = mempty-fromVertices vvs@(v:vs) = setStart v $ fromOffsets (zipWith (flip (.-.)) vvs vs)+fromVertices vvs@(v:_) = pathLike v False (segmentsFromVertices vvs) +-- | Construct a list of segments from a (non-empty) list of vertices.+segmentsFromVertices :: AdditiveGroup v => [Point v] -> [Segment v]+segmentsFromVertices [] = []+segmentsFromVertices vvs@(_:vs) = map Linear (zipWith (flip (.-.)) vvs vs)+ ------------------------------------------------------------+--  Closeable class+------------------------------------------------------------++-- | Path-like things that can be \"open\" or \"closed\".+class PathLike p => Closeable p where+  -- | \"Open\" a path-like thing.+  open  :: p -> p++  -- | \"Close\" a path-like thing, by implicitly connecting the+  --   endpoint(s) back to the starting point(s).+  close :: p -> p++instance VectorSpace v => Closeable (Trail v) where+  close (Trail segs _) = Trail segs True+  open  (Trail segs _) = Trail segs False++instance (VectorSpace v, Ord v) => Closeable (Path v) where+  close = (over Path . map . second) close+  open  = (over Path . map . second) open++------------------------------------------------------------ --  Trails  ------------------------------------------------ ------------------------------------------------------------ @@ -131,10 +164,7 @@ --   translationally invariant, 'setStart' has no effect. --   'fromSegments' creates an open trail. instance VectorSpace v => PathLike (Trail v) where-  setStart _ tr     = tr-  fromSegments segs = Trail segs False-  close tr          = tr { isClosed = True }-  open tr           = tr { isClosed = False }+  pathLike _ cl segs = Trail segs cl  instance HasLinearMap v => Transformable (Trail v) where   transform t (Trail segs c) = Trail (transform t segs) c@@ -180,10 +210,7 @@ -- | Convert a trail to any path-like thing.  @pathLikeFromTrail@ is the --   identity on trails. pathLikeFromTrail :: PathLike p => Trail (V p) -> p-pathLikeFromTrail t = (if isClosed t then close else id)-                    . fromSegments-                    . trailSegments-                    $ t+pathLikeFromTrail t = pathLike origin (isClosed t) (trailSegments t)  ------------------------------------------------------------ --  Paths  -------------------------------------------------@@ -198,26 +225,21 @@  type instance V (Path v) = v -inPath :: ([(Point v, Trail v)] -> [(Point v, Trail v)]) -> Path v -> Path v-inPath f (Path ts) = Path (f ts)+instance Newtype (Path v) [(Point v, Trail v)] where+  pack   = Path+  unpack = pathTrails  instance (Ord v, VectorSpace v) => HasOrigin (Path v) where-  moveOriginTo = inPath . map . first . moveOriginTo+  moveOriginTo = over Path . map . first . moveOriginTo  -- | Paths are (of course) path-like. 'fromSegments' creates a path --   with start point at the origin. instance (Ord v, VectorSpace v) => PathLike (Path v) where-  setStart          = moveTo--  fromSegments []   = Path []-  fromSegments segs = Path [(origin, fromSegments segs)]--  close = (inPath . map . second) close-  open  = (inPath . map . second) open+  pathLike s cl segs = Path [(s, pathLike origin cl segs)]  -- See Note [Transforming paths] instance (HasLinearMap v, Ord v) => Transformable (Path v) where-  transform t = (inPath . map) (transform t *** transform t)+  transform t = (over Path . map) (transform t *** transform t)  {- ~~~~ Note [Transforming paths] @@ -230,9 +252,10 @@ -}  instance (InnerSpace v, OrderedField (Scalar v)) => Boundable (Path v) where-   getBounds = F.foldMap trailBounds . pathTrails-    where trailBounds (p, t) = moveOriginTo ((-1) *. p) (getBounds t)+          -- this type signature is necessary to work around an apparent bug in ghc 6.12.1+    where trailBounds :: (Point v, Trail v) -> Bounds v+          trailBounds (p, t) = moveOriginTo ((-1) *. p) (getBounds t)  ------------------------------------------------------------ --  Constructing paths from trails  ------------------------@@ -273,3 +296,7 @@ -- | \"Explode\" a path by exploding every component trail (see 'explodeTrail'). explodePath :: VectorSpace v => Path v -> [[Path v]] explodePath = map (uncurry explodeTrail) . pathTrails++-- | Create a single-segment path between two given points.+(~~) :: PathLike p => Point (V p) -> Point (V p) -> p+p1 ~~ p2 = fromVertices [p1, p2]

@@ -0,0 +1,41 @@+{-# LANGUAGE TypeFamilies+           , FlexibleContexts+  #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Diagrams.ThreeD.Shapes+-- Copyright   :  (c) 2011 diagrams-lib team (see LICENSE)+-- License     :  BSD-style (see LICENSE)+-- Maintainer  :  diagrams-discuss@googlegroups.com+--+-- Various three-dimensional shapes.+--+-----------------------------------------------------------------------------++module Diagrams.ThreeD.Shapes+       (+         Ellipsoid(..)+       , sphere+       ) where++import Graphics.Rendering.Diagrams++import Diagrams.ThreeD.Types+import Diagrams.Util++import Data.Monoid++data Ellipsoid = Ellipsoid T3++type instance V Ellipsoid = R3++instance Transformable Ellipsoid where+  transform t1 (Ellipsoid t2) = Ellipsoid (t1 <> t2)++sphere :: (Backend b R3, Renderable Ellipsoid b) => Diagram b R3+sphere = mkAD (Prim $ Ellipsoid mempty)+              (Bounds sphereBounds)+              mempty+              (Query sphereQuery)+  where sphereBounds (x,y,z) = 1 / sqrt(x*x + y*y + z*z)+        sphereQuery (P (x,y,z)) = Any $ x*x + y*y + z*z <= 1

@@ -0,0 +1,43 @@+{-# LANGUAGE TypeSynonymInstances+           , TypeFamilies+  #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Diagrams.ThreeD.Types+-- Copyright   :  (c) 2011 diagrams-lib team (see LICENSE)+-- License     :  BSD-style (see LICENSE)+-- Maintainer  :  diagrams-discuss@googlegroups.com+--+-- Basic types for three-dimensional Euclidean space.+--+-----------------------------------------------------------------------------++module Diagrams.ThreeD.Types+       ( -- * 3D Euclidean space+         R3+       , P3+       , T3++       ) where++import Graphics.Rendering.Diagrams++------------------------------------------------------------+-- 3D Euclidean space++-- | The three-dimensional Euclidean vector space R^3.+type R3 = (Double, Double, Double)++type instance V R3 = R3++-- | Points in R^3.+type P3 = Point R3++-- | Transformations in R^3.+type T3 = Transformation R3++instance Transformable R3 where+  transform = apply+

@@ -27,7 +27,7 @@ --     such as rotation by an angle, and scaling, translation, and --     reflection in the X and Y directions. -----   * "Diagrams.TwoD.Ellipse" defines ellipses.+--   * "Diagrams.TwoD.Ellipse" defines circles and ellipses. -- --   * "Diagrams.TwoD.Arc" defines circular arcs. --@@ -37,6 +37,10 @@ --   * "Diagrams.TwoD.Shapes" defines other two-dimensional shapes, --     e.g. various polygons. --+--   * "Diagrams.TwoD.Text" defines primitive text diagrams.+--+--   * "Diagrams.TwoD.Image" allows importing external images into diagrams.+-- --   * "Diagrams.TwoD.Util" defines some two-dimensional utilities, --     such as unit vectors and functions for computing the size and --     extent of diagrams in R^2.@@ -48,8 +52,7 @@ ----------------------------------------------------------------------------- module Diagrams.TwoD        ( -- * R^2-         R2-       , P2+         R2, P2, T2        , unitX, unitY, unit_X, unit_Y, direction           -- * Angles@@ -60,33 +63,43 @@           -- * Paths          -- ** Stroking-       , stroke, strokeT+       , stroke, stroke', strokeT, strokeT'+       , StrokeOpts(..)           -- ** Clipping-       , Clip(..), clipBy+       , clipBy           -- * Shapes          -- ** Rules        , hrule, vrule           -- ** Circle-ish things+       , unitCircle        , circle        , ellipse+       , ellipseXY        , arc           -- ** General polygons-       , polygon, polygonPath, polygonVertices+       , polygon, polygonVertices        , PolygonOpts(..), PolygonOrientation(..)           -- ** Special polygons+       , unitSquare        , square        , rect        , starPolygon        , eqTriangle           -- ** Other shapes-       , roundedRectPath, roundedRect+       , roundedRect +         -- * Text+       , text, font, fontSize, italic, oblique, bold++         -- * Images+       , image+          -- * Transformations          -- ** Rotation        , rotation, rotate, rotateBy@@ -117,12 +130,18 @@        , alignX, alignY        , centerX, centerY, centerXY -         -- * Utilities+         -- * Size+         -- ** Computing size        , width, height, size2D        , extentX, extentY, center2D +         -- ** Specifying size+       , SizeSpec2D(..)+          -- * Visual aids for understanding the internal model        , showOrigin+       , showLabels+        ) where  import Diagrams.TwoD.Types@@ -135,3 +154,5 @@ import Diagrams.TwoD.Combinators import Diagrams.TwoD.Util import Diagrams.TwoD.Model+import Diagrams.TwoD.Text+import Diagrams.TwoD.Image

@@ -0,0 +1,82 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Diagrams.TwoD.Adjust+-- Copyright   :  (c) 2011 diagrams-lib team (see LICENSE)+-- License     :  BSD-style (see LICENSE)+-- Maintainer  :  diagrams-discuss@googlegroups.com+--+-- A default diagram-adjustment implementation for two-dimensional+-- diagrams, useful for backend implementors.+--+-----------------------------------------------------------------------------++module Diagrams.TwoD.Adjust (+    adjustDia2D+  , adjustSize+  ) where++import Graphics.Rendering.Diagrams++import Diagrams.Attributes  (lw, lc)+import Diagrams.Util        ((#))++import Diagrams.TwoD.Types  (R2)+import Diagrams.TwoD.Util   (size2D, center2D)+import Diagrams.TwoD.Text   (fontSize)+import Diagrams.TwoD.Util   (SizeSpec2D(..))++import Data.AffineSpace     ((.-.))++import Data.Colour.Names    (black)+import Data.Monoid          (Monoid, mempty)++-- | @adjustDia2D@ provides a useful default implementation of+--   the 'adjustDia' method from the 'Backend' type class.+--+--   As its first argument it requires a method for extracting the+--   requested output size from the rendering options.+--+--   It then performs the following adjustments:+--+--   * Set some default attributes (in case they have not been set):+--+--       * Line width 0.01+--+--       * Line color black+--+--       * Font size 1+--+--   * Freeze the diagram in its final form+--+--   * Scale and translate the diagram to fit within the requested size++adjustDia2D :: Monoid m => (Options b R2 -> R2) -> b -> Options b R2 -> AnnDiagram b R2 m -> AnnDiagram b R2 m+adjustDia2D getSize _ opts d = d # lw 0.01 # lc black # fontSize 1 # freeze+                                 # scale s+                                 # translate tr+    where (w,h)   = getSize opts+          (wd,hd) = size2D d+          xscale  = w / wd+          yscale  = h / hd+          s'      = min xscale yscale+          s | isInfinite s' = 1+            | otherwise     = s'+          tr      = (0.5 *. P (w,h)) .-. (s *. center2D d)++-- | @adjustSize spec sz@ returns a transformation which can be+--   applied to something of size @sz@ to make it the requested size+--   @spec@.+adjustSize :: SizeSpec2D -> R2 -> Transformation R2+adjustSize Absolute _ = mempty+adjustSize (Width wSpec) (w,_)+  | wSpec == 0 || w == 0 = mempty+  | otherwise = scaling (wSpec / w)+adjustSize (Height hSpec) (_,h)+  | hSpec == 0 || h == 0 = mempty+  | otherwise = scaling (hSpec / h)+adjustSize (Dims wSpec hSpec) (w,h) = scaling s+  where xscale  = wSpec / w+        yscale  = hSpec / h+        s'      = min xscale yscale+        s | isInfinite s' = 1+          | otherwise     = s'

@@ -75,13 +75,13 @@ --   * any other argument interpolates linearly between these.  For --     example, @alignX 0@ centers, @alignX 2@ moves the origin one --     \"radius\" to the right of the right edge, and so on.-alignX :: (HasOrigin a, Boundable a, V a ~ R2) => Rational -> a -> a+alignX :: (HasOrigin a, Boundable a, V a ~ R2) => Double -> a -> a alignX = alignBy unitX  -- | Like 'alignX', but moving the local origin vertically, with an --   argument of @1@ corresponding to the top edge and @(-1)@ corresponding --   to the bottom edge.-alignY :: (HasOrigin a, Boundable a, V a ~ R2) => Rational -> a -> a+alignY :: (HasOrigin a, Boundable a, V a ~ R2) => Double -> a -> a alignY = alignBy unitY  -- | Center the local origin along the X-axis.

@@ -83,4 +83,6 @@ -- | Given a start angle @s@ and an end angle @e@, @'arc' s e@ is the --   path of a radius one arc counterclockwise between the two angles. arc :: (Angle a, PathLike p, V p ~ R2) => a -> a -> p-arc start end = setStart (rotate start $ P unitX) . pathLikeFromTrail $ arcT start end+arc start end = pathLike (rotate start $ P unitX)+                         False+                         (trailSegments $ arcT start end)

@@ -99,10 +99,12 @@ vcat' :: (HasOrigin a, Boundable a, Qualifiable a, V a ~ R2, Monoid a) => CatOpts R2 -> [a] -> a vcat' = cat' (negateV unitY) --- | @strutX d@ is an empty diagram with width @d@ and height 0.+-- | @strutX d@ is an empty diagram with width @d@ and height 0.  Note+--   that @strutX (-w)@ behaves the same as @strutX w@. strutX :: (Backend b R2, Monoid m) => Double -> AnnDiagram b R2 m strutX d = strut (d,0) --- | @strutY d@ is an empty diagram with height @d@ and width 0.+-- | @strutY d@ is an empty diagram with height @d@ and width 0. Note+--   that @strutX (-w)@ behaves the same as @strutX w@. strutY :: (Backend b R2, Monoid m) => Double -> AnnDiagram b R2 m strutY d = strut (0,d)

@@ -17,8 +17,10 @@ module Diagrams.TwoD.Ellipse     (       -- * Ellipse and circle diagrams-      circle+      unitCircle+    , circle     , ellipse+    , ellipseXY        -- * Mathematical ellipses       -- ** Representation@@ -35,10 +37,10 @@     ) where  import Graphics.Rendering.Diagrams-import Graphics.Rendering.Diagrams.Util  import Diagrams.TwoD.Types import Diagrams.TwoD.Transform+import Diagrams.Util  import Data.Monoid (Any(..), mempty) @@ -53,26 +55,32 @@ instance Transformable Ellipse where   transform t (Ellipse e) = Ellipse (t <> e) --- | A circle of radius 1.-circle :: (Backend b R2, Renderable Ellipse b) => Diagram b R2-circle = mkAD (Prim $ Ellipse mempty)-              (Bounds circleBounds)-              (fromNames [ ("C", P ( 0, 0))-                         , ("E", P ( 1, 0))-                         , ("N", P ( 0, 1))-                         , ("W", P (-1, 0))-                         , ("S", P ( 0,-1)) ])-              (Query circleQuery)+-- | A circle of radius 1, with center at the origin.+unitCircle :: (Backend b R2, Renderable Ellipse b) => Diagram b R2+unitCircle = mkAD (Prim $ Ellipse mempty)+                  (Bounds circleBounds)+                  mempty+                  (Query circleQuery)   where circleBounds (x,y) = 1 / sqrt(x*x + y*y)         circleQuery (P (x,y)) = Any $ x*x + y*y <= 1 +-- | A circle of the given radius, centered at the origin.+circle :: (Backend b R2, Renderable Ellipse b) => Double -> Diagram b R2+circle d = unitCircle # scale d+ -- | @ellipse e@ constructs an ellipse with eccentricity @e@ by --   scaling the unit circle in the X direction.  The eccentricity must --   be within the interval [0,1). ellipse :: (Backend b R2, Renderable Ellipse b) => Double -> Diagram b R2 ellipse e-    | e >= 0 && e < 1  = scaleX (sqrt (1 - e*e)) circle+    | e >= 0 && e < 1  = scaleX (sqrt (1 - e*e)) unitCircle     | otherwise        = error "Eccentricity of ellipse must be >= 0 and < 1."++-- | @ellipseXY x y@ creates an axis-aligned ellipse, centered at the+--   origin, with radius @x@ along the x-axis and radius @y@ along the+--   y-axis.+ellipseXY :: (Backend b R2, Renderable Ellipse b) => Double -> Double -> Diagram b R2+ellipseXY x y = unitCircle # scaleX x # scaleY y  -- | Compute the coefficients of the quadratic form --

@@ -0,0 +1,75 @@+{-# LANGUAGE TypeFamilies+           , FlexibleContexts+  #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Diagrams.TwoD.Image+-- Copyright   :  (c) 2011 diagrams-lib team (see LICENSE)+-- License     :  BSD-style (see LICENSE)+-- Maintainer  :  diagrams-discuss@googlegroups.com+--+-- Importing external images into diagrams.+--+-----------------------------------------------------------------------------++module Diagrams.TwoD.Image+    (+      Image(..)+    , image+    ) where++import Graphics.Rendering.Diagrams++import Diagrams.Path+import Diagrams.TwoD.Types+import Diagrams.TwoD.Path+import Diagrams.TwoD.Shapes+import Diagrams.TwoD.Util (SizeSpec2D(..))+import Diagrams.Util++import Data.AffineSpace ((.-.))++import Data.Monoid++-- | An external image primitive, representing an image the backend+--   should import from another file when rendering.+data Image = Image { imgFile   :: FilePath+                   , imgSize   :: SizeSpec2D+                   , imgTransf :: T2+                   }++type instance V Image = R2++instance Transformable Image where+  transform t1 (Image file sz t2) = Image file sz (t1 <> t2)++instance HasOrigin Image where+  moveOriginTo p = translate (origin .-. p)++-- See Note [Image size specification]++-- | Take an external image from the specified file and turn it into a+--   diagram with the specified width and height, centered at the+--   origin.  Note that the image's aspect ratio will be preserved; if+--   the specified width and height have a different ratio than the+--   image's aspect ratio, there will be extra space in one dimension.+image :: (Renderable Image b) => FilePath -> Double -> Double -> Diagram b R2+image file w h = mkAD (Prim (Image file (Dims w h) mempty))+                      (getBounds r)+                      mempty+                      (Query $ \p -> Any (isInsideEvenOdd p r))+  where r :: Path R2+        r = rect w h++{- ~~~~ Note [Image size specification]++It's tempting to make 'image' take a SizeSpec2D instead of two+Doubles.  For example, if I know I want the image to be x units wide+but I don't know the original aspect ratio of the image, I'd like to+be able to just say "make it x units wide".  The problem is that+diagrams would then not know how tall the image is until rendering+time (at least, not without unsafePerformIO yuckiness).  A more+general solution will have to wait until we can specify constraints+and solve them later.++-}

@@ -14,18 +14,25 @@ module Diagrams.TwoD.Model        ( -- * Showing the local origin          showOrigin+       , showLabels        ) where  import Graphics.Rendering.Diagrams--- import Graphics.Rendering.Diagrams.UDTree+import Graphics.Rendering.Diagrams.Names+ import Diagrams.TwoD.Types import Diagrams.TwoD.Ellipse import Diagrams.TwoD.Util+import Diagrams.TwoD.Text import Diagrams.Attributes import Diagrams.Util +import Control.Arrow (second) import Data.Monoid+import Data.AffineSpace ((.-.)) +import qualified Data.Map as M+ import Data.Colour.Names  ------------------------------------------------------------@@ -36,10 +43,10 @@ showOrigin :: (Renderable Ellipse b, Backend b R2, Monoid m)            => AnnDiagram b R2 m -> AnnDiagram b R2 m showOrigin d = o <> d-  where o     = circle # fc red-                       # lw 0-                       # scale (max (w/50) (h/50))-                       # fmap (const mempty)+  where o     = circle (max (w/50) (h/50))+                # fc red+                # lw 0+                # fmap (const mempty)         (w,h) = size2D d  -- data OriginOpts b m = OriginOpts { oDia   :: AnnDiagram b R2 m@@ -51,6 +58,24 @@ --         (w,h) = size2D d  +------------------------------------------------------------+-- Labeling named points+------------------------------------------------------------++showLabels :: (Renderable Text b, Backend b R2)+           => AnnDiagram b R2 m -> AnnDiagram b R2 Any+showLabels d = (fontSize (max (w/40) (h/40))+             . mconcat+             . map (\(n,p) -> text (show n) # translate (p .-. origin))+             . concatMap (\(n,ps) -> zip (repeat n) ps)+             . (map . second . map) fst+             . M.assocs+             $ m)+               `atop`+               (fmap (const (Any False)) d)+  where+    NameMap m = names d+    (w,h) = size2D d  -- XXX finish: 

@@ -1,8 +1,10 @@ {-# LANGUAGE FlexibleContexts+           , FlexibleInstances            , DeriveDataTypeable            , GeneralizedNewtypeDeriving            , TypeFamilies   #-}+{-# OPTIONS_GHC -fno-warn-orphans #-} ----------------------------------------------------------------------------- -- | -- Module      :  Diagrams.TwoD.Path@@ -19,8 +21,14 @@ module Diagrams.TwoD.Path        ( -- * Constructing path-based diagrams -         stroke, strokeT+         stroke, stroke', strokeT, strokeT' +       , StrokeOpts(..)++         -- * Inside/outside testing++       , isInsideWinding, isInsideEvenOdd+          -- * Clipping         , Clip(..), clipBy@@ -38,9 +46,9 @@ import Data.AffineSpace  import Data.Semigroup hiding ((<>))-import Data.Monoid import Control.Applicative (liftA2) import qualified Data.Foldable as F+import Data.Default  import Data.Typeable @@ -51,22 +59,62 @@ -- | Convert a path into a diagram.  The resulting diagram has the --   names 0, 1, ... assigned to each of the path's vertices. --+--   See also 'stroke'', which takes an extra options record allowing+--   its behavior to be customized.+-- --   Note that a bug in GHC 7.0.1 causes a context stack overflow when --   inferring the type of @stroke@.  The solution is to give a type --   signature to expressions involving @stroke@, or (recommended) --   upgrade GHC (the bug is fixed in 7.0.2 onwards).-stroke :: (Renderable (Path R2) b)+stroke :: Renderable (Path R2) b        => Path R2 -> Diagram b R2-stroke p = mkAD (Prim p)-                (getBounds p)-                mempty-                {-  XXX what to do here?-                    fromNames $ zip ([0..] :: [Int])-                                    (pathVertices p)  -- XXX names for Bezier-                                                      --   control points too?-                -}-                (Query $ Any . flip isInsideWinding p)+stroke = stroke' (def :: StrokeOpts ()) +instance Renderable (Path R2) b => PathLike (AnnDiagram b R2 Any) where+  pathLike st cl segs = stroke $ pathLike st cl segs++-- | A variant of 'stroke' that takes an extra record of options to+--   customize its behavior.  In particular:+--+--     * Names can be assigned to the path's vertices+--+--   'StrokeOpts' is an instance of 'Default', so @stroke' 'with' {+--   ... }@ syntax may be used.+stroke' :: (Renderable (Path R2) b, Atomic a) => StrokeOpts a -> Path R2 -> Diagram b R2+stroke' opts p+  = mkAD (Prim p)+         (getBounds p)+         (fromNames . concat $+           zipWith zip (vertexNames opts) (pathVertices p))+         (Query $ Any . flip isInsideWinding p)++-- | A record of options that control how a path is stroked.+--   @StrokeOpts@ is an instance of 'Default', so a @StrokeOpts@+--   records can be created using @'with' { ... }@ notation.+data StrokeOpts a+  = StrokeOpts+    { vertexNames :: [[a]]  -- ^ Atomic names that should be assigned+                            --   to the vertices of the path so that+                            --   they can be referenced later.  If+                            --   there are not enough names, the extra+                            --   vertices are not assigned names; if+                            --   there are too many, the extra names+                            --   are ignored.  Note that this is a+                            --   /list of lists/ of names, since paths+                            --   can consist of multiple trails.  The+                            --   first list of names are assigned to+                            --   the vertices of the first trail, the+                            --   second list to the second trail, and+                            --   so on.+                            --+                            --   The default value is the empty list.+    }++instance Default (StrokeOpts a) where+  def = StrokeOpts+        { vertexNames = []+        }+ -- | A composition of 'stroke' and 'pathFromTrail' for conveniently --   converting a trail directly into a diagram. --@@ -79,6 +127,12 @@         => Trail R2 -> Diagram b R2 strokeT = stroke . pathFromTrail +-- | A composition of 'stroke'' and 'pathFromTrail' for conveniently+--   converting a trail directly into a diagram.+strokeT' :: (Renderable (Path R2) b, Atomic a)+         => StrokeOpts a -> Trail R2 -> Diagram b R2+strokeT' opts = stroke' opts . pathFromTrail+ ------------------------------------------------------------ --  Inside/outside testing ------------------------------------------------------------@@ -86,9 +140,20 @@ cross :: R2 -> R2 -> Double cross (x,y) (x',y') = x * y' - y * x' +-- XXX link to more info on this++-- | Test whether the given point is inside the given (closed) path,+--   by testing whether the point's /winding number/ is nonzero. Note+--   that @False@ is /always/ returned for /open/ paths, regardless of+--   the winding number. isInsideWinding :: P2 -> Path R2 -> Bool isInsideWinding p = (/= 0) . crossings p +-- | Test whether the given point is inside the given (closed) path,+--   by testing whether a ray extending from the point in the positive+--   x direction crosses the path an even (outside) or odd (inside)+--   number of times.  Note that @False@ is /always/ returned for+--   /open/ paths, regardless of the number of crossings. isInsideEvenOdd :: P2 -> Path R2 -> Bool isInsideEvenOdd p = odd . crossings p @@ -163,7 +228,7 @@ --   concatenation, so applying multiple clipping paths is sensible. --   The clipping region is the intersection of all the applied --   clipping paths.-newtype Clip = Clip [Path R2]+newtype Clip = Clip { getClip :: [Path R2] }   deriving (Typeable, Semigroup) instance AttributeClass Clip @@ -180,3 +245,8 @@ --   * The bounding function of the diagram is unaffected. clipBy :: (HasStyle a, V a ~ R2) => Path R2 -> a -> a clipBy = applyTAttr . Clip . (:[])++-- XXX Should include a 'clipTo' function which clips a diagram AND+-- restricts its bounding function.  It will have to take a *pointwise+-- minimum* of the diagram's current bounding function and the path's+-- bounding function.  Not sure of the best way to do this at the moment.

@@ -16,10 +16,11 @@          hrule, vrule           -- * General polygons-       , polygon, polygonPath, polygonVertices+       , polygon, polygonVertices        , PolygonOpts(..), PolygonOrientation(..)           -- * Special polygons+       , unitSquare        , square        , rect        , starPolygon@@ -28,17 +29,16 @@           -- * Other shapes -       , roundedRectPath, roundedRect+       , roundedRect        ) where  import Graphics.Rendering.Diagrams +import Diagrams.Segment import Diagrams.Path import Diagrams.TwoD.Arc-import Diagrams.TwoD.Path import Diagrams.TwoD.Types import Diagrams.TwoD.Transform-import Diagrams.TwoD.Align  import Diagrams.Util @@ -47,13 +47,13 @@  import Data.Default --- | Create a centered horizontal line of the given length.-hrule :: (Backend b R2, Renderable (Path R2) b) => Double -> Diagram b R2-hrule d = centerX . stroke $ fromOffsets [(d,0)]+-- | Create a centered horizontal (L-R) line of the given length.+hrule :: (PathLike p, V p ~ R2) => Double -> p+hrule d = pathLike (P (-d/2,0)) False [Linear (d,0)] --- | Create a centered vertical line of the given length.-vrule :: (Backend b R2, Renderable (Path R2) b) => Double -> Diagram b R2-vrule d = centerY . stroke $ fromOffsets [(0,d)]+-- | Create a centered vertical (T-B) line of the given length.+vrule :: (PathLike p, V p ~ R2) => Double -> p+vrule d = pathLike (P (0,d/2)) False [Linear (0,-d)]  -- | Determine how a polygon should be oriented. data PolygonOrientation = NoOrient  -- ^ No special orientation; one@@ -80,13 +80,10 @@ instance Default PolygonOpts where   def = PolygonOpts { sides = 5, edgeSkip = 1, orientation = NoOrient } --- | Create a regular polygon from the given options.-polygon :: (Backend b R2, Renderable (Path R2) b) => PolygonOpts -> Diagram b R2-polygon = stroke . polygonPath---- | Create a closed regular polygonal path from the given options.-polygonPath :: (PathLike p, V p ~ R2) => PolygonOpts -> p-polygonPath = close . fromVertices . polygonVertices+-- | Create a closed regular polygon from the given options.+polygon :: (PathLike p, V p ~ R2) => PolygonOpts -> p+polygon opts = pathLike v True (segmentsFromVertices vvs)+  where vvs@(v:vs) = polygonVertices opts  -- | Generate the vertices of a regular polygon from the given --   options.@@ -106,22 +103,27 @@  -- | A sqaure with its center at the origin and sides of length 1, --   oriented parallel to the axes.-square ::  (Backend b R2, Renderable (Path R2) b) => Diagram b R2-square = scale (1/sqrt 2) $ polygon def { sides = 4, orientation = OrientToX }+unitSquare :: (Transformable p, PathLike p, V p ~ R2) => p+unitSquare = scale (1/sqrt 2) $ polygon with { sides = 4, orientation = OrientToX } +-- | A sqaure with its center at the origin and sides of the given+--   length, oriented parallel to the axes.+square :: (PathLike p, Transformable p, V p ~ R2) => Double -> p+square d = unitSquare # scale d+ -- | @rect w h@ is an axis-aligned rectangle of width @w@ and height --   @h@, centered at the origin.-rect :: (Backend b R2, Renderable (Path R2) b) => Double -> Double -> Diagram b R2-rect w h = square # scaleX w # scaleY h+rect :: (PathLike p, Transformable p, V p ~ R2) => Double -> Double -> p+rect w h = unitSquare # scaleX w # scaleY h  -- | @starPolygon p q@ creates a star polygon, where @p@ indicates the --   number of vertices, and an edge connects every @q@th vertex.-starPolygon :: (Backend b R2, Renderable (Path R2) b) => Int -> Int -> Diagram b R2+starPolygon :: (PathLike p, Transformable p, V p ~ R2) => Int -> Int -> p starPolygon p q = polygon def { sides = p, edgeSkip = q }  -- | An equilateral triangle, with radius 1 and base parallel to the --   x-axis.-eqTriangle :: (Backend b R2, Renderable (Path R2) b) => Diagram b R2+eqTriangle :: (PathLike p, Transformable p, V p ~ R2) => p eqTriangle = polygon with {sides = 3, orientation = OrientToX}  {-@@ -154,26 +156,26 @@ --  Other shapes  ------------------------------------------ ------------------------------------------------------------ --- | @roundedRectPath v r@ generates a closed trail, or closed path+-- | @roundedRect v r@ generates a closed trail, or closed path -- centered at the origin, of an axis-aligned rectangle with diagonal -- @v@ and circular rounded corners of radius @r@.  @r@ must be -- between @0@ and half the smaller dimension of @v@, inclusive; smaller or -- larger values of @r@ will be treated as @0@ or half the smaller -- dimension of @v@, respectively.  The trail or path begins with the -- right edge and proceeds counterclockwise.-roundedRectPath :: (PathLike p, V p ~ R2) => R2 -> Double -> p-roundedRectPath v r = close-                    . setStart (P (xOff/2 + r', -yOff/2))-                    . pathLikeFromTrail-                    $ fromOffsets [(0,yOff)]-                      <> mkCorner 0-                      <> fromOffsets [(-xOff,0)]-                      <> mkCorner 1-                      <> fromOffsets [(0, -yOff)]-                      <> mkCorner 2-                      <> fromOffsets [(xOff,0)]-                      <> mkCorner 3-  where r'   = clamp r 0 maxR+roundedRect :: (PathLike p, V p ~ R2) => R2 -> Double -> p+roundedRect v r = pathLike (P (xOff/2 + r', -yOff/2)) True+                . trailSegments+                $ seg (0,yOff)+                <> mkCorner 0+                <> seg (-xOff,0)+                <> mkCorner 1+                <> seg (0, -yOff)+                <> mkCorner 2+                <> seg (xOff,0)+                <> mkCorner 3+  where seg = fromOffsets  . (:[])+        r'   = clamp r 0 maxR         maxR = uncurry min v / 2         (xOff,yOff) = v ^-^ (2*r', 2*r')         mkCorner k | r' == 0   = mempty@@ -186,6 +188,3 @@ clamp x lo hi | x < lo    = lo               | x > hi    = hi               | otherwise = x--roundedRect :: (Backend b R2, Renderable (Path R2) b) => R2 -> Double -> Diagram b R2-roundedRect v r = stroke $ roundedRectPath v r

@@ -0,0 +1,195 @@+{-# LANGUAGE DeriveDataTypeable+           , GeneralizedNewtypeDeriving+           , FlexibleContexts+           , TypeFamilies+  #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Diagrams.TwoD.Text+-- Copyright   :  (c) 2011 diagrams-lib team (see LICENSE)+-- License     :  BSD-style (see LICENSE)+-- Maintainer  :  diagrams-discuss@googlegroups.com+--+-- Very basic text primitives along with associated attributes.+--+-----------------------------------------------------------------------------++module Diagrams.TwoD.Text (+  -- * Creating text diagrams+    Text(..)+  , text++  -- * Text attributes+  -- ** Font family+  , Font(..), getFont, font+  -- ** Font size+  , FontSize(..), getFontSize, fontSize+  -- ** Font slant+  , FontSlant(..), FontSlantA, getFontSlant, fontSlant, italic, oblique+  -- ** Font weight+  , FontWeight(..), FontWeightA, getFontWeight, fontWeight, bold+  ) where++import Graphics.Rendering.Diagrams++import Diagrams.TwoD.Types+import Diagrams.Util++import Data.AffineSpace ((.-.))++import Data.Monoid (mempty)+import Data.Semigroup (Semigroup, Last(..))++import Data.Typeable++------------------------------------------------------------+-- Text diagrams+------------------------------------------------------------++-- | A text primitive consists of the string contents along with a+--   transformation mapping from the local vector space of the text to+--   the vector space in which it is embedded.+data Text = Text T2 String++type instance V Text = R2++instance Transformable Text where+  transform t (Text tt s) = Text (t <> tt) s++instance HasOrigin Text where+  moveOriginTo p = translate (origin .-. p)++-- | Create a primitive text diagram from the given string, which+--   /takes up no space/.  By default, the text is centered with+--   respect to its local origin (see 'alignText').+text :: Renderable Text b => String -> Diagram b R2+text t = mkAD (Prim (Text mempty t))+              mempty+              mempty+              mempty++------------------------------------------------------------+-- Text attributes+------------------------------------------------------------++{-+--------------------------------------------------+-- Alignment++-- | The @TextAlignment@ attribute specifies what alignment should be+--   applied to text.  Inner @TextAlignment@ attributes override outer+--   ones.+newtype TextAlignment = TextAlignment (Last (Alignment R2))+  deriving (Typeable, Semigroup)+instance AttributeClass TextAlignment++-- | Extract an alignment from a @TextAlignment@ attribute.+getTextAlignment :: TextAlignment -> Alignment R2+getTextAlignment (TextAlignment (Last a)) = a++-- | The default alignment for text is centered.+centeredText :: TextAlignment+centeredText = TextAlignment (Last (asAlignment id))++-- | @alignText f@ aligns text by applying the alignment function @f@+--   (any transformation of boundable things with origins may be used;+--   for example, 'alignTL' and friends).+alignText :: HasStyle a => (Alignment R2 -> Alignment R2) -> a -> a+alignText = applyAttr . TextAlignment . Last . asAlignment+-}++--------------------------------------------------+-- Font family++-- | The @Font@ attribute specifies the name of a font family.  Inner+--   @Font@ attributes override outer ones.+newtype Font = Font (Last String)+  deriving (Typeable, Semigroup)+instance AttributeClass Font++-- | Extract the font family name from a @Font@ attribute.+getFont :: Font -> String+getFont (Font (Last f)) = f++-- | Specify a font family to be used for all text within a diagram.+font :: HasStyle a => String -> a -> a+font = applyAttr . Font . Last++--------------------------------------------------+-- Font size++-- | The @FontSize@ attribute specifies the size of a font's+--   em-square, measured with respect to the current local vector space.+--   Inner @FontSize@ attributes override outer ones.+newtype FontSize = FontSize (Last Double)+  deriving (Typeable, Semigroup)+instance AttributeClass FontSize++-- | Extract the size from a @FontSize@ attribute.+getFontSize :: FontSize -> Double+getFontSize (FontSize (Last s)) = s++-- | Set the font size, that is, the size of the font's em-square as+--   measured within the current local vector space.  The default size+--   is @1@.+fontSize :: HasStyle a => Double -> a -> a+fontSize = applyAttr . FontSize . Last++--------------------------------------------------+-- Font slant++data FontSlant = FontSlantNormal+               | FontSlantItalic+               | FontSlantOblique++-- | The @FontSlantA@ attribute specifies the slant (normal, italic,+--   or oblique) that should be used for all text within a diagram.+--   Inner @FontSlantA@ attributes override outer ones.+newtype FontSlantA = FontSlantA (Last (FontSlant))+  deriving (Typeable, Semigroup)+instance AttributeClass FontSlantA++-- | Extract the font slant from a 'FontSlantA' attribute.+getFontSlant :: FontSlantA -> FontSlant+getFontSlant (FontSlantA (Last s)) = s++-- | Specify the slant (normal, italic, or oblique) that should be+--   used for all text within a diagram.  See also 'italic' and+--   'oblique' for useful special cases.+fontSlant :: HasStyle a => FontSlant -> a -> a+fontSlant = applyAttr . FontSlantA . Last++-- | Set all text in italics.+italic :: HasStyle a => a -> a+italic = fontSlant FontSlantItalic++-- | Set all text using an oblique slant.+oblique :: HasStyle a => a -> a+oblique = fontSlant FontSlantOblique++--------------------------------------------------+-- Font weight++data FontWeight = FontWeightNormal+                | FontWeightBold++-- | The @FontWeightA@ attribute specifies the weight (normal or bold)+--   that should be used for all text within a diagram.  Inner+--   @FontWeightA@ attributes override outer ones.+newtype FontWeightA = FontWeightA (Last (FontWeight))+  deriving (Typeable, Semigroup)+instance AttributeClass FontWeightA++-- | Extract the font weight from a 'FontWeightA' attribute.+getFontWeight :: FontWeightA -> FontWeight+getFontWeight (FontWeightA (Last w)) = w++-- | Specify the weight (normal or bold) that should be+--   used for all text within a diagram.  See also 'bold'+--   for a useful special case.+fontWeight :: HasStyle a => FontWeight -> a -> a+fontWeight = applyAttr . FontWeightA . Last++-- | Set all text using a bold font weight.+bold :: HasStyle a => a -> a+bold = fontWeight FontWeightBold

@@ -50,7 +50,7 @@ -- Angles  -- | The circle constant, i.e. the ratio of a circle's circumference---   to its radius.+--   to its radius.  See <http://tauday.com/>. tau :: Floating a => a tau = 2*pi 

@@ -17,8 +17,12 @@        , direction           -- * Size and extent of diagrams in R2+         -- ** Computing sizes        , width, height, size2D        , extentX, extentY, center2D++         -- ** Specifying sizes+       , SizeSpec2D(..)        ) where  import Graphics.Rendering.Diagrams@@ -77,3 +81,22 @@ --   vector is arbitrarily assigned the direction 0. direction :: R2 -> CircleFrac direction (x,y) = toCircleFrac . Rad $ atan2 y x++------------------------------------------------------------+-- Size specifications+------------------------------------------------------------++-- | A specification of a (requested) rectangular size.+data SizeSpec2D = Width  Double       -- ^ Specify an explicit+                                      -- width. The height should be+                                      -- determined automatically (so+                                      -- as to preserve aspect ratio).+                | Height Double       -- ^ Specify an explicit+                                      -- height. The width should be+                                      -- determined automatically (so+                                      -- as to preserve aspect ratio)+                | Dims Double Double  -- ^ An explicit specification+                                      --   of both dimensions.+                | Absolute            -- ^ Absolute size: use whatever+                                      -- size an object already has;+                                      -- do not rescale.