diagrams-lib 0.5.0.1 → 0.6

raw patch · 38 files changed

+1392/−597 lines, 38 filesdep +monoid-extrasdep ~basedep ~containersdep ~diagrams-corePVP ok

version bump matches the API change (PVP)

Dependencies added: monoid-extras

Dependency ranges changed: base, containers, diagrams-core

API changes (from Hackage documentation)

Files

• CHANGES +0/−211
• CHANGES.markdown +279/−0
• LICENSE +2/−0
• README +0/−9
• README.markdown +5/−0
• diagrams-lib.cabal +12/−8
• src/Diagrams/Align.hs +1/−1
• src/Diagrams/Animation.hs +8/−7
• src/Diagrams/Animation/Active.hs +1/−1
• src/Diagrams/Attributes.hs +19/−13
• src/Diagrams/BoundingBox.hs +166/−94
• src/Diagrams/Combinators.hs +73/−12
• src/Diagrams/Coordinates.hs +87/−0
• src/Diagrams/CubicSpline.hs +2/−2
• src/Diagrams/Path.hs +21/−8
• src/Diagrams/Points.hs +12/−3
• src/Diagrams/Prelude.hs +16/−8
• src/Diagrams/Segment.hs +39/−17
• src/Diagrams/ThreeD/Shapes.hs +21/−5
• src/Diagrams/ThreeD/Types.hs +19/−8
• src/Diagrams/Transform.hs +1/−1
• src/Diagrams/TwoD.hs +15/−1
• src/Diagrams/TwoD/Adjust.hs +58/−57
• src/Diagrams/TwoD/Align.hs +1/−1
• src/Diagrams/TwoD/Arc.hs +46/−10
• src/Diagrams/TwoD/Combinators.hs +87/−15
• src/Diagrams/TwoD/Ellipse.hs +1/−1
• src/Diagrams/TwoD/Image.hs +2/−1
• src/Diagrams/TwoD/Model.hs +5/−16
• src/Diagrams/TwoD/Path.hs +39/−16
• src/Diagrams/TwoD/Polygons.hs +9/−3
• src/Diagrams/TwoD/Segment.hs +102/−0
• src/Diagrams/TwoD/Shapes.hs +10/−9
• src/Diagrams/TwoD/Size.hs +52/−2
• src/Diagrams/TwoD/Text.hs +20/−14
• src/Diagrams/TwoD/Transform.hs +84/−14
• src/Diagrams/TwoD/Types.hs +70/−23
• src/Diagrams/TwoD/Vector.hs +7/−6

@@ -1,211 +0,0 @@-0.5: 9 March 2012--  * New features:--    - 'mkSizeSpec' function for constructing a SizeSpec2D from two (Maybe Double)s--    - 'beneath' as convenient synonym for 'flip atop'--    - Improvements and extensions to rounded rectangles by Peter Hall:-      + roundedRect' allows rounded rectangles with a different radius-        specified for each corner-      + both roundedRect' and roundedRect now allow negative radii,-        resulting in "inverted" circular corners--    - #64: New 'Alignable' class for things that can be aligned.--    - explodeTrail and explodePath have been generalized to return any-      PathLike type.--    - New path functions pathCentroid (compute the centroid of a-      path's vertices) and expandPath (scale a path about its centroid).--    - Generalized 'centroid' function now exported from new module-      Diagrams.Points--    - Initial (experimental) support for animation:-      + Animation and QAnimation defined as synonyms for Active-        diagrams (see 'active' package)-      + Instances for Active: V, HasOrigin, Transformable,-        HasStyle, PathLike, Juxtaposable, Alignable-      + animEnvelope and animRect functions for automatic bounding of-        animations--    - addClosingSegment function for making the implicit closing-      segment of a closed trail explicit--    - Improvements to BoundingBox module from Michael Sloan: querying-      of BoundingBox bounds, corners, extents, and transformation of-      objects to fit within a given box.--    - Text alignment options from Michael Sloan--    - 'view' function for restricting a diagram's envelope to a-      rectangular region.--    - 'iterateN' function for iterating a finite number of times--    - 'atAngle' for placing two diagrams next to each other along a-      specified angle.--    - padX and padY functions for padding in the X- and Y-directions-      independently.--    - generalized showOrigin function from Ian Ross--    - #40: add shears to Diagrams.TwoD.Transform--  * Performance improvements--    - Use a balanced folding scheme for cat', reducing time in some-      cases from O(n^2) to O(n log n)--    - More efficient implementation of beside--  * New instances:--    - Alignable instances for QDiagram, Path, Envelope, Active, Set,-      Map, []-    - Renderable instances for NullBackend (Trail, Path, Segment,-      Image, Text)-    - Instances for Active: V, HasOrigin, Transformable,-      HasStyle, PathLike, Juxtaposable, Alignable--  * API changes--    - #61: terminology change from "bounds" to "envelope"-      + boundary -> envelopeP-      + "bounding region" -> "envelope"-      + Bounds -> Envelope-      + Boundable -> Enveloped-      + getBounds -> getEnvelope-      + etc.--    - rename AnnDiagram to QDiagram--    - R2 used to be a synonym for (Double, Double) but is now-      abstract. To convert between pairs of Doubles and R2, use the-      new functions 'r2' and 'unr2'.  There are two reasons for this-      change:--        1. to allow for future changes to the implementation of R2;--	2. (Double, Double) was an awkward special case getting in the-           way of useful tuple instances for classes like HasOrigin,-           Enveloped, and so on.--    - 'circlePath' has been removed; its functionality has been-      subsumed by 'circle'.--    - adjustSegment now takes an extra tolerance option.--    - Ellipses are now represented using Bezier approximations rather-      than a separate special type.--    - BoundingBox no longer has a Transformable instance; the old-      instance was misleading at best.--    - Change semantics of 'beside' (hence also (|||) and (===)) so the-      result's origin is the same as that of the first argument.--    - adjustDia2D now takes a SizeSpec2D.--    - 'beside' and related functions are now implemented in terms of-      'juxtapose'.--    - Instead of taking an R2, roundedRect now takes a pair of-      Doubles, to be more consistent with 'rect'.--  * Dependency/version changes--    - Support for GHC 7.4.1:-      + depend on colour >= 2.3.2-      + update base and array upper bounds--    - bump vector-space upper bound--  * Bug fixes--    - Avoid scale by zero error in showOrigin.--    - Base adjustDia2D translation on output size rather than diagram size.--0.4.0.1: 30 October 2011--  * bump data-default dependency to allow version 0.3--0.4: 23 October 2011--  * documentation fixes--  * New functions and primitives:--    + 'wedge' shape primitive-    + 'fromDirection' function for converting angles to 2D unit vectors;-      inverse function 'direction' generalized to return any Angle type-    + New functions for computing and adjusting segment lengths-    + 'scaleUToX' and 'scaleUToY' for doing uniform scales-      resulting in a desired width or height.-    + 'circlePath', 'reversePath', 'decoratePath'--  * New features:--    + Completely new and improved polygon generation API-    + Cubic splines-    + User-controllable path fill rules--  * Bug fixes:--    + fix incorrect corner case in arc generation-    + fix incorrect reverseTrail function--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)--0.2: 3 June 2011--  * documentation fixes--  * New functions and primitives:-    + scaleToX and scaleToY for scaling to an absolute width/height-    + reverseTrail-    + new Angle class and ability to use radians, degrees, or circle fractions-      for specifying angles-    + rotateAbout and reflectAbout transformations based on new conjugation functions-    + rect and roundedRect primitives-    + explodeTrail/Path for breaking trails and paths into individual segments--  * New features:-    + opacity attribute-    + support for path clipping--  * New modules:-    + Diagrams.BoundingBox--  * Fixes and updates:-    + withBounds now properly uses the new bounds instead of just combining-      them with the old--0.1.1: 18 May 2011-  * minor documentation fixes-  * link to new website--0.1: 17 May 2011-  * initial preview release-

@@ -0,0 +1,279 @@+0.6: 11 December 2012+---------------------++* **New features**++    - `boundingRect` function for constructing a bounding rectangle++    - `bg` function for "setting the background color" (*i.e.* placing+      atop a colored bounding rectangle)++    - New functions `setDefault2DAttributes` and `adjustDiaSize2D`.+      `adjustDia2D` does both --- so the behavior of `adjustDia2D` has+      not changed, but it is now possible to apply just one of the two+      adjustments using the new functions.++    - `Diagrams.TwoD.Transform` now exports a `ScaleInv` type for creating+      scale-invariant objects, which are only affected by rotational+      and translational components of transformations.++    - The new `Diagrams.Coordinates` module provides nicer syntax for+      constructing and pattern-matching point and vector literals.++    - New `fromFixedSeg` function in `Diagrams.Segment`, which+      decomposes a `FixedSegment` into a starting point and a `Segment`.++    - New `withTrace` function for setting the `Trace` of a diagram.++    - Three new size-related functions:++        - New `sized` function for scaling an object to a particular size.+          One particularly nice use of this is to obviate the need to keep+          fiddling with the line width to get diagrams to "look right";+          just set the line width relative to some arbitrary scale+          (*e.g.* assuming the final diagram will fit into a 1x1 box) and+          then apply `sized` to the final diagram to make it that given+          arbitrary size.  It can also be used for easily making something+          (a diagram, path, trail, ...) the same size as something else,+          with the help of the new `sizeSpec2D` function.++        - New `sizedAs` function, for setting the size of some object to+          be "the same as" some other object.++        - New `sizeSpec2D` function for conveniently calculating the size+          of an object as a `SizeSpec2D` value (for use with the new `sized`+          funtion).++    - New `extrudeEnvelope` and `intrudeEnvelope` functions for+      modifying envelopes in a single direction only, as well as new+      functions `extrude{Left,Right,Bottom,Top}` specializing+      `extrudeEnvelope` to 2D.++    - `arcCW` draws clockwise arcs; `arc'` draws arcs counterclockwise+      or clockwise as the radius is positive or negative,+      respectively.++    - fill color attribute is generalized to support "recommended" and+      "committed" colors; text objects use a recommended fill color of+      black.++* **New instances**++    - The `Show` instance for `R2` now produces something like `2 & 6`+      instead of `R2 { unR2 = (2,6) }`.  The `Read` instance has also+      been changed to match, so `read . show = id`.++    - `Enveloped` instance for `FixedSegment`++    - `Traced` instances for `Segment`, `FixedSegment`, `Trail`, and `Path`++    - New derived `Eq` instances for `LineCapA`, `LineJoinA`, `Dashing`,+      `DashingA`, `FillRule`, `Font`, `FontSize`, `FontSlant`, `FontSlantA`,+      `FontWeight`, and `FontWeightA`++    - `Renderable Ellipsoid NullBackend` instance++* **API changes**++    - `Data.Colour` (minus `atop` and `AffineSpace`) is now re-exported+      from Diagrams.Prelude for convenience.++    - The `beneath` function is now infixl 6.++    - The `BoundingBox` module has had a complete overhaul.  There is+      now a special empty bounding box, and bounding boxes are an+      instance of `Monoid`.++    - The type of `withEnvelope` has been slightly generalized.++    - `Diagrams.TwoD.Adjust.adjustSize` is now deprecated; it has been+      renamed and moved to `Diagrams.TwoD.Size.requiredScaleT`.++    - `expandPath` has been renamed to `scalePath`.++* **Dependency/version changes**++    - Allow `data-default` 0.4 and 0.5+    - Allow `base`-4.6+    - Allow `containers`-0.5++* **Bug fixes**++    - `arc` and `arcT` functions now always produce counterclockwise arcs,+      as claimed.++0.5: 9 March 2012+-----------------++* **New features**+    - `mkSizeSpec` function for constructing a `SizeSpec2D` from two `Maybe Double`s+    - `beneath` as convenient synonym for `flip atop`+    - Improvements and extensions to rounded rectangles by Peter Hall:+        + `roundedRect'` allows rounded rectangles with a different radius+          specified for each corner+        + both `roundedRect'` and `roundedRect` now allow negative radii,+          resulting in "inverted" circular corners+    - [\#64](http://code.google.com/p/diagrams/issues/detail?id=64): New `Alignable` class for things that can be aligned.+    - `explodeTrail` and `explodePath` have been generalized to return any+      `PathLike` type.+    - New path functions `pathCentroid` (compute the centroid of a+      path's vertices) and `expandPath` (scale a path about its centroid).+    - Generalized `centroid` function now exported from new module+      `Diagrams.Points`.+    - Initial (experimental) support for animation:+        + `Animation` and `QAnimation` defined as synonyms for `Active`+          diagrams (see `active` package)+        + Instances for `Active`: `V`, `HasOrigin`, `Transformable`,+          `HasStyle`, `PathLike`, `Juxtaposable`, `Alignable`+        + `animEnvelope` and `animRect` functions for automatic bounding of+          animations+    - `addClosingSegment` function for making the implicit closing+      segment of a closed trail explicit+    - Improvements to `BoundingBox` module from Michael Sloan: querying+      of `BoundingBox` bounds, corners, extents, and transformation of+      objects to fit within a given box.+    - Text alignment options from Michael Sloan+    - `view` function for restricting a diagram's envelope to a+      rectangular region.+    - `iterateN` function for iterating a finite number of times+    - `atAngle` for placing two diagrams next to each other along a+      specified angle.+    - `padX` and `padY` functions for padding in the X- and Y-directions+      independently.+    - generalized `showOrigin` function from Ian Ross+    - [\#40](http://code.google.com/p/diagrams/issues/detail?id=40): add shears to `Diagrams.TwoD.Transform`++* **Performance improvements**+    - Use a balanced folding scheme for `cat'`, reducing time in some+      cases from \\(O(n^2)\\) to \\(O(n \\log n)\\)+    - More efficient implementation of `beside`++* **New instances**+    - `Alignable` instances for `QDiagram`, `Path`, `Envelope`, `Active`, `Set`,+      `Map`, `[]`+    - `Renderable` instances for `NullBackend` (`Trail`, `Path`, `Segment`,+      `Image`, `Text`)+    - Instances for `Active`: `V`, `HasOrigin`, `Transformable`,+      `HasStyle`, `PathLike`, `Juxtaposable`, `Alignable`++* **API changes**+    - `R2` used to be a synonym for `(Double, Double)` but is now+      abstract. To convert between pairs of `Doubles` and `R2`, use the+      new functions `r2` and `unr2`.  There are two reasons for this+      change:+          1. to allow for future changes to the implementation of `R2`;+          2. `(Double, Double)` was an awkward special case getting in the+           way of useful tuple instances for classes like `HasOrigin`,+           `Enveloped`, and so on.+    - `circlePath` has been removed; its functionality has been+      subsumed by `circle`.+    - `adjustSegment` now takes an extra tolerance option.+    - Ellipses are now represented using Bezier approximations rather+      than a separate special type.+    - `BoundingBox` no longer has a `Transformable` instance; the old+      instance was misleading at best.+    - Change semantics of `beside` (hence also `(|||)` and `(===)`) so the+      result's origin is the same as that of the first argument.+    - `adjustDia2D` now takes a `SizeSpec2D`.+    - `beside` and related functions are now implemented in terms of+      `juxtapose`.+    - Instead of taking an `R2`, `roundedRect` now takes a pair of+      `Double`s, to be more consistent with `rect`.++* **Dependency/version changes**+    - Support for GHC 7.4.1:+        + depend on `colour` >= 2.3.2+        + update `base` and `array` upper bounds+    - bump `vector-space` upper bound++* **Bug fixes**+    - Avoid scale by zero error in `showOrigin`.+    - Base `adjustDia2D` translation on output size rather than diagram size.++0.4.0.1: 30 October 2011+------------------------++* bump `data-default` dependency to allow version 0.3++0.4: 23 October 2011+--------------------++* **documentation fixes**++* **New functions and primitives**++    + `wedge` shape primitive+    + `fromDirection` function for converting angles to 2D unit vectors;+      inverse function `direction` generalized to return any Angle type+    + New functions for computing and adjusting segment lengths+    + `scaleUToX` and `scaleUToY` for doing uniform scales+      resulting in a desired width or height.+    + `circlePath`, `reversePath`, `decoratePath`++* **New features**++    + Completely new and improved polygon generation API+    + Cubic splines+    + User-controllable path fill rules++* **Bug fixes**++    + fix incorrect corner case in arc generation+    + fix incorrect `reverseTrail` function++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 diagrams-povray package.++* **Bug fixes**+    + Issue 32 (`mempty` not behaving correctly within concatenations)++0.2: 3 June 2011+----------------++* **documentation fixes**++* **New functions and primitives**+    + `scaleToX` and `scaleToY` for scaling to an absolute width/height+    + `reverseTrail`+    + new `Angle` class and ability to use radians, degrees, or circle fractions+      for specifying angles+    + `rotateAbout` and `reflectAbout` transformations based on new conjugation functions+    + `rect` and `roundedRect` primitives+    + `explodeTrail`/`Path` for breaking trails and paths into individual segments++* **New features**+    + opacity attribute+    + support for path clipping++* **New modules**+    + `Diagrams.BoundingBox`++* **Fixes and updates**+    + `withBounds` now properly uses the new bounds instead of just combining+      them with the old++0.1.1: 18 May 2011+------------------++* minor documentation fixes+* link to new website++0.1: 17 May 2011+----------------++* initial preview release+

@@ -2,8 +2,10 @@    Peter Hall <peter.hall@memorphic.com>   Claude Heiland-Allen <claudiusmaximus@goto10.org>+  Deepak Jois <deepak.jois@gmail.com>   Ian Ross <ian@skybluetrades.net>   Michael Sloan <mgsloan@gmail.com>+  Jim Snavely <ludflu@gmail.com>   Kanchalai Suveepattananont <ksuvee@seas.upenn.edu>   Scott Walck <walck@lvc.edu>   Ryan Yates <fryguybob@gmail.com>

@@ -1,9 +0,0 @@-The standard library for 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.

@@ -0,0 +1,5 @@+[![Build Status](https://secure.travis-ci.org/diagrams/diagrams-lib.png)](http://travis-ci.org/diagrams/diagrams-lib)++The standard library for+[diagrams](http://projects.haskell.org/diagrams/), a Haskell embedded+domain-specific language for compositional, declarative drawing.

@@ -1,5 +1,5 @@ Name:                diagrams-lib-Version:             0.5.0.1+Version:             0.6 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@@ -13,19 +13,21 @@ License-file:        LICENSE Author:              Brent Yorgey Maintainer:          diagrams-discuss@googlegroups.com+Bug-reports:         http://github.com/diagrams/diagrams-lib/issues Category:            Graphics Build-type:          Simple Cabal-version:       >=1.6-Extra-source-files:  CHANGES, README-Tested-with:         GHC == 6.12.3, GHC == 7.0.4, GHC == 7.2.1, GHC == 7.4.1+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 Source-repository head-  type:     darcs-  location: http://patch-tag.com/r/byorgey/diagrams-lib+  type:     git+  location: http://github.com/diagrams/diagrams-lib.git  Library   Exposed-modules:     Diagrams.Prelude,                        Diagrams.Align,                        Diagrams.Combinators,+                       Diagrams.Coordinates,                        Diagrams.Attributes,                        Diagrams.Points,                        Diagrams.Segment,@@ -42,6 +44,7 @@                        Diagrams.TwoD.Transform,                        Diagrams.TwoD.Ellipse,                        Diagrams.TwoD.Arc,+                       Diagrams.TwoD.Segment,                        Diagrams.TwoD.Path,                        Diagrams.TwoD.Polygons,                        Diagrams.TwoD.Shapes,@@ -57,11 +60,12 @@                        Diagrams.Animation.Active,                        Diagrams.Util,                        Diagrams.Backend.Show-  Build-depends:       base >= 4.2 && < 4.6,-                       containers >= 0.3 && < 0.5,+  Build-depends:       base >= 4.2 && < 4.7,+                       containers >= 0.3 && < 0.6,                        array >= 0.3 && < 0.5,                        semigroups >= 0.3.4 && < 0.9,-                       diagrams-core >= 0.5 && < 0.6,+                       monoid-extras >= 0.2.2 && < 0.3,+                       diagrams-core >= 0.6 && < 0.7,                        active >= 0.1 && < 0.2,                        vector-space >= 0.7.7 && < 0.9,                        NumInstances >= 1.0 && < 1.1,

@@ -31,7 +31,7 @@         ) where -import Graphics.Rendering.Diagrams+import Diagrams.Core  import Data.VectorSpace import Data.AffineSpace (alerp)

@@ -29,7 +29,7 @@         ) where -import Graphics.Rendering.Diagrams+import Diagrams.Core  import Diagrams.Combinators import Diagrams.Animation.Active ()@@ -41,9 +41,9 @@ import Data.Active import Data.Semigroup -import Data.VectorSpace- import Control.Applicative ((<$>))+import Data.Foldable       (foldMap)+import Data.VectorSpace  -- | A value of type @QAnimation b v m@ is an animation (a --   time-varying diagram with start and end times) that can be@@ -119,7 +119,8 @@ --   accurate but slower. animRect' :: (PathLike p, Enveloped p, Transformable p, V p ~ R2)           => Rational -> QAnimation b R2 m -> p-animRect' r = maybe (rect 1 1) (`boxFit` rect 1 1)-            . unions-            . map boundingBox-            . simulate r+animRect' r anim+    | null results = rect 1 1+    | otherwise    = boxFit (foldMap boundingBox results) (rect 1 1)+  where+    results = simulate r anim

@@ -38,7 +38,7 @@  module Diagrams.Animation.Active where -import Graphics.Rendering.Diagrams+import Diagrams.Core import Control.Applicative ((<$>), pure)  import Diagrams.Align

@@ -32,7 +32,7 @@   , LineColor, getLineColor, lineColor, lc, lcA    -- ** Fill color-  , FillColor, getFillColor, fillColor, fc, fcA+  , FillColor, getFillColor, recommendFillColor, fillColor, fc, fcA    -- ** Opacity   , Opacity, getOpacity, opacity@@ -52,14 +52,15 @@    ) where -import Graphics.Rendering.Diagrams+import           Diagrams.Core -import Data.Colour+import           Data.Colour import qualified Data.Colour.SRGB as RGB -import Data.Typeable+import           Data.Typeable -import Data.Semigroup+import           Data.Monoid.Recommend+import           Data.Semigroup  ------------------------------------------------------------ --  Color  -------------------------------------------------@@ -121,7 +122,7 @@ --   . 'fillColor' c2 $ d@ is equivalent to @'lineColor' c2 $ d@. --   More precisely, the semigroup structure on fill color attributes --   is that of 'Last'.-newtype FillColor = FillColor (Last SomeColor)+newtype FillColor = FillColor (Recommend (Last SomeColor))   deriving (Typeable, Semigroup) instance AttributeClass FillColor @@ -130,10 +131,15 @@ --   but this can sometimes create problems for type inference, so the --   'fc' and 'fcA' variants are provided with more concrete types. fillColor :: (Color c, HasStyle a) => c -> a -> a-fillColor = applyAttr . FillColor . Last . SomeColor+fillColor = applyAttr . FillColor . Commit . Last . SomeColor +-- | Set a \"recommended\" fill color, to be used only if no explicit+--   calls to 'fillColor' (or 'fc', or 'fcA') are used.+recommendFillColor :: (Color c, HasStyle a) => c -> a -> a+recommendFillColor = applyAttr . FillColor . Recommend . Last . SomeColor+ getFillColor :: FillColor -> SomeColor-getFillColor (FillColor (Last c)) = c+getFillColor (FillColor c) = getLast . getRecommend $ c  -- | A synonym for 'fillColor', specialized to @'Colour' Double@ --   (i.e. opaque colors).@@ -168,7 +174,7 @@   colorToRGBA (LineColor (Last c)) = colorToRGBA c  instance Color FillColor where-  colorToRGBA (FillColor (Last c)) = colorToRGBA c+  colorToRGBA (FillColor c) = colorToRGBA . getLast . getRecommend $ c  alphaToColour :: (Floating a, Ord a, Fractional a) => AlphaColour a -> Colour a alphaToColour ac | alphaChannel ac == 0 = ac `over` black@@ -238,7 +244,7 @@   deriving (Eq,Show,Typeable)  newtype LineCapA = LineCapA (Last LineCap)-  deriving (Typeable, Semigroup)+  deriving (Typeable, Semigroup, Eq) instance AttributeClass LineCapA  getLineCap :: LineCapA -> LineCap@@ -258,7 +264,7 @@   deriving (Eq,Show,Typeable)  newtype LineJoinA = LineJoinA (Last LineJoin)-  deriving (Typeable, Semigroup)+  deriving (Typeable, Semigroup, Eq) instance AttributeClass LineJoinA  getLineJoin :: LineJoinA -> LineJoin@@ -270,10 +276,10 @@  -- | Create lines that are dashing... er, dashed. data Dashing = Dashing [Double] Double-  deriving Typeable+  deriving (Typeable, Eq)  newtype DashingA = DashingA (Last Dashing)-  deriving (Typeable, Semigroup)+  deriving (Typeable, Semigroup, Eq) instance AttributeClass DashingA  getDashing :: DashingA -> Dashing

@@ -1,8 +1,10 @@ {-# LANGUAGE DeriveDataTypeable            , DeriveFunctor            , FlexibleContexts+           , GeneralizedNewtypeDeriving            , NoMonomorphismRestriction            , ScopedTypeVariables+           , StandaloneDeriving            , TypeFamilies            , UndecidableInstances   #-}@@ -13,7 +15,11 @@ -- License     :  BSD-style (see LICENSE) -- Maintainer  :  diagrams-discuss@googlegroups.com ----- Definitions and functions for working with bounding boxes.+-- Bounding boxes are not very compositional (/e.g./ it is not+-- possible to do anything sensible with them under rotation), so they+-- are not used in the diagrams core.  However, they do have their+-- uses; this module provides definitions and functions for working+-- with them. -- ----------------------------------------------------------------------------- @@ -22,201 +28,267 @@          BoundingBox()           -- * Constructing bounding boxes-       , fromCorners, fromPoint, fromPoints+       , emptyBox, fromCorners, fromPoint, fromPoints        , boundingBox           -- * Queries on bounding boxes+       , isEmptyBox        , getCorners, getAllCorners        , boxExtents, boxTransform, boxFit        , contains, contains'        , inside, inside', outside, outside'           -- * Operations on bounding boxes-       , union, intersection, unions, intersections+       , union, intersection        ) where -import Control.Applicative ((<*>))+import Control.Applicative ((<$>)) import Control.Monad (join, liftM2) import Data.Map (Map, fromList, toList, fromDistinctAscList, toAscList) import qualified Data.Foldable as F -import Data.Maybe (fromJust)+import Data.Maybe (fromMaybe)  import Data.VectorSpace -- (VectorSpace, Scalar, AdditiveGroup, zeroV, negateV, (^+^), (^-^)) import Data.Basis (HasBasis, Basis, decompose, recompose, basisValue)+import Data.Monoid (Monoid(..))+import Data.Semigroup (Semigroup(..), Option(..))  import Data.Data (Data) import Data.Typeable (Typeable) -import Graphics.Rendering.Diagrams.Points (Point(..))-import Graphics.Rendering.Diagrams.HasOrigin (HasOrigin(..))-import Graphics.Rendering.Diagrams.Envelope (Enveloped(..), envelopeP)-import Graphics.Rendering.Diagrams.V (V)-import Graphics.Rendering.Diagrams.Transform+import Diagrams.Core.Points (Point(..))+import Diagrams.Core.HasOrigin (HasOrigin(..))+import Diagrams.Core.Envelope (Enveloped(..), appEnvelope)+import Diagrams.Core.V (V)+import Diagrams.Core.Transform   (Transformation(..), Transformable(..), HasLinearMap, (<->)) --- | A bounding box is an axis-aligned region determined---   by two points indicating its \"lower\" and \"upper\" corners.-data BoundingBox v = BoundingBox (Point v) (Point v)-  deriving (Show, Read, Eq, Data, Typeable, Functor)+-- Unexported utility newtype +newtype NonEmptyBoundingBox v = NonEmptyBoundingBox (Point v, Point v)+  deriving (Eq, Data, Typeable)++fromNonEmpty :: NonEmptyBoundingBox v -> BoundingBox v+fromNonEmpty = BoundingBox . Option . Just++fromMaybeEmpty :: Maybe (NonEmptyBoundingBox v) -> BoundingBox v+fromMaybeEmpty = maybe emptyBox fromNonEmpty++nonEmptyCorners :: NonEmptyBoundingBox v -> (Point v, Point v)+nonEmptyCorners (NonEmptyBoundingBox x) = x++instance (HasBasis v, Ord (Basis v), AdditiveGroup (Scalar v), Ord (Scalar v))+    => Semigroup (NonEmptyBoundingBox v) where+  (NonEmptyBoundingBox (ul, uh)) <> (NonEmptyBoundingBox (vl, vh))+    = NonEmptyBoundingBox+    $ mapT toPoint (combineP min ul vl, combineP max uh vh)+++-- | A bounding box is an axis-aligned region determined by two points+--   indicating its \"lower\" and \"upper\" corners.  It can also represent+--   an empty bounding box - the points are wrapped in @Maybe@.+newtype BoundingBox v = BoundingBox (Option (NonEmptyBoundingBox v))+  deriving (Eq, Data, Typeable)++deriving instance+  ( HasBasis v, Ord (Basis v), AdditiveGroup (Scalar v), Ord (Scalar v)+  ) => Semigroup (BoundingBox v)+deriving instance+  ( HasBasis v, Ord (Basis v), AdditiveGroup (Scalar v), Ord (Scalar v)+  ) => Monoid (BoundingBox v)+ type instance V (BoundingBox v) = v -instance VectorSpace v => HasOrigin (BoundingBox v) where-  moveOriginTo p (BoundingBox p1 p2) = BoundingBox (moveOriginTo p p1)-                                                   (moveOriginTo p p2)+-- Map a function on a homogenous 2-tuple. (unexported utility)+mapT :: (a -> b) -> (a, a) -> (b, b)+mapT f (x, y) = (f x, f y) -instance ( InnerSpace v, Floating (Scalar v), Ord (Scalar v), AdditiveGroup (Scalar v)-         , HasBasis v, Ord (Basis v)+instance ( VectorSpace v, HasBasis v, Ord (Basis v)+         , AdditiveGroup (Scalar v), Ord (Scalar v)+         )  => HasOrigin (BoundingBox v) where+  moveOriginTo p b+    = fromMaybeEmpty+    ( NonEmptyBoundingBox . mapT (moveOriginTo p) <$> getCorners b )++instance ( InnerSpace v, HasBasis v, Ord (Basis v)+         , AdditiveGroup (Scalar v), Ord (Scalar v), Floating (Scalar v)          ) => Enveloped (BoundingBox v) where   getEnvelope = getEnvelope . getAllCorners --- | Create a bounding box from any two opposite corners.+instance Show v => Show (BoundingBox v) where+  show+    = maybe "emptyBox" (\(l, u) -> "fromCorners " ++ show l ++ " " ++ show u)+    . getCorners++{- TODO+instance Read v => Read (BoundingBox v) where+  read "emptyBox" = emptyBox+-}++-- | An empty bounding box.  This is the same thing as @mempty@, but it doesn't+--   require the same type constraints that the @Monoid@ +emptyBox :: BoundingBox v+emptyBox = BoundingBox $ Option Nothing++-- | Create a bounding box from a point that is component-wise @(<=)@ than the+--   other.  If this is not the case, then @mempty@ is returned. fromCorners   :: (HasBasis v, Ord (Basis v), AdditiveGroup (Scalar v), Ord (Scalar v))   => Point v -> Point v -> BoundingBox v-fromCorners u v = BoundingBox (toPoint (combineP min u v))-                              (toPoint (combineP max u v))+fromCorners l h+  | F.and (combineP (<=) l h) = fromNonEmpty $ NonEmptyBoundingBox (l, h)+  | otherwise = mempty  -- | Create a degenerate bounding \"box\" containing only a single point. fromPoint   :: (HasBasis v, Ord (Basis v), AdditiveGroup (Scalar v), Ord (Scalar v))   => Point v -> BoundingBox v-fromPoint p = BoundingBox p p+fromPoint p = fromNonEmpty $ NonEmptyBoundingBox (p, p)  -- | Create the smallest bounding box containing all the given points. fromPoints   :: (HasBasis v, Ord (Basis v), AdditiveGroup (Scalar v), Ord (Scalar v))-  => [Point v] -> Maybe (BoundingBox v)-fromPoints = unions . map fromPoint+  => [Point v] -> BoundingBox v+fromPoints = mconcat . map fromPoint --- | Create a bounding box for any boundable object (such as a diagram or path).-boundingBox :: forall a. (Enveloped a, HasBasis (V a), Ord (Basis (V a)))-            => a -> BoundingBox (V a)-boundingBox a = fromJust . fromPoints . map (`envelopeP` a) $ [id, negateV] <*> units-  where units = map (basisValue . fst) (decompose (zeroV :: V a))+-- | Create a bounding box for any enveloped object (such as a diagram or path).+boundingBox :: forall a. ( Enveloped a, HasBasis (V a), AdditiveGroup (V a)+                         , Ord (Basis (V a))+                         ) => a -> BoundingBox (V a)+boundingBox a = fromMaybeEmpty $ do+    env <- appEnvelope $ getEnvelope a+    let h = recompose $ map (\v -> (v,          env           $ basisValue v)) us+        l = recompose $ map (\v -> (v, negate . env . negateV $ basisValue v)) us+    return $ NonEmptyBoundingBox (P l, P h)+  where+    -- The units. Might not work if 0-components aren't reported.+    --TODO: Depend on Enum Basis?+    us = map fst $ decompose (zeroV :: V a) --- | Gets the lower and upper corners that define the bounding box.-getCorners :: BoundingBox v -> (Point v, Point v)-getCorners (BoundingBox l u) = (l, u)+-- | Queries whether the BoundingBox is empty.+isEmptyBox :: BoundingBox v -> Bool+isEmptyBox (BoundingBox (Option Nothing)) = True+isEmptyBox _ = False -{--Ord (Data.Basis.Basis b),-      Data.AdditiveGroup.AdditiveGroup (Data.VectorSpace.Scalar b),-      Data.Basis.HasBasis b,-      Data.Basis.HasBasis v,-      Data.Basis.Basis v ~ Data.Basis.Basis b,-      Data.VectorSpace.Scalar v ~ Data.VectorSpace.Scalar b) =>--}+-- | Gets the lower and upper corners that define the bounding box.+getCorners :: BoundingBox v -> Maybe (Point v, Point v)+getCorners (BoundingBox p) = nonEmptyCorners <$> getOption p  -- | Computes all of the corners of the bounding box. getAllCorners :: (HasBasis v, AdditiveGroup (Scalar v), Ord (Basis v))               => BoundingBox v -> [Point v]-getAllCorners (BoundingBox l u)+getAllCorners (BoundingBox (Option Nothing)) = []+getAllCorners (BoundingBox (Option (Just (NonEmptyBoundingBox (l, u)))))   = map (P . recompose)   -- Enumerate all combinations of selections of lower / higher values. -  . mapM (\(b, (x, y)) -> [(b, x), (b, y)])-  . toList $ combineP (,) l u+  . mapM (\(b, (l', u')) -> [(b, l'), (b, u')])+  -- List of [(basis, (lower, upper))]+  . toList+  $ combineP (,) l u --- | Get the size of the bounding box - the vector from the lesser to the greater---   point.+-- | Get the size of the bounding box - the vector from the (component-wise)+--   lesser point to the greater point. boxExtents :: (AdditiveGroup v) => BoundingBox v -> v-boxExtents (BoundingBox (P l) (P h)) = h ^-^ l+boxExtents = maybe zeroV (\(P l, P h) -> h ^-^ l) . getCorners  -- | Create a transformation mapping points from one bounding box to the other. boxTransform :: (AdditiveGroup v, HasLinearMap v,                   Fractional (Scalar v), AdditiveGroup (Scalar v), Ord (Basis v))-             => BoundingBox v -> BoundingBox v -> Transformation v-boxTransform a@(BoundingBox (P l1) _) b@(BoundingBox (P l2) _)-  = Transformation s s (l2 ^-^ boxTrans a b l1)- where-  s = boxTrans a b <-> boxTrans b a-  boxTrans b1 b2 = vcombineV (*) (vcombineV (/) (boxExtents b2) (boxExtents b1))-  vcombineV f x = toVector . combineV f x+             => BoundingBox v -> BoundingBox v -> Maybe (Transformation v)+boxTransform u v = do+    ((P ul), _) <- getCorners u+    ((P vl), _) <- getCorners v+    let lin_map = box_scale (v, u) <-> box_scale (u, v)+        box_scale = combineV' (*) . uncurry (combineV' (/)) . mapT boxExtents+        combineV' f x = toVector . combineV f x+    return $ Transformation lin_map lin_map (vl ^-^ box_scale (v, u) ul) --- | Transforms a boundable thing to fit within a @BoundingBox@.-boxFit :: (Enveloped a, Transformable a, Ord (Basis (V a)))+-- | Transforms an enveloped thing to fit within a @BoundingBox@.  If it's+--   empty, then the result is also @mempty@.+boxFit :: (Enveloped a, Transformable a, Monoid a, Ord (Basis (V a)))        => BoundingBox (V a) -> a -> a-boxFit b x = transform (boxTransform (boundingBox x) b) x+boxFit b x = maybe mempty (`transform` x) $ boxTransform (boundingBox x) b  -- | Check whether a point is contained in a bounding box (including its edges). contains   :: (HasBasis v, Ord (Basis v), AdditiveGroup (Scalar v), Ord (Scalar v))   => BoundingBox v -> Point v -> Bool-contains (BoundingBox l h) p = F.and (combineP (<=) l p)-                            && F.and (combineP (<=) p h)+contains b p = maybe False check $ getCorners b+  where+    check (l, h) = F.and (combineP (<=) l p)+                && F.and (combineP (<=) p h)  -- | Check whether a point is /strictly/ contained in a bounding box. contains'   :: (HasBasis v, Ord (Basis v), AdditiveGroup (Scalar v), Ord (Scalar v))   => BoundingBox v -> Point v -> Bool-contains' (BoundingBox l h) p = F.and (combineP (< ) l p)-                             && F.and (combineP (< ) p h)---- | Compute the smallest bounding box containing all the given---   bounding boxes (or @Nothing@ if the list is empty).-unions-  :: (HasBasis v, Ord (Basis v), AdditiveGroup (Scalar v), Ord (Scalar v))-  => [BoundingBox v] -> Maybe (BoundingBox v)-unions [] = Nothing-unions ps = Just . foldr1 union $ ps---- | Compute the largest bounding box contained in all the given---   bounding boxes (or @Nothing@ is the list is empty).-intersections-  :: (HasBasis v, Ord (Basis v), AdditiveGroup (Scalar v), Ord (Scalar v))-  => [BoundingBox v] -> Maybe (BoundingBox v)-intersections [] = Nothing-intersections ps = foldr1 ((join .) . liftM2 intersection) (map Just ps)+contains' b p = maybe False check $ getCorners b+  where+    check (l, h) = F.and (combineP (<) l p)+                && F.and (combineP (<) p h)  -- | Test whether the first bounding box is contained inside --   the second. inside   :: (HasBasis v, Ord (Basis v), AdditiveGroup (Scalar v), Ord (Scalar v))   => BoundingBox v -> BoundingBox v -> Bool-inside   (BoundingBox ul uh) (BoundingBox vl vh) =  F.and (combineP (<=) uh vh)-                                                 && F.and (combineP (>=) ul vl)+inside u v = fromMaybe False $ do+  (ul, uh) <- getCorners u+  (vl, vh) <- getCorners v+  return $ F.and (combineP (>=) ul vl)+        && F.and (combineP (<=) uh vh)  -- | Test whether the first bounding box is /strictly/ contained --   inside the second. inside'   :: (HasBasis v, Ord (Basis v), AdditiveGroup (Scalar v), Ord (Scalar v))   => BoundingBox v -> BoundingBox v -> Bool-inside'  (BoundingBox ul uh) (BoundingBox vl vh) =  F.and (combineP (< ) uh vh)-                                                 && F.and (combineP (> ) ul vl)+inside' u v = fromMaybe False $ do+  (ul, uh) <- getCorners u+  (vl, vh) <- getCorners v+  return $ F.and (combineP (>) ul vl)+        && F.and (combineP (<) uh vh)  -- | Test whether the first bounding box lies outside the second --   (although they may intersect in their boundaries). outside   :: (HasBasis v, Ord (Basis v), AdditiveGroup (Scalar v), Ord (Scalar v))   => BoundingBox v -> BoundingBox v -> Bool-outside  (BoundingBox ul uh) (BoundingBox vl vh) =  F.or  (combineP (<=) uh vl)-                                                 || F.or  (combineP (>=) ul vh)+outside u v = fromMaybe True $ do+  (ul, uh) <- getCorners u+  (vl, vh) <- getCorners v+  return $ F.or (combineP (<=) uh vl)+        || F.or (combineP (>=) ul vh)  -- | Test whether the first bounding box lies /strictly/ outside the second --   (they do not intersect at all). outside'   :: (HasBasis v, Ord (Basis v), AdditiveGroup (Scalar v), Ord (Scalar v))   => BoundingBox v -> BoundingBox v -> Bool-outside' (BoundingBox ul uh) (BoundingBox vl vh) =  F.or  (combineP (< ) uh vl)-                                                 || F.or  (combineP (> ) ul vh)+outside' u v = fromMaybe True $ do+  (ul, uh) <- getCorners u+  (vl, vh) <- getCorners v+  return $ F.or (combineP (<) uh vl)+        || F.or (combineP (>) ul vh)  -- | Form the largest bounding box contained within this given two --   bounding boxes, or @Nothing@ if the two bounding boxes do not --   overlap at all. intersection   :: (HasBasis v, Ord (Basis v), AdditiveGroup (Scalar v), Ord (Scalar v))-  => BoundingBox v -> BoundingBox v -> Maybe (BoundingBox v)-intersection u@(BoundingBox ul uh) v@(BoundingBox vl vh)-  | u `outside'` v = Nothing-  | otherwise = Just (fromCorners (toPoint (combineP max ul vl)) (toPoint (combineP min uh vh)))---- | Form the smallest bounding box containing the given two bounding boxes.-union-  :: (HasBasis v, Ord (Basis v), AdditiveGroup (Scalar v), Ord (Scalar v))   => BoundingBox v -> BoundingBox v -> BoundingBox v-union (BoundingBox ul uh) (BoundingBox vl vh) = BoundingBox (toPoint (combineP min ul vl)) (toPoint (combineP max uh vh))+intersection u v = maybe mempty (uncurry fromCorners) $ do+  (ul, uh) <- getCorners u+  (vl, vh) <- getCorners v+  return $ mapT toPoint (combineP max ul vl, combineP min uh vh)++-- | Form the smallest bounding box containing the given two bound union.  This+--   function is just an alias for @mappend@.+union :: (HasBasis v, Ord (Basis v), AdditiveGroup (Scalar v), Ord (Scalar v))+      => BoundingBox v -> BoundingBox v -> BoundingBox v+union = mappend  -- internals using Map (Basis v) (Scalar v) -- probably paranoia, but decompose might not always

@@ -16,10 +16,10 @@ module Diagrams.Combinators        ( -- * Unary operations -         withEnvelope+         withEnvelope, withTrace        , phantom, strut-        , pad+       , extrudeEnvelope, intrudeEnvelope           -- * Binary operations        , beneath@@ -32,7 +32,7 @@         ) where -import Graphics.Rendering.Diagrams+import Diagrams.Core  import Diagrams.Segment (Segment(..)) import Diagrams.Path@@ -51,14 +51,20 @@  -- | Use the envelope from some object as the envelope for a --   diagram, in place of the diagram's default envelope.-withEnvelope :: (Backend b (V a), Enveloped a, Monoid' m)+withEnvelope :: (HasLinearMap (V a), Enveloped a, Monoid' m)            => a -> QDiagram b (V a) m -> QDiagram b (V a) m withEnvelope = setEnvelope . getEnvelope +-- | Use the trace from some object as the trace for a diagram, in+--   place of the diagram's default trace.+withTrace :: (HasLinearMap (V a), Traced a, OrderedField (Scalar (V a)), InnerSpace (V a), Monoid' m)+          => a -> QDiagram b (V a) m -> QDiagram b (V a) m+withTrace = setTrace . getTrace+ -- | @phantom x@ produces a \"phantom\" diagram, which has the same---   envelope as @x@ but produces no output.-phantom :: (Backend b (V a), Enveloped a, Monoid' m) => a -> QDiagram b (V a) m-phantom a = mkQD nullPrim (getEnvelope a) mempty mempty+--   envelope and trace as @x@ but produces no output.+phantom :: (Backend b (V a), Enveloped a, Traced a, Monoid' m) => a -> QDiagram b (V a) m+phantom a = mkQD nullPrim (getEnvelope a) (getTrace a) mempty mempty  -- | @pad s@ \"pads\" a diagram, expanding its envelope by a factor of --   @s@ (factors between 0 and 1 can be used to shrink the envelope).@@ -74,15 +80,68 @@  -- | @strut v@ is a diagram which produces no output, but with respect --   to alignment and envelope acts like a 1-dimensional segment---   oriented along the vector @v@, with local origin at its center.---   Useful for manually creating separation between two diagrams.+--   oriented along the vector @v@, with local origin at its+--   center. (Note, however, that it has an empty trace; for 2D struts+--   with a nonempty trace see 'strutR2', 'strutX', and 'strutY' from+--   "Diagrams.TwoD.Combinators".) Useful for manually creating+--   separation between two diagrams. strut :: ( Backend b v, InnerSpace v          , OrderedField (Scalar v)          , Monoid' m          )       => v -> QDiagram b v m-strut v = phantom . translate ((-0.5) *^ v) . getEnvelope $ Linear v+strut v = mkQD nullPrim env mempty mempty mempty+  where env = translate ((-0.5) *^ v) . getEnvelope $ Linear v+  -- note we can't use 'phantom' here because it tries to construct a+  -- trace as well, and segments do not have a trace in general (only+  -- in 2D; see Diagrams.TwoD.Segment).  This is a good reason to have+  -- a special 'strut' combinator (before the introduction of traces+  -- it was mostly just for convenience).+  --+  -- also note that we can't remove the call to getEnvelope, since+  -- translating a segment has no effect. +-- | @extrudeEnvelope v d@ asymmetrically \"extrudes\" the envelope of+--   a diagram in the given direction.  All parts of the envelope+--   within 90 degrees of this direction are modified, offset outwards+--   by the magnitude of the vector.+--+--   This works by offsetting the envelope distance proportionally to+--   the cosine of the difference in angle, and leaving it unchanged+--   when this factor is negative.+extrudeEnvelope+  :: ( Ord (Scalar v), Num (Scalar v), AdditiveGroup (Scalar v)+     , Floating (Scalar v), HasLinearMap v, InnerSpace v, Monoid' m )+  => v -> QDiagram b v m -> QDiagram b v m+extrudeEnvelope = deformEnvelope 0.5++-- | @intrudeEnvelope v d@ asymmetrically \"intrudes\" the envelope of+--   a diagram away from the given direction.  All parts of the envelope+--   within 90 degrees of this direction are modified, offset inwards+--   by the magnitude of the vector.+--+--   Note that this could create strange inverted envelopes, where+--   @ diameter v d < 0 @.+intrudeEnvelope+  :: ( Ord (Scalar v), Num (Scalar v), AdditiveGroup (Scalar v)+     , Floating (Scalar v), HasLinearMap v, InnerSpace v, Monoid' m )+  => v -> QDiagram b v m -> QDiagram b v m+intrudeEnvelope = deformEnvelope (-0.5)++-- Utility for extrudeEnvelope / intrudeEnvelope+deformEnvelope+  :: ( Ord (Scalar v), Num (Scalar v), AdditiveGroup (Scalar v)+     , Floating (Scalar v), HasLinearMap v, InnerSpace v, Monoid' m )+  => (Scalar v) -> v -> QDiagram b v m -> QDiagram b v m+deformEnvelope s v d = setEnvelope (inEnvelope deform $ getEnvelope d) d+  where+    deform = Option . fmap deform' . getOption+    deform' env v'+        | dot > 0 = Max $ getMax (env v') + (dot * s) / magnitude v'+        | otherwise = env v'+      where+        dot = v' <.> v+ ------------------------------------------------------------ -- Combining two objects ------------------------------------------------------------@@ -94,6 +153,8 @@      => QDiagram b v m -> QDiagram b v m -> QDiagram b v m beneath = flip atop +infixl 6 `beneath`+ -- | Place two monoidal objects (/i.e./ diagrams, paths, --   animations...) next to each other along the given vector.  In --   particular, place the second object so that the vector points@@ -244,8 +305,8 @@      => V a -> CatOpts (V a) -> [a] -> a cat' v (CatOpts { catMethod = Cat, sep = s }) = foldB comb mempty   where comb d1 d2 = d1 <> (juxtapose v d1 d2 # moveOriginBy vs)-        vs = withLength s (negateV v)+        vs = s *^ normalized (negateV v)  cat' v (CatOpts { catMethod = Distrib, sep = s }) =-  decorateTrail . fromOffsets . repeat $ withLength s v+  decorateTrail . fromOffsets . repeat $ s *^ normalized v   -- infinite trail, no problem for Haskell =D

@@ -0,0 +1,87 @@+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Diagrams.Coordinates+-- Copyright   :  (c) 2012 diagrams-lib team (see LICENSE)+-- License     :  BSD-style (see LICENSE)+-- Maintainer  :  diagrams-discuss@googlegroups.com+--+-- Nice syntax for constructing and pattern-matching on literal+-- points and vectors.+--+-----------------------------------------------------------------------------++module Diagrams.Coordinates+    ( (:&)(..), Coordinates(..) )+    where++-- | A pair of values, with a convenient infix (left-associative)+--   data constructor.+data a :& b = a :& b+  deriving (Eq, Ord, Show)++infixl 7 :&+++-- | Types which are instances of the @Coordinates@ class can be+--   constructed using '&' (for example, a three-dimensional vector+--   could be constructed by @1 & 6 & 3@), and deconstructed using+--   'coords'.  A common pattern is to use 'coords' in conjunction+--   with the @ViewPatterns@ extension, like so:+--+-- > foo :: Vector3 -> ...+-- > foo (coords -> x :& y :& z) = ...+class Coordinates c where++  -- | The type of the final coordinate.+  type FinalCoord c    :: *++  -- | The type of everything other than the final coordinate.+  type PrevDim c       :: *++  -- | Decomposition of @c@ into applications of ':&'.+  type Decomposition c :: *+    -- Decomposition c = Decomposition (PrevDim c) :& FinalCoord c  (essentially)++  -- | Construct a value of type @c@ by providing something of one+  --   less dimension (which is perhaps itself recursively constructed+  --   using @(&)@) and a final coordinate.  For example,+  --+  -- > 2 & 3 :: P2+  -- > 3 & 5 & 6 :: R3+  --+  --   Note that @&@ is left-associative.+  (&)    :: PrevDim c -> FinalCoord c -> c++  -- | Decompose a value of type @c@ into its constituent coordinates,+  --   stored in a nested @(:&)@ structure.+  coords :: c -> Decomposition c++infixl 7 &++-- Some standard instances for plain old tuples++instance Coordinates (a,b) where+  type FinalCoord (a,b)    = b+  type PrevDim (a,b)       = a+  type Decomposition (a,b) = a :& b++  x & y                    = (x,y)+  coords (x,y)             = x :& y++instance Coordinates (a,b,c) where+  type FinalCoord (a,b,c)    = c+  type PrevDim (a,b,c)       = (a,b)+  type Decomposition (a,b,c) = Decomposition (a,b) :& c++  (x,y) & z                  = (x,y,z)+  coords (x,y,z)             = coords (x,y) :& z++instance Coordinates (a,b,c,d) where+  type FinalCoord (a,b,c,d)    = d+  type PrevDim (a,b,c,d)       = (a,b,c)+  type Decomposition (a,b,c,d) = Decomposition (a,b,c) :& d++  (w,x,y) & z                  = (w,x,y,z)+  coords (w,x,y,z)             = coords (w,x,y) :& z

@@ -25,8 +25,8 @@  import Diagrams.CubicSpline.Internal -import Graphics.Rendering.Diagrams-import Graphics.Rendering.Diagrams.Points+import Diagrams.Core+import Diagrams.Core.Points  import Diagrams.Segment import Diagrams.Path

@@ -59,7 +59,7 @@        , pathVertices        , pathOffsets        , pathCentroid-       , expandPath+       , scalePath        , reversePath        , fixPath @@ -71,8 +71,8 @@         ) where -import Graphics.Rendering.Diagrams-import Graphics.Rendering.Diagrams.Points+import Diagrams.Core+import Diagrams.Core.Points  import Diagrams.Align import Diagrams.Segment@@ -193,10 +193,23 @@ instance (InnerSpace v, OrderedField (Scalar v)) => Enveloped (Trail v) where    getEnvelope (Trail segs _) =-    foldr (\seg bds -> moveOriginTo (P . negateV . segOffset $ seg) bds <> getEnvelope seg)+    foldr (\seg bds -> moveOriginBy (negateV . segOffset $ seg) bds <> getEnvelope seg)           mempty           segs +  -- XXX can we improve the efficiency of the above?  E.g. note the+  -- last segment in each trail ends up getting translated O(n) times,+  -- so overall we do O(n^2) work!  (to find the max over the bounds+  -- for O(n) segments, where the ith segment requires working through+  -- a stack of i translations...)+  --+  -- The idea would be to first convert to a list of FixedSegments (to+  -- cache the translation work) then take the bounds of those.+  --+  -- Also, use a balanced fold!+  --+  -- Need to make some benchmarks I guess.+ instance HasLinearMap v => Renderable (Trail v) NullBackend where   render _ _ = mempty @@ -248,7 +261,7 @@ addClosingSegment :: AdditiveGroup v => Trail v -> Trail v addClosingSegment t | isClosed t = Trail (trailSegments t ++ [closeSeg]) False                     | otherwise = t- where closeSeg = Linear . negateV $ trailOffset t + where closeSeg = Linear . negateV $ trailOffset t  -- | Convert a starting point and a trail into a list of fixed segments. fixTrail :: AdditiveGroup v => Point v -> Trail v -> [FixedSegment v]@@ -340,9 +353,9 @@  -- | Scale a path using its centroid (see 'pathCentroid') as the base --   point for the scale.-expandPath :: (HasLinearMap v, VectorSpace v, Fractional (Scalar v), Eq (Scalar v))-           => Scalar v -> Path v -> Path v-expandPath d p = (scale d `under` translation (origin .-. pathCentroid p)) p+scalePath :: (HasLinearMap v, VectorSpace v, Fractional (Scalar v), Eq (Scalar v))+          => Scalar v -> Path v -> Path v+scalePath d p = (scale d `under` translation (origin .-. pathCentroid p)) p  -- | Reverse the direction of all the component trails of a path. reversePath :: AdditiveGroup v => Path v -> Path v

@@ -1,5 +1,5 @@-{-# LANGUAGE FlexibleContexts-  #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE FlexibleContexts #-}  ----------------------------------------------------------------------------- -- |@@ -17,7 +17,8 @@         ) where -import Graphics.Rendering.Diagrams+import Diagrams.Coordinates+import Diagrams.Core.Points  import Control.Newtype @@ -28,3 +29,11 @@ -- | The centroid of a set of /n/ points is their sum divided by /n/. centroid :: (VectorSpace v, Fractional (Scalar v)) => [Point v] -> Point v centroid = pack . uncurry (^/) . (sumV &&& (fromIntegral . length)) . map unpack++instance Coordinates v => Coordinates (Point v) where+  type FinalCoord (Point v)    = FinalCoord v+  type PrevDim (Point v)       = PrevDim v+  type Decomposition (Point v) = Decomposition v++  x & y        = P (x & y)+  coords (P v) = coords v

@@ -16,9 +16,14 @@          -- * Core library          -- | The core definitions of transformations, diagrams,          --   backends, and so on.-         module Graphics.Rendering.Diagrams+         module Diagrams.Core           -- * Standard library++         -- | Nice syntax for constructing and pattern-matching+         --   literal points and vectors.+       , module Diagrams.Coordinates+          -- | Attributes (color, line style, etc.) and styles.        , module Diagrams.Attributes @@ -57,6 +62,8 @@        , module Diagrams.Util           -- * Convenience re-exports+         -- | For representing and operating on colors.+       , module Data.Colour          -- | A large list of color names.        , module Data.Colour.Names          -- | Semigroups and monoids show up all over the place, so things from@@ -73,24 +80,25 @@        , Applicative(..), (*>), (<*), (<$>), (<$), liftA, liftA2, liftA3        ) where -import Graphics.Rendering.Diagrams+import Diagrams.Core -import Diagrams.Attributes import Diagrams.Align+import Diagrams.Animation+import Diagrams.Attributes+import Diagrams.BoundingBox import Diagrams.Combinators-import Diagrams.Segment-import Diagrams.Path+import Diagrams.Coordinates import Diagrams.CubicSpline+import Diagrams.Path+import Diagrams.Segment import Diagrams.Transform-import Diagrams.BoundingBox import Diagrams.TwoD-import Diagrams.Animation import Diagrams.Util +import Data.Colour hiding (atop, AffineSpace(..)) import Data.Colour.Names import Data.Semigroup import Data.VectorSpace hiding (Sum(..)) import Data.AffineSpace import Data.Active import Control.Applicative-

@@ -47,12 +47,12 @@           -- * Fixed (absolutely located) segments        , FixedSegment(..)-       , mkFixedSeg+       , mkFixedSeg, fromFixedSeg        , fAtParam         ) where -import Graphics.Rendering.Diagrams+import Diagrams.Core  import Diagrams.Solve import Diagrams.Util@@ -285,8 +285,8 @@ --   performed; see 'AdjustOpts'. adjustSegment :: (InnerSpace v, OrderedField (Scalar v))               => Segment v -> AdjustOpts v -> Segment v-adjustSegment s opts = adjustSegmentToParams s -    (if adjSide opts == End   then 0 else getParam s) +adjustSegment s opts = adjustSegmentToParams s+    (if adjSide opts == End   then 0 else getParam s)     (if adjSide opts == Start then 0 else 1 - getParam (reverseSegment s))   where     getParam seg = case adjMethod opts of@@ -319,27 +319,49 @@ type instance V (FixedSegment v) = v  instance HasLinearMap v => Transformable (FixedSegment v) where-  transform t (FLinear p1 p2) = FLinear (transform t p1) (transform t p2)-  transform t (FCubic p1 c1 c2 p2) = FCubic (transform t p1)-                                            (transform t c1)-                                            (transform t c2)-                                            (transform t p2)+  transform t (FLinear p1 p2)+    = FLinear+      (transform t p1)+      (transform t p2) +  transform t (FCubic p1 c1 c2 p2)+    = FCubic+      (transform t p1)+      (transform t c1)+      (transform t c2)+      (transform t p2)+ instance VectorSpace v => HasOrigin (FixedSegment v) where-  moveOriginTo o (FLinear p1 p2) = FLinear (moveOriginTo o p1)-                                           (moveOriginTo o p2)-  moveOriginTo o (FCubic p1 c1 c2 p2) = FCubic (moveOriginTo o p1)-                                               (moveOriginTo o c1)-                                               (moveOriginTo o c2)-                                               (moveOriginTo o p2)+  moveOriginTo o (FLinear p1 p2)+    = FLinear+      (moveOriginTo o p1)+      (moveOriginTo o p2) --- instance Enveloped (FixedSegment v) where-  -- XXX write me+  moveOriginTo o (FCubic p1 c1 c2 p2)+    = FCubic+      (moveOriginTo o p1)+      (moveOriginTo o c1)+      (moveOriginTo o c2)+      (moveOriginTo o p2) +instance (InnerSpace v, OrderedField (Scalar v)) => Enveloped (FixedSegment v) where+  getEnvelope f = moveTo p (getEnvelope s)+    where (p, s) = fromFixedSeg f++    -- Eventually we might decide it's cleaner/more efficient (?) to+    -- have all the computation in the FixedSegment instance of+    -- Envelope, and implement the Segment instance in terms of it,+    -- instead of the other way around+ -- | Create a 'FixedSegment' from a starting point and a 'Segment'. mkFixedSeg :: AdditiveGroup v => Point v -> Segment v -> FixedSegment v mkFixedSeg p (Linear v)       = FLinear p (p .+^ v) mkFixedSeg p (Cubic c1 c2 x2) = FCubic p (p .+^ c1) (p .+^ c2) (p .+^ x2)++-- | Decompose a 'FixedSegment' into a starting point and a 'Segment'.+fromFixedSeg :: AdditiveGroup v => FixedSegment v -> (Point v, Segment v)+fromFixedSeg (FLinear p1 p2)      = (p1, Linear (p2 .-. p1))+fromFixedSeg (FCubic x1 c1 c2 x2) = (x1, Cubic (c1 .-. x1) (c2 .-. x1) (x2 .-. x1))  -- | Compute the point on a fixed segment at a given parameter.  A --   parameter of 0 corresponds to the starting point and 1 corresponds

@@ -1,5 +1,6 @@ {-# LANGUAGE TypeFamilies            , FlexibleContexts+           , MultiParamTypeClasses            , ViewPatterns   #-} -----------------------------------------------------------------------------@@ -19,12 +20,18 @@        , sphere        ) where -import Graphics.Rendering.Diagrams+import Prelude hiding (minimum)+import Data.Semigroup -import Diagrams.ThreeD.Types+import Data.AffineSpace+import Data.Monoid.PosInf (minimum)+import Data.VectorSpace -import Data.Semigroup+import Diagrams.Core +import Diagrams.ThreeD.Types+import Diagrams.Solve+ data Ellipsoid = Ellipsoid T3  type instance V Ellipsoid = R3@@ -32,10 +39,19 @@ instance Transformable Ellipsoid where   transform t1 (Ellipsoid t2) = Ellipsoid (t1 <> t2) +instance Renderable Ellipsoid NullBackend where+  render _ _ = mempty+ sphere :: (Backend b R3, Renderable Ellipsoid b) => Diagram b R3 sphere = mkQD (Prim $ Ellipsoid mempty)               (mkEnvelope sphereEnv)+              (mkTrace sphereTrace)               mempty               (Query sphereQuery)-  where sphereEnv (unr3 -> (x,y,z))   = 1 / sqrt(x*x + y*y + z*z)-        sphereQuery (unp3 -> (x,y,z)) = Any $ x*x + y*y + z*z <= 1+  where sphereEnv v = 1 / magnitude v+        sphereTrace p v = minimum (quadForm a b c)+          where a = v <.> v+                b = 2 *^ p' <.> v+                c = p' <.> p' - 1+                p' = p .-. origin+        sphereQuery v = Any $ magnitudeSq (v .-. origin) <= 1

@@ -1,10 +1,11 @@-{-# LANGUAGE TypeSynonymInstances-           , FlexibleInstances-           , TypeFamilies-           , ViewPatterns-           , MultiParamTypeClasses-           , GeneralizedNewtypeDeriving-  #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+ {-# OPTIONS_GHC -fno-warn-orphans #-}  -----------------------------------------------------------------------------@@ -26,7 +27,9 @@         ) where -import Graphics.Rendering.Diagrams+import Diagrams.Coordinates+import Diagrams.TwoD.Types+import Diagrams.Core  import Control.Newtype @@ -66,6 +69,14 @@  instance InnerSpace R3 where   (unR3 -> vec1) <.> (unR3 -> vec2) = vec1 <.> vec2++instance Coordinates R3 where+  type FinalCoord R3       = Double+  type PrevDim R3          = R2+  type Decomposition R3    = Double :& Double :& Double++  (coords -> x :& y) & z   = r3 (x,y,z)+  coords (unR3 -> (x,y,z)) = x :& y :& z  -- | Points in R^3. type P3 = Point R3

@@ -14,7 +14,7 @@         ) where -import Graphics.Rendering.Diagrams+import Diagrams.Core import Data.Semigroup  -- | Conjugate one transformation by another. @conjugate t1 t2@ is the

@@ -87,6 +87,8 @@        , ellipse        , ellipseXY        , arc+       , arc'+       , arcCW        , wedge           -- ** General polygons@@ -147,14 +149,23 @@        , shearingY, shearY           -- * Combinators+         -- ** Combining multiple diagrams        , (===), (|||), atAngle        , hcat, hcat'        , vcat, vcat' +         -- ** Spacing and envelopes        , strutX, strutY        , padX, padY++       , extrudeLeft, extrudeRight, extrudeBottom, extrudeTop+        , view +         -- ** Background++       , boundingRect, bg+          -- * Alignment        , alignL, alignR, alignT, alignB, alignTL, alignTR, alignBL, alignBR        , alignX, alignY@@ -162,12 +173,15 @@           -- * Size          -- ** Computing size-       , width, height, size2D+       , width, height, size2D, sizeSpec2D        , extentX, extentY, center2D           -- ** Specifying size        , SizeSpec2D(..)        , mkSizeSpec++         -- ** Adjusting size+       , sized, sizedAs           -- * Visual aids for understanding the internal model        , showOrigin

@@ -13,61 +13,58 @@ -- ----------------------------------------------------------------------------- -module Diagrams.TwoD.Adjust (-    adjustDia2D-  , adjustSize-  , requiredScale-  ) where+module Diagrams.TwoD.Adjust+    (+      setDefault2DAttributes+    , adjustDiaSize2D+    , adjustDia2D+    , adjustSize     -- for backwards compatibility+    , requiredScale  -- re-exported for backwards compatibility+    ) where -import Graphics.Rendering.Diagrams+import Diagrams.Core  import Diagrams.Attributes  (lw, lc) import Diagrams.Util        ((#))  import Diagrams.TwoD.Types  (R2, p2)-import Diagrams.TwoD.Size   (size2D, center2D, SizeSpec2D(..))+import Diagrams.TwoD.Size   ( size2D, center2D, SizeSpec2D(..)+                            , requiredScaleT, requiredScale+                            ) import Diagrams.TwoD.Text   (fontSize)  import Data.AffineSpace     ((.-.))+import Data.Semigroup  import Data.Colour.Names    (black) --- | @adjustDia2D@ provides a useful default implementation of---   the 'adjustDia' method from the 'Backend' type class.------   As its first two arguments it requires a method for extracting---   the requested output size from the rendering options, and a way---   of updating the rendering options with a new (more specific) size.------   It then performs the following adjustments:------   * Set some default attributes (in case they have not been set):+-- | Set default attributes of a 2D diagram (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------   * Also return the actual adjusted size of the diagram.+setDefault2DAttributes :: Semigroup m => QDiagram b R2 m -> QDiagram b R2 m+setDefault2DAttributes d = d # lw 0.01 # lc black # fontSize 1 --- XXX should split out the attribute-setting into a separate function.-adjustDia2D :: Monoid' m-            => (Options b R2 -> SizeSpec2D)-            -> (SizeSpec2D -> Options b R2 -> Options b R2)-            -> b -> Options b R2 -> QDiagram b R2 m-            -> (Options b R2, QDiagram b R2 m)-adjustDia2D getSize setSize _ opts d =+-- | Adjust the size and position of a 2D diagram to fit within the+--   requested size. The first two arguments specify a method for+--   extracting the requested output size from the rendering options,+--   and a way of updating the rendering options with a new (more+--   specific) size.+adjustDiaSize2D :: Monoid' m+                => (Options b R2 -> SizeSpec2D)+                -> (SizeSpec2D -> Options b R2 -> Options b R2)+                -> b -> Options b R2 -> QDiagram b R2 m+                -> (Options b R2, QDiagram b R2 m)+adjustDiaSize2D getSize setSize _ opts d =   ( case spec of        Dims _ _ -> opts        _        -> setSize (uncurry Dims . scale s $ size) opts -  , d # lw 0.01 # lc black # fontSize 1 # freeze-      # scale s+  , d # scale s       # translate tr   )   where spec = getSize opts@@ -78,29 +75,33 @@                     _        -> scale s size         tr = (0.5 *. p2 finalSz) .-. (s *. center2D d) --- | @adjustSize spec sz@ returns a transformation (a uniform scale)---   which can be applied to something of size @sz@ to make it the---   requested size @spec@.-adjustSize :: SizeSpec2D -> (Double, Double) -> Transformation R2-adjustSize spec size = scaling (requiredScale spec size)+-- | @adjustDia2D@ provides a useful default implementation of+--   the 'adjustDia' method from the 'Backend' type class.+--+--   As its first two arguments it requires a method for extracting+--   the requested output size from the rendering options, and a way+--   of updating the rendering options with a new (more specific) size.+--+--   It then performs the following adjustments:+--+--   * Set default attributes (see 'setDefault2DAttributes')+--+--   * Freeze the diagram in its final form+--+--   * Scale and translate the diagram to fit within the requested+--     size (see 'adjustDiaSize2D')+--+--   * Also return the actual adjusted size of the diagram.+adjustDia2D :: Monoid' m+            => (Options b R2 -> SizeSpec2D)+            -> (SizeSpec2D -> Options b R2 -> Options b R2)+            -> b -> Options b R2 -> QDiagram b R2 m+            -> (Options b R2, QDiagram b R2 m)+adjustDia2D getSize setSize b opts d+  = adjustDiaSize2D getSize setSize b opts (d # setDefault2DAttributes # freeze) --- | @requiredScale spec sz@ returns a scaling factor necessary to---   make something of size @sz@ fit the requested size @spec@,---   without changing the aspect ratio.  Hence an explicit---   specification of both dimensions may not be honored if the aspect---   ratios do not match; in that case the scaling will be as large as---   possible so that the object still fits within the requested size.-requiredScale :: SizeSpec2D -> (Double, Double) -> Double-requiredScale Absolute _    = 1-requiredScale (Width wSpec) (w,_)-  | wSpec == 0 || w == 0 = 1-  | otherwise            = wSpec / w-requiredScale (Height hSpec) (_,h)-  | hSpec == 0 || h == 0 = 1-  | otherwise            = hSpec / h-requiredScale (Dims wSpec hSpec) (w,h) = s-  where xscale  = wSpec / w-        yscale  = hSpec / h-        s'      = min xscale yscale-        s | isInfinite s' = 1-          | otherwise     = s'+{-# DEPRECATED adjustSize "Use Diagrams.TwoD.Size.requiredScaleT instead." #-}+-- | Re-export 'requiredScaleT' with the name 'adjustSize' for+--   backwards compatibility.+adjustSize :: SizeSpec2D -> (Double, Double) -> Transformation R2+adjustSize = requiredScaleT

@@ -34,7 +34,7 @@      ) where -import Graphics.Rendering.Diagrams+import Diagrams.Core  import Diagrams.TwoD.Types import Diagrams.TwoD.Vector

@@ -14,20 +14,22 @@  module Diagrams.TwoD.Arc     ( arc+    , arc'+    , arcCW     , arcT     , bezierFromSweep      , wedge     ) where -import Graphics.Rendering.Diagrams--import Diagrams.TwoD.Types-import Diagrams.TwoD.Transform-import Diagrams.TwoD.Vector (unitX, e)+import Diagrams.Core +import Diagrams.Coordinates import Diagrams.Path import Diagrams.Segment+import Diagrams.TwoD.Transform+import Diagrams.TwoD.Types+import Diagrams.TwoD.Vector (unitX, e) import Diagrams.Util ((#), tau)  import Data.Semigroup ((<>))@@ -42,10 +44,10 @@ --   quadrant. bezierFromSweepQ1 :: Rad -> Segment R2 bezierFromSweepQ1 s = fmap (^-^ v) . rotate (s/2) $ Cubic c2 c1 p0-  where p0@(unr2 -> (x,y)) = rotate (s/2) v-        c1                 = r2 ((4-x)/3, (1-x)*(3-x)/(3*y))-        c2                 = reflectY c1-        v                  = unitX+  where p0@(coords -> x :& y) = rotate (s/2) v+        c1                    = ((4-x)/3)  &  ((1-x)*(3-x)/(3*y))+        c2                    = reflectY c1+        v                     = unitX  -- | @bezierFromSweep s@ constructs a series of 'Cubic' segments that --   start in the positive y direction and sweep counter clockwise@@ -82,17 +84,51 @@ the approximation error. -} +-- | Given a start angle @s@ and an end angle @e@, @'arcT' s e@ is the+--   'Trail' of a radius one arc counterclockwise between the two angles. arcT :: Angle a => a -> a -> Trail R2-arcT start end = Trail bs (sweep >= tau)+arcT start end+    | e < s     = arcT s (e + fromIntegral d)+    | otherwise = Trail bs (sweep >= tau)   where sweep = convertAngle $ end - start         bs    = map (rotate start) . bezierFromSweep $ sweep+        +        -- We want to compare the start and the end and in case+        -- there isn't some law about 'Angle' ordering, we use a+        -- known 'Angle' for that.+        s = convertAngle start :: CircleFrac+        e = convertAngle end+        d = ceiling (s - e) :: Integer  -- | 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.+--   The origin of the arc is its center. arc :: (Angle a, PathLike p, V p ~ R2) => a -> a -> p arc start end = pathLike (rotate start $ p2 (1,0))                          False                          (trailSegments $ arcT start end)++-- | Like 'arc' but clockwise.+arcCW :: (Angle a, PathLike p, V p ~ R2) => a -> a -> p+arcCW start end = pathLike (rotate start $ p2 (1,0))+                           False+                           -- flipped arguments to get the path we want+                           -- then reverse the trail to get the cw direction.+                           (trailSegments . reverseTrail $ arcT end start)+                   -- We could just have `arcCW = reversePath . flip arc`+                   -- but that wouldn't be `PathLike`.++-- | Given a radus @r@, a start angle @s@ and an end angle @e@,+--   @'arc'' r s e@ is the path of a radius @(abs r)@ arc between +--   the two angles.  If a negative radius is given, the arc will+--   be clockwise, otherwise it will be counterclockwise. The origin +--   of the arc is its center.+arc' :: (Angle a, PathLike p, V p ~ R2) => Double -> a -> a -> p+arc' r start end = pathLike (rotate start $ p2 (abs r,0))+                   False+                   (trailSegments . scale (abs r) $ ts)+  where ts | r < 0     = reverseTrail $ arcT end start+           | otherwise = arcT start end  -- | Create a circular wedge of the given radius, beginning at the --   first angle and extending counterclockwise to the second.

@@ -25,30 +25,42 @@     , vcat, vcat'        -- * Spacing/envelopes+    , strutR2     , strutX, strutY     , padX, padY +    , extrudeLeft, extrudeRight, extrudeBottom, extrudeTop+     , view +    , boundingRect, bg+     ) where -import Graphics.Rendering.Diagrams+import Data.AffineSpace+import Data.Colour+import Data.Default+import Data.Semigroup+import Data.VectorSpace +import Diagrams.Core++import Diagrams.Attributes (lw, fc)+import Diagrams.BoundingBox+import Diagrams.Combinators+import Diagrams.Coordinates+import Diagrams.Path+import Diagrams.Segment+import Diagrams.TwoD.Align+import Diagrams.TwoD.Path ()   -- for PathLike (D R2) instance+import Diagrams.TwoD.Segment+import Diagrams.TwoD.Shapes import Diagrams.TwoD.Transform (scaleX, scaleY) import Diagrams.TwoD.Types import Diagrams.TwoD.Vector (unitX, unitY, fromDirection)-import Diagrams.TwoD.Shapes-import Diagrams.TwoD.Align-import Diagrams.TwoD.Path ()   -- for PathLike (D R2) instance- import Diagrams.Util ((#))-import Diagrams.Combinators -import Data.VectorSpace -import Data.Semigroup-import Data.Default- infixl 6 === infixl 6 ||| @@ -128,17 +140,28 @@       => CatOpts R2 -> [a] -> a vcat' = cat' (negateV unitY) +-- | @strutR2 v@ is a two-dimensional diagram which produces no+--   output, but with respect to alignment, envelope, /and trace/ acts+--   like a 1-dimensional segment oriented along the vector @v@, with+--   local origin at its center.  If you don't care about the trace+--   then there's no difference between @strutR2@ and the more general+--   'strut'.+strutR2 :: (Backend b R2, Monoid' m) => R2 -> QDiagram b R2 m+strutR2 v = phantom seg+  where+    seg = FLinear (origin .+^ 0.5 *^ v) (origin .+^ (-0.5) *^ v)+ -- | @strutX d@ is an empty diagram with width @d@, height 0, and a --   centered local origin.  Note that @strutX (-w)@ behaves the same as --   @strutX w@. strutX :: (Backend b R2, Monoid' m) => Double -> QDiagram b R2 m-strutX d = strut (r2 (d,0))+strutX d = strut (d & 0)  -- | @strutY d@ is an empty diagram with height @d@, width 0, and a---   centered local origin. Note that @strutY (-w)@ behaves the same as---   @strutY w@.+--   centered local origin. Note that @strutY (-h)@ behaves the same as+--   @strutY h@. strutY :: (Backend b R2, Monoid' m) => Double -> QDiagram b R2 m-strutY d = strut (r2 (0,d))+strutY d = strut (0 & d)  -- | @padX s@ \"pads\" a diagram in the x-direction, expanding its --   envelope horizontally by a factor of @s@ (factors between 0 and 1@@ -162,6 +185,42 @@      => Double -> QDiagram b R2 m -> QDiagram b R2 m padY s d = withEnvelope (d # scaleY s) d +-- | @extrudeLeft s@ \"extrudes\" a diagram in the negative x-direction,+--   offsetting its envelope by the provided distance. When @ s < 0 @,+--   the envelope is inset instead.+--+--   See the documentation for 'extrudeEnvelope' for more information.+extrudeLeft s+  | s >= 0    = extrudeEnvelope $ unitX ^* negate s+  | otherwise = intrudeEnvelope $ unitX ^* negate s++-- | @extrudeRight s@ \"extrudes\" a diagram in the positive x-direction,+--   offsetting its envelope by the provided distance. When @ s < 0 @,+--   the envelope is inset instead.+--+--   See the documentation for 'extrudeEnvelope' for more information.+extrudeRight s+  | s >= 0    = extrudeEnvelope $ unitX ^* s+  | otherwise = intrudeEnvelope $ unitX ^* s++-- | @extrudeBottom s@ \"extrudes\" a diagram in the negative y-direction,+--   offsetting its envelope by the provided distance. When @ s < 0 @,+--   the envelope is inset instead.+--+--   See the documentation for 'extrudeEnvelope' for more information.+extrudeBottom s+  | s >= 0    = extrudeEnvelope $ unitY ^* negate s+  | otherwise = intrudeEnvelope $ unitY ^* negate s++-- | @extrudeTop s@ \"extrudes\" a diagram in the positive y-direction,+--   offsetting its envelope by the provided distance. When @ s < 0 @,+--   the envelope is inset instead.+--+--   See the documentation for 'extrudeEnvelope' for more information.+extrudeTop s+  | s >= 0    = extrudeEnvelope $ unitY ^* s+  | otherwise = intrudeEnvelope $ unitY ^* s+ -- | @view p v@ sets the envelope of a diagram to a rectangle whose --   lower-left corner is at @p@ and whose upper-right corner is at @p --   .+^ v@.  Useful for selecting the rectangular portion of a@@ -169,4 +228,17 @@ --   if you don't want to see the entire diagram. view :: ( Backend b R2, Monoid' m )      => P2 -> R2 -> QDiagram b R2 m -> QDiagram b R2 m-view p (unr2 -> (w,h)) = withEnvelope (rect w h # alignBL # moveTo p :: D R2)+view p (coords -> w :& h) = withEnvelope (rect w h # alignBL # moveTo p :: D R2)++-- | Construct a bounding rectangle for an enveloped object, that is,+--   the smallest axis-aligned rectangle which encloses the object.+boundingRect :: ( Enveloped p, Transformable p, PathLike p, V p ~ R2+                , Enveloped a, V a ~ R2+                )+             => a -> p+boundingRect = (`boxFit` rect 1 1) . boundingBox++-- | \"Set the background color\" of a diagram.  That is, place a+--   diagram atop a bounding rectangle of the given color.+bg :: (Renderable (Path R2) b) => Colour Double -> Diagram b R2 -> Diagram b R2+bg c d = d <> boundingRect d # lw 0 # fc c

@@ -23,7 +23,7 @@     , ellipseXY     ) where -import Graphics.Rendering.Diagrams+import Diagrams.Core  import Diagrams.TwoD.Types import Diagrams.TwoD.Transform

@@ -19,7 +19,7 @@     , image     ) where -import Graphics.Rendering.Diagrams+import Diagrams.Core  import Diagrams.Path import Diagrams.TwoD.Types@@ -59,6 +59,7 @@ image :: (Renderable Image b) => FilePath -> Double -> Double -> Diagram b R2 image file w h = mkQD (Prim (Image file (Dims w h) mempty))                       (getEnvelope r)+                      (getTrace r)                       mempty                       (Query $ \p -> Any (isInsideEvenOdd p r))   where r :: Path R2

@@ -19,8 +19,8 @@        , showLabels        ) where -import Graphics.Rendering.Diagrams-import Graphics.Rendering.Diagrams.Names+import Diagrams.Core+import Diagrams.Core.Names  import Diagrams.Path @@ -50,7 +50,7 @@ -- | Mark the origin of a diagram by placing a red dot 1/50th its size. showOrigin :: (Renderable (Path R2) b, Backend b R2, Monoid' m)            => QDiagram b R2 m -> QDiagram b R2 m-showOrigin = showOrigin' def +showOrigin = showOrigin' def  -- | Mark the origin of a diagram, with control over colour and scale -- of marker dot.@@ -79,7 +79,7 @@  showLabels :: (Renderable Text b, Backend b R2)            => QDiagram b R2 m -> QDiagram b R2 Any-showLabels d = +showLabels d =              ( mconcat              . map (\(n,p) -> text (show n) # translate (p .-. origin))              . concatMap (\(n,ps) -> zip (repeat n) ps)@@ -89,15 +89,4 @@              ) <>              fmap (const (Any False)) d   where-    NameMap m = names d---- XXX finish:----   Draw the separating lines between diagrams composed with 'beside'---   (or any combinators implemented in terms of 'beside', like '(|||)'---   or '(===)').---- showSep :: QDiagram b R2 m -> QDiagram b R2 m--- showSep d = s <> d---   where ... = case d of---                 QDiagram (Branch u ds children) -> ...+    SubMap m = subMap d

@@ -15,7 +15,8 @@ -- -- Paths in two dimensions are special since we may stroke them to -- create a 2D diagram, and (eventually) perform operations such as--- intersection and union.+-- intersection and union.  They also have a trace, whereas paths in+-- higher dimensions do not. -- ----------------------------------------------------------------------------- @@ -39,25 +40,44 @@        , Clip(..), clipBy        ) where -import Graphics.Rendering.Diagrams+import           Control.Applicative (liftA2)+import qualified Data.Foldable as F+import           Data.Semigroup+import           Data.Typeable -import Diagrams.Util (tau)+import           Data.AffineSpace+import           Data.Default+import           Data.VectorSpace -import Diagrams.Segment-import Diagrams.Path-import Diagrams.TwoD.Types-import Diagrams.Solve+import           Diagrams.Core -import Data.AffineSpace-import Data.VectorSpace+import           Diagrams.Coordinates+import           Diagrams.Path+import           Diagrams.Segment+import           Diagrams.Solve+import           Diagrams.TwoD.Segment+import           Diagrams.TwoD.Types+import           Diagrams.Util (tau) -import Data.Semigroup hiding ((<>))-import Control.Applicative (liftA2)-import qualified Data.Foldable as F-import Data.Default+------------------------------------------------------------+--  Trail and path traces  ---------------------------------+------------------------------------------------------------ -import Data.Typeable+-- Only 2D trails and paths have a trace. +-- XXX can the efficiency of this be improved?  See the comment in+-- Diagrams.Path on the Enveloped instance for Trail.+instance Traced (Trail R2) where+  getTrace t = case addClosingSegment t of+    (Trail segs _) ->+      foldr (\seg bds -> moveOriginBy (negateV . segOffset $ seg) bds <> getTrace seg)+            mempty+            segs++instance Traced (Path R2) where+  getTrace = F.foldMap trailTrace . pathTrails+    where trailTrace (p, t) = moveOriginTo ((-1) *. p) (getTrace t)+ ------------------------------------------------------------ --  Constructing path-based diagrams  ---------------------- ------------------------------------------------------------@@ -90,8 +110,10 @@ stroke' opts p   = mkQD (Prim p)          (getEnvelope p)+         (getTrace p)          (fromNames . concat $-           zipWith zip (vertexNames opts) (pathVertices p))+           zipWith zip (vertexNames opts) ((map . map) subPoint (pathVertices p))+         )          (Query $ Any . flip (runFillRule (queryFillRule opts)) p)  -- | A record of options that control how a path is stroked.@@ -165,6 +187,7 @@                          --   direction crosses the path an odd number                          --   of times. See                          --   <http://en.wikipedia.org/wiki/Even-odd_rule>.+    deriving (Eq)  runFillRule :: FillRule -> P2 -> Path R2 -> Bool runFillRule Winding = isInsideWinding@@ -184,7 +207,7 @@ fillRule = applyAttr . FillRuleA . Last  cross :: R2 -> R2 -> Double-cross (unr2 -> (x,y)) (unr2 -> (x',y')) = x * y' - y * x'+cross (coords -> x :& y) (coords -> x' :& y') = x * y' - y * x'  -- XXX link to more info on this 

@@ -7,7 +7,7 @@  ----------------------------------------------------------------------------- -- |--- Module      :  Diagrams.TwoD.Polygon+-- Module      :  Diagrams.TwoD.Polygons -- Copyright   :  (c) 2011 diagrams-lib team (see LICENSE) -- License     :  BSD-style (see LICENSE) -- Maintainer  :  diagrams-discuss@googlegroups.com@@ -39,6 +39,7 @@         , star          -- ** Function graphs+        -- $graphs         , GraphPart(..)         , orbits, mkGraph @@ -58,7 +59,7 @@ import Data.VectorSpace  (magnitude, normalized, project, (<.>), (^*)) import Data.Default -import Graphics.Rendering.Diagrams+import Diagrams.Core  import Diagrams.TwoD.Types import Diagrams.TwoD.Transform@@ -224,11 +225,16 @@ -- Function graphs ------------------------------------------------------------ --- | Pieces of a function graph can either be cycles or "hairs".+-- $graphs+-- These functions are used to implement 'star', but are exported on+-- the offchance that someone else finds them useful.++-- | Pieces of a function graph can either be cycles or \"hairs\". data GraphPart a = Cycle [a]                  | Hair  [a]   deriving (Show, Functor) +-- | @orbits f n@ computes the graph of @f@ on the integers mod @n@. orbits :: (Int -> Int) -> Int -> [GraphPart Int] orbits f n = runST genOrbits   where

@@ -0,0 +1,102 @@+{-# LANGUAGE FlexibleContexts+           , FlexibleInstances+           , UndecidableInstances+  #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Diagrams.TwoD.Segment+-- Copyright   :  (c) 2012 diagrams-lib team (see LICENSE)+-- License     :  BSD-style (see LICENSE)+-- Maintainer  :  diagrams-discuss@googlegroups.com+--+-- Segments in two dimensions are special since we may meaningfully+-- compute their point of intersection with a ray.+--+-----------------------------------------------------------------------------++module Diagrams.TwoD.Segment where++import Control.Applicative (liftA2)++import Data.AffineSpace+import Data.Monoid.PosInf hiding (minimum)+import Data.VectorSpace++import Diagrams.Core+import Diagrams.Core.Trace++import Diagrams.Segment+import Diagrams.Solve+import Diagrams.TwoD.Transform+import Diagrams.TwoD.Types+import Diagrams.TwoD.Vector+import Diagrams.Util++instance Traced (Segment R2) where+  getTrace = getTrace . mkFixedSeg origin++instance Traced (FixedSegment R2) where++{- Given lines defined by p0 + t0 * v0 and p1 + t1 * v1, their point of+   intersection in 2D is given by++     t_i = (v_(1-i)^ . (p1 - p0)) / (v1^ . v0)++   where v^ denotes the perpendicular to v, i.e. v rotated by+   -tau/4.++   This can be derived by starting with the parametric equation++     p0 + v0 t0 = p1 + v1 t1++   and rearranging to get the matrix equation++     [v0 -v1] [ t0 ]  =  (p1 - p0)+              [ t1 ]++   Working out the product of the inverse of [v0 -v1] with (p1 - p0)+   results in the above formulas for t_i.+-}++  getTrace (FLinear p0 p0') = mkTrace $ \p1 v1 ->+    let+      v0     = p0' .-. p0+      det    = perp v1 <.> v0+      perp v = rotateBy (-1/4) v+      p      = p1 .-. p0+      t0     = (perp v1 <.> p) / det+      t1     = (perp v0 <.> p) / det+    in+      if det == 0 || t0 < 0 || t0 > 1+        then PosInfty+        else Finite t1++{- To do intersection of a line with a cubic Bezier, we first rotate+   and scale everything so that the line has parameters (origin, unitX);+   then we find the intersection(s) of the Bezier with the x-axis.++   XXX could we speed this up by first checking whether all the+   control point y-coordinates lie on the same side of the x-axis (if so,+   there can't possibly be any intersections)?  Need to set up some+   benchmarks.+-}++  getTrace bez@(FCubic {}) = mkTrace $ \p1 v1 ->+    let+      bez'@(FCubic x1 c1 c2 x2) =+        bez # moveOriginTo p1+            # rotateBy (negate (direction v1))+            # scale (1/magnitude v1)+      [y0,y1,y2,y3] = map (snd . unp2) [x1,c1,c2,x2]+      a  = -y0 + 3*y1 - 3*y2 + y3+      b  = 3*y0 - 6*y1 + 3*y2+      c  = -3*y0 + 3*y1+      d  = y0+      ts = filter (liftA2 (&&) (>= 0) (<= 1)) (cubForm a b c d)+      xs = map (fst . unp2 . fAtParam bez') ts+    in+      case xs of+        [] -> PosInfty+        _  -> Finite (minimum xs)+

@@ -44,14 +44,15 @@        , roundedRect'        ) where -import Graphics.Rendering.Diagrams+import Diagrams.Core -import Diagrams.Segment+import Diagrams.Coordinates import Diagrams.Path+import Diagrams.Segment import Diagrams.TwoD.Arc-import Diagrams.TwoD.Types-import Diagrams.TwoD.Transform import Diagrams.TwoD.Polygons+import Diagrams.TwoD.Transform+import Diagrams.TwoD.Types  import Diagrams.Util @@ -60,19 +61,19 @@  -- | Create a centered horizontal (L-R) line of the given length. hrule :: (PathLike p, V p ~ R2) => Double -> p-hrule d = pathLike (p2 (-d/2,0)) False [Linear (r2 (d,0))]+hrule d = pathLike (p2 (-d/2,0)) False [Linear (d & 0)]  -- | Create a centered vertical (T-B) line of the given length. vrule :: (PathLike p, V p ~ R2) => Double -> p-vrule d = pathLike (p2 (0,d/2)) False [Linear (r2 (0,-d))]+vrule d = pathLike (p2 (0,d/2)) False [Linear (0 & (-d))] --- | A sqaure with its center at the origin and sides of length 1,+-- | A square with its center at the origin and sides of length 1, --   oriented parallel to the axes. unitSquare :: (PathLike p, V p ~ R2) => p unitSquare = polygon with { polyType   = PolyRegular 4 (sqrt 2 / 2)                           , polyOrient = OrientH } --- | A sqaure with its center at the origin and sides of the given+-- | A square 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@@ -204,7 +205,7 @@         mkCorner k r | r == 0    = mempty                      | r < 0     = doArc 3 2                      | otherwise = doArc 0 1-                     where doArc d d' = arc ((k+d)/4) ((k+d')/4:: CircleFrac) # scale (abs r)+                     where doArc d d' = arc' r ((k+d)/4) ((k+d')/4:: CircleFrac)  data RoundedRectOpts = RoundedRectOpts { radiusTL :: Double                                        , radiusTR :: Double

@@ -15,15 +15,20 @@        (          -- * Size and extent of diagrams in R2          -- ** Computing sizes-         width, height, size2D+         width, height, size2D, sizeSpec2D        , extentX, extentY, center2D           -- ** Specifying sizes        , SizeSpec2D(..)        , mkSizeSpec++       , requiredScaleT, requiredScale++         -- ** Changing the size of things+       , sized, sizedAs        ) where -import Graphics.Rendering.Diagrams+import Diagrams.Core import Diagrams.TwoD.Types import Diagrams.TwoD.Vector @@ -46,6 +51,10 @@ size2D :: (Enveloped a, V a ~ R2) => a -> (Double, Double) size2D = width &&& height +-- | Compute the size of an enveloped object as a 'SizeSpec2D' value.+sizeSpec2D :: (Enveloped a, V a ~ R2) => a -> SizeSpec2D+sizeSpec2D = uncurry Dims . size2D+ -- | Compute the absolute  x-coordinate range of an enveloped object in --   R2, in  the form (lo,hi).   Return @Nothing@ for objects  with an --   empty envelope.@@ -91,3 +100,44 @@ mkSizeSpec (Just w) Nothing  = Width w mkSizeSpec Nothing  (Just h) = Height h mkSizeSpec (Just w) (Just h) = Dims w h++-- | @requiredScaleT spec sz@ returns a transformation (a uniform scale)+--   which can be applied to something of size @sz@ to make it fit the+--   requested size @spec@, without changing the aspect ratio.+requiredScaleT :: SizeSpec2D -> (Double, Double) -> Transformation R2+requiredScaleT spec size = scaling (requiredScale spec size)++-- | @requiredScale spec sz@ returns a scaling factor necessary to+--   make something of size @sz@ fit the requested size @spec@,+--   without changing the aspect ratio.  Hence an explicit+--   specification of both dimensions may not be honored if the aspect+--   ratios do not match; in that case the scaling will be as large as+--   possible so that the object still fits within the requested size.+requiredScale :: SizeSpec2D -> (Double, Double) -> Double+requiredScale Absolute _    = 1+requiredScale (Width wSpec) (w,_)+  | wSpec == 0 || w == 0 = 1+  | otherwise            = wSpec / w+requiredScale (Height hSpec) (_,h)+  | hSpec == 0 || h == 0 = 1+  | otherwise            = hSpec / h+requiredScale (Dims wSpec hSpec) (w,h) = s+  where xscale  = wSpec / w+        yscale  = hSpec / h+        s'      = min xscale yscale+        s | isInfinite s' = 1+          | otherwise     = s'++-- | Uniformly scale any enveloped object so that it fits within the+--   given size.+sized :: (Transformable a, Enveloped a, V a ~ R2)+      => SizeSpec2D -> a -> a+sized spec a = transform (requiredScaleT spec (size2D a)) a++-- | Uniformly scale an enveloped object so that it \"has the same+--   size as\" (fits within the width and height of) some other+--   object.+sizedAs :: ( Transformable a, Enveloped a, V a ~ R2+           , Enveloped b, V b ~ R2)+        => b -> a -> a+sizedAs other = sized (sizeSpec2D other)

@@ -31,14 +31,16 @@   , FontWeight(..), FontWeightA, getFontWeight, fontWeight, bold   ) where -import Graphics.Rendering.Diagrams-+import Diagrams.Attributes+import Diagrams.Core import Diagrams.TwoD.Types  import Data.AffineSpace ((.-.))  import Data.Semigroup +import Data.Colour+ import Data.Typeable  ------------------------------------------------------------@@ -66,23 +68,25 @@ data TextAlignment = BaselineText | BoxAlignedText Double Double  mkText :: Renderable Text b => TextAlignment -> String -> Diagram b R2-mkText a t = mkQD (Prim (Text mempty a t))+mkText a t = recommendFillColor black+           $ mkQD (Prim (Text mempty a t))                        mempty                        mempty                        mempty+                       mempty  -- | Create a primitive text diagram from the given string, with center---   alignment, equivalent to @alignedText 0.5 0.5@.---    +--   alignment, equivalent to @'alignedText' 0.5 0.5@.+-- --   Note that it /takes up no space/, as text size information is not --   available. text :: Renderable Text b => String -> Diagram b R2 text = alignedText 0.5 0.5  -- | Create a primitive text diagram from the given string, origin at---   the top left corner of the text's bounding box, equivalent to ---   @alignedText 0.5 0.5@.---    +--   the top left corner of the text's bounding box, equivalent to+--   @'alignedText' 0 1@.+-- --   Note that it /takes up no space/. topLeftText :: Renderable Text b => String -> Diagram b R2 topLeftText = alignedText 0 1@@ -91,7 +95,7 @@ --   origin set to a point interpolated within the bounding box.  The --   first parameter varies from 0 (left) to 1 (right), and the second --   parameter from 0 (bottom) to 1 (top).---   +-- --   The height of this box is determined by the font's potential ascent --   and descent, rather than the height of the particular string. --@@ -103,7 +107,7 @@ --   origin set to be on the baseline, at the beginning (although not --   bounding).  This is the reference point of showText in the Cairo --   graphics library.---   +-- --   Note that it /takes up no space/. baselineText :: Renderable Text b => String -> Diagram b R2 baselineText = mkText BaselineText@@ -118,7 +122,7 @@ -- | The @Font@ attribute specifies the name of a font family.  Inner --   @Font@ attributes override outer ones. newtype Font = Font (Last String)-  deriving (Typeable, Semigroup)+  deriving (Typeable, Semigroup, Eq) instance AttributeClass Font  -- | Extract the font family name from a @Font@ attribute.@@ -136,7 +140,7 @@ --   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)+  deriving (Typeable, Semigroup, Eq) instance AttributeClass FontSize  -- | Extract the size from a @FontSize@ attribute.@@ -155,12 +159,13 @@ data FontSlant = FontSlantNormal                | FontSlantItalic                | FontSlantOblique+    deriving (Eq)  -- | 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)+  deriving (Typeable, Semigroup, Eq) instance AttributeClass FontSlantA  -- | Extract the font slant from a 'FontSlantA' attribute.@@ -186,12 +191,13 @@  data FontWeight = FontWeightNormal                 | FontWeightBold+    deriving (Eq)  -- | 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)+  deriving (Typeable, Semigroup, Eq) instance AttributeClass FontWeightA  -- | Extract the font weight from a 'FontWeightA' attribute.

@@ -1,4 +1,5 @@ {-# LANGUAGE FlexibleContexts+           , FlexibleInstances            , TypeFamilies            , ViewPatterns   #-}@@ -44,16 +45,20 @@        , shearingX, shearX        , shearingY, shearY +         -- * Scale invariance+       , ScaleInv(..), scaleInv+        ) where -import Graphics.Rendering.Diagrams+import Diagrams.Core  import Control.Newtype (over) -import Diagrams.TwoD.Types+import Diagrams.Coordinates+import Diagrams.Transform import Diagrams.TwoD.Size   (width, height)+import Diagrams.TwoD.Types import Diagrams.TwoD.Vector (direction)-import Diagrams.Transform  import Data.Semigroup @@ -63,21 +68,23 @@  -- Rotation ------------------------------------------------ --- | Create a transformation which performs a rotation by the given---   angle.  See also 'rotate'.+-- | Create a transformation which performs a rotation about the local+--   origin by the given angle.  See also 'rotate'. rotation :: Angle a => a -> T2 rotation ang = fromLinear r (linv r)   where     r            = rot theta <-> rot (-theta)     Rad theta    = convertAngle ang-    rot th (unr2 -> (x,y)) = r2 (cos th * x - sin th * y, sin th * x + cos th * y)+    rot th (coords -> x :& y) = (cos th * x - sin th * y) & (sin th * x + cos th * y) --- | Rotate by the given angle. Positive angles correspond to---   counterclockwise rotation, negative to clockwise. The angle can---   be expressed using any type which is an instance of 'Angle'.  For---   example, @rotate (1\/4 :: 'CircleFrac')@, @rotate (tau\/4 :: 'Rad')@, and---   @rotate (90 :: 'Deg')@ all represent the same transformation, namely,---   a counterclockwise rotation by a right angle.+-- | Rotate about the local origin by the given angle. Positive angles+--   correspond to counterclockwise rotation, negative to+--   clockwise. The angle can be expressed using any type which is an+--   instance of 'Angle'.  For example, @rotate (1\/4 ::+--   'CircleFrac')@, @rotate (tau\/4 :: 'Rad')@, and @rotate (90 ::+--   'Deg')@ all represent the same transformation, namely, a+--   counterclockwise rotation by a right angle.  To rotate about some+--   point other than the local origin, see 'rotateAbout'. -- --   Note that writing @rotate (1\/4)@, with no type annotation, will --   yield an error since GHC cannot figure out which sort of angle@@ -157,7 +164,7 @@ -- | Construct a transformation which translates by the given distance --   in the x (horizontal) direction. translationX :: Double -> T2-translationX x = translation (r2 (x,0))+translationX x = translation (x & 0)  -- | Translate a diagram by the given distance in the x (horizontal) --   direction.@@ -167,7 +174,7 @@ -- | Construct a transformation which translates by the given distance --   in the y (vertical) direction. translationY :: Double -> T2-translationY y = translation (r2 (0,y))+translationY y = translation (0 & y)  -- | Translate a diagram by the given distance in the y (vertical) --   direction.@@ -238,3 +245,66 @@ shearY :: (Transformable t, V t ~ R2) => Double -> t -> t shearY = transform . shearingY ++-- Scale invariance ----------------------------------------++-- XXX what about freezing?  Doesn't interact with ScaleInv the way it+-- ought.++-- | The @ScaleInv@ wrapper creates two-dimensional /scale-invariant/+--   objects.  Intuitively, a scale-invariant object is affected by+--   transformations like translations and rotations, but not by scales.+--+--   However, this is problematic when it comes to /non-uniform/+--   scales (/e.g./ @scaleX 2 . scaleY 3@) since they can introduce a+--   perceived rotational component.  The prototypical example is an+--   arrowhead on the end of a path, which should be scale-invariant.+--   However, applying a non-uniform scale to the path but not the+--   arrowhead would leave the arrowhead pointing in the wrong+--   direction.+--+--   Moreover, for objects whose local origin is not at the local+--   origin of the parent diagram, any scale can result in a+--   translational component as well.+--+--   The solution is to also store a point (indicating the location,+--   /i.e./ the local origin) and a unit vector (indicating the+--   /direction/) along with a scale-invariant object.  A+--   transformation to be applied is decomposed into rotational and+--   translational components as follows:+--+--   * The transformation is applied to the direction vector, and the+--   difference in angle between the original direction vector and its+--   image under the transformation determines the rotational+--   component.  The rotation is applied with respect to the stored+--   location, rather than the global origin.+--+--   * The vector from the location to the image of the location under+--   the transformation determines the translational component.++data ScaleInv t =+  ScaleInv+  { unScaleInv :: t+  , scaleInvDir :: R2+  , scaleInvLoc :: P2+  }+  deriving (Show)++-- | Create a scale-invariant object pointing in the given direction.+scaleInv :: t -> R2 -> ScaleInv t+scaleInv t d = ScaleInv t d origin++type instance V (ScaleInv t) = R2++instance (V t ~ R2, HasOrigin t) => HasOrigin (ScaleInv t) where+  moveOriginTo p (ScaleInv t v l) = ScaleInv (moveOriginTo p t) v (moveOriginTo p l)++instance (V t ~ R2, Transformable t) => Transformable (ScaleInv t) where+  transform tr (ScaleInv t v l) = ScaleInv (trans . rot $ t) (rot v) l'+    where+      angle :: Rad+      angle = direction (transform tr v) - direction v+      rot :: ( Transformable t,  (V t ~ R2) ) => t -> t+      rot = rotateAbout l angle+      l'  = transform tr l+      trans = translate (l' .-. l)

@@ -1,11 +1,12 @@-{-# LANGUAGE TypeFamilies-           , TypeSynonymInstances-           , FlexibleInstances-           , GeneralizedNewtypeDeriving-           , MultiParamTypeClasses-           , ViewPatterns-           , DeriveDataTypeable-  #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE DeriveDataTypeable #-}+ {-# OPTIONS_GHC -fno-warn-orphans #-} ----------------------------------------------------------------------------- -- |@@ -30,8 +31,9 @@        , fullCircle, convertAngle        ) where -import Graphics.Rendering.Diagrams+import Diagrams.Coordinates import Diagrams.Util (tau)+import Diagrams.Core  import Control.Newtype @@ -47,27 +49,55 @@ -- | The two-dimensional Euclidean vector space R^2.  This type is --   intentionally abstract. -----   * To construct a vector, use 'r2'.+--   * To construct a vector, use 'r2', or '&' (from "Diagrams.Coordinates"): --+-- > r2 (3,4) :: R2+-- > 3 & 4    :: R2+-- --   * To construct the vector from the origin to a point @p@, use---     @p .-. origin@.+--     @p 'Data.AffineSpace..-.' 'origin'@. -- --   * To convert a vector @v@ into the point obtained by following---     @v@ from the origin, use @'origin' '.+^' v@.+--     @v@ from the origin, use @'origin' 'Data.AffineSpace..+^' v@. -----   * To convert a vector back into a pair of components, use 'unv2'.+--   * To convert a vector back into a pair of components, use 'unv2'+--     or 'coords' (from "Diagrams.Coordinates").  These are typically+--     used in conjunction with the @ViewPatterns@ extension:+--+-- > foo (unr2 -> (x,y)) = ...+-- > foo (coords -> x :& y) = ...+ newtype R2 = R2 { unR2 :: (Double, Double) }-  deriving (AdditiveGroup, Eq, Ord, Show, Read, Typeable, Num, Fractional)+  deriving (AdditiveGroup, Eq, Ord, Typeable, Num, Fractional) +instance Show R2 where+  showsPrec p (R2 (x,y)) = showParen (p >= 7) $+    showCoord x . showString " & " . showCoord y+   where+    showCoord x | x < 0     = showParen True (shows x)+                | otherwise = shows x++instance Read R2 where+  readsPrec d r = readParen (d > app_prec)+                  (\r -> [ (R2 (x,y), r''')+                         | (x,r')    <- readsPrec (amp_prec + 1) r+                         , ("&",r'') <- lex r'+                         , (y,r''')  <- readsPrec (amp_prec + 1) r''+                         ])+                  r+    where+      app_prec = 10+      amp_prec = 7+ instance Newtype R2 (Double, Double) where   pack   = R2   unpack = unR2 --- | Construct a 2D vector from a pair of components.+-- | Construct a 2D vector from a pair of components.  See also '&'. r2 :: (Double, Double) -> R2 r2 = pack --- | Convert a 2D vector back into a pair of components.+-- | Convert a 2D vector back into a pair of components.  See also 'coords'. unr2 :: R2 -> (Double, Double) unr2 = unpack @@ -86,23 +116,40 @@ instance InnerSpace R2 where   (unR2 -> vec1) <.> (unR2 -> vec2) = vec1 <.> vec2 +instance Coordinates R2 where+  type FinalCoord R2     = Double+  type PrevDim R2        = Double+  type Decomposition R2  = Double :& Double++  x & y                  = r2 (x,y)+  coords (unR2 -> (x,y)) = x :& y+ -- | Points in R^2.  This type is intentionally abstract. -----   * To construct a point, use 'p2'.+--   * To construct a point, use 'p2', or '&' (see+--     "Diagrams.Coordinates"): -----   * To construct a point from a vector @v@, use @origin .+^ v@.+-- > p2 (3,4)  :: P2+-- > 3 & 4     :: P2 --+--   * To construct a point from a vector @v@, use @'origin' 'Data.AffineSpace..+^' v@.+-- --   * To convert a point @p@ into the vector from the origin to @p@,---   use @p '.-.' 'origin'@.+--   use @p 'Data.AffineSpace..-.' 'origin'@. -----   * To convert a point back into a pair of coordinates, use 'unp2'.+--   * To convert a point back into a pair of coordinates, use 'unp2',+--     or 'coords' (from "Diagrams.Coordinates").  It's common to use+--     these in conjunction with the @ViewPatterns@ extension:+--+-- > foo (unp2 -> (x,y)) = ...+-- > foo (coords -> x :& y) = ... type P2 = Point R2 --- | Construct a 2D point from a pair of coordinates.+-- | Construct a 2D point from a pair of coordinates.  See also '&'. p2 :: (Double, Double) -> P2 p2 = pack . pack --- | Convert a 2D point back into a pair of coordinates.+-- | Convert a 2D point back into a pair of coordinates.  See also 'coords'. unp2 :: P2 -> (Double, Double) unp2 = unpack . unpack @@ -116,7 +163,7 @@ -- Angles  -- | Newtype wrapper used to represent angles as fractions of a---   circle.  For example, 1/3 = tau/3 radians = 120 degrees.+--   circle.  For example, 1\/3 = tau\/3 radians = 120 degrees. newtype CircleFrac = CircleFrac { getCircleFrac :: Double }   deriving (Read, Show, Eq, Ord, Enum, Floating, Fractional, Num, Real, RealFloat, RealFrac) 

@@ -20,33 +20,34 @@        , direction, fromDirection,  e        ) where +import Diagrams.Coordinates import Diagrams.TwoD.Types  -- | The unit vector in the positive X direction. unitX :: R2-unitX = r2 (1,0)+unitX = 1 & 0  -- | The unit vector in the positive Y direction. unitY :: R2-unitY = r2 (0,1)+unitY = 0 & 1  -- | The unit vector in the negative X direction. unit_X :: R2-unit_X = r2 (-1,0)+unit_X = (-1) & 0  -- | The unit vector in the negative Y direction. unit_Y :: R2-unit_Y = r2 (0,-1)+unit_Y = 0 & (-1)  -- | Compute the direction of a vector, measured counterclockwise from --   the positive x-axis as a fraction of a full turn.  The zero --   vector is arbitrarily assigned the direction 0. direction :: Angle a => R2 -> a-direction (unr2 -> (x,y)) = convertAngle . Rad $ atan2 y x+direction (coords -> x :& y) = convertAngle . Rad $ atan2 y x  -- | Convert an angle into a unit vector pointing in that direction. fromDirection :: Angle a => a -> R2-fromDirection a = r2 (cos a', sin a')+fromDirection a = cos a' & sin a'   where Rad a' = convertAngle a  -- | A convenient synonym for 'fromDirection'.