diagrams-lib 0.7.1.1 → 1.5.1

raw patch · 182 files changed

Files

CHANGELOG.md +1837/−0
CHANGES.markdown +0/−405
LICENSE +21/−1
README.markdown +1/−1
Setup.hs +1/−28
diagrams-lib.cabal +141/−48
diagrams/besideEx.svg +0/−4
diagrams/closeLineEx.svg +0/−4
diagrams/cubicOffsetExample.svg +0/−4
diagrams/cubicSplineEx.svg +0/−4
diagrams/decagonEx.svg +0/−4
diagrams/diagramA.svg +0/−4
diagrams/diagramNeg.svg +0/−4
diagrams/diagramPos.svg +0/−4
diagrams/diagramZero.svg +0/−4
diagrams/dodecagonEx.svg +0/−4
diagrams/glueLineEx.svg +0/−4
diagrams/hendecagonEx.svg +0/−4
diagrams/hexagonEx.svg +0/−4
diagrams/hruleEx.svg +0/−4
diagrams/lineFromOffsetsEx.svg +0/−4
diagrams/lineFromVerticesEx.svg +0/−4
diagrams/nonagonEx.svg +0/−4
diagrams/octagonEx.svg +0/−4
diagrams/pentagonEx.svg +0/−4
diagrams/rectEx.svg +0/−4
diagrams/roundedRectEx.svg +0/−4
diagrams/septagonEx.svg +0/−4
diagrams/squareEx.svg +0/−4
diagrams/src_Diagrams_Combinators_alignedEx1.svg +1/−0
diagrams/src_Diagrams_Combinators_alignedEx2.svg +1/−0
diagrams/src_Diagrams_Combinators_appendsEx.svg +1/−0
diagrams/src_Diagrams_Combinators_besideEx.svg +1/−0
diagrams/src_Diagrams_Combinators_positionEx.svg +1/−0
diagrams/src_Diagrams_Combinators_strutEx.svg +1/−0
diagrams/src_Diagrams_Combinators_withEnvelopeEx.svg +1/−0
diagrams/src_Diagrams_CubicSpline_Boehm_bsplineEx.svg +1/−0
diagrams/src_Diagrams_CubicSpline_cubicSplineEx.svg +1/−0
diagrams/src_Diagrams_TrailLike_explodeTrailEx.svg +1/−0
diagrams/src_Diagrams_TrailLike_fromOffsetsEx.svg +1/−0
diagrams/src_Diagrams_TrailLike_fromSegmentsEx.svg +1/−0
diagrams/src_Diagrams_TrailLike_fromVerticesEx.svg +1/−0
diagrams/src_Diagrams_TrailLike_twiddleEx.svg +1/−0
diagrams/src_Diagrams_Trail_closeLineEx.svg +1/−0
diagrams/src_Diagrams_Trail_glueLineEx.svg +1/−0
diagrams/src_Diagrams_Trail_lineFromOffsetsEx.svg +1/−0
diagrams/src_Diagrams_Trail_lineFromVerticesEx.svg +1/−0
diagrams/src_Diagrams_Trail_trailOffsetEx.svg +1/−0
diagrams/src_Diagrams_TwoD_Arc_annularWedgeEx.svg +1/−0
diagrams/src_Diagrams_TwoD_Arc_arc'Ex.svg +1/−0
diagrams/src_Diagrams_TwoD_Arc_arcBetweenEx.svg +1/−0
diagrams/src_Diagrams_TwoD_Arc_wedgeEx.svg +1/−0
diagrams/src_Diagrams_TwoD_Arrow_example1.svg +1/−0
diagrams/src_Diagrams_TwoD_Arrow_example2.svg +1/−0
diagrams/src_Diagrams_TwoD_Arrowheads_blockEx.svg +1/−0
diagrams/src_Diagrams_TwoD_Arrowheads_dart'Ex.svg +1/−0
diagrams/src_Diagrams_TwoD_Arrowheads_dartEx.svg +1/−0
diagrams/src_Diagrams_TwoD_Arrowheads_halfDart'Ex.svg +1/−0
diagrams/src_Diagrams_TwoD_Arrowheads_halfDartEx.svg +1/−0
diagrams/src_Diagrams_TwoD_Arrowheads_quillEx.svg +1/−0
diagrams/src_Diagrams_TwoD_Arrowheads_spike'Ex.svg +1/−0
diagrams/src_Diagrams_TwoD_Arrowheads_spikeEx.svg +1/−0
diagrams/src_Diagrams_TwoD_Arrowheads_thorn'Ex.svg +1/−0
diagrams/src_Diagrams_TwoD_Arrowheads_thornEx.svg +1/−0
diagrams/src_Diagrams_TwoD_Arrowheads_tri'Ex.svg +1/−0
diagrams/src_Diagrams_TwoD_Arrowheads_tri25Ex.svg +1/−0
diagrams/src_Diagrams_TwoD_Arrowheads_triEx.svg +1/−0
diagrams/src_Diagrams_TwoD_Curvature_diagramA.svg +1/−0
diagrams/src_Diagrams_TwoD_Curvature_diagramNeg.svg +1/−0
diagrams/src_Diagrams_TwoD_Curvature_diagramPos.svg +1/−0
diagrams/src_Diagrams_TwoD_Curvature_diagramZero.svg +1/−0
diagrams/src_Diagrams_TwoD_Offset_cubicOffsetExample.svg +1/−0
diagrams/src_Diagrams_TwoD_Offset_expandLoopExample.svg +1/−0
diagrams/src_Diagrams_TwoD_Offset_expandTrailExample.svg +1/−0
diagrams/src_Diagrams_TwoD_Offset_offsetTrailExample.svg +1/−0
diagrams/src_Diagrams_TwoD_Offset_offsetTrailLeftExample.svg +1/−0
diagrams/src_Diagrams_TwoD_Offset_offsetTrailOuterExample.svg +1/−0
diagrams/src_Diagrams_TwoD_Shapes_decagonEx.svg +1/−0
diagrams/src_Diagrams_TwoD_Shapes_dodecagonEx.svg +1/−0
diagrams/src_Diagrams_TwoD_Shapes_hendecagonEx.svg +1/−0
diagrams/src_Diagrams_TwoD_Shapes_heptagonEx.svg +1/−0
diagrams/src_Diagrams_TwoD_Shapes_hexagonEx.svg +1/−0
diagrams/src_Diagrams_TwoD_Shapes_hruleEx.svg +1/−0
diagrams/src_Diagrams_TwoD_Shapes_nonagonEx.svg +1/−0
diagrams/src_Diagrams_TwoD_Shapes_octagonEx.svg +1/−0
diagrams/src_Diagrams_TwoD_Shapes_pentagonEx.svg +1/−0
diagrams/src_Diagrams_TwoD_Shapes_rectEx.svg +1/−0
diagrams/src_Diagrams_TwoD_Shapes_roundedRectEx.svg +1/−0
diagrams/src_Diagrams_TwoD_Shapes_squareEx.svg +1/−0
diagrams/src_Diagrams_TwoD_Shapes_triangleEx.svg +1/−0
diagrams/src_Diagrams_TwoD_Shapes_unitSquareEx.svg +1/−0
diagrams/src_Diagrams_TwoD_Shapes_vruleEx.svg +1/−0
diagrams/trailOffsetEx.svg +0/−4
diagrams/triangleEx.svg +0/−4
diagrams/unitSquareEx.svg +0/−4
diagrams/vruleEx.svg +0/−4
src/Diagrams.hs +153/−0
src/Diagrams/Align.hs +118/−33
src/Diagrams/Angle.hs +284/−0
src/Diagrams/Animation.hs +16/−17
src/Diagrams/Animation/Active.hs +3/−6
src/Diagrams/Attributes.hs +366/−191
src/Diagrams/Attributes/Compile.hs +127/−0
src/Diagrams/Backend/CmdLine.hs +518/−0
src/Diagrams/Backend/Show.hs +0/−69
src/Diagrams/BoundingBox.hs +210/−208
src/Diagrams/Combinators.hs +182/−115
src/Diagrams/Coordinates.hs +78/−29
src/Diagrams/CubicSpline.hs +38/−27
src/Diagrams/CubicSpline/Boehm.hs +149/−0
src/Diagrams/CubicSpline/Internal.hs +7/−68
src/Diagrams/Deform.hs +129/−0
src/Diagrams/Direction.hs +86/−0
src/Diagrams/LinearMap.hs +175/−0
src/Diagrams/Located.hs +81/−42
src/Diagrams/Names.hs +14/−8
src/Diagrams/Parametric.hs +33/−96
src/Diagrams/Parametric/Adjust.hs +99/−0
src/Diagrams/Path.hs +170/−66
src/Diagrams/Points.hs +16/−19
src/Diagrams/Prelude.hs +74/−109
src/Diagrams/Query.hs +76/−2
src/Diagrams/Segment.hs +310/−149
src/Diagrams/Size.hs +157/−0
src/Diagrams/Solve.hs +0/−118
src/Diagrams/Tangent.hs +150/−0
src/Diagrams/ThreeD.hs +62/−0
src/Diagrams/ThreeD/Align.hs +140/−0
src/Diagrams/ThreeD/Attributes.hs +138/−0
src/Diagrams/ThreeD/Camera.hs +146/−0
src/Diagrams/ThreeD/Deform.hs +28/−0
src/Diagrams/ThreeD/Light.hs +65/−0
src/Diagrams/ThreeD/Projection.hs +168/−0
src/Diagrams/ThreeD/Shapes.hs +300/−35
src/Diagrams/ThreeD/Size.hs +50/−0
src/Diagrams/ThreeD/Transform.hs +223/−0
src/Diagrams/ThreeD/Types.hs +56/−55
src/Diagrams/ThreeD/Vector.hs +35/−0
src/Diagrams/Trace.hs +18/−6
src/Diagrams/Trail.hs +1396/−880
src/Diagrams/TrailLike.hs +73/−25
src/Diagrams/Transform.hs +83/−11
src/Diagrams/Transform/Matrix.hs +73/−0
src/Diagrams/Transform/ScaleInv.hs +185/−0
src/Diagrams/TwoD.hs +138/−30
src/Diagrams/TwoD/Adjust.hs +61/−76
src/Diagrams/TwoD/Align.hs +69/−32
src/Diagrams/TwoD/Arc.hs +156/−72
src/Diagrams/TwoD/Arrow.hs +588/−0
src/Diagrams/TwoD/Arrowheads.hs +346/−0
src/Diagrams/TwoD/Attributes.hs +423/−0
src/Diagrams/TwoD/Combinators.hs +88/−56
src/Diagrams/TwoD/Curvature.hs +56/−53
src/Diagrams/TwoD/Deform.hs +41/−0
src/Diagrams/TwoD/Ellipse.hs +9/−6
src/Diagrams/TwoD/Image.hs +139/−52
src/Diagrams/TwoD/Model.hs +124/−36
src/Diagrams/TwoD/Offset.hs +490/−57
src/Diagrams/TwoD/Path.hs +360/−166
src/Diagrams/TwoD/Points.hs +60/−0
src/Diagrams/TwoD/Polygons.hs +106/−96
src/Diagrams/TwoD/Segment.hs +337/−61
src/Diagrams/TwoD/Segment/Bernstein.hs +138/−0
src/Diagrams/TwoD/Shapes.hs +92/−74
src/Diagrams/TwoD/Size.hs +38/−103
src/Diagrams/TwoD/Text.hs +252/−84
src/Diagrams/TwoD/Transform.hs +157/−210
src/Diagrams/TwoD/Types.hs +56/−186
src/Diagrams/TwoD/Vector.hs +58/−36
src/Diagrams/Util.hs +165/−16
src/Linear/Vector/Compat.hs +24/−0
test/Diagrams/Test/Angle.hs +29/−0
test/Diagrams/Test/Direction.hs +34/−0
test/Diagrams/Test/Trail.hs +113/−0
test/Diagrams/Test/Transform.hs +76/−0
test/Diagrams/Test/Transform/Matrix.hs +26/−0
test/Diagrams/Test/TwoD.hs +65/−0
test/Diagrams/Test/TwoD/Offset.hs +48/−0
test/Diagrams/Test/TwoD/Segment.hs +54/−0
test/Instances.hs +157/−0
test/Speed.hs +47/−0
test/Test.hs +26/−0

+ CHANGELOG.md view

@@ -0,0 +1,1837 @@+## [v1.5.1](https://github.com/diagrams/diagrams-lib/tree/v1.5.1) (2025-12-02)++- New `Semigroup` instance for located lines (i.e. `Located (Trail'+  Line v n)`), which adds an extra segment from the end of the first+  to the start of the second.++## [v1.5.0.1](https://github.com/diagrams/diagrams-lib/tree/v1.5.0.1) (2025-08-25)++- Fix bug in `bezierFindRoot` that caused diagrams to hang when+  computing the trace of certain degenerate Bezier curves.  See+  https://github.com/diagrams/diagrams-contrib/issues/91 .++## [v1.5-r2](https://github.com/diagrams/diagrams-lib/tree/v1.5-r2) (2025-06-12)++- Allow `optparse-applicative-0.19`++## [v1.5-r1](https://github.com/diagrams/diagrams-lib/tree/v1.5-r1) (2025-05-17)++- Allow `monoid-extras-0.7`++## [v1.5](https://github.com/diagrams/diagrams-lib/tree/v1.5) (2025-02-13)++- Allow `base-4.21` and test on GHC 9.12+- Remove looped compilation mode options ([#372](https://github.com/diagrams/diagrams-lib/pull/372))+    - This allows us to remove the `fsnotify` dependency, which in+      turn allows compiling diagrams to Wasm.+    - To recover similar functionality (automatically recompiling+      every time a source file changes), try an external tool like+      `ghcid` or `ghciwatch`, or, more generically, `entr`.++## [v1.4.7](https://github.com/diagrams/diagrams-lib/tree/v1.4.7) (2024-10-26)++- Switch to `data-default-0.8` instead of `data-default-class`++## [v1.4.6.2-r3](https://github.com/diagrams/diagrams-lib/tree/v1.4.6.2-r3) (2024-08-23)++- Allow `hashable-1.5`++## [v1.4.6.2-r2](https://github.com/diagrams/diagrams-lib/tree/v1.4.6.2-r2) (2024-07-01)++- Allow `tasty-quickcheck-0.11`++## [v1.4.6.2-r1](https://github.com/diagrams/diagrams-lib/tree/v1.4.6.2-r1) (2024-05-01)++- Allow `base-4.21` (GHC 9.10), `containers-0.7`, `lens-5.3`, and `filepath-1.5`++## [v1.4.6.2](https://github.com/diagrams/diagrams-lib/tree/v1.4.6.2) (2024-05-01)++- Support for `linear-1.23`.  This version of `linear` introduces a+  breaking change, so add an internal compatibility module that allows+  diagrams to work with any version of `linear` both before and after+  the change.++## [v1.4.6.1](https://github.com/diagrams/diagrams-lib/tree/v1.4.6.1) (2024-02-26)++- Fix compilation on BSD ([#367](https://github.com/diagrams/diagrams-lib/pull/367), thanks to Finn Espen Gundersen)++## [v1.4.6-r4](https://github.com/diagrams/diagrams-lib/tree/v1.4.6-r4) (2024-01-11)++- Allow `base-4.19` and test with GHC 9.8+- Allow `text-2.1`++## [v1.4.6-r3](https://github.com/diagrams/diagrams-lib/tree/v1.4.6-r3) (2023-09-14)++- Allow `tasty-1.5`++## [v1.4.6-r2](https://github.com/diagrams/diagrams-lib/tree/v1.4.6-r2) (2023-08-16)++- Allow `bytestring-0.12` and `deepseq-1.5`++## [v1.4.6-r1](https://github.com/diagrams/diagrams-lib/tree/v1.4.6-r1) (2023-05-25)++- Allow `optparse-applicative-0.18`++## [v1.4.6](https://github.com/diagrams/diagrams-lib/tree/v1.4.5.3) (2023-05-15)++- Allow `base-4.18`; test with GHC 9.6 (thanks to @sergv)+- Fix some warnings (thanks to @sergv)++## [v1.4.5.3](https://github.com/diagrams/diagrams-lib/tree/v1.4.5.3) (2022-09-19)++- Update to `fsnotify-0.4`++- Revisions:+  - r1: require `lens-5.1`+  - r2: allow `mtl-2.3`+  - r3 (3 Dec 2022): allow `linear-1.22`++## [v1.4.5.2](https://github.com/diagrams/diagrams-lib/tree/v1.4.5.2) (2022-09-14)++- Fix build with `transformers-0.6`+- Fix some deprecation warnings++## [v1.4.5.1-r3](https://github.com/diagrams/diagrams-lib/tree/v1.4.5.1-r3) (2022-08-27)++- Allow `base-4.17` and `lens-5.2`; test with GHC 9.4++## [v1.4.5.1-r2](https://github.com/diagrams/diagrams-lib/tree/v1.4.5.1-r2) (2022-02-01)++- Allow `optparse-applicative-0.17`++## [v1.4.5.1-r1](https://github.com/diagrams/diagrams-lib/tree/v1.4.5.1-r1) (2022-01-08)++- Allow `text-2.0`++## [v1.4.5.1](https://github.com/diagrams/diagrams-lib/tree/v1.4.5.1) (2021-12-17)++- Bug fix: make things compile again under versions of `lens` before 5.1.++## [v1.4.5](https://github.com/diagrams/diagrams-lib/tree/v1.4.5) (2021-12-16)++- Allow `base-4.16` (tested with GHC 9.2.1)+- Allow `semigroups-0.20`, `lens-5.1`, `hashable-1.4`,+  `transformers-0.6`+- Add `Eq` instance for `SizeSpec`++## [v1.4.4-r1](https://github.com/diagrams/diagrams-lib/tree/v1.4.4-r1) (2021-06-05)++- Bumps to dependency upper bounds:+    - Allow `tasty-1.4`+    - Allow `bytestring-0.11`++## [v1.4.4](https://github.com/diagrams/diagrams-lib/tree/v1.4.4) (2021-05-24)++- Bumps to upper bounds, to allow building with:+    - `base-4.15` (tested with GHC 9.0.1)+    - `optparse-applicative` (tested with GHC 8.8.4 & 8.10.2)++- Updated use of Kinds thoughout the package++- Drop support for GHC 8.2 or earlier++## [v1.4.3](https://github.com/diagrams/diagrams-lib/tree/v1.4.3) (2019-11-06)++- Bumps to upper bounds, to allow building with:+    - `base-4.13` (tested with GHC 8.8.1)+    - `intervals-0.9`+    - `semigroups-0.19`+    - `hashable-1.3`+- Many bug fixes, including+    - [#313](https://github.com/diagrams/diagrams-lib/issues/313) (`combineBoundaries`)+    - [#322](https://github.com/diagrams/diagrams-lib/issues/322), [#329](https://github.com/diagrams/diagrams-lib/issues/329) (`section`)+    - [#325](https://github.com/diagrams/diagrams-lib/pull/325)+      (Bezier/Bezier intersection)+    - [#339](https://github.com/diagrams/diagrams-lib/pull/339) (`perspectiveZ1`)+- Added derived `Eq` and `Ord` instances for `FixedSegment`++## [v1.4.2.3](https://github.com/diagrams/diagrams-lib/tree/v1.4.2.3) (2018-06-11)++- Bug fix for `extrudeEnvelope` and friends ([#316](https://github.com/diagrams/diagrams-lib/issues/316))++## [v1.4.2.2](https://github.com/diagrams/diagrams-lib/tree/v1.4.2.2) (2018-05-08)++- Fixes for GHC < 8.0++## [v1.4.2.1](https://github.com/diagrams/diagrams-lib/tree/v1.4.2.1) (2018-04-13)++- Allow `base-4.11` (GHC 8.4)+- Allow `tasty-quickcheck-0.10`+- Bug fix for `Diagrams.TwoD.Offset.capArc` ([#310](https://github.com/diagrams/diagrams-lib/pull/310))++## [v1.4.2-r1](https://github.com/diagrams/diagrams-lib/tree/v1.4.2-r1) (2017-12-20)++Hackage revision to allow `tasty-1.0` in the test suite.++## [v1.4.2](https://github.com/diagrams/diagrams-lib/tree/v1.4.2) (2017-12-20)++- New functions:+    - `boxGrid`, for computing a grid of regularly spaced points.+    - `scalingRotationTo` and `scaleRotateTo`, for affine conformal 2D+      transformations.+- Documentation fixes:+    - `dirBetween`+    - `PolyOrientation`+- Upper bound updates: allow `tasty-0.12`, `tasty-quickcheck-0.9`,+  `tasty-hunit-0.10`, `optparse-applicative-0.14`+- Test with GHC 8.2.2++## [v1.4.1.2](https://github.com/diagrams/diagrams-lib/tree/v1.4.1.2) (2017-06-10)++- Fix test suite compilation failure [#299](https://github.com/diagrams/diagrams-lib/issues/299).++## [v1.4.1.1](https://github.com/diagrams/diagrams-lib/tree/v1.4.1.1) (2017-06-06)++- Fix `Diagrams.Points.centroid` to make it total.+- Fix bug in `Diagrams.Transform.Matrix.fromMatWithInv` (and hence+  also related functions which called it, such as `fromMat22` and+  `fromMat33`).++## [v1.4.1](https://github.com/diagrams/diagrams-lib/tree/v1.4.1) (2017-05-28)++- New functions `embeddedImage` and `loadImageEmbBS` for loading+  images.+- Fix [#289](https://github.com/diagrams/diagrams-lib/issues/289)+  which could have caused strange behavior in looped compilation mode+  on 32-bit platforms.+- Allow `intervals-0.8` and `directory-1.3`.+- Minor fixes to compile with GHC 8.2.++## [v1.4.0.1](https://github.com/diagrams/diagrams-lib/tree/v1.4.0.1) (2016-11-07)++- Fix test suite compilation problem ([#286](https://github.com/diagrams/diagrams-lib/issues/286))++## [v1.4](https://github.com/diagrams/diagrams-lib/tree/v1.4) (2016-10-26)++* **New features**++    - New `mkText'` function, which allows making a text primitive+      without recommending a fill colour or font size so users can+      recommend their own (*e.g.* using the `recommendFontSize`+      function).++    - New functions `reflectXY` and `reflectionXY`++    - New `composeAligned` combinator for doing composition under an+      alignment while leaving the local origin unaffected.++    - Add `_LocLoop` and `_LocLine` prisms++    - New `bspline` function for creating uniform cubic B-splines++    - New 3D features:+        - New `Skinned` class+        - Improved handling of 3D primitives+        - CSG++    - New standard attributes for separate fill and stroke opacity+      (see+      [#248](https://github.com/diagrams/diagrams-lib/issues/248)).++    - New `HasQuery` class for things which can be spatially queried+      for values from some monoid.++    - New function `inquire` for testing whether a given point is+      inside a diagram.++    - New font weights: `bolder`, `lighter`, `thinWeight`,+      `ultraLight`, `light`, `mediumWeight`, `heavy`, `semiBold`,+      `ultraBold`.  Note that currently only the SVG backend deals+      with the new weights.++    - Export `GetSegmentCodomain` and update documentation++    - Improved performance of 2D rotations++* **New instances**++    - `Alignable` instance for `Located`++    - `ToPath` instances for lines and loops++    - `Serialize` instances for `Trail`, `Path`, `Located`, `SegTree`,+      `Segment`++    - `Generic` instances for `Path`, `Located`++    - `Action` instance for `Angle`: angles act by rotation.++* **API changes**++    - `snugBL`, `snugBR`, `snugTR` and `snugBR` are deprecated.+      These functions were unintuitive, ad-hoc, and not particularly useful,+      especially since e.g. `snugL` and `snugB` do not commute. You+      can use something like `snugB . snugL` directly, or use `snug`+      with a direction vector.  See+      [#250](https://github.com/diagrams/diagrams-lib/issues/250) for+      more details.++* **Dependency/version changes**++    - upgrade `fsnotify` and drop dependency on deprecated+      `system-filepath`+    - Allow `lens-4.15`+    - Many other bumped upper bounds, see release notes for minor releases+      below++* **Bug fixes**++    - fix `orientPoints` function, which was previously generating NaN+      values with lists of only one or two+      points. ([#210](https://github.com/diagrams/diagrams-lib/issues/210))++    - Broken offset joins with non-vertices in loops ([#263](https://github.com/diagrams/diagrams-lib/issues/263))++    - Properly transform arrow shaft styles ([#274](https://github.com/diagrams/diagrams-lib/issues/274))++    - Fix sign error in `reflectionAbout`++## [v1.3.1.4](https://github.com/diagrams/diagrams-lib/tree/v1.3.1.4) (2016-08-16) (16 August 2016)++- allow `optparse-applicative-0.13`++## [v1.3.1.3](https://github.com/diagrams/diagrams-lib/tree/v1.3.1.3) (2016-06-05)++- allow `base-4.9`+- allow `data-default-class-0.1`+- test with GHC 8.0.1++[Full Changelog](https://github.com/diagrams/diagrams-lib/compare/v1.3.1.2...v1.3.1.3)++## [v1.3.1.2](https://github.com/diagrams/diagrams-lib/tree/v1.3.1.2) (2016-05-01)++- allow `lens-4.14`++[Full Changelog](https://github.com/diagrams/diagrams-lib/compare/v1.3.1.1...v1.3.1.2)++## [v1.3.1.2](https://github.com/diagrams/diagrams-lib/tree/v1.3.1.2) (2016-02-19)++  - allow `unordered-containers-0.2.*`++[Full Changelog](https://github.com/diagrams/diagrams-lib/compare/v1.3.1.0...v1.3.1.1)++## [v1.3.1.0](https://github.com/diagrams/diagrams-lib/tree/v1.3.1.0) (2016-02-14)++- improve path offset calculations++[Full Changelog](https://github.com/diagrams/diagrams-lib/compare/v1.3.0.9...v1.3.1.0)++## [v1.3.0.9](https://github.com/diagrams/diagrams-lib/tree/v1.3.0.9) (2016-01-14)++- allow `unordered-containers-0.2.6`++[Full Changelog](https://github.com/diagrams/diagrams-lib/compare/v1.3.0.8...v1.3.0.9)++## [v1.3.0.8](https://github.com/diagrams/diagrams-lib/tree/v1.3.0.8) (2015-11-10)++- allow `semigroups-0.18`++[Full Changelog](https://github.com/diagrams/diagrams-lib/compare/v1.3.0.7...v1.3.0.8)++## [v1.3.0.7](https://github.com/diagrams/diagrams-lib/tree/v1.3.0.7) (2015-10-08) ##++- Add `LambdaCase` extension to `.cabal` file, so `cabal` correctly+  reports that `diagrams-lib` does not build on `GHC-7.4`.++[Full Changelog](https://github.com/diagrams/diagrams-lib/compare/v1.3.0.6...v1.3.0.7)++## [v1.3.0.6](https://github.com/diagrams/diagrams-lib/tree/v1.3.0.6) (2015-09-29) ##++- Allow `optparse-applicative-0.12`++[Full Changelog](https://github.com/diagrams/diagrams-lib/compare/v1.3.0.5...v1.3.0.6)++## [v1.3.0.5](https://github.com/diagrams/diagrams-lib/tree/v1.3.0.5) (2015-09-18) ##++- Fix compilation problem with `lens-4.13`++[Full Changelog](https://github.com/diagrams/diagrams-lib/compare/v1.3.0.4...v1.3.0.5)++## [v1.3.0.4](https://github.com/diagrams/diagrams-lib/tree/v1.3.0.4) (2015-09-17) ##++**Dependency/version changes**++- Allow `lens-1.13`+- Allow `semigroups-0.17`+- Require `linear-1.20`++## [v1.3.0.3](https://github.com/diagrams/diagrams-lib/tree/v1.3.0.3) (2015-08-10)++**Dependency/version changes**++- Drop dependency on deprecated `system-filepath` package+- Require `fsnotify-0.2.1`++## [v1.3.0.2](https://github.com/diagrams/diagrams-lib/tree/v1.3.0.2) (2015-07-19)++[Full Changelog](https://github.com/diagrams/diagrams-lib/compare/v1.3.0.1...v1.3.0.2)++## [v1.3.0.1](https://github.com/diagrams/diagrams-lib/tree/v1.3.0.1) (2015-05-26)++[Full Changelog](https://github.com/diagrams/diagrams-lib/compare/v1.3...v1.3.0.1)++## [v1.3](https://github.com/diagrams/diagrams-lib/tree/v1.3) (2015-04-19)++**New features**++- Native image type that backends can specify.++- Affine maps between spaces for path-like objects. A new+  `Diagrams.ThreeD.Projections` has some helper functions for+  orthographic and perspective projections.++- Intersections for path-like objects using Bézier clipping.++- Helper functions in `Diagrams.Matrix` for converting between+  transforms and matrices.++- New `Diagrams` module that only exports functions defined in+  diagrams.++- New `Direction` type. `Direction` is a vector that's forgot it's+  magnitude. Some functions have changed their type from `R2` to+  `Direction V2 n` to make it clear that magnitude has no effect.++- Use the [`fsnotify`](https://hackage.haskell.org/package/fsnotify)+  package for command line looping. Command line looping now works+  on Windows.++- `groupOpacity` function added for lowering the opacity of a+  diagram as a whole.++- New `ToPath` class for converting path-like things to a `Path`.++**New instances**++- `Each` instances for `BoundingBox`, `Offset`, `Segment`,+  `FixedSegment` and `Path`.++- `Reversing` instances for `Offset`, `Segment`, `FixedSegment`,+  `Trail` and `Path`.++- `AsEmpty` instances for `BoundingBox`, `Trail` and `Path`.++- `Cons` and `Snoc` instances for `Path` and `Line`.++- New `Show` instances for `Angle`, `Segment`, `SomeColor`, `Trail'`+  and `at`.++- `Tangent` instance for `(FixedSegment v n)`.++- `Ord` instances for `LineMiterLimit`, `LineJoin` and `LineCap`.++**New helper functions**++- `_Line` and `_Loop` prisms.++- Style lenses: `_fontSize`, `_lineWidth`, `_fillTexture`,+  `_lineTexture`, `_opacity`, `_font`, `_lineCap`, `_lineJoin`+  `_dashing`.++- `_SomeColor` iso and `_AC` prism onto an `AlphaColour`.++- `atPoints` function to zip points with diagrams.++**API changes**++- `Diagram` type synonym now only takes a backend token: `Diagram B`++- Types that previously had a `v` variable now have `v` and `n`.++- `Control.Lens` and `Data.Default.Class` are now exported from from+  `Diagrams.Prelude`++- `Measure` has a new internal representation. `Local`, `Global`,+  `Normalized`, and `Output` have been renamed to `local`, `global`,+  `normalized` and `output` respectivly.++- `SizeSpec2D` has moved to `SizeSpec v n` in `Diagrams.SizeSpec`.+  `Dims, Height, Width and `Absolute` have moved to `dims2D`,+  `mkHeight`, `mkWidth` and `absolute` respectively.++- `Color` instances for `Colour` and `AlphaColour` are limited to+  `Double` for better type inference.++- `under` has been renamed to `underT`. New `transformed`,+  `translated`, `movedTo`, `movedFrom` and `rotated` isomorphisms to+  use with lens's `under` function.++- `stroke` is now polymorphic. Use `strokePath` or `strokeP` to get+  old `stroke` behaviour.++- `angleBetween` now works for any vector space, which means the+  angle is always positive. The old behaviour can be retrieved from+  `signedAngleBetween`++- `arc` now takes a starting `Direction` and a sweep `Angle`.+  `arcCW` and `arcCCW` take a start and finish `Direction`.++**Dependency/version changes**++- use `linear` instead of `vector-space`++**Closed issues:**++- Perspective deformation of square vertices yields extra point [\#244](https://github.com/diagrams/diagrams-lib/issues/244)++- Local fontsize renders inconsistentl on diffrent backends [\#243](https://github.com/diagrams/diagrams-lib/issues/243)++- Factor out Diagrams.Solve into a package? [\#235](https://github.com/diagrams/diagrams-lib/issues/235)++**Merged pull requests:**++- add pathPoints and pathVertices' functions [\#245](https://github.com/diagrams/diagrams-lib/pull/245) ([byorgey](https://github.com/byorgey))++- New loop [\#242](https://github.com/diagrams/diagrams-lib/pull/242) ([cchalmers](https://github.com/cchalmers))++- Pre 1.3 [\#241](https://github.com/diagrams/diagrams-lib/pull/241) ([cchalmers](https://github.com/cchalmers))++- Update CubicSpline.hs [\#240](https://github.com/diagrams/diagrams-lib/pull/240) ([fryguybob](https://github.com/fryguybob))++- updated changes for GHC-7.10 [\#239](https://github.com/diagrams/diagrams-lib/pull/239) ([bergey](https://github.com/bergey))++- split out new package diagrams-solve [\#237](https://github.com/diagrams/diagrams-lib/pull/237) ([byorgey](https://github.com/byorgey))++- Lens style [\#236](https://github.com/diagrams/diagrams-lib/pull/236) ([cchalmers](https://github.com/cchalmers))++- Half-dart arrowheads [\#234](https://github.com/diagrams/diagrams-lib/pull/234) ([byorgey](https://github.com/byorgey))++- TwoD.Points: Needs TypeFamilies [\#233](https://github.com/diagrams/diagrams-lib/pull/233) ([bgamari](https://github.com/bgamari))++- Projections [\#229](https://github.com/diagrams/diagrams-lib/pull/229) ([cchalmers](https://github.com/cchalmers))++## [1.2.0.9]() (2 April 2015)++ - allow `lens-4.9`++ - allow `vector-space-0.10`++## [v1.2.0.8](https://github.com/diagrams/diagrams-lib/tree/v1.2.0.8) (2015-01-13)++[Full Changelog](https://github.com/diagrams/diagrams-lib/compare/v1.2.0.7...v1.2.0.8)++**Merged pull requests:**++- typo in haddocks [\#232](https://github.com/diagrams/diagrams-lib/pull/232) ([ggreif](https://github.com/ggreif))++- Update diagrams-lib.cabal : bumping JuicyPixels dependency [\#230](https://github.com/diagrams/diagrams-lib/pull/230) ([Twinside](https://github.com/Twinside))++## [v1.2.0.7](https://github.com/diagrams/diagrams-lib/tree/v1.2.0.7) (2014-12-07)++[Full Changelog](https://github.com/diagrams/diagrams-lib/compare/v1.2.0.6...v1.2.0.7)++## [v1.2.0.6](https://github.com/diagrams/diagrams-lib/tree/v1.2.0.6) (2014-12-04)++[Full Changelog](https://github.com/diagrams/diagrams-lib/compare/v1.2.0.5...v1.2.0.6)++**Merged pull requests:**++- Minor changes in documentation about Polygons. [\#228](https://github.com/diagrams/diagrams-lib/pull/228) ([alexDarcy](https://github.com/alexDarcy))++## [v1.2.0.5](https://github.com/diagrams/diagrams-lib/tree/v1.2.0.5) (2014-11-17)++[Full Changelog](https://github.com/diagrams/diagrams-lib/compare/v1.2.0.4...v1.2.0.5)++**Implemented enhancements:**++- Path/trail intersection [\#209](https://github.com/diagrams/diagrams-lib/issues/209)++- Turn R2 into D2 \(Generalize R2 to any numeric type\) [\#50](https://github.com/diagrams/diagrams-lib/issues/50)++**Fixed bugs:**++- `Sectionable` instance for `SegTree` is not a linear reparameterization. [\#217](https://github.com/diagrams/diagrams-lib/issues/217)++**Closed issues:**++- bezierFromSweep very slow? [\#227](https://github.com/diagrams/diagrams-lib/issues/227)++- All lines render at same width [\#222](https://github.com/diagrams/diagrams-lib/issues/222)++- numerically stable cubic rootfinder [\#204](https://github.com/diagrams/diagrams-lib/issues/204)++**Merged pull requests:**++- Intersections [\#226](https://github.com/diagrams/diagrams-lib/pull/226) ([cchalmers](https://github.com/cchalmers))++- Linear update [\#225](https://github.com/diagrams/diagrams-lib/pull/225) ([cchalmers](https://github.com/cchalmers))++- Add arcCCW and friends.  Fix offset joins. [\#221](https://github.com/diagrams/diagrams-lib/pull/221) ([fryguybob](https://github.com/fryguybob))++- Reparameterize section [\#220](https://github.com/diagrams/diagrams-lib/pull/220) ([fryguybob](https://github.com/fryguybob))++- Diagram b v n to QDiagram b v n Any [\#219](https://github.com/diagrams/diagrams-lib/pull/219) ([jeffreyrosenbluth](https://github.com/jeffreyrosenbluth))++- New stuff [\#218](https://github.com/diagrams/diagrams-lib/pull/218) ([cchalmers](https://github.com/cchalmers))++- Linear [\#215](https://github.com/diagrams/diagrams-lib/pull/215) ([cchalmers](https://github.com/cchalmers))++## [v1.2.0.4](https://github.com/diagrams/diagrams-lib/tree/v1.2.0.4) (2014-10-08)++[Full Changelog](https://github.com/diagrams/diagrams-lib/compare/v1.2.0.3...v1.2.0.4)++**Merged pull requests:**++- add semi-portable looping using fsnotify [\#213](https://github.com/diagrams/diagrams-lib/pull/213) ([bergey](https://github.com/bergey))++## [v1.2.0.3](https://github.com/diagrams/diagrams-lib/tree/v1.2.0.3) (2014-09-07)++[Full Changelog](https://github.com/diagrams/diagrams-lib/compare/v1.2.0.2...v1.2.0.3)++**Closed issues:**++- arrowFromLocatedTrail function [\#205](https://github.com/diagrams/diagrams-lib/issues/205)++**Merged pull requests:**++- Added `arrowFromLocatedTrail` [\#206](https://github.com/diagrams/diagrams-lib/pull/206) ([pnutus](https://github.com/pnutus))++## [v1.2.0.2](https://github.com/diagrams/diagrams-lib/tree/v1.2.0.2) (2014-08-22)++[Full Changelog](https://github.com/diagrams/diagrams-lib/compare/v1.2.0.1...v1.2.0.2)++**Implemented enhancements:**++- Generalize Angle class? [\#38](https://github.com/diagrams/diagrams-lib/issues/38)++**Fixed bugs:**++- --selection and --src both use -s abbreviation [\#172](https://github.com/diagrams/diagrams-lib/issues/172)++**Closed issues:**++- Spike arrowhead and tail render with oversized joint [\#203](https://github.com/diagrams/diagrams-lib/issues/203)++**Merged pull requests:**++- Enable compilation with GHC HEAD \(v7.9\) [\#211](https://github.com/diagrams/diagrams-lib/pull/211) ([ggreif](https://github.com/ggreif))++- cli-options [\#200](https://github.com/diagrams/diagrams-lib/pull/200) ([bergey](https://github.com/bergey))++- Add Native images to Diagrams.TwoD.Image [\#199](https://github.com/diagrams/diagrams-lib/pull/199) ([taruti](https://github.com/taruti))++- add atPoints, deprecate decorateFoo [\#198](https://github.com/diagrams/diagrams-lib/pull/198) ([jeffreyrosenbluth](https://github.com/jeffreyrosenbluth))++- Add bg' [\#197](https://github.com/diagrams/diagrams-lib/pull/197) ([jeffreyrosenbluth](https://github.com/jeffreyrosenbluth))++- add convenience synonyms \[hv\]sep for \[hv\]cat' \(with & sep .~ x\) [\#196](https://github.com/diagrams/diagrams-lib/pull/196) ([byorgey](https://github.com/byorgey))++- Vertices [\#192](https://github.com/diagrams/diagrams-lib/pull/192) ([jeffreyrosenbluth](https://github.com/jeffreyrosenbluth))++- Direction type [\#186](https://github.com/diagrams/diagrams-lib/pull/186) ([bergey](https://github.com/bergey))++## [v1.2.0.1](https://github.com/diagrams/diagrams-lib/tree/v1.2.0.1) (2014-06-04)++[Full Changelog](https://github.com/diagrams/diagrams-lib/compare/v1.2...v1.2.0.1)++**Closed issues:**++- Local headLength / headGaps act like Output [\#193](https://github.com/diagrams/diagrams-lib/issues/193)++**Merged pull requests:**++- transform Local Measure in arrow styles [\#194](https://github.com/diagrams/diagrams-lib/pull/194) ([bergey](https://github.com/bergey))++## [v1.2](https://github.com/diagrams/diagrams-lib/tree/v1.2) (2014-06-02)++[Full Changelog](https://github.com/diagrams/diagrams-lib/compare/v1.1.0.4...v1.2)++**New features**++- Several attributes (such as line width, dashing size, arrowhead+  size, and font size) that formerly had a value of type `Double`+  now have the more general type `Measure R2`. This allows the+  attributes to be specified relative to one of four measurement+  frames: `Local`, `Global`, `Normalized`, and `Output`.++- New DSL for specifying measurements.++- New synonyms for specifying measurements, *e.g.* `thin`,+  `thick`, and `medium`, `large`.++- Support for radial and linear gradients for fills and strokes.++- New `DImage` type that supports both embedded and external images in+  Backends that support them.++- New `lengths` Traversal for setting `headLength` and `tailLength`+  simultaneously.++- `Frustrum` and `Box` shapes added to `Diagrams.ThreeD.Shapes`.++- New function `quartForm` to find roots of quartic polynomials.++- New Lenses for polar coordinates.++- New trig functions, `sinA`, `atanA`, etc. which take `Angle` as+  input or output.++**New instances**++- `Transformable` instances for `LineWidth`, `Dashing`,+  `LineTexture`, and  `FillTexture`.++**API changes**++- `FillColor` and `LineColor` attributes have been replaced with+  the more general `FillTexture` and `LineTexture`. Use the `solid`+  function to convert a color to a texture.++- The size of arrow heads and tails is now specified in terms of+  length instead of the radius of their circumcircle.++- Gaps at the ends of arrows are now specified using `Measure R2`.++- The `gap` traversal has been replaced by `gaps` for consistency+  in naming, though `gap` is still provided for backwards compatibility.++- `fontSize` now takes a value of type `Measure R2`.++- Get rid of (bitrotted) `Show` backend.++- Functions in `TwoD.Adjust` now return the adjustment+  transformation itself in addition to the resized `Diagram` and+  `Options` record; this can be used, *e.g.* to convert screen+  coordinates back into diagram coordinates.++- Export `pathLocSegments`.++- The `avgScale` function has been moved to `Diagrams.Core`.++- The `Angle` definition and related functions (*e.g.*+  `angleBetween`) have moved to a separate module, `Diagrams.Angle`.++- A separate `Diagrams.TwoD.Attributes` module now contains most+  of the attributes that require 2D transformation instances.++- The `splitColorFills` function has been replaced by `splitTextureFills`.++**Dependency/version changes**++- Allow `semigroups-0.15`++- Allow `opt-parse-applicative-0.9.0++- Allow `lens-4.2`++**Implemented enhancements:**++- 'image' should be in IO [\#29](https://github.com/diagrams/diagrams-lib/issues/29)++- Add gradient support [\#9](https://github.com/diagrams/diagrams-lib/issues/9)++**Closed issues:**++- fails to build against HP [\#190](https://github.com/diagrams/diagrams-lib/issues/190)++- text does not scale [\#179](https://github.com/diagrams/diagrams-lib/issues/179)++- Please add support for latest version of intervals library [\#170](https://github.com/diagrams/diagrams-lib/issues/170)++- presence of arrowHead can tilt connection sideways [\#162](https://github.com/diagrams/diagrams-lib/issues/162)++**Merged pull requests:**++- Quartic formula, no obvious bugs [\#187](https://github.com/diagrams/diagrams-lib/pull/187) ([Mathnerd314](https://github.com/Mathnerd314))++- Arrow length [\#185](https://github.com/diagrams/diagrams-lib/pull/185) ([jeffreyrosenbluth](https://github.com/jeffreyrosenbluth))++- fix handling of text scaling [\#182](https://github.com/diagrams/diagrams-lib/pull/182) ([byorgey](https://github.com/byorgey))++- Texture [\#181](https://github.com/diagrams/diagrams-lib/pull/181) ([jeffreyrosenbluth](https://github.com/jeffreyrosenbluth))++- arrow envelopes [\#180](https://github.com/diagrams/diagrams-lib/pull/180) ([jeffreyrosenbluth](https://github.com/jeffreyrosenbluth))++- make headSize and tailSize back into ArrowOpts fields [\#177](https://github.com/diagrams/diagrams-lib/pull/177) ([byorgey](https://github.com/byorgey))++- updated the upper bounds of the .cabal constraints for 'semigroups' package [\#176](https://github.com/diagrams/diagrams-lib/pull/176) ([zgredzik](https://github.com/zgredzik))++- Image2 [\#174](https://github.com/diagrams/diagrams-lib/pull/174) ([jeffreyrosenbluth](https://github.com/jeffreyrosenbluth))++- Image [\#173](https://github.com/diagrams/diagrams-lib/pull/173) ([jeffreyrosenbluth](https://github.com/jeffreyrosenbluth))++- Preliminary implementation of Measure [\#159](https://github.com/diagrams/diagrams-lib/pull/159) ([jeffreyrosenbluth](https://github.com/jeffreyrosenbluth))++- Gradient [\#136](https://github.com/diagrams/diagrams-lib/pull/136) ([jeffreyrosenbluth](https://github.com/jeffreyrosenbluth))++## [v1.1.0.7]() (2014-05-15)++- Allow `semigroups-0.14`++## [v1.1.0.6]() (2014-04-10)++- Allow `semigroups-0.13`++## [v1.1.0.4](https://github.com/diagrams/diagrams-lib/tree/v1.1.0.4) (2014-04-04)++[Full Changelog](https://github.com/diagrams/diagrams-lib/compare/v1.1.0.2...v1.1.0.4)++**Merged pull requests:**++- Updates to work with `Backend` redesign [\#171](https://github.com/diagrams/diagrams-lib/pull/171) ([byorgey](https://github.com/byorgey))++- Rework of units [\#169](https://github.com/diagrams/diagrams-lib/pull/169) ([byorgey](https://github.com/byorgey))++- Make Diagrams.Transform.under more polymorphic [\#168](https://github.com/diagrams/diagrams-lib/pull/168) ([FlorentBecker](https://github.com/FlorentBecker))++## [v1.1.0.3]() (2014-03-19)++- Allow `lens-4.1`++## [v1.1.0.2](https://github.com/diagrams/diagrams-lib/tree/v1.1.0.2) (2014-03-19)++[Full Changelog](https://github.com/diagrams/diagrams-lib/compare/v1.1.0.1...v1.1.0.2)++**Merged pull requests:**++- move avgScale to core [\#167](https://github.com/diagrams/diagrams-lib/pull/167) ([jeffreyrosenbluth](https://github.com/jeffreyrosenbluth))++- 3d color & lighting, more solids, Angle utilities [\#166](https://github.com/diagrams/diagrams-lib/pull/166) ([bergey](https://github.com/bergey))++- Added bothSize function, lineHead and lineTail [\#165](https://github.com/diagrams/diagrams-lib/pull/165) ([jeffreyrosenbluth](https://github.com/jeffreyrosenbluth))++## [v1.1.0.1](https://github.com/diagrams/diagrams-lib/tree/v1.1.0.1) (2014-03-09)++[Full Changelog](https://github.com/diagrams/diagrams-lib/compare/v1.1...v1.1.0.1)++- Depend on `hashable` package, and add `Hashable` instance for+  `SizeSpec2D`.++  Technically, the PVP specifies that adding a new instance+  requires a major version bump.  However, I highly doubt anyone+  was making their own orphan `Hashable` instances before.  Feel+  free to yell at Brent if this breaks your build.++## [v1.1](https://github.com/diagrams/diagrams-lib/tree/v1.1) (2014-03-09)++[Full Changelog](https://github.com/diagrams/diagrams-lib/compare/v1.0.1...v1.1)++**New features**++- Support for `Deformation`s, arbitrary (non-affine)+  transformations on objects such as points, paths, and located+  trails (though not on diagrams).++- New functions `clipTo`, which clips a diagram's envelope and+  trace along with its visual representation, and `clipped`, which+  clips the diagram's visual representation but replaces its+  envelope and trace with those of the clipping path.++- New `arrowV` function, for creating an arrow with the direction+  and magnitude of a given vector.++- `gap` traversal, for setting the head and tail gaps of an arrow+  simultaneously.++- Generalized types for `centerXY` and `snugXY`, based on new+  `basis` function from `diagrams-core++- New 3D `Transform`s, alignment, and 3D-specific `Prelude`.++- New `frame` function similar to `pad`, but increases the envelope+  of a diagram by an amount specified in local units in every direction+  irrespective of the local origin.++- New `splitFills` function for pushing fill attributes down to+  subtrees containing only loops (mostly of relevance only to+  backend implementors).++**New instances**++- `Typeable` instances for all data types that are used as diagram+  primitives.++- `Sectionable` instance for `FixedSegment`.++**API changes**++- `Angle` is now a type, rather than a class.  It uses a single+  internal representation for angles, and lenses `turn`, `rad,`+  and `deg` are supplied for constructing (using `@@`) and viewing+  (using `^.`) `Angle`s in various units.  In addition, the `Num`+  instance for `Angle` has been removed, eliminating a class of+  errors where a bare number is interpreted in units other than+  what you expect.++- Removed `Num` instance for angles.++**Dependency/version changes**++- Require `lens >= 4.0`.++- Allow `array-0.5`.++- Allow `hashable-1.1`.++- Remove `NumInstances` dependency.++**Bug fixes**++- Exclude joins in offsets on close segments (#160).++- Exclude extra segment when joining loops in offset (#155).++**Performance improvements**++- `colorToSRGBA` function now avoids expensive matrix operations,+  offering dramatic speedups in rendering diagrams with many color+  attributes.++**Implemented enhancements:**++- Better color model in 3D [\#121](https://github.com/diagrams/diagrams-lib/issues/121)++- Projective/perspective transforms for points and paths [\#108](https://github.com/diagrams/diagrams-lib/issues/108)++- clipTo function [\#35](https://github.com/diagrams/diagrams-lib/issues/35)++**Fixed bugs:**++- Offset Bug [\#155](https://github.com/diagrams/diagrams-lib/issues/155)++**Closed issues:**++- Expand of an expand [\#160](https://github.com/diagrams/diagrams-lib/issues/160)++**Merged pull requests:**++- fix doc for === and ||| [\#164](https://github.com/diagrams/diagrams-lib/pull/164) ([denys-duchier](https://github.com/denys-duchier))++- Split fills [\#161](https://github.com/diagrams/diagrams-lib/pull/161) ([byorgey](https://github.com/byorgey))++- Exclude extra segment when joining loops in offset. Fixes \#155. [\#158](https://github.com/diagrams/diagrams-lib/pull/158) ([fryguybob](https://github.com/fryguybob))++- added basis, generalized `centerXY` and `snugXY` [\#157](https://github.com/diagrams/diagrams-lib/pull/157) ([jeffreyrosenbluth](https://github.com/jeffreyrosenbluth))++- derive Typeable for all data types used in Prims [\#156](https://github.com/diagrams/diagrams-lib/pull/156) ([byorgey](https://github.com/byorgey))++- Lens4 [\#154](https://github.com/diagrams/diagrams-lib/pull/154) ([bergey](https://github.com/bergey))++- removed NumInstances dependency [\#153](https://github.com/diagrams/diagrams-lib/pull/153) ([jeffreyrosenbluth](https://github.com/jeffreyrosenbluth))++- Remove Num instance for Angle [\#150](https://github.com/diagrams/diagrams-lib/pull/150) ([bergey](https://github.com/bergey))++- Change internal color representation to SRGBA [\#149](https://github.com/diagrams/diagrams-lib/pull/149) ([jeffreyrosenbluth](https://github.com/jeffreyrosenbluth))++- Projections - non-affine transformations [\#148](https://github.com/diagrams/diagrams-lib/pull/148) ([bergey](https://github.com/bergey))++## [v1.0.1](https://github.com/diagrams/diagrams-lib/tree/v1.0.1) (2014-01-26)++[Full Changelog](https://github.com/diagrams/diagrams-lib/compare/v1.0.0.1...v1.0.1)++**Implemented enhancements:**++- Module for generating nice colors/color schemes [\#77](https://github.com/diagrams/diagrams-lib/issues/77)++**Closed issues:**++- "Maybe.fromJust: Nothing" error when connecting translated small diagram [\#147](https://github.com/diagrams/diagrams-lib/issues/147)++**Merged pull requests:**++- Add Hashable instance for SizeSpec2D [\#146](https://github.com/diagrams/diagrams-lib/pull/146) ([byorgey](https://github.com/byorgey))++- return list of traces [\#145](https://github.com/diagrams/diagrams-lib/pull/145) ([jeffreyrosenbluth](https://github.com/jeffreyrosenbluth))++- added clipTo [\#144](https://github.com/diagrams/diagrams-lib/pull/144) ([jeffreyrosenbluth](https://github.com/jeffreyrosenbluth))++- Unified angle type [\#140](https://github.com/diagrams/diagrams-lib/pull/140) ([bergey](https://github.com/bergey))++## [v1.0.0.1](https://github.com/diagrams/diagrams-lib/tree/v1.0.0.1) (2013-11-28)++[Full Changelog](https://github.com/diagrams/diagrams-lib/compare/v1.0...v1.0.0.1)++## [v1.0](https://github.com/diagrams/diagrams-lib/tree/v1.0) (2013-11-25)++[Full Changelog](https://github.com/diagrams/diagrams-lib/compare/v0.7.1.1...v1.0)++**New features**++- New modules `Diagrams.TwoD.Arrow` and `Diagrams.TwoD.Arrowheads`+  for creating arrows.++- New module `Diagrams.Backend.CmdLine`, providing a flexible+  framework for creating command-line-driven diagram rendering executables.++- New functions in `Diagrams.Offset`: `offsetTrail` and+  `offsetPath` for one-sided offsets of trails and paths;+  `expandTrail` and `expandPath` for "stroking" trails and paths,+  computing a path whose fill corresponds to the stroke of the+  given trail or path.++- New module `Diagrams.Tangent` for computing tangent and normal+  vectors of segments, trails, and paths.++- New functions in `Diagrams.Align` to allow diagrams to be aligned by `Trace`+  called `snug`, `snugBy` and `snugCenter`+  and the ability to define other boundary functions for alignment. Functions+  `snugL`, `snugR`, etc. are included in `TwoD.Align`.++- Lenses from `Control.Lens` are now used consistently for record fields+  throughout the library.++- New function `angleRatio` for calculating the ratio between two angles.++- Restricted identity functions `asTurn`, `asRad`, and `asDeg` for+  resolving type ambiguity++- New miter limit attribute.++- New function `annularWedge` in `TwoD.Arc`++- New `avgScale` utility in `TwoD.Transform`, for backends which+  cannot fully implement freezing of line width++- New function `heptagon`, a vast improvement over the linguistic+  frankenstein `septagon`.++- New function `lookupName` (re-exported from `diagrams-core`) for+  simple lookups of named subdiagrams++- New function `angleBetween` to calculate the angle between two+  vectors.++- New function `arcBetween` to draw an arc between two given+  points.++- A bunch of new modules containing types, primitives and+  utilities for constructing 3D diagrams: `Diagrams.ThreeD.Align`,+  `.Camera`, `.Light`, `.Shapes`, `.Transform`, `.Types`, and+  `.Vector`.  This is still a "feature preview" (in particular,+  appropriate 3D backends are still under construction).++**New instances**++- `AdditiveGroup` and `VectorSpace` instances for `Turn`, `Rad`, `Deg`++- `Alignable` instance for `(->) e`++- `Default` instances for `FillRule`, `FillRuleA`, `LineJoin`,+    `LineCap`, `FillColor`++- `Show` instances for `FillRule`, `FillRuleA`++**API changes**++- `e` no longer exported from `Diagrams.Prelude`.++- `Diagrams.BoundingBox` is no longer exported from `Diagrams.Prelude`.++- Re-export `Diagrams.Core.pointDiagram` from `Diagrams.Prelude`.++- Added `fromAlphaColour` method to `Color` class.++- `&` renamed to `^&`++- Stop re-exporting `tan`, `over`, and `both` from `Data.Colour`.++- New coordinate lenses `_x`, `_y`, and `_z` for `R2`, `P2`, `R3`, `P3`++- Export `fullTurn` from `Diagrams.Prelude`.++- `Codomain (Located a)` is now `Point (Codomain a)` instead of+  `Located (Codomain a)`.++- Export `domainBounds` from `Diagrams.Parametric`.++- Adjusting functionality moved from `Diagrams.Parametric` to its+  own module, `Diagrams.Parametric.Adjust`.++- Rename `strokeT` (and primed variant) to `strokeTrail`; rename+  `strokeLocT` to `strokeLocTrail`.++- `ScaleInv` is now in its own module, `Diagrams.TwoD.Transform.ScaleInv`.++- Re-export `Image` type (but not constructor) from `Diagrams.TwoD`++- Removed `Floating` and `RealFloat` instances for `Turn` and `Deg`++- `offsetSegment` now returns a `Located` instead of a tuple.++- Removed `Num` and `Fractional` instances for `R2`.++**Dependency/version changes**++- Remove `newtype` dependency++- New dependencies on `lens`, `tagged`, `optparse-applicative`,+  `filepath`, `safe`, `vector-space-points`, `MemoTrie`++- Depend on `intervals >= 0.3 && < 0.5`.++**Bug fixes**++- Depend on `intervals 0.3`, which allows diagrams to build on+  Windows, by evading a GHCi linker bug which affects the FFI use in+  previous versions of intervals ([diagrams-contrib#14](https://github.com/diagrams/diagrams-contrib/issues/14))++- Use point envelope at the origin for text objects instead of an+  empty envelope+  ([#115](https://github.com/diagrams/diagrams-lib/issues/115),+  [#116](https://github.com/diagrams/diagrams-lib/issues/116)).++- Adjusting the end of a trail now works correctly ([#95](https://github.com/diagrams/diagrams-lib/issues/95)).++- Only look for miter join on corners in `Diagrams.TwoD.Offset` ([#118](https://github.com/diagrams/diagrams-lib/issues/118)).++- `wedge` from `Diagrams.TwoD.Arc` is now a Loop ([#99](https://github.com/diagrams/diagrams-lib/issues/99))++- Arrows do not behave correctly under scaling [\#112](https://github.com/diagrams/diagrams-lib/issues/112)++**Performance improvements**++- `R2` is now strict and `UNPACK`ed++- Add strictness to `Offset`, `Segment`, `OffsetEnvelope`, and `SizeSpec2D`.++- Make `getEnvelope` calculation for `Segment` more efficient by+  floating divisions out of the inner calculation.++- Use a specialized `HasTrie` instance for `R2`.+++**Closed issues:**++- diagrams-lib-0.7.1.1 fails to build with ghc-7.7 \(-HEAD\) [\#128](https://github.com/diagrams/diagrams-lib/issues/128)++- Arrow misses target [\#126](https://github.com/diagrams/diagrams-lib/issues/126)++**Merged pull requests:**++- Lenses for setting arrow head, tail, and shaft colors [\#138](https://github.com/diagrams/diagrams-lib/pull/138) ([byorgey](https://github.com/byorgey))++- Delayed subtrees [\#137](https://github.com/diagrams/diagrams-lib/pull/137) ([byorgey](https://github.com/byorgey))++- Add helpers for common optparse-applicative backend command line. [\#135](https://github.com/diagrams/diagrams-lib/pull/135) ([fryguybob](https://github.com/fryguybob))++- add located lens for access into Located things [\#134](https://github.com/diagrams/diagrams-lib/pull/134) ([byorgey](https://github.com/byorgey))++- add b-\>a instance for Alignable [\#133](https://github.com/diagrams/diagrams-lib/pull/133) ([cscheid](https://github.com/cscheid))++- Strictness optimizations [\#132](https://github.com/diagrams/diagrams-lib/pull/132) ([JohnLato](https://github.com/JohnLato))++- Lens [\#131](https://github.com/diagrams/diagrams-lib/pull/131) ([jeffreyrosenbluth](https://github.com/jeffreyrosenbluth))++- 3D scaling, alignment, coordinate lenses [\#129](https://github.com/diagrams/diagrams-lib/pull/129) ([bergey](https://github.com/bergey))++- correctly \(?\) compute shaftScale by solving a quadratic [\#127](https://github.com/diagrams/diagrams-lib/pull/127) ([byorgey](https://github.com/byorgey))++- calculate arrow shaftScale using projection of ends onto shaft offset [\#125](https://github.com/diagrams/diagrams-lib/pull/125) ([bergey](https://github.com/bergey))++- Convert from newtype to lens [\#124](https://github.com/diagrams/diagrams-lib/pull/124) ([byorgey](https://github.com/byorgey))++- Version bump on lens [\#123](https://github.com/diagrams/diagrams-lib/pull/123) ([haasn](https://github.com/haasn))++## [v0.7.1.1](https://github.com/diagrams/diagrams-lib/tree/v0.7.1.1) (2013-09-27)++[Full Changelog](https://github.com/diagrams/diagrams-lib/compare/v0.7.1...v0.7.1.1)++**Implemented enhancements:**++- Use a point envelope for built-in text objects [\#116](https://github.com/diagrams/diagrams-lib/issues/116)++- implement rotations in 3D [\#86](https://github.com/diagrams/diagrams-lib/issues/86)++- Control over boundary conditions on cubic splines. [\#32](https://github.com/diagrams/diagrams-lib/issues/32)++**Fixed bugs:**++- diagrams with empty envelopes are not properly separated by struts [\#115](https://github.com/diagrams/diagrams-lib/issues/115)++**Closed issues:**++- calculate ratio between two angles [\#109](https://github.com/diagrams/diagrams-lib/issues/109)++- Add primitives for arrows [\#73](https://github.com/diagrams/diagrams-lib/issues/73)++**Merged pull requests:**++- Three d render [\#114](https://github.com/diagrams/diagrams-lib/pull/114) ([bergey](https://github.com/bergey))++- API for computing tangent and normal vectors to segments and trails [\#113](https://github.com/diagrams/diagrams-lib/pull/113) ([byorgey](https://github.com/byorgey))++- change default styles for arrows [\#111](https://github.com/diagrams/diagrams-lib/pull/111) ([byorgey](https://github.com/byorgey))++- 3D utility functions [\#107](https://github.com/diagrams/diagrams-lib/pull/107) ([bergey](https://github.com/bergey))++## [v0.7.1](https://github.com/diagrams/diagrams-lib/tree/v0.7.1) (2013-09-11)++**New features**++- New standard miter limit attribute++- New functions `lineColorA`, `lineWidthA`, `lineMiterLimitA`,+  `fontSizeA` for directly applying attribute values++- `setDefault2DAttributes` now sets default line cap (butt), line+  join (miter), and miter limit (10) attributes++**New instances**++- `Data.Default` instances for++- `LineCap`++- `LineJoin`++- `LineMiterLimit`++- `LineWidth`++- `LineColor`++- `FontSize`++[Full Changelog](https://github.com/diagrams/diagrams-lib/compare/v0.7...v0.7.1)++**Implemented enhancements:**++- Path expansion. [\#55](https://github.com/diagrams/diagrams-lib/issues/55)++- way to move diagrams closer together [\#18](https://github.com/diagrams/diagrams-lib/issues/18)++**Fixed bugs:**++- wedge should be closed [\#99](https://github.com/diagrams/diagrams-lib/issues/99)++- Adjusting trail from the end has no effect [\#95](https://github.com/diagrams/diagrams-lib/issues/95)++**Merged pull requests:**++- Add offsetTrail and expandTrail. [\#103](https://github.com/diagrams/diagrams-lib/pull/103) ([fryguybob](https://github.com/fryguybob))++- change Codomain of Located to Point \(Codomain a\) [\#102](https://github.com/diagrams/diagrams-lib/pull/102) ([byorgey](https://github.com/byorgey))++- Default and Show instances for FillRule and FillRuleA [\#100](https://github.com/diagrams/diagrams-lib/pull/100) ([jbracker](https://github.com/jbracker))++- Changes required due to the introduction of Roles in GHC [\#98](https://github.com/diagrams/diagrams-lib/pull/98) ([co-dan](https://github.com/co-dan))++- removed default implementation of reverseDomain [\#97](https://github.com/diagrams/diagrams-lib/pull/97) ([jeffreyrosenbluth](https://github.com/jeffreyrosenbluth))++- fixed issue \#95 [\#96](https://github.com/diagrams/diagrams-lib/pull/96) ([jeffreyrosenbluth](https://github.com/jeffreyrosenbluth))++## [v0.7](https://github.com/diagrams/diagrams-lib/tree/v0.7) (2013-08-09)++[Full Changelog](https://github.com/diagrams/diagrams-lib/compare/v0.6.0.3...v0.7)++**New features**++- New module `Diagrams.TwoD.Curvature`, for computing the+  curvature of 2D segments at any given point.++- New module `Diagrams.Offset`, containing an `offsetSegment`+  function that builds a trail a fixed distance from the original+  segment.  This is a precursor to planned functions `offsetTrail`+  and `offsetPath`.++- New function `Diagrams.TwoD.Transform.onBasis`, for extracting a+  matrix representation of a 2D transformation++- New functions `extrudeEnvelope` and `intrudeEnvelope`, for+  extending or shrinking an envelope only in a certain direction.++- Generalize the `Color` class to absolute colors.+  This addresses concerns raised in issue #66 by letting the backend+  choose which color space to render `Color` instances to. Functions are+  provided for backwards compatibility with the old semantics.++- New function `scaleInvPrim` for creating a diagram from a single+  scale-invariant primitive.++- New module `Diagrams.Parametric`, containing a collection of+  classes abstracting over "parametric" things: `Parametric`,+  `DomainBounds`, `EndValues`, `Sectionable`, and `HasArcLength`,+  with instances for segments, trails, and related things.++- A big refactoring of segments and trails:++  - Segments can now be either "closed" or "open".++  - There are now two types of trails: "lines" (which travel+    from point A to point B) or "loops" (closed curves which end+      where they started). `Trail` is now a wrapper type which can+      contain both loops and lines.++  - There is a new `Located` wrapper type for adding locations to+    translation-invariant things.  `Path`s now consist of a+    collection of `Located Trail`s.++  - The `PathLike` class is now renamed to `TrailLike`; the+    `trailLike` function takes a `Located Trail` as input.++- New convenience functions `boundaryFrom` and `boundaryFromMay`,+  for computing boundaries of subdiagrams.++- Re-export from `diagrams-lib` a lot of things defined in+  `diagrams-core`, to make them easier for users to find.  Several+  new modules have been created as a result: `Diagrams.Query`,+  `Diagrams.Envelope`, `Diagrams.Trace`, and `Diagrams.Names`.++- Export the `centroid` function from `Diagrams.Prelude`.++- `triangle` is now a synonym for `eqTriangle`.++**New instances**++- `IsPrim` instances for `Path`, `Ellipsoid`, `Image`, `Text`, and+  `ScaleInv`++- `Eq`, `Ord`, and `Show` instances for `SizeSpec2D`++**API changes**++- `CircleFrac` has been renamed `Turn` (though `CircleFrac` is+  retained as a deprecated synonym).++- `Diagrams.Coordinates` is no longer exported from+  `Diagrams.Prelude`.  This is for compatibility with `lens`, as `(&)`+  is a rather important lens operator and clashes with+  `Diagrams.Coordinates`.  Users who want the `Coordinates` stuff can import+  `Diagrams.Coordinates` explicitly.++**Dependency/version changes**++- allow `base-4.7`++- upgrade to `monoid-extras-0.3`++- depend on `data-default-class` instead of `data-default`++- Tested with GHC 7.7.++**Bug fixes**++- Added a special case that was a not handled properly by the+  quadratic solver, resulting in bogus envelopes in certain cases+  (#88).++- Import only `Data.NumInstances.Tuple` instead of+  `Data.NumInstances`. Previously, `Diagrams.Prelude` exported+  `Eq`, `Show`, and `Num` instances for functions and tuples; now+  it only exports tuple instances. Users wishing to use+  `Diagrams.CubicSpline` with a vector space built over functions (!?)+  can import `Data.NumInstances.Function` themselves. (#48)++- Do scaling on a `Path` *before* constructing a `TrailLike` in+      `rect` (#43)++**Implemented enhancements:**++- Split PathLike, Trail, and Path into separate modules [\#25](https://github.com/diagrams/diagrams-lib/issues/25)++- Add support for path-oriented diagrams. [\#13](https://github.com/diagrams/diagrams-lib/issues/13)++**Fixed bugs:**++- Wrong envelope for cubic segment [\#88](https://github.com/diagrams/diagrams-lib/issues/88)++- Fix documentation of beside, \(===\), and \(|||\) re: monoidal semantics [\#83](https://github.com/diagrams/diagrams-lib/issues/83)++- reverseTrail should not generate extra segments for closed trails [\#24](https://github.com/diagrams/diagrams-lib/issues/24)++**Closed issues:**++- Test issue [\#91](https://github.com/diagrams/diagrams-lib/issues/91)++**Merged pull requests:**++- Add parametric generalizations for segments, trails, Located, etc. [\#92](https://github.com/diagrams/diagrams-lib/pull/92) ([byorgey](https://github.com/byorgey))++- Adding type signature so it compiles with GHC7.7 [\#90](https://github.com/diagrams/diagrams-lib/pull/90) ([co-dan](https://github.com/co-dan))++- bug fix: add special case for b==0 to quadform solver [\#89](https://github.com/diagrams/diagrams-lib/pull/89) ([byorgey](https://github.com/byorgey))++- Big refactoring of segments and trails. [\#87](https://github.com/diagrams/diagrams-lib/pull/87) ([byorgey](https://github.com/byorgey))++- Stop exporting Diagrams.Coordinates from Diagrams.Prelude [\#82](https://github.com/diagrams/diagrams-lib/pull/82) ([byorgey](https://github.com/byorgey))++- Generalization of R2 to D2 a [\#65](https://github.com/diagrams/diagrams-lib/pull/65) ([jbracker](https://github.com/jbracker))++## [v0.6.0.3](https://github.com/diagrams/diagrams-lib/tree/v0.6.0.3) (2013-05-04)++[Full Changelog](https://github.com/diagrams/diagrams-lib/compare/v0.6.0.2...v0.6.0.3)++**Closed issues:**++- Offset [\#80](https://github.com/diagrams/diagrams-lib/issues/80)++**Merged pull requests:**++- Added offsetSegment function [\#79](https://github.com/diagrams/diagrams-lib/pull/79) ([fryguybob](https://github.com/fryguybob))++- Working on adding curvature. [\#74](https://github.com/diagrams/diagrams-lib/pull/74) ([fryguybob](https://github.com/fryguybob))++- New `scaleInvPrim` function [\#71](https://github.com/diagrams/diagrams-lib/pull/71) ([byorgey](https://github.com/byorgey))++## [v0.6.0.2](https://github.com/diagrams/diagrams-lib/tree/v0.6.0.2) (2013-03-29)++[Full Changelog](https://github.com/diagrams/diagrams-lib/compare/types-generalized...v0.6.0.2)++**Implemented enhancements:**++- Don't export Eq and Show instances for functions from Diagrams.Prelude [\#48](https://github.com/diagrams/diagrams-lib/issues/48)++**Closed issues:**++- radius is wrong [\#75](https://github.com/diagrams/diagrams-lib/issues/75)++**Merged pull requests:**++- Matrix basis rep [\#78](https://github.com/diagrams/diagrams-lib/pull/78) ([bergey](https://github.com/bergey))++## [types-generalized](https://github.com/diagrams/diagrams-lib/tree/types-generalized) (2013-02-13)++[Full Changelog](https://github.com/diagrams/diagrams-lib/compare/v0.6.0.1...types-generalized)++## [v0.6.0.1](https://github.com/diagrams/diagrams-lib/tree/v0.6.0.1) (2013-01-07)++[Full Changelog](https://github.com/diagrams/diagrams-lib/compare/v0.6...v0.6.0.1)++**Fixed bugs:**++- text on zero width rect leads to nans [\#51](https://github.com/diagrams/diagrams-lib/issues/51)++- wrong result when using `beside` with circle and vector \(1 & \(-1\)\) [\#46](https://github.com/diagrams/diagrams-lib/issues/46)++- Handle `rect` with zero arguments. [\#43](https://github.com/diagrams/diagrams-lib/issues/43)++**Closed issues:**++- Generalization of color space used in rendering [\#66](https://github.com/diagrams/diagrams-lib/issues/66)++**Merged pull requests:**++- do scaling on a Path before constructing PathLike in 'rect' \(fixes \#43\) [\#70](https://github.com/diagrams/diagrams-lib/pull/70) ([byorgey](https://github.com/byorgey))++## [v0.6](https://github.com/diagrams/diagrams-lib/tree/v0.6) (2012-12-12)++[Full Changelog](https://github.com/diagrams/diagrams-lib/compare/0_5_0_1...v0.6)++**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.++**Implemented enhancements:**++- Enhancements for `arc`s. [\#54](https://github.com/diagrams/diagrams-lib/issues/54)++- align and friends should be in terms of a new 'Alignable' class instead of 'Boundable' [\#31](https://github.com/diagrams/diagrams-lib/issues/31)++- Tools for more accurate boundary calculations in common cases [\#30](https://github.com/diagrams/diagrams-lib/issues/30)++- Reimplement Diagrams.TwoD.Ellipse in terms of Diagrams.TwoD.Arc [\#27](https://github.com/diagrams/diagrams-lib/issues/27)++- Function to convert angles into 2D unit vectors [\#23](https://github.com/diagrams/diagrams-lib/issues/23)++- 2D specialization of 'beside' which takes an angle instead of a vector [\#22](https://github.com/diagrams/diagrams-lib/issues/22)++- Generalize showOrigin function [\#21](https://github.com/diagrams/diagrams-lib/issues/21)++- Add generic 'extent' and 'breadth' ? functions [\#20](https://github.com/diagrams/diagrams-lib/issues/20)++- Add shearing transformations to standard library [\#19](https://github.com/diagrams/diagrams-lib/issues/19)++- Add support for text [\#15](https://github.com/diagrams/diagrams-lib/issues/15)++- Allow the user to choose the fill rule used for paths when stroking [\#14](https://github.com/diagrams/diagrams-lib/issues/14)++- Image primitives [\#10](https://github.com/diagrams/diagrams-lib/issues/10)++- Merge polygon code from Dmitry Olshansky [\#4](https://github.com/diagrams/diagrams-lib/issues/4)++**Fixed bugs:**++- Enhancements for `arc`s. [\#54](https://github.com/diagrams/diagrams-lib/issues/54)++- boundingBox computes incorrect bounding box for transformed diagrams [\#39](https://github.com/diagrams/diagrams-lib/issues/39)++- hcat is really \*terrible\* performance-wise [\#28](https://github.com/diagrams/diagrams-lib/issues/28)++- stroke sets the fill rule attribute to a default value, so it can't be changed later [\#26](https://github.com/diagrams/diagrams-lib/issues/26)++- Text alignment should be with respect to descent and ascent lines rather than text bounding box [\#17](https://github.com/diagrams/diagrams-lib/issues/17)++- incorrect bounds for Bezier segments [\#11](https://github.com/diagrams/diagrams-lib/issues/11)++- More combinators in D.Combinators [\#5](https://github.com/diagrams/diagrams-lib/issues/5)++**Merged pull requests:**++- clean up and fix bugs with ScaleInv wrapper [\#69](https://github.com/diagrams/diagrams-lib/pull/69) ([byorgey](https://github.com/byorgey))++- Patch proposal for generalized Color [\#67](https://github.com/diagrams/diagrams-lib/pull/67) ([haasn](https://github.com/haasn))++- Renamed `expandPath` to `scalePath` to make room [\#61](https://github.com/diagrams/diagrams-lib/pull/61) ([fryguybob](https://github.com/fryguybob))++- Envelope deformation [\#60](https://github.com/diagrams/diagrams-lib/pull/60) ([mgsloan](https://github.com/mgsloan))++- Added `Eq` instances for some data structures. [\#59](https://github.com/diagrams/diagrams-lib/pull/59) ([fryguybob](https://github.com/fryguybob))++- More involved diameter benchmark + better implementation [\#58](https://github.com/diagrams/diagrams-lib/pull/58) ([mgsloan](https://github.com/mgsloan))++- Add NullBackend for Ellipsoid [\#57](https://github.com/diagrams/diagrams-lib/pull/57) ([mgsloan](https://github.com/mgsloan))++- Fixed `arc` and `arcT` so they are always CCW. [\#56](https://github.com/diagrams/diagrams-lib/pull/56) ([fryguybob](https://github.com/fryguybob))++- new sized, sizedAs, and sizeSpec2D functions [\#52](https://github.com/diagrams/diagrams-lib/pull/52) ([byorgey](https://github.com/byorgey))++- Update to track with diagrams-core renaming, and a better Show instance for R2 [\#47](https://github.com/diagrams/diagrams-lib/pull/47) ([byorgey](https://github.com/byorgey))++- Minor tweaks due to monoid-extra and dual-tree changes [\#45](https://github.com/diagrams/diagrams-lib/pull/45) ([byorgey](https://github.com/byorgey))++- split out default attribute setting and size adjustment into separate functions [\#42](https://github.com/diagrams/diagrams-lib/pull/42) ([byorgey](https://github.com/byorgey))++- make beneath infixl 6 [\#41](https://github.com/diagrams/diagrams-lib/pull/41) ([byorgey](https://github.com/byorgey))++- scale invariant [\#3](https://github.com/diagrams/diagrams-lib/pull/3) ([ludflu](https://github.com/ludflu))++- BoundingBox is now Monoidal [\#2](https://github.com/diagrams/diagrams-lib/pull/2) ([mgsloan](https://github.com/mgsloan))++- New module enabling nice syntax for constructing and pattern-matching literal points and vectors [\#1](https://github.com/diagrams/diagrams-lib/pull/1) ([byorgey](https://github.com/byorgey))++## [v0.5.0.1](https://github.com/diagrams/diagrams-lib/tree/0_5_0_1) (2012-07-24)++[Full Changelog](https://github.com/diagrams/diagrams-lib/compare/0_5...0_5_0_1)++## [v0.5](https://github.com/diagrams/diagrams-lib/tree/0_5) (2012-03-09)++[Full Changelog](https://github.com/diagrams/diagrams-lib/compare/0_4...0_5)++**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.++## [v0.4.0.1] () (30 October 2011)+------------------------++- bump `data-default` dependency to allow version 0.3++## [v0.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++## [v0.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)++## [v0.2]() (3 June 2011)+----------------++**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++## [v0.1.1]() (18 May 2011)+------------------++* minor documentation fixes++* link to new website++## [v0.1]() [17 May 2011]+----------------++* initial preview release++\* *This Change Log was automatically generated by (and then edited by hand) [github_changelog_generator](https://github.com/skywinder/Github-Changelog-Generator)*

− CHANGES.markdown

@@ -1,405 +0,0 @@-0.7.1.1 (27 September 2013)------------------------------* allow semigroups-0.11--0.7.1 (11 September 2013)----------------------------* **New features**--    - New standard miter limit attribute-    - New functions `lineColorA`, `lineWidthA`, `lineMiterLimitA`,-      `fontSizeA` for directly applying attribute values-    - `setDefault2DAttributes` now sets default line cap (butt), line-      join (miter), and miter limit (10) attributes--* **New instances**--    - `Data.Default` instances for-        - `LineCap`-	- `LineJoin`-	- `LineMiterLimit`-	- `LineWidth`-	- `LineColor`-	- `FontSize`--0.7 (9 August 2013)----------------------* **New features**--    - New module `Diagrams.TwoD.Curvature`, for computing the-      curvature of 2D segments at any given point.-    - New module `Diagrams.Offset`, containing an `offsetSegment`-      function that builds a trail a fixed distance from the original-      segment.  This is a precursor to planned functions `offsetTrail`-      and `offsetPath`.-    - New function `Diagrams.TwoD.Transform.onBasis`, for extracting a-      matrix representation of a 2D transformation-    - New functions `extrudeEnvelope` and `intrudeEnvelope`, for-      extending or shrinking an envelope only in a certain direction.-    - Generalize the `Color` class to absolute colors.-      This addresses concerns raised in issue #66 by letting the backend-      choose which color space to render `Color` instances to. Functions are-      provided for backwards compatibility with the old semantics.-    - New function `scaleInvPrim` for creating a diagram from a single-      scale-invariant primitive.-    - New module `Diagrams.Parametric`, containing a collection of-      classes abstracting over "parametric" things: `Parametric`,-      `DomainBounds`, `EndValues`, `Sectionable`, and `HasArcLength`,-      with instances for segments, trails, and related things.-    - A big refactoring of segments and trails:-        - Segments can now be either "closed" or "open".-        - There are now two types of trails: "lines" (which travel-          from point A to point B) or "loops" (closed curves which end-          where they started). `Trail` is now a wrapper type which can-          contain both loops and lines.-        - There is a new `Located` wrapper type for adding locations to-          translation-invariant things.  `Path`s now consist of a-          collection of `Located Trail`s.-        - The `PathLike` class is now renamed to `TrailLike`; the-          `trailLike` function takes a `Located Trail` as input.-    - New convenience functions `boundaryFrom` and `boundaryFromMay`,-      for computing boundaries of subdiagrams.-    - Re-export from `diagrams-lib` a lot of things defined in-      `diagrams-core`, to make them easier for users to find.  Several-      new modules have been created as a result: `Diagrams.Query`,-      `Diagrams.Envelope`, `Diagrams.Trace`, and `Diagrams.Names`.-    - Export the `centroid` function from `Diagrams.Prelude`.-    - `triangle` is now a synonym for `eqTriangle`.--* **New instances**--    - `IsPrim` instances for `Path`, `Ellipsoid`, `Image`, `Text`, and-      `ScaleInv`-    - `Eq`, `Ord`, and `Show` instances for `SizeSpec2D`--* **API changes**--    - `CircleFrac` has been renamed `Turn` (though `CircleFrac` is-      retained as a deprecated synonym).-    - `Diagrams.Coordinates` is no longer exported from-      `Diagrams.Prelude`.  This is for compatibility with `lens`, as `(&)`-      is a rather important lens operator and clashes with-      `Diagrams.Coordinates`.  Users who want the `Coordinates` stuff can import-      `Diagrams.Coordinates` explicitly.--* **Dependency/version changes**--    - allow `base-4.7`-    - upgrade to `monoid-extras-0.3`-    - depend on `data-default-class` instead of `data-default`-    - Tested with GHC 7.7.--* **Bug fixes**--    - Added a special case that was a not handled properly by the-      quadratic solver, resulting in bogus envelopes in certain cases-      (#88).-    - Import only `Data.NumInstances.Tuple` instead of-      `Data.NumInstances`. Previously, `Diagrams.Prelude` exported-      `Eq`, `Show`, and `Num` instances for functions and tuples; now-      it only exports tuple instances. Users wishing to use-      `Diagrams.CubicSpline` with a vector space built over functions (!?)-      can import `Data.NumInstances.Function` themselves. (#48)-    - Do scaling on a `Path` *before* constructing a `TrailLike` in-      `rect` (#43)--0.6.0.3 (4 May 2013)-----------------------* bump upper bound to allow `NumInstances-1.3`--0.6.0.2 (28 March 2013)--------------------------* bump upper bound to allow `NumInstances-1.2`--* Quadratic solver is now more numerically stable, getting rid of some-  incorrect behavior of `juxtapose`-  ([\#46](https://github.com/diagrams/diagrams-lib/issues/46))--0.6.0.1: 7 January 2013--------------------------* allow `semigroups-0.9`--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

LICENSE view

@@ -1,15 +1,35 @@-Copyright (c) 2011-2013 diagrams-lib team:+Copyright (c) 2011-2016 diagrams-lib team: +  Florent Becker <florent.becker@univ-orleans.fr>+  Jan Bracker <jan.bracker@googlemail.com>   Daniel Bergey <bergey@alum.mit.edu>+  Vincent Berthoux <vincent.berthoux@gmail.com>+  Christopher Chalmers <c.chalmers@me.com>+  Michael Chavinda <mchavinda@colgate.edu>+  Denys Duchier <denys.duchier@univ-orleans.fr>   Daniil Frumin <difrumin@gmail.com>+  Ben Gamari <ben@smart-cactus.org>+  Allan Gardner <allanegardner@gmail.com>+  Pontus Granström <pnutus@gmail.com>+  Gabor Greif <ggreif@gmail.com>   Niklas Haas <nand@lavabit.com>   Peter Hall <peter.hall@memorphic.com>+  Dashiell Halpern   Claude Heiland-Allen <claudiusmaximus@goto10.org>   Deepak Jois <deepak.jois@gmail.com>+  Sidharth Kapur <sidharthkapur1@gmail.com>+  Taru Karttunen <taruti@taruti.net>+  John Lato <jwlato@tsurucapital.com>+  Konrad Madej <kdmadej@gmail.com>+  Chris Mears <chris@cmears.id.au>+  Alexis Praga <praga@cerfacs.fr>+  Jeffrey Rosenbluth <jeffrey.rosenbluth@gmail.com>   Ian Ross <ian@skybluetrades.net>+  Carlos Scheidegger <cscheid@research.att.com>   Michael Sloan <mgsloan@gmail.com>   Jim Snavely <ludflu@gmail.com>   Kanchalai Suveepattananont <ksuvee@seas.upenn.edu>+  Robert Vollmert <rfvollmert@gmail.com>   Scott Walck <walck@lvc.edu>   Ryan Yates <fryguybob@gmail.com>   Brent Yorgey <byorgey@cis.upenn.edu>

README.markdown view

@@ -1,4 +1,4 @@-[![Build Status](https://secure.travis-ci.org/diagrams/diagrams-lib.png)](http://travis-ci.org/diagrams/diagrams-lib)+[![Build Status](https://github.com/diagrams/diagrams-lib/actions/workflows/haskell-ci.yml/badge.svg)](https://github.com/diagrams/diagrams-lib/actions/workflows/haskell-ci.yml)  The standard library for [diagrams](http://projects.haskell.org/diagrams/), a Haskell embedded

Setup.hs view

@@ -1,29 +1,2 @@-import           Data.List                 (isSuffixOf) import           Distribution.Simple-import           Distribution.Simple.Setup (Flag (..), HaddockFlags,-                                            haddockDistPref)-import           Distribution.Simple.Utils (copyFiles)-import           Distribution.Text         (display)-import           Distribution.Verbosity    (normal)-import           System.Directory          (getDirectoryContents)-import           System.FilePath           ((</>))---- Ugly hack, logic copied from Distribution.Simple.Haddock-haddockOutputDir :: Package pkg => HaddockFlags -> pkg -> FilePath-haddockOutputDir flags pkg = destDir-   where-     baseDir = case haddockDistPref flags of-                      NoFlag -> "."-                      Flag x -> x-     destDir = baseDir </> "doc" </> "html" </> display (packageName pkg)--diagramsDir = "diagrams"--main :: IO ()-main = defaultMainWithHooks simpleUserHooks-         { postHaddock = \args flags pkg lbi -> do-             dias <- filter ("svg" `isSuffixOf`) `fmap` getDirectoryContents diagramsDir-             copyFiles normal (haddockOutputDir flags pkg)-               (map (\d -> ("", diagramsDir </> d)) dias)-             postHaddock simpleUserHooks args flags pkg lbi-         }+main = defaultMain

diagrams-lib.cabal view

@@ -1,5 +1,5 @@ Name:                diagrams-lib-Version:             0.7.1.1+Version:             1.5.1 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@@ -7,83 +7,176 @@                      multiple backends.  diagrams-lib provides a                      standard library of primitives and operations for                      creating diagrams.  To get started using it, see-                     "Diagrams.Prelude".-Homepage:            http://projects.haskell.org/diagrams+                     the "Diagrams" module, and refer to the tutorials and+                     documentation on the diagrams website,+                     <http://diagrams.github.io>.+Homepage:            http://diagrams.github.io License:             BSD3 License-file:        LICENSE Author:              Brent Yorgey Maintainer:          diagrams-discuss@googlegroups.com Bug-reports:         http://github.com/diagrams/diagrams-lib/issues Category:            Graphics-Build-type:          Custom-Cabal-version:       >=1.10-Extra-source-files:  CHANGES.markdown, README.markdown, diagrams/*.svg-Tested-with:         GHC == 7.4.2, GHC == 7.6.1+Build-type:          Simple+Cabal-version:       1.18+Extra-source-files:  diagrams/*.svg+Extra-doc-files:     CHANGELOG.md, README.markdown, diagrams/*.svg+Tested-with:         GHC ==8.4.4 || ==8.6.5 || ==8.8.4 || ==8.10.7 || ==9.0.2 || ==9.2.8 || ==9.4.8 || ==9.6.6 || ==9.8.2 || ==9.10.1 || ==9.12.1 Source-repository head   type:     git   location: http://github.com/diagrams/diagrams-lib.git  Library-  Exposed-modules:     Diagrams.Prelude,+  Exposed-modules:     Diagrams,+                       Diagrams.Prelude,                        Diagrams.Align,+                       Diagrams.Angle,+                       Diagrams.Animation,+                       Diagrams.Animation.Active,+                       Diagrams.Attributes,+                       Diagrams.Attributes.Compile,+                       Diagrams.Backend.CmdLine,+                       Diagrams.BoundingBox,                        Diagrams.Combinators,                        Diagrams.Coordinates,-                       Diagrams.Attributes,-                       Diagrams.Points,+                       Diagrams.CubicSpline,+                       Diagrams.CubicSpline.Boehm,+                       Diagrams.CubicSpline.Internal,+                       Diagrams.Deform+                       Diagrams.Direction,+                       Diagrams.Envelope,+                       Diagrams.LinearMap,                        Diagrams.Located,+                       Diagrams.Names,                        Diagrams.Parametric,+                       Diagrams.Parametric.Adjust,+                       Diagrams.Path,+                       Diagrams.Points,+                       Diagrams.Query,                        Diagrams.Segment,+                       Diagrams.Size,+                       Diagrams.Tangent,+                       Diagrams.ThreeD,+                       Diagrams.ThreeD.Align,+                       Diagrams.ThreeD.Attributes,+                       Diagrams.ThreeD.Camera,+                       Diagrams.ThreeD.Deform,+                       Diagrams.ThreeD.Light,+                       Diagrams.ThreeD.Shapes,+                       Diagrams.ThreeD.Size,+                       Diagrams.ThreeD.Transform,+                       Diagrams.ThreeD.Projection,+                       Diagrams.ThreeD.Types,+                       Diagrams.ThreeD.Vector,+                       Diagrams.Trace,                        Diagrams.Trail,                        Diagrams.TrailLike,-                       Diagrams.Path,-                       Diagrams.CubicSpline,-                       Diagrams.CubicSpline.Internal,-                       Diagrams.Solve,                        Diagrams.Transform,-                       Diagrams.BoundingBox,-                       Diagrams.Names,-                       Diagrams.Envelope,-                       Diagrams.Trace,-                       Diagrams.Query,+                       Diagrams.Transform.ScaleInv,+                       Diagrams.Transform.Matrix,                        Diagrams.TwoD,-                       Diagrams.TwoD.Types,+                       Diagrams.TwoD.Adjust,                        Diagrams.TwoD.Align,-                       Diagrams.TwoD.Combinators,-                       Diagrams.TwoD.Transform,-                       Diagrams.TwoD.Ellipse,                        Diagrams.TwoD.Arc,-                       Diagrams.TwoD.Segment,+                       Diagrams.TwoD.Arrow,+                       Diagrams.TwoD.Arrowheads,+                       Diagrams.TwoD.Attributes,+                       Diagrams.TwoD.Combinators,                        Diagrams.TwoD.Curvature,+                       Diagrams.TwoD.Deform,+                       Diagrams.TwoD.Ellipse,+                       Diagrams.TwoD.Image,+                       Diagrams.TwoD.Model,                        Diagrams.TwoD.Offset,                        Diagrams.TwoD.Path,+                       Diagrams.TwoD.Points,                        Diagrams.TwoD.Polygons,-                       Diagrams.TwoD.Shapes,-                       Diagrams.TwoD.Vector,+                       Diagrams.TwoD.Segment,+                       Diagrams.TwoD.Segment.Bernstein,                        Diagrams.TwoD.Size,-                       Diagrams.TwoD.Model,+                       Diagrams.TwoD.Shapes,                        Diagrams.TwoD.Text,-                       Diagrams.TwoD.Image,-                       Diagrams.TwoD.Adjust,-                       Diagrams.ThreeD.Types,-                       Diagrams.ThreeD.Shapes,-                       Diagrams.Animation,-                       Diagrams.Animation.Active,-                       Diagrams.Util,-                       Diagrams.Backend.Show-  Build-depends:       base >= 4.2 && < 4.8,-                       containers >= 0.3 && < 0.6,-                       array >= 0.3 && < 0.5,-                       semigroups >= 0.3.4 && < 0.12,-                       monoid-extras >= 0.3 && < 0.4,-                       diagrams-core >= 0.7 && < 0.8,-                       active >= 0.1 && < 0.2,-                       vector-space >= 0.7.7 && < 0.9,-                       NumInstances >= 1.2 && < 1.4,+                       Diagrams.TwoD.Transform,+                       Diagrams.TwoD.Types,+                       Diagrams.TwoD.Vector,+                       Diagrams.Util+  other-modules:       Linear.Vector.Compat+  Build-depends:       base >= 4.9 && < 4.22,+                       containers >= 0.3 && < 0.8,+                       array >= 0.3 && < 0.6,+                       semigroups >= 0.3.4 && < 0.21,+                       monoid-extras >= 0.6 && < 0.8,+                       dual-tree >= 0.2 && < 0.3,+                       diagrams-core >= 1.4 && < 1.6,+                       diagrams-solve >= 0.1 && < 0.2,+                       active >= 0.2 && < 0.3,                        colour >= 2.3.2 && < 2.4,-                       data-default-class < 0.1,-                       pretty >= 1.0.1.2 && < 1.2,-                       newtype >= 0.2 && < 0.3,+                       data-default >= 0.8 && < 0.9,                        fingertree >= 0.1 && < 0.2,-                       intervals >= 0.2.2 && < 0.3+                       intervals >= 0.7 && < 0.10,+                       lens >= 5.1 && < 5.4,+                       tagged >= 0.7 && < 0.9,+                       optparse-applicative >= 0.11 && < 0.20,+                       filepath >= 1.4 && < 1.6,+                       JuicyPixels >= 3.3.4 && < 3.4,+                       hashable >= 1.1 && < 1.6,+                       linear >= 1.20.1 && < 1.24,+                       adjunctions >= 4.0 && < 5.0,+                       distributive >=0.2.2 && < 1.0,+                       process >= 1.1 && < 1.7,+                       directory >= 1.2 && < 1.4,+                       unordered-containers >= 0.2 && < 0.3,+                       text >= 0.7.1 && < 2.2,+                       mtl >= 2.0 && < 2.3 || >= 2.3.1 && < 2.4,+                       transformers >= 0.3.0 && < 0.7.0,+                       profunctors >= 5.0 && < 6.0,+                       exceptions >= 0.6 && < 1.0,+                       cereal >=0.4.1.1 && <0.6,+                       bytestring >=0.9 && <0.13,+                       fail >= 4.9.0.0 && <4.10   Hs-source-dirs:      src+  ghc-options: -Wall   default-language:    Haskell2010+  other-extensions: BangPatterns, CPP, DefaultSignatures, DeriveDataTypeable,+    DeriveFunctor, DeriveGeneric, EmptyDataDecls, ExistentialQuantification,+    GADTs, GeneralizedNewtypeDeriving, NoMonomorphismRestriction, Rank2Types,+    RankNTypes, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell,+    TypeOperators, TypeSynonymInstances, UndecidableInstances, ViewPatterns,+    LambdaCase++test-suite tests+  type: exitcode-stdio-1.0+  main-is: Test.hs+  other-modules: Diagrams.Test.Direction+               , Diagrams.Test.Trail+               , Diagrams.Test.Transform+               , Diagrams.Test.Transform.Matrix+               , Diagrams.Test.TwoD.Offset+               , Diagrams.Test.TwoD.Segment+               , Diagrams.Test.TwoD+               , Diagrams.Test.Angle+               , Instances+  hs-source-dirs: test+  build-depends:       base,+                       tasty >= 0.10 && < 1.6,+                       tasty-hunit >= 0.9.2 && < 0.11,+                       tasty-quickcheck >= 0.8 && < 0.12,+                       QuickCheck >= 2.7,+                       deepseq >= 1.3 && < 1.6,+                       diagrams-lib,+                       lens,+                       distributive,+                       numeric-extras,+                       diagrams-solve+  default-language:    Haskell2010++benchmark benchmarks+  type: exitcode-stdio-1.0+  main-is:Speed.hs+  hs-source-dirs:test+  default-language: Haskell2010+  build-depends:+    base < 5,+    criterion,+    diagrams-core,+    diagrams-lib

− diagrams/besideEx.svg

@@ -1,4 +0,0 @@-<?xml version="1.0" encoding="UTF-8"?>-<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN"-    "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd">-<svg xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" version="1.1" width="84.860339985334" height="100.0" font-size="1" viewBox="0 0 85 100"><g><g transform="matrix(21.832407982400788,0.0,0.0,21.832407982400788,21.832407982400788,78.16759201759922)"><g stroke="rgb(0,0,0)" stroke-opacity="1.0" fill="rgb(128,0,128)" fill-opacity="1.0" stroke-width="1.0e-2" font-size="1.0em"><path d="M 2.8868978654915356,-2.0803467982373034 c 0.0,-0.8284271247461902 -0.6715728752538097,-1.5 -1.4999999999999996 -1.5c -0.8284271247461902,-5.072653133236334e-17 -1.5,0.6715728752538096 -1.5 1.4999999999999996c -1.0145306266472669e-16,0.8284271247461902 0.6715728752538095,1.5 1.4999999999999993 1.5c 0.8284271247461902,1.5217959399709003e-16 1.5,-0.6715728752538094 1.5000000000000002 -1.4999999999999996Z" /></g></g><g transform="matrix(21.832407982400788,0.0,0.0,21.832407982400788,21.832407982400788,78.16759201759922)"><g stroke="rgb(0,0,0)" stroke-opacity="1.0" fill="rgb(255,165,0)" fill-opacity="1.0" stroke-width="1.0e-2" font-size="1.0em"><path d="M 1.0,0.0 c 0.0,-0.5522847498307935 -0.44771525016920644,-1.0 -0.9999999999999998 -1.0c -0.5522847498307935,-3.3817687554908895e-17 -1.0,0.4477152501692064 -1.0 0.9999999999999997c -6.763537510981779e-17,0.5522847498307935 0.4477152501692063,1.0 0.9999999999999996 1.0c 0.5522847498307935,1.0145306266472669e-16 1.0,-0.44771525016920627 1.0000000000000002 -0.9999999999999997Z" /></g></g><g transform="matrix(21.832407982400788,0.0,0.0,21.832407982400788,21.832407982400788,78.16759201759922)"><g stroke="rgb(0,0,0)" stroke-opacity="1.0" fill="rgb(255,0,0)" fill-opacity="1.0" stroke-width="0.0" font-size="1.0em"><path d="M 9.160693596474608e-2,0.0 c 0.0,-5.05931137120553e-2 -4.101382225269076e-2,-9.160693596474608e-2 -9.160693596474606e-2 -9.160693596474608e-2c -5.05931137120553e-2,-3.0979347383183296e-18 -9.160693596474608e-2,4.1013822252690756e-2 -9.160693596474608e-2 9.160693596474605e-2c -6.195869476636659e-18,5.05931137120553e-2 4.1013822252690756e-2,9.160693596474608e-2 9.160693596474603e-2 9.160693596474608e-2c 5.05931137120553e-2,9.293804214954989e-18 9.160693596474608e-2,-4.101382225269075e-2 9.160693596474609e-2 -9.160693596474605e-2Z" /></g></g></g></svg>

− diagrams/closeLineEx.svg

@@ -1,4 +0,0 @@-<?xml version="1.0" encoding="UTF-8"?>-<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN"-    "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd">-<svg xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" version="1.1" width="500.0" height="68.18181818181819" font-size="1" viewBox="0 0 500 68"><g><g transform="matrix(41.32231404958678,0.0,0.0,41.32231404958678,250.0,34.09090909090909)"><g stroke="rgb(0,0,0)" stroke-opacity="1.0" fill="rgb(0,0,0)" fill-opacity="0.0" stroke-width="1.0e-2" font-size="1.0em"><path d="M 3.5,-0.75 l 2.0,1.0 l -3.0,0.5 l -2.0,-1.0 l 1.0,-0.5 h 2.0 Z" /></g></g><g transform="matrix(41.32231404958678,0.0,0.0,41.32231404958678,250.0,34.09090909090909)"><g stroke="rgb(0,0,0)" stroke-opacity="1.0" fill="rgb(0,0,0)" fill-opacity="0.0" stroke-width="1.0e-2" font-size="1.0em"><path d="M -2.5,-0.75 l 2.0,1.0 l -3.0,0.5 l -2.0,-1.0 l 1.0,-0.5 " /></g></g></g></svg>

− diagrams/cubicOffsetExample.svg

@@ -1,4 +0,0 @@-<?xml version="1.0" encoding="UTF-8"?>-<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN"-    "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd">-<svg xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" version="1.1" width="600.0" height="302.8587568898731" font-size="1" viewBox="0 0 600 303"><g><g transform="matrix(13.155574898915933,0.0,0.0,13.155574898915933,72.35566194403765,151.42937844493656)"><g stroke="rgb(0,128,0)" stroke-opacity="1.0" fill="rgb(0,0,0)" fill-opacity="0.0" stroke-width="0.1" font-size="1.0em"><path d="M 33.417476733497544,-1.6473872989404414 c 0.8062160672722946,1.905601613552696 2.6000741970593846,4.243483864433998 6.1181079451566704 6.588839696498854" /></g></g><g transform="matrix(13.155574898915933,0.0,0.0,13.155574898915933,72.35566194403765,151.42937844493656)"><g stroke="rgb(255,0,0)" stroke-opacity="1.0" fill="rgb(0,0,0)" fill-opacity="0.0" stroke-width="0.1" font-size="1.0em"><path d="M 32.86092310128323,-3.9349733247464833 c 2.5438939233202715e-2,0.6274938344190003 0.18344919012734384,1.4057027990550142 0.5565536322143172 2.287586025806042" /></g></g><g transform="matrix(13.155574898915933,0.0,0.0,13.155574898915933,72.35566194403765,151.42937844493656)"><g stroke="rgb(0,128,0)" stroke-opacity="1.0" fill="rgb(0,0,0)" fill-opacity="0.0" stroke-width="0.1" font-size="1.0em"><path d="M 33.000311673428904,-5.029283712603785 c -0.11129079091128233,0.22258158182256466 -0.16025559544153956,0.5795904798926219 -0.13938857214567413 1.0943103878573026" /></g></g><g transform="matrix(13.155574898915933,0.0,0.0,13.155574898915933,72.35566194403765,151.42937844493656)"><g stroke="rgb(255,0,0)" stroke-opacity="1.0" fill="rgb(0,0,0)" fill-opacity="0.0" stroke-width="0.1" font-size="1.0em"><path d="M 32.97862528132407,-5.0044688233462296 c 5.153156049894565e-3,-5.841483753310084e-3 1.692390853525727e-2,-1.5289922118400523e-2 2.1686392104834917e-2 -2.4814889257555817e-2" /></g></g><g transform="matrix(13.155574898915933,0.0,0.0,13.155574898915933,72.35566194403765,151.42937844493656)"><g stroke="rgb(0,128,0)" stroke-opacity="1.0" fill="rgb(0,0,0)" fill-opacity="0.0" stroke-width="0.1" font-size="1.0em"><path d="M 32.70873785722833,-4.826371179429536 c 8.358937623750423e-2,-3.1497446118479856e-2 0.1859951877994061,-8.299958544359087e-2 0.2698874240957419 -0.17809764391669347" /></g></g><g transform="matrix(13.155574898915933,0.0,0.0,13.155574898915933,72.35566194403765,151.42937844493656)"><g stroke="rgb(255,0,0)" stroke-opacity="1.0" fill="rgb(0,0,0)" fill-opacity="0.0" stroke-width="0.1" font-size="1.0em"><path d="M 32.055356993320274,-4.853120624705525 c 0.22391741974384227,0.10443579260779995 0.40910731509659143,0.11879455062523658 0.6533808639080557 2.6749445275989214e-2" /></g></g><g transform="matrix(13.155574898915933,0.0,0.0,13.155574898915933,72.35566194403765,151.42937844493656)"><g stroke="rgb(0,128,0)" stroke-opacity="1.0" fill="rgb(0,0,0)" fill-opacity="0.0" stroke-width="0.1" font-size="1.0em"><path d="M 31.72347357921467,-5.143549245977102 c 9.378804941573246e-2,0.15871823747277802 0.21780468092203953,0.23722193939149805 0.33188341410559885 0.290428621271577" /></g></g><g transform="matrix(13.155574898915933,0.0,0.0,13.155574898915933,72.35566194403765,151.42937844493656)"><g stroke="rgb(255,0,0)" stroke-opacity="1.0" fill="rgb(0,0,0)" fill-opacity="0.0" stroke-width="0.1" font-size="1.0em"><path d="M 31.691808767395802,-5.205805672754545 c 5.879553721364279e-3,2.4935979612594604e-2 2.2991427605793424e-2,4.7578391955314714e-2 3.166481181886982e-2 6.2256426777443974e-2" /></g></g><g transform="matrix(13.155574898915933,0.0,0.0,13.155574898915933,72.35566194403765,151.42937844493656)"><g stroke="rgb(0,128,0)" stroke-opacity="1.0" fill="rgb(0,0,0)" fill-opacity="0.0" stroke-width="0.1" font-size="1.0em"><path d="M 31.711972577462916,-5.042326266928818 c -3.953664939657162e-3,-6.508340746820251e-2 -9.443295519196648e-3,-0.11801225901967066 -2.0163810067113208e-2 -0.163479405825728" /></g></g><g transform="matrix(13.155574898915933,0.0,0.0,13.155574898915933,72.35566194403765,151.42937844493656)"><g stroke="rgb(255,0,0)" stroke-opacity="1.0" fill="rgb(0,0,0)" fill-opacity="0.0" stroke-width="0.1" font-size="1.0em"><path d="M 31.661929314384686,-4.205360512837057 c 4.7781656372351815e-2,-0.35039881339724666 6.298412834573885e-2,-0.6239392027650263 5.004326307822693e-2 -0.8369657540917615" /></g></g><g transform="matrix(13.155574898915933,0.0,0.0,13.155574898915933,72.35566194403765,151.42937844493656)"><g stroke="rgb(0,128,0)" stroke-opacity="1.0" fill="rgb(0,0,0)" fill-opacity="0.0" stroke-width="0.1" font-size="1.0em"><path d="M 28.08645729142907,5.326289096396298 c 2.4270875082384364,-4.854175016476873 3.347932569058263,-7.86302694731943 3.5754720229556165 -9.531649609233355" /></g></g><g transform="matrix(13.155574898915933,0.0,0.0,13.155574898915933,72.35566194403765,151.42937844493656)"><g stroke="rgb(0,0,255)" stroke-opacity="1.0" fill="rgb(0,0,0)" fill-opacity="0.0" stroke-width="0.1" font-size="1.0em"><path d="M 28.980884482428987,5.773502691896256 c 10.0,-20.0 -5.0,-10.0 10.0 0.0" /></g></g><g transform="matrix(13.155574898915933,0.0,0.0,13.155574898915933,72.35566194403765,151.42937844493656)"><g stroke="rgb(0,128,0)" stroke-opacity="1.0" fill="rgb(0,0,0)" fill-opacity="0.0" stroke-width="0.1" font-size="1.0em"><path d="M 22.22681744227194,-4.975977707743982 c 0.0,1.1652184940288222 4.623280507125882e-2,5.8820192426981635 4.707106781186548 10.542893218813452" /></g></g><g transform="matrix(13.155574898915933,0.0,0.0,13.155574898915933,72.35566194403765,151.42937844493656)"><g stroke="rgb(255,0,0)" stroke-opacity="1.0" fill="rgb(0,0,0)" fill-opacity="0.0" stroke-width="0.1" font-size="1.0em"><path d="M 22.22527234029002,-5.190961309967572 c 1.3596945248057525e-3,5.336801009862579e-2 1.5451019819200384e-3,0.12796315263602145 1.5451019819200384e-3 0.21498360222358961" /></g></g><g transform="matrix(13.155574898915933,0.0,0.0,13.155574898915933,72.35566194403765,151.42937844493656)"><g stroke="rgb(0,128,0)" stroke-opacity="1.0" fill="rgb(0,0,0)" fill-opacity="0.0" stroke-width="0.1" font-size="1.0em"><path d="M 22.219061458808028,-5.310773112363486 c 2.667352776137804e-3,3.119320885427821e-2 5.02539135926483e-3,7.328131507884304e-2 6.2108814819927805e-3 0.11981180239591362" /></g></g><g transform="matrix(13.155574898915933,0.0,0.0,13.155574898915933,72.35566194403765,151.42937844493656)"><g stroke="rgb(255,0,0)" stroke-opacity="1.0" fill="rgb(0,0,0)" fill-opacity="0.0" stroke-width="0.1" font-size="1.0em"><path d="M 22.17283082599389,-5.555708087831506 c 1.5097180450167632e-2,4.9065836463044805e-2 3.77384688109178e-2,0.14562383531926093 4.6230632814137085e-2 0.2449349754680199" /></g></g><g transform="matrix(13.155574898915933,0.0,0.0,13.155574898915933,72.35566194403765,151.42937844493656)"><g stroke="rgb(0,128,0)" stroke-opacity="1.0" fill="rgb(0,0,0)" fill-opacity="0.0" stroke-width="0.1" font-size="1.0em"><path d="M 21.98765210484117,-5.902700770832827 c 5.915986229623687e-2,7.248909052964826e-2 0.1384351262519885,0.19507599957394778 0.18517872115271883 0.34699268300132147" /></g></g><g transform="matrix(13.155574898915933,0.0,0.0,13.155574898915933,72.35566194403765,151.42937844493656)"><g stroke="rgb(255,0,0)" stroke-opacity="1.0" fill="rgb(0,0,0)" fill-opacity="0.0" stroke-width="0.1" font-size="1.0em"><path d="M 21.651201254320615,-6.170110768106993 c 0.11662169140991802,5.726092743049299e-2 0.23178207485071373,0.1391584419009324 0.33645085052055707 0.26740999727416637" /></g></g><g transform="matrix(13.155574898915933,0.0,0.0,13.155574898915933,72.35566194403765,151.42937844493656)"><g stroke="rgb(0,128,0)" stroke-opacity="1.0" fill="rgb(0,0,0)" fill-opacity="0.0" stroke-width="0.1" font-size="1.0em"><path d="M 21.098403476790917,-6.266956245808321 c 0.20191976907307557,-2.2211174598038314e-2 0.3705651859412463,7.369780030821671e-3 0.552797777529697 9.684547770132823e-2" /></g></g><g transform="matrix(13.155574898915933,0.0,0.0,13.155574898915933,72.35566194403765,151.42937844493656)"><g stroke="rgb(255,0,0)" stroke-opacity="1.0" fill="rgb(0,0,0)" fill-opacity="0.0" stroke-width="0.1" font-size="1.0em"><path d="M 20.68717773824717,-6.127488517764909 c 0.14370207595416082,-8.692183392465397e-2 0.28088371953770774,-0.12513010595274754 0.41122573854374933 -0.13946772804341212" /></g></g><g transform="matrix(13.155574898915933,0.0,0.0,13.155574898915933,72.35566194403765,151.42937844493656)"><g stroke="rgb(0,128,0)" stroke-opacity="1.0" fill="rgb(0,0,0)" fill-opacity="0.0" stroke-width="0.1" font-size="1.0em"><path d="M 20.48926554076378,-5.971144448967711 c 6.721861761310331e-2,-6.819078770254902e-2 0.13666548184831018,-0.11929744431724854 0.19791219748338984 -0.15634406879719753" /></g></g><g transform="matrix(13.155574898915933,0.0,0.0,13.155574898915933,72.35566194403765,151.42937844493656)"><g stroke="rgb(255,0,0)" stroke-opacity="1.0" fill="rgb(0,0,0)" fill-opacity="0.0" stroke-width="0.1" font-size="1.0em"><path d="M 20.34021917756031,-5.779740302591862 c 4.992158119902007e-2,-8.181592474283846e-2 0.10709836789040328,-0.14884946518015663 0.14904636320346876 -0.19140414637584913" /></g></g><g transform="matrix(13.155574898915933,0.0,0.0,13.155574898915933,72.35566194403765,151.42937844493656)"><g stroke="rgb(0,128,0)" stroke-opacity="1.0" fill="rgb(0,0,0)" fill-opacity="0.0" stroke-width="0.1" font-size="1.0em"><path d="M 20.208899018783505,-5.493502020830685 c 4.542742635734029e-2,-0.12492542248268579 0.10576723145080258,-0.2443598730880031 0.13132015877680647 -0.28623828176117616" /></g></g><g transform="matrix(13.155574898915933,0.0,0.0,13.155574898915933,72.35566194403765,151.42937844493656)"><g stroke="rgb(255,0,0)" stroke-opacity="1.0" fill="rgb(0,0,0)" fill-opacity="0.0" stroke-width="0.1" font-size="1.0em"><path d="M 19.662024018783505,-3.911470770830685 c 0.3068064887395122,-0.8437178440336586 0.4701733778151219,-1.3711017889915853 0.546875 -1.58203125" /></g></g><g transform="matrix(13.155574898915933,0.0,0.0,13.155574898915933,72.35566194403765,151.42937844493656)"><g stroke="rgb(0,128,0)" stroke-opacity="1.0" fill="rgb(0,0,0)" fill-opacity="0.0" stroke-width="0.1" font-size="1.0em"><path d="M 15.332390251272024,5.826808696756062 c 2.472343200154557,-4.944686400309114 3.7115479674728395,-8.03854351748049 4.329633767511479 -9.738279467586747" /></g></g><g transform="matrix(13.155574898915933,0.0,0.0,13.155574898915933,72.35566194403765,151.42937844493656)"><g stroke="rgb(0,0,255)" stroke-opacity="1.0" fill="rgb(0,0,0)" fill-opacity="0.0" stroke-width="0.1" font-size="1.0em"><path d="M 16.22681744227194,6.27402229225602 c 10.0,-20.0 0.0,-10.0 10.0 0.0" /></g></g><g transform="matrix(13.155574898915933,0.0,0.0,13.155574898915933,72.35566194403765,151.42937844493656)"><g stroke="rgb(0,128,0)" stroke-opacity="1.0" fill="rgb(0,0,0)" fill-opacity="0.0" stroke-width="0.1" font-size="1.0em"><path d="M 13.009770219789226,-2.4104743608548755 c -0.2855399505357898,9.691052866669228e-2 -0.6461909532308479,0.16047436085487377 -1.0892105128500125 0.16047436085487377" /></g></g><g transform="matrix(13.155574898915933,0.0,0.0,13.155574898915933,72.35566194403765,151.42937844493656)"><g stroke="rgb(255,0,0)" stroke-opacity="1.0" fill="rgb(0,0,0)" fill-opacity="0.0" stroke-width="0.1" font-size="1.0em"><path d="M 13.893839526646092,-2.982120392131483 c -0.2040335330264581,0.2331811806016664 -0.4832891526977512,0.4356236759256361 -0.8840693068568652 0.5716460312766082" /></g></g><g transform="matrix(13.155574898915933,0.0,0.0,13.155574898915933,72.35566194403765,151.42937844493656)"><g stroke="rgb(0,128,0)" stroke-opacity="1.0" fill="rgb(0,0,0)" fill-opacity="0.0" stroke-width="0.1" font-size="1.0em"><path d="M 14.185013884508258,-4.851123441588392 c 0.26509461237177,0.70691896632472 0.17274121378843077,1.3388138247133698 -0.2911743578621666 1.8690030494569096" /></g></g><g transform="matrix(13.155574898915933,0.0,0.0,13.155574898915933,72.35566194403765,151.42937844493656)"><g stroke="rgb(255,0,0)" stroke-opacity="1.0" fill="rgb(0,0,0)" fill-opacity="0.0" stroke-width="0.1" font-size="1.0em"><path d="M 11.295559706939214,-6.75 c 1.3528278761481514,0.0 2.551247208532007,0.996991307646174 2.8894541775690445 1.8988765584116083" /></g></g><g transform="matrix(13.155574898915933,0.0,0.0,13.155574898915933,72.35566194403765,151.42937844493656)"><g stroke="rgb(0,128,0)" stroke-opacity="1.0" fill="rgb(0,0,0)" fill-opacity="0.0" stroke-width="0.1" font-size="1.0em"><path d="M 9.203810396758112,-5.989978417355905 c 0.7131947941382994,-0.5593684659908231 1.4205071509921139,-0.7600215826440954 2.0917493101811018 -0.7600215826440954" /></g></g><g transform="matrix(13.155574898915933,0.0,0.0,13.155574898915933,72.35566194403765,151.42937844493656)"><g stroke="rgb(255,0,0)" stroke-opacity="1.0" fill="rgb(0,0,0)" fill-opacity="0.0" stroke-width="0.1" font-size="1.0em"><path d="M 7.49586988404493,-3.666654710493214 c 0.5144343791036886,-1.122402281680775 1.1116643005702707,-1.8556560894957015 1.7079405127131826 -2.3233237068626913" /></g></g><g transform="matrix(13.155574898915933,0.0,0.0,13.155574898915933,72.35566194403765,151.42937844493656)"><g stroke="rgb(0,128,0)" stroke-opacity="1.0" fill="rgb(0,0,0)" fill-opacity="0.0" stroke-width="0.1" font-size="1.0em"><path d="M 5.920559706939214,6.75 c 0.0,-5.2028660713222505 0.6810675710972038,-8.46557993374737 1.5753101771057156 -10.416654710493214" /></g></g><g transform="matrix(13.155574898915933,0.0,0.0,13.155574898915933,72.35566194403765,151.42937844493656)"><g stroke="rgb(0,0,255)" stroke-opacity="1.0" fill="rgb(0,0,0)" fill-opacity="0.0" stroke-width="0.1" font-size="1.0em"><path d="M 6.920559706939214,6.75 c 0.0,-20.0 10.0,-10.0 5.0 -10.0" /></g></g><g transform="matrix(13.155574898915933,0.0,0.0,13.155574898915933,72.35566194403765,151.42937844493656)"><g stroke="rgb(0,128,0)" stroke-opacity="1.0" fill="rgb(0,0,0)" fill-opacity="0.0" stroke-width="0.1" font-size="1.0em"><path d="M 2.660826934705069,-8.569475230141833 c 0.48895650949203384,-0.9250528557957396 1.122019777927579,-1.556458070895497 1.9677823889408268 -1.894763115300796" /></g></g><g transform="matrix(13.155574898915933,0.0,0.0,13.155574898915933,72.35566194403765,151.42937844493656)"><g stroke="rgb(255,0,0)" stroke-opacity="1.0" fill="rgb(0,0,0)" fill-opacity="0.0" stroke-width="0.1" font-size="1.0em"><path d="M 1.7534960535105757,-5.761630493146541 c 0.2156599309608425,-1.086926052042646 0.5083600089169349,-2.0530349786323434 0.9073308811944935 -2.807844736995292" /></g></g><g transform="matrix(13.155574898915933,0.0,0.0,13.155574898915933,72.35566194403765,151.42937844493656)"><g stroke="rgb(0,128,0)" stroke-opacity="1.0" fill="rgb(0,0,0)" fill-opacity="0.0" stroke-width="0.1" font-size="1.0em"><path d="M 0.8835457044574557,1.0837838328712444 c 0.31486663625486255,-2.3929864355369554 0.4763670537345416,-4.86175451761215 0.8699503490531199 -6.845414326017784" /></g></g><g transform="matrix(13.155574898915933,0.0,0.0,13.155574898915933,72.35566194403765,151.42937844493656)"><g stroke="rgb(255,0,0)" stroke-opacity="1.0" fill="rgb(0,0,0)" fill-opacity="0.0" stroke-width="0.1" font-size="1.0em"><path d="M -0.7828015282143159,7.11175903331599 c 0.9591837382060431,-1.6232340185025345 1.3712137747622202,-3.7849609203321535 1.6663472326717716 -6.027975200444747" /></g></g><g transform="matrix(13.155574898915933,0.0,0.0,13.155574898915933,72.35566194403765,151.42937844493656)"><g stroke="rgb(0,128,0)" stroke-opacity="1.0" fill="rgb(0,0,0)" fill-opacity="0.0" stroke-width="0.1" font-size="1.0em"><path d="M -5.0,9.46423834544263 c 2.0016683287913244,0.0 3.404020713214209,-0.9763323360826055 4.217198471785684 -2.3524793121266407" /></g></g><g transform="matrix(13.155574898915933,0.0,0.0,13.155574898915933,72.35566194403765,151.42937844493656)"><g stroke="rgb(0,0,255)" stroke-opacity="1.0" fill="rgb(0,0,0)" fill-opacity="0.0" stroke-width="0.1" font-size="1.0em"><path d="M -5.0,10.46423834544263 c 10.0,0.0 5.0,-18.0 10.0 -20.0" /></g></g></g></svg>

− diagrams/cubicSplineEx.svg

@@ -1,4 +0,0 @@-<?xml version="1.0" encoding="UTF-8"?>-<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN"-    "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd">-<svg xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" version="1.1" width="600.0" height="150.9864382575877" font-size="1" viewBox="0 0 600 151"><g><g transform="matrix(25.27996301518507,0.0,0.0,25.27996301518507,300.0,75.49321912879385)"><g stroke="rgb(0,0,0)" stroke-opacity="1.0" fill="rgb(0,0,0)" fill-opacity="0.0" stroke-width="5.0e-2" font-size="1.0em"><path d="M 5.30560144347186,0.5148061556407302 c -0.2727272727272727,-0.2727272727272727 0.2727272727272728,-3.3636363636363638 2.0 -3.000000000000001c 1.727272727272727,0.36363636363636376 4.636363636363635,4.181818181818182 3.0 5.000000000000002c -1.6363636363636362,0.8181818181818175 -7.8181818181818175,-1.3636363636363633 -8.999999999999998 -2.999999999999999c -1.1818181818181817,-1.6363636363636362 2.6363636363636367,-2.727272727272727 4.000000000000002 -2.0c 1.3636363636363635,0.7272727272727275 0.27272727272727276,3.272727272727273 -3.552713678800501e-15 2.9999999999999982Z" /></g></g><g transform="matrix(25.27996301518507,0.0,0.0,25.27996301518507,300.0,75.49321912879385)"><g stroke="rgb(0,0,0)" stroke-opacity="1.0" fill="rgb(0,0,255)" fill-opacity="1.0" stroke-width="0.0" font-size="1.0em"><path d="M 5.5056014434718605,-2.48519384435927 c 0.0,-0.1104569499661587 -8.954305003384129e-2,-0.2 -0.19999999999999996 -0.2c -0.1104569499661587,-6.763537510981779e-18 -0.2,8.954305003384128e-2 -0.2 0.19999999999999996c -1.3527075021963559e-17,0.1104569499661587 8.954305003384128e-2,0.2 0.19999999999999993 0.2c 0.1104569499661587,2.029061253294534e-17 0.2,-8.954305003384126e-2 0.20000000000000004 -0.19999999999999996Z" /></g></g><g transform="matrix(25.27996301518507,0.0,0.0,25.27996301518507,300.0,75.49321912879385)"><g stroke="rgb(0,0,0)" stroke-opacity="1.0" fill="rgb(0,0,255)" fill-opacity="1.0" stroke-width="0.0" font-size="1.0em"><path d="M 1.5056014434718603,-0.4851938443592698 c 0.0,-0.1104569499661587 -8.954305003384129e-2,-0.2 -0.19999999999999996 -0.2c -0.1104569499661587,-6.763537510981779e-18 -0.2,8.954305003384128e-2 -0.2 0.19999999999999996c -1.3527075021963559e-17,0.1104569499661587 8.954305003384128e-2,0.2 0.19999999999999993 0.2c 0.1104569499661587,2.029061253294534e-17 0.2,-8.954305003384126e-2 0.20000000000000004 -0.19999999999999996Z" /></g></g><g transform="matrix(25.27996301518507,0.0,0.0,25.27996301518507,300.0,75.49321912879385)"><g stroke="rgb(0,0,0)" stroke-opacity="1.0" fill="rgb(0,0,255)" fill-opacity="1.0" stroke-width="0.0" font-size="1.0em"><path d="M 10.50560144347186,2.51480615564073 c 0.0,-0.1104569499661587 -8.954305003384129e-2,-0.2 -0.19999999999999996 -0.2c -0.1104569499661587,-6.763537510981779e-18 -0.2,8.954305003384128e-2 -0.2 0.19999999999999996c -1.3527075021963559e-17,0.1104569499661587 8.954305003384128e-2,0.2 0.19999999999999993 0.2c 0.1104569499661587,2.029061253294534e-17 0.2,-8.954305003384126e-2 0.20000000000000004 -0.19999999999999996Z" /></g></g><g transform="matrix(25.27996301518507,0.0,0.0,25.27996301518507,300.0,75.49321912879385)"><g stroke="rgb(0,0,0)" stroke-opacity="1.0" fill="rgb(0,0,255)" fill-opacity="1.0" stroke-width="0.0" font-size="1.0em"><path d="M 7.5056014434718605,-2.48519384435927 c 0.0,-0.1104569499661587 -8.954305003384129e-2,-0.2 -0.19999999999999996 -0.2c -0.1104569499661587,-6.763537510981779e-18 -0.2,8.954305003384128e-2 -0.2 0.19999999999999996c -1.3527075021963559e-17,0.1104569499661587 8.954305003384128e-2,0.2 0.19999999999999993 0.2c 0.1104569499661587,2.029061253294534e-17 0.2,-8.954305003384126e-2 0.20000000000000004 -0.19999999999999996Z" /></g></g><g transform="matrix(25.27996301518507,0.0,0.0,25.27996301518507,300.0,75.49321912879385)"><g stroke="rgb(0,0,0)" stroke-opacity="1.0" fill="rgb(0,0,255)" fill-opacity="1.0" stroke-width="0.0" font-size="1.0em"><path d="M 5.5056014434718605,0.5148061556407302 c 0.0,-0.1104569499661587 -8.954305003384129e-2,-0.2 -0.19999999999999996 -0.2c -0.1104569499661587,-6.763537510981779e-18 -0.2,8.954305003384128e-2 -0.2 0.19999999999999996c -1.3527075021963559e-17,0.1104569499661587 8.954305003384128e-2,0.2 0.19999999999999993 0.2c 0.1104569499661587,2.029061253294534e-17 0.2,-8.954305003384126e-2 0.20000000000000004 -0.19999999999999996Z" /></g></g><g transform="matrix(25.27996301518507,0.0,0.0,25.27996301518507,300.0,75.49321912879385)"><g stroke="rgb(0,0,0)" stroke-opacity="1.0" fill="rgb(0,0,0)" fill-opacity="0.0" stroke-width="1.0e-2" font-size="1.0em"></g></g><g transform="matrix(25.27996301518507,0.0,0.0,25.27996301518507,300.0,75.49321912879385)"><g stroke="rgb(0,0,0)" stroke-opacity="1.0" fill="rgb(0,0,0)" fill-opacity="0.0" stroke-width="5.0e-2" font-size="1.0em"><path d="M -6.333419254268965,0.5148061556407302 c 0.2142857142857144,-1.9107142857142858 0.4285714285714288,-3.8214285714285716 2.0 -3.0c 1.5714285714285712,0.8214285714285716 4.5,4.375 2.999999999999999 5.0c -1.5,0.625 -7.428571428571428,-1.6785714285714284 -8.999999999999998 -2.999999999999999c -1.5714285714285712,-1.3214285714285712 1.2142857142857149,-1.6607142857142856 4.0 -2.0" /></g></g><g transform="matrix(25.27996301518507,0.0,0.0,25.27996301518507,300.0,75.49321912879385)"><g stroke="rgb(0,0,0)" stroke-opacity="1.0" fill="rgb(0,0,255)" fill-opacity="1.0" stroke-width="0.0" font-size="1.0em"><path d="M -6.133419254268965,-2.48519384435927 c 0.0,-0.1104569499661587 -8.954305003384129e-2,-0.2 -0.19999999999999996 -0.2c -0.1104569499661587,-6.763537510981779e-18 -0.2,8.954305003384128e-2 -0.2 0.19999999999999996c -1.3527075021963559e-17,0.1104569499661587 8.954305003384128e-2,0.2 0.19999999999999993 0.2c 0.1104569499661587,2.029061253294534e-17 0.2,-8.954305003384126e-2 0.20000000000000004 -0.19999999999999996Z" /></g></g><g transform="matrix(25.27996301518507,0.0,0.0,25.27996301518507,300.0,75.49321912879385)"><g stroke="rgb(0,0,0)" stroke-opacity="1.0" fill="rgb(0,0,255)" fill-opacity="1.0" stroke-width="0.0" font-size="1.0em"><path d="M -10.133419254268965,-0.4851938443592698 c 0.0,-0.1104569499661587 -8.954305003384129e-2,-0.2 -0.19999999999999996 -0.2c -0.1104569499661587,-6.763537510981779e-18 -0.2,8.954305003384128e-2 -0.2 0.19999999999999996c -1.3527075021963559e-17,0.1104569499661587 8.954305003384128e-2,0.2 0.19999999999999993 0.2c 0.1104569499661587,2.029061253294534e-17 0.2,-8.954305003384126e-2 0.20000000000000004 -0.19999999999999996Z" /></g></g><g transform="matrix(25.27996301518507,0.0,0.0,25.27996301518507,300.0,75.49321912879385)"><g stroke="rgb(0,0,0)" stroke-opacity="1.0" fill="rgb(0,0,255)" fill-opacity="1.0" stroke-width="0.0" font-size="1.0em"><path d="M -1.1334192542689652,2.51480615564073 c 0.0,-0.1104569499661587 -8.954305003384129e-2,-0.2 -0.19999999999999996 -0.2c -0.1104569499661587,-6.763537510981779e-18 -0.2,8.954305003384128e-2 -0.2 0.19999999999999996c -1.3527075021963559e-17,0.1104569499661587 8.954305003384128e-2,0.2 0.19999999999999993 0.2c 0.1104569499661587,2.029061253294534e-17 0.2,-8.954305003384126e-2 0.20000000000000004 -0.19999999999999996Z" /></g></g><g transform="matrix(25.27996301518507,0.0,0.0,25.27996301518507,300.0,75.49321912879385)"><g stroke="rgb(0,0,0)" stroke-opacity="1.0" fill="rgb(0,0,255)" fill-opacity="1.0" stroke-width="0.0" font-size="1.0em"><path d="M -4.133419254268965,-2.48519384435927 c 0.0,-0.1104569499661587 -8.954305003384129e-2,-0.2 -0.19999999999999996 -0.2c -0.1104569499661587,-6.763537510981779e-18 -0.2,8.954305003384128e-2 -0.2 0.19999999999999996c -1.3527075021963559e-17,0.1104569499661587 8.954305003384128e-2,0.2 0.19999999999999993 0.2c 0.1104569499661587,2.029061253294534e-17 0.2,-8.954305003384126e-2 0.20000000000000004 -0.19999999999999996Z" /></g></g><g transform="matrix(25.27996301518507,0.0,0.0,25.27996301518507,300.0,75.49321912879385)"><g stroke="rgb(0,0,0)" stroke-opacity="1.0" fill="rgb(0,0,255)" fill-opacity="1.0" stroke-width="0.0" font-size="1.0em"><path d="M -6.133419254268965,0.5148061556407302 c 0.0,-0.1104569499661587 -8.954305003384129e-2,-0.2 -0.19999999999999996 -0.2c -0.1104569499661587,-6.763537510981779e-18 -0.2,8.954305003384128e-2 -0.2 0.19999999999999996c -1.3527075021963559e-17,0.1104569499661587 8.954305003384128e-2,0.2 0.19999999999999993 0.2c 0.1104569499661587,2.029061253294534e-17 0.2,-8.954305003384126e-2 0.20000000000000004 -0.19999999999999996Z" /></g></g></g></svg>

− diagrams/decagonEx.svg

@@ -1,4 +0,0 @@-<?xml version="1.0" encoding="UTF-8"?>-<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN"-    "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd">-<svg xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" version="1.1" width="100.0" height="95.10565162951534" font-size="1" viewBox="0 0 100 95"><g><g transform="matrix(28.092454034086124,0.0,0.0,28.092454034086124,49.99999999999999,47.55282581475767)"><g stroke="rgb(0,0,0)" stroke-opacity="1.0" fill="rgb(0,0,0)" fill-opacity="0.0" stroke-width="1.0e-2" font-size="1.0em"><path d="M 1.3090169943749481,0.9510565162951532 l 0.3090169943749472,-0.9510565162951536 l -0.3090169943749477,-0.9510565162951534 l -0.8090169943749475,-0.5877852522924729 l -1.0,4.440892098500626e-16 l -0.8090169943749473,0.5877852522924731 l -0.3090169943749473,0.9510565162951536 l 0.3090169943749475,0.9510565162951535 l 0.8090169943749475,0.587785252292473 l 1.0,-5.551115123125783e-17 l 0.8090169943749477,-0.5877852522924736 Z" /></g></g></g></svg>

− diagrams/diagramA.svg

@@ -1,4 +0,0 @@-<?xml version="1.0" encoding="UTF-8"?>-<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN"-    "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd">-<svg xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" version="1.1" width="400.0" height="200.0" font-size="1" viewBox="0 0 400 200"><g><g transform="matrix(18.181818181818183,0.0,0.0,18.181818181818183,200.0,100.0)"><g stroke="rgb(0,0,0)" stroke-opacity="1.0" fill="rgb(0,0,0)" fill-opacity="0.0" stroke-width="0.1" font-size="1.0em"><path d="M -10.0,4.132231404958677 c 12.0,0.0 8.0,-10.0 20.0 -8.0" /></g></g></g></svg>

− diagrams/diagramNeg.svg

@@ -1,4 +0,0 @@-<?xml version="1.0" encoding="UTF-8"?>-<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN"-    "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd">-<svg xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" version="1.1" width="400.0" height="200.0" font-size="1" viewBox="0 0 400 200"><g><g transform="matrix(18.181818181818183,0.0,0.0,18.181818181818183,200.0,100.0)"><g stroke="rgb(255,0,0)" stroke-opacity="1.0" fill="rgb(0,0,0)" fill-opacity="0.0" stroke-width="5.0e-2" font-size="1.0em"><path d="M 4.464000000000002,-3.8037685950413227 l 2.077770135746605,7.445342986425346 " /></g></g><g transform="matrix(18.181818181818183,0.0,0.0,18.181818181818183,200.0,100.0)"><g stroke="rgb(255,0,0)" stroke-opacity="1.0" fill="rgb(0,0,0)" fill-opacity="0.0" stroke-width="5.0e-2" font-size="1.0em"><path d="M 14.271599430272687,3.6415743913840233 c 0.0,-4.269066838162075 -3.4607624563640047,-7.7298292945260805 -7.729829294526079 -7.7298292945260805c -4.269066838162075,-2.614049519350648e-16 -7.7298292945260805,3.4607624563640043 -7.7298292945260805 7.729829294526078c -5.228099038701296e-16,4.269066838162075 3.460762456364004,7.7298292945260805 7.729829294526077 7.7298292945260805c 4.269066838162075,7.842148558051945e-16 7.7298292945260805,-3.4607624563640034 7.729829294526082 -7.729829294526078Z" /></g></g><g transform="matrix(18.181818181818183,0.0,0.0,18.181818181818183,200.0,100.0)"><g stroke="rgb(0,0,0)" stroke-opacity="1.0" fill="rgb(0,0,0)" fill-opacity="0.0" stroke-width="0.1" font-size="1.0em"><path d="M -10.0,4.132231404958677 c 12.0,0.0 8.0,-10.0 20.0 -8.0" /></g></g></g></svg>

− diagrams/diagramPos.svg

@@ -1,4 +0,0 @@-<?xml version="1.0" encoding="UTF-8"?>-<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN"-    "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd">-<svg xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" version="1.1" width="400.0" height="200.0" font-size="1" viewBox="0 0 400 200"><g><g transform="matrix(18.181818181818183,0.0,0.0,18.181818181818183,200.0,100.0)"><g stroke="rgb(255,0,0)" stroke-opacity="1.0" fill="rgb(0,0,0)" fill-opacity="0.0" stroke-width="5.0e-2" font-size="1.0em"><path d="M -4.463999999999999,3.1082314049586772 l -3.900145794392522,-8.6003214953271 " /></g></g><g transform="matrix(18.181818181818183,0.0,0.0,18.181818181818183,200.0,100.0)"><g stroke="rgb(255,0,0)" stroke-opacity="1.0" fill="rgb(0,0,0)" fill-opacity="0.0" stroke-width="5.0e-2" font-size="1.0em"><path d="M 1.079194030081819,-5.492090090368422 c 0.0,-5.215412572526979 -4.227927251947359,-9.44333982447434 -9.443339824474338 -9.44333982447434c -5.215412572526979,-3.193519156589014e-16 -9.44333982447434,4.227927251947358 -9.44333982447434 9.443339824474336c -6.387038313178028e-16,5.215412572526979 4.227927251947357,9.44333982447434 9.443339824474336 9.44333982447434c 5.215412572526979,9.580557469767042e-16 9.44333982447434,-4.227927251947357 9.443339824474343 -9.443339824474336Z" /></g></g><g transform="matrix(18.181818181818183,0.0,0.0,18.181818181818183,200.0,100.0)"><g stroke="rgb(0,0,0)" stroke-opacity="1.0" fill="rgb(0,0,0)" fill-opacity="0.0" stroke-width="0.1" font-size="1.0em"><path d="M -10.0,4.132231404958677 c 12.0,0.0 8.0,-10.0 20.0 -8.0" /></g></g></g></svg>

− diagrams/diagramZero.svg

@@ -1,4 +0,0 @@-<?xml version="1.0" encoding="UTF-8"?>-<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN"-    "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd">-<svg xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" version="1.1" width="400.0" height="200.0" font-size="1" viewBox="0 0 400 200"><g><g transform="matrix(18.181818181818183,0.0,0.0,18.181818181818183,200.0,100.0)"><g stroke="rgb(255,0,0)" stroke-opacity="1.0" fill="rgb(0,0,0)" fill-opacity="0.0" stroke-width="5.0e-2" font-size="1.0em"><path d="M 0.0,-0.6177685950413228 l 61.17187500000001,54.37500000000001 " /></g></g><g transform="matrix(18.181818181818183,0.0,0.0,18.181818181818183,200.0,100.0)"><g stroke="rgb(255,0,0)" stroke-opacity="1.0" fill="rgb(0,0,0)" fill-opacity="0.0" stroke-width="5.0e-2" font-size="1.0em"><path d="M 143.0170881527289,53.75723140495869 c 0.0,-45.20186307090284 -36.64335008182604,-81.84521315272889 -81.84521315272887 -81.84521315272889c -45.20186307090284,-2.7678158462639055e-15 -81.84521315272889,36.643350081826036 -81.84521315272889 81.84521315272886c -5.535631692527811e-15,45.20186307090284 36.64335008182603,81.84521315272889 81.84521315272885 81.84521315272889c 45.20186307090284,8.303447538791717e-15 81.84521315272889,-36.64335008182603 81.84521315272893 -81.84521315272886Z" /></g></g><g transform="matrix(18.181818181818183,0.0,0.0,18.181818181818183,200.0,100.0)"><g stroke="rgb(0,0,0)" stroke-opacity="1.0" fill="rgb(0,0,0)" fill-opacity="0.0" stroke-width="0.1" font-size="1.0em"><path d="M -10.0,4.132231404958677 c 12.0,0.0 8.0,-10.0 20.0 -8.0" /></g></g></g></svg>

− diagrams/dodecagonEx.svg

@@ -1,4 +0,0 @@-<?xml version="1.0" encoding="UTF-8"?>-<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN"-    "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd">-<svg xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" version="1.1" width="100.0" height="99.99999999999999" font-size="1" viewBox="0 0 100 100"><g><g transform="matrix(24.35901749373842,0.0,0.0,24.35901749373842,50.0,49.99999999999999)"><g stroke="rgb(0,0,0)" stroke-opacity="1.0" fill="rgb(0,0,0)" fill-opacity="0.0" stroke-width="1.0e-2" font-size="1.0em"><path d="M 1.8660254037844393,0.4999999999999996 l -2.220446049250313e-16,-1.0 l -0.5000000000000001,-0.8660254037844386 l -0.8660254037844387,-0.49999999999999994 l -1.0,1.6081226496766364e-16 l -0.8660254037844386,0.49999999999999994 l -0.5000000000000001,0.8660254037844386 l -3.4450928483976665e-16,1.0 l 0.49999999999999956,0.8660254037844389 l 0.8660254037844385,0.5000000000000002 l 1.0,-3.834758505292834e-17 l 0.8660254037844385,-0.5000000000000003 l 0.5000000000000021,-0.8660254037844389 Z" /></g></g></g></svg>

− diagrams/glueLineEx.svg

@@ -1,4 +0,0 @@-<?xml version="1.0" encoding="UTF-8"?>-<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN"-    "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd">-<svg xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" version="1.1" width="500.0" height="68.18181818181819" font-size="1" viewBox="0 0 500 68"><g><g transform="matrix(41.32231404958677,0.0,0.0,41.32231404958677,136.36363636363637,0.0)"><g stroke="rgb(0,0,0)" stroke-opacity="1.0" fill="rgb(0,0,0)" fill-opacity="0.0" stroke-width="1.0e-2" font-size="1.0em"><path d="M 6.0,0.0 l 2.0,1.0 l -3.0,0.5 l -2.0,-1.0 l 3.0,-0.5 Z" /></g></g><g transform="matrix(41.32231404958677,0.0,0.0,41.32231404958677,136.36363636363637,0.0)"><g stroke="rgb(0,0,0)" stroke-opacity="1.0" fill="rgb(0,0,0)" fill-opacity="0.0" stroke-width="1.0e-2" font-size="1.0em"><path d="M 0.0,0.0 l 2.0,1.0 l -3.0,0.5 l -2.0,-1.0 l 1.0,-0.5 " /></g></g></g></svg>

− diagrams/hendecagonEx.svg

@@ -1,4 +0,0 @@-<?xml version="1.0" encoding="UTF-8"?>-<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN"-    "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd">-<svg xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" version="1.1" width="100.0" height="98.98214418809323" font-size="1" viewBox="0 0 100 99"><g><g transform="matrix(25.875425140597297,0.0,0.0,25.875425140597297,50.00000000000001,50.5141613269018)"><g stroke="rgb(0,0,0)" stroke-opacity="1.0" fill="rgb(0,0,0)" fill-opacity="0.0" stroke-width="1.0e-2" font-size="1.0em"><path d="M 1.7566685458330673,0.2525708066345108 l -0.1423148382732844,-0.9898214418809328 l -0.6548607339452844,-0.7557495743542588 l -0.9594929736144971,-0.28173255684143045 l -0.9594929736144977,0.28173255684142884 l -0.6548607339452855,0.7557495743542577 l -0.14231483827328584,0.9898214418809326 l 0.4154150130018858,0.9096319953545187 l 0.841253532831181,0.5406408174555977 l 0.9999999999999999,-2.7755575615628914e-17 l 0.8412535328311814,-0.5406408174555973 l 0.41541501300188677,-0.9096319953545157 Z" /></g></g></g></svg>

− diagrams/hexagonEx.svg

@@ -1,4 +0,0 @@-<?xml version="1.0" encoding="UTF-8"?>-<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN"-    "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd">-<svg xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" version="1.1" width="100.0" height="86.6025403784439" font-size="1" viewBox="0 0 100 87"><g><g transform="matrix(45.45454545454546,0.0,0.0,45.45454545454546,50.0,43.30127018922196)"><g stroke="rgb(0,0,0)" stroke-opacity="1.0" fill="rgb(0,0,0)" fill-opacity="0.0" stroke-width="1.0e-2" font-size="1.0em"><path d="M 0.49999999999999967,0.8660254037844387 l 0.5000000000000002,-0.8660254037844385 l -0.4999999999999996,-0.8660254037844388 l -0.9999999999999999,-4.440892098500626e-16 l -0.5000000000000003,0.8660254037844384 l 0.49999999999999933,0.866025403784439 l 1.0000000000000002,2.220446049250313e-16 Z" /></g></g></g></svg>

− diagrams/hruleEx.svg

@@ -1,4 +0,0 @@-<?xml version="1.0" encoding="UTF-8"?>-<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN"-    "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd">-<svg xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" version="1.1" width="300.0" height="48.00000000000001" font-size="1" viewBox="0 0 300 48"><g><g transform="matrix(54.54545454545455,0.0,0.0,54.54545454545455,150.0,24.000000000000004)"><g stroke="rgb(0,0,0)" stroke-opacity="1.0" fill="rgb(0,0,0)" fill-opacity="0.0" stroke-width="1.0e-2" font-size="1.0em"><path d="M -2.5,0.4000000000000001 h 5.0 " /></g></g><g transform="matrix(54.54545454545455,0.0,0.0,54.54545454545455,150.0,24.000000000000004)"><g stroke="rgb(0,0,0)" stroke-opacity="1.0" fill="rgb(0,0,0)" fill-opacity="0.0" stroke-width="1.0e-2" font-size="1.0em"><path d="M -2.0,0.2 h 4.0 " /></g></g><g transform="matrix(54.54545454545455,0.0,0.0,54.54545454545455,150.0,24.000000000000004)"><g stroke="rgb(0,0,0)" stroke-opacity="1.0" fill="rgb(0,0,0)" fill-opacity="0.0" stroke-width="1.0e-2" font-size="1.0em"><path d="M -1.5,0.0 h 3.0 " /></g></g><g transform="matrix(54.54545454545455,0.0,0.0,54.54545454545455,150.0,24.000000000000004)"><g stroke="rgb(0,0,0)" stroke-opacity="1.0" fill="rgb(0,0,0)" fill-opacity="0.0" stroke-width="1.0e-2" font-size="1.0em"><path d="M -1.0,-0.2 h 2.0 " /></g></g><g transform="matrix(54.54545454545455,0.0,0.0,54.54545454545455,150.0,24.000000000000004)"><g stroke="rgb(0,0,0)" stroke-opacity="1.0" fill="rgb(0,0,0)" fill-opacity="0.0" stroke-width="1.0e-2" font-size="1.0em"><path d="M -0.5,-0.4 h 1.0 " /></g></g></g></svg>

− diagrams/lineFromOffsetsEx.svg

@@ -1,4 +0,0 @@-<?xml version="1.0" encoding="UTF-8"?>-<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN"-    "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd">-<svg xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" version="1.1" width="300.0" height="50.0" font-size="1" viewBox="0 0 300 50"><g><g transform="matrix(50.0,0.0,0.0,50.0,0.0,50.0)"><g stroke="rgb(0,0,0)" stroke-opacity="1.0" fill="rgb(0,0,0)" fill-opacity="0.0" stroke-width="1.0e-2" font-size="1.0em"><path d="M 0.0,0.0 l 2.0,-1.0 l 2.0,1.0 l 2.0,-0.5 " /></g></g></g></svg>

− diagrams/lineFromVerticesEx.svg

@@ -1,4 +0,0 @@-<?xml version="1.0" encoding="UTF-8"?>-<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN"-    "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd">-<svg xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" version="1.1" width="300.0" height="120.00000000000001" font-size="1" viewBox="0 0 300 120"><g><g transform="matrix(54.54545454545455,0.0,0.0,54.54545454545455,150.0,60.00000000000001)"><g stroke="rgb(0,0,0)" stroke-opacity="1.0" fill="rgb(0,0,0)" fill-opacity="0.0" stroke-width="1.0e-2" font-size="1.0em"><path d="M -2.5,1.0 v -1.0 l 1.0,-1.0 l 4.0,1.0 " /></g></g></g></svg>

− diagrams/nonagonEx.svg

@@ -1,4 +0,0 @@-<?xml version="1.0" encoding="UTF-8"?>-<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN"-    "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd">-<svg xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" version="1.1" width="100.0" height="98.48077530122075" font-size="1" viewBox="0 0 100 98"><g><g transform="matrix(31.572395939441876,0.0,0.0,31.572395939441876,50.0,50.771330594287235)"><g stroke="rgb(0,0,0)" stroke-opacity="1.0" fill="rgb(0,0,0)" fill-opacity="0.0" stroke-width="1.0e-2" font-size="1.0em"><path d="M 1.266044443118978,0.7309511000407727 l 0.1736481776669308,-0.984807753012208 l -0.49999999999999956,-0.8660254037844388 l -0.9396926207859082,-0.3420201433256692 l -0.9396926207859086,0.3420201433256681 l -0.5000000000000006,0.8660254037844384 l 0.17364817766692983,0.9848077530122082 l 0.766044443118978,0.6427876096865394 l 1.0,-2.7755575615628914e-17 l 0.7660444431189786,-0.6427876096865375 Z" /></g></g></g></svg>

− diagrams/octagonEx.svg

@@ -1,4 +0,0 @@-<?xml version="1.0" encoding="UTF-8"?>-<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN"-    "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd">-<svg xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" version="1.1" width="100.0" height="99.99999999999999" font-size="1" viewBox="0 0 100 100"><g><g transform="matrix(37.65577839755409,0.0,0.0,37.65577839755409,50.00000000000001,50.00000000000001)"><g stroke="rgb(0,0,0)" stroke-opacity="1.0" fill="rgb(0,0,0)" fill-opacity="0.0" stroke-width="1.0e-2" font-size="1.0em"><path d="M 1.2071067811865475,0.4999999999999996 l -2.220446049250313e-16,-1.0 l -0.7071067811865476,-0.7071067811865475 l -1.0,1.6081226496766364e-16 l -0.7071067811865475,0.7071067811865476 l 9.957992501029599e-17,1.0 l 0.7071067811865476,0.7071067811865476 l 1.0,-3.834758505292834e-17 l 0.7071067811865477,-0.7071067811865477 Z" /></g></g></g></svg>

− diagrams/pentagonEx.svg

@@ -1,4 +0,0 @@-<?xml version="1.0" encoding="UTF-8"?>-<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN"-    "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd">-<svg xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" version="1.1" width="100.0" height="95.10565162951538" font-size="1" viewBox="0 0 100 95"><g><g transform="matrix(56.18490806817227,0.0,0.0,56.18490806817227,50.00000000000001,52.573111211913364)"><g stroke="rgb(0,0,0)" stroke-opacity="1.0" fill="rgb(0,0,0)" fill-opacity="0.0" stroke-width="1.0e-2" font-size="1.0em"><path d="M 0.5000000000000001,0.6881909602355868 l 0.3090169943749472,-0.9510565162951536 l -0.8090169943749475,-0.5877852522924729 l -0.8090169943749473,0.5877852522924731 l 0.3090169943749479,0.9510565162951533 l 0.9999999999999996,1.1102230246251565e-16 Z" /></g></g></g></svg>

− diagrams/rectEx.svg

@@ -1,4 +0,0 @@-<?xml version="1.0" encoding="UTF-8"?>-<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN"-    "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd">-<svg xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" version="1.1" width="150.0" height="104.99999999999999" font-size="1" viewBox="0 0 150 105"><g><g transform="matrix(136.36363636363635,0.0,0.0,136.36363636363635,74.99999999999999,52.49999999999999)"><g stroke="rgb(0,0,0)" stroke-opacity="1.0" fill="rgb(0,0,0)" fill-opacity="0.0" stroke-width="1.0e-2" font-size="1.0em"><path d="M 0.5000000000000001,0.35 l -1.1102230246251565e-16,-0.7 h -1.0 l -1.1102230246251565e-16,0.7 h 1.0 Z" /></g></g></g></svg>

− diagrams/roundedRectEx.svg

@@ -1,4 +0,0 @@-<?xml version="1.0" encoding="UTF-8"?>-<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN"-    "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd">-<svg xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" version="1.1" width="400.0" height="76.19047619047622" font-size="1" viewBox="0 0 400 76"><g><g transform="matrix(173.1601731601732,0.0,0.0,173.1601731601732,199.99999999999997,38.09523809523811)"><g stroke="rgb(0,0,0)" stroke-opacity="1.0" fill="rgb(0,0,0)" fill-opacity="0.0" stroke-width="1.0e-2" font-size="1.0em"><path d="M 1.0499999999999998,0.10000000000000003 v -0.1 c -0.11045694996615868,-4.4408920985006264e-17 -0.19999999999999996,-8.954305003384136e-2 -0.19999999999999996 -0.20000000000000007h -0.29999999999999993 c -0.1104569499661587,-6.763537510981779e-18 -0.2,8.954305003384128e-2 -0.2 0.19999999999999996v 0.2 h 0.6 c 5.522847498307935e-2,1.014530626647267e-17 0.1,-4.477152501692063e-2 9.999999999999992e-2 -9.999999999999992e-2Z" /></g></g><g transform="matrix(173.1601731601732,0.0,0.0,173.1601731601732,199.99999999999997,38.09523809523811)"><g stroke="rgb(0,0,0)" stroke-opacity="1.0" fill="rgb(0,0,0)" fill-opacity="0.0" stroke-width="1.0e-2" font-size="1.0em"><path d="M 0.15000000000000013,0.10000000000000003 v -0.20000000000000004 c -5.522847498307934e-2,-2.2204460492503132e-17 -9.999999999999998e-2,-4.477152501692068e-2 -9.999999999999998e-2 -0.10000000000000003h -0.3 c -2.2204460492503132e-17,5.5228474983079326e-2 -4.477152501692068e-2,9.999999999999998e-2 -0.10000000000000003 9.999999999999996e-2v 0.2 c 5.522847498307934e-2,2.2204460492503132e-17 9.999999999999998e-2,4.477152501692068e-2 9.999999999999996e-2 0.10000000000000003h 0.30000000000000004 c 0.0,-5.522847498307934e-2 4.477152501692068e-2,-9.999999999999998e-2 9.999999999999998e-2 -9.999999999999998e-2Z" /></g></g><g transform="matrix(173.1601731601732,0.0,0.0,173.1601731601732,199.99999999999997,38.09523809523811)"><g stroke="rgb(0,0,0)" stroke-opacity="1.0" fill="rgb(0,0,0)" fill-opacity="0.0" stroke-width="1.0e-2" font-size="1.0em"><path d="M -0.5499999999999998,0.10000000000000003 v -0.20000000000000004 c 0.0,-5.522847498307935e-2 -4.4771525016920645e-2,-0.1 -9.999999999999998e-2 -0.1h -0.3 c -5.522847498307935e-2,-3.3817687554908897e-18 -0.1,4.477152501692064e-2 -0.1 9.999999999999998e-2v 0.2 c -6.763537510981779e-18,5.522847498307935e-2 4.477152501692064e-2,0.1 9.999999999999998e-2 0.10000000000000003h 0.30000000000000004 c 5.522847498307935e-2,1.014530626647267e-17 0.1,-4.477152501692063e-2 9.999999999999998e-2 -9.999999999999998e-2Z" /></g></g></g></svg>

− diagrams/septagonEx.svg

@@ -1,4 +0,0 @@-<?xml version="1.0" encoding="UTF-8"?>-<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN"-    "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd">-<svg xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" version="1.1" width="100.0" height="97.49279121818235" font-size="1" viewBox="0 0 100 97"><g><g transform="matrix(40.45835162842079,0.0,0.0,40.45835162842079,50.0,51.28584316362768)"><g stroke="rgb(0,0,0)" stroke-opacity="1.0" fill="rgb(0,0,0)" fill-opacity="0.0" stroke-width="1.0e-2" font-size="1.0em"><path d="M 1.1234898018587336,0.2564292158181373 l -0.22252093395631548,-0.9749279121818234 l -0.9009688679024197,-0.4338837391175572 l -0.9009688679024187,0.43388373911755906 l -0.22252093395631345,0.9749279121818237 l 0.6234898018587343,0.7818314824680291 l 1.0,-2.7755575615628914e-17 l 0.6234898018587329,-0.7818314824680312 Z" /></g></g></g></svg>

− diagrams/squareEx.svg

@@ -1,4 +0,0 @@-<?xml version="1.0" encoding="UTF-8"?>-<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN"-    "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd">-<svg xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" version="1.1" width="200.0" height="85.71428571428572" font-size="1" viewBox="0 0 200 86"><g><g transform="matrix(25.974025974025974,0.0,0.0,25.974025974025974,100.0,42.85714285714286)"><g stroke="rgb(0,0,0)" stroke-opacity="1.0" fill="rgb(0,0,0)" fill-opacity="0.0" stroke-width="3.0e-2" font-size="1.0em"><path d="M 3.5000000000000004,1.5 l -3.3306690738754696e-16,-3.0 h -3.0 l -3.3306690738754696e-16,3.0 h 3.000000000000001 Z" /></g></g><g transform="matrix(25.974025974025974,0.0,0.0,25.974025974025974,100.0,42.85714285714286)"><g stroke="rgb(0,0,0)" stroke-opacity="1.0" fill="rgb(0,0,0)" fill-opacity="0.0" stroke-width="3.0e-2" font-size="1.0em"><path d="M 2.220446049250313e-16,1.0 l -2.220446049250313e-16,-2.0 h -2.0 l -2.220446049250313e-16,2.0 h 2.0 Z" /></g></g><g transform="matrix(25.974025974025974,0.0,0.0,25.974025974025974,100.0,42.85714285714286)"><g stroke="rgb(0,0,0)" stroke-opacity="1.0" fill="rgb(0,0,0)" fill-opacity="0.0" stroke-width="3.0e-2" font-size="1.0em"><path d="M -2.5,0.5 l -1.1102230246251565e-16,-1.0 h -1.0 l -1.1102230246251565e-16,1.0 h 1.0 Z" /></g></g></g></svg>

+ diagrams/src_Diagrams_Combinators_alignedEx1.svg view

@@ -0,0 +1,1 @@+<svg xmlns="http://www.w3.org/2000/svg" height="151.7241" stroke-opacity="1" viewBox="0 0 400 152" font-size="1" width="400.0000" xmlns:xlink="http://www.w3.org/1999/xlink" stroke="rgb(0,0,0)" version="1.1"><defs></defs><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9854108192823033" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 393.1034,34.4828 c 0.0000,-15.2354 -12.3508,-27.5862 -27.5862 -27.5862c -15.2354,-0.0000 -27.5862,12.3508 -27.5862 27.5862c -0.0000,15.2354 12.3508,27.5862 27.5862 27.5862c 15.2354,0.0000 27.5862,-12.3508 27.5862 -27.5862Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9854108192823033" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 310.3448,75.8621 c 0.0000,-38.0886 -30.8769,-68.9655 -68.9655 -68.9655c -38.0886,-0.0000 -68.9655,30.8769 -68.9655 68.9655c -0.0000,38.0886 30.8769,68.9655 68.9655 68.9655c 38.0886,0.0000 68.9655,-30.8769 68.9655 -68.9655Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9854108192823033" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 144.8276,48.2759 c 0.0000,-22.8532 -18.5261,-41.3793 -41.3793 -41.3793c -22.8532,-0.0000 -41.3793,18.5261 -41.3793 41.3793c -0.0000,22.8532 18.5261,41.3793 41.3793 41.3793c 22.8532,0.0000 41.3793,-18.5261 41.3793 -41.3793Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9854108192823033" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 34.4828,20.6897 c 0.0000,-7.6177 -6.1754,-13.7931 -13.7931 -13.7931c -7.6177,-0.0000 -13.7931,6.1754 -13.7931 13.7931c -0.0000,7.6177 6.1754,13.7931 13.7931 13.7931c 7.6177,0.0000 13.7931,-6.1754 13.7931 -13.7931Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(255,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 28.4138,20.6897 c 0.0000,-4.2659 -3.4582,-7.7241 -7.7241 -7.7241c -4.2659,-0.0000 -7.7241,3.4582 -7.7241 7.7241c -0.0000,4.2659 3.4582,7.7241 7.7241 7.7241c 4.2659,0.0000 7.7241,-3.4582 7.7241 -7.7241Z"/></g></svg>

+ diagrams/src_Diagrams_Combinators_alignedEx2.svg view

@@ -0,0 +1,1 @@+<svg xmlns="http://www.w3.org/2000/svg" height="400.0000" stroke-opacity="1" viewBox="0 0 400 400" font-size="1" width="400.0000" xmlns:xlink="http://www.w3.org/1999/xlink" stroke="rgb(0,0,0)" version="1.1"><defs></defs><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="1.5999999999999999" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 256.1849,297.9712 l 56.1849,-172.9194 l -147.0940,-106.8700 l -147.0940,106.8700 l 56.1849,172.9194 Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="1.5999999999999999" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 200.0000,175.6410 l -90.9091,-157.4592 l -90.9091,157.4592 Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="1.5999999999999999" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 200.0000,200.0000 l -0.0000,-181.8182 h -181.8182 l -0.0000,181.8182 Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="1.5999999999999999" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 381.8182,200.0000 c 0.0000,-100.4154 -81.4028,-181.8182 -181.8182 -181.8182c -100.4154,-0.0000 -181.8182,81.4028 -181.8182 181.8182c -0.0000,100.4154 81.4028,181.8182 181.8182 181.8182c 100.4154,0.0000 181.8182,-81.4028 181.8182 -181.8182Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(255,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 207.2727,200.0000 c 0.0000,-4.0166 -3.2561,-7.2727 -7.2727 -7.2727c -4.0166,-0.0000 -7.2727,3.2561 -7.2727 7.2727c -0.0000,4.0166 3.2561,7.2727 7.2727 7.2727c 4.0166,0.0000 7.2727,-3.2561 7.2727 -7.2727Z"/></g></svg>

+ diagrams/src_Diagrams_Combinators_appendsEx.svg view

@@ -0,0 +1,1 @@+<svg xmlns="http://www.w3.org/2000/svg" height="182.1560" stroke-opacity="1" viewBox="0 0 200 182" font-size="1" width="200.0000" xmlns:xlink="http://www.w3.org/1999/xlink" stroke="rgb(0,0,0)" version="1.1"><defs></defs><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.7634783583493163" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 160.6111,143.5732 c 0.0000,-16.7359 -13.5671,-30.3030 -30.3030 -30.3030c -16.7359,-0.0000 -30.3030,13.5671 -30.3030 30.3030c -0.0000,16.7359 13.5671,30.3030 30.3030 30.3030c 16.7359,0.0000 30.3030,-13.5671 30.3030 -30.3030Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.7634783583493163" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 99.9949,143.5732 c 0.0000,-16.7359 -13.5671,-30.3030 -30.3030 -30.3030c -16.7359,-0.0000 -30.3030,13.5671 -30.3030 30.3030c -0.0000,16.7359 13.5671,30.3030 30.3030 30.3030c 16.7359,0.0000 30.3030,-13.5671 30.3030 -30.3030Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.7634783583493163" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 69.6970,91.0780 c 0.0000,-16.7359 -13.5671,-30.3030 -30.3030 -30.3030c -16.7359,-0.0000 -30.3030,13.5671 -30.3030 30.3030c -0.0000,16.7359 13.5671,30.3030 30.3030 30.3030c 16.7359,0.0000 30.3030,-13.5671 30.3030 -30.3030Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.7634783583493163" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 99.9949,38.5828 c 0.0000,-16.7359 -13.5671,-30.3030 -30.3030 -30.3030c -16.7359,-0.0000 -30.3030,13.5671 -30.3030 30.3030c -0.0000,16.7359 13.5671,30.3030 30.3030 30.3030c 16.7359,0.0000 30.3030,-13.5671 30.3030 -30.3030Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.7634783583493163" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 160.6111,38.5828 c 0.0000,-16.7359 -13.5671,-30.3030 -30.3030 -30.3030c -16.7359,-0.0000 -30.3030,13.5671 -30.3030 30.3030c -0.0000,16.7359 13.5671,30.3030 30.3030 30.3030c 16.7359,0.0000 30.3030,-13.5671 30.3030 -30.3030Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.7634783583493163" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 190.9091,91.0780 c 0.0000,-16.7359 -13.5671,-30.3030 -30.3030 -30.3030c -16.7359,-0.0000 -30.3030,13.5671 -30.3030 30.3030c -0.0000,16.7359 13.5671,30.3030 30.3030 30.3030c 16.7359,0.0000 30.3030,-13.5671 30.3030 -30.3030Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.7634783583493163" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 130.3030,91.0780 c 0.0000,-16.7359 -13.5671,-30.3030 -30.3030 -30.3030c -16.7359,-0.0000 -30.3030,13.5671 -30.3030 30.3030c -0.0000,16.7359 13.5671,30.3030 30.3030 30.3030c 16.7359,0.0000 30.3030,-13.5671 30.3030 -30.3030Z"/></g></svg>

+ diagrams/src_Diagrams_Combinators_besideEx.svg view

@@ -0,0 +1,1 @@+<svg xmlns="http://www.w3.org/2000/svg" height="200.0000" stroke-opacity="1" viewBox="0 0 170 200" font-size="1" width="169.7207" xmlns:xlink="http://www.w3.org/1999/xlink" stroke="rgb(0,0,0)" version="1.1"><defs></defs><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.7369573772655632" fill="rgb(128,0,128)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 162.0061,68.6338 c 0.0000,-32.8847 -26.6583,-59.5429 -59.5429 -59.5429c -32.8847,-0.0000 -59.5429,26.6583 -59.5429 59.5429c -0.0000,32.8847 26.6583,59.5429 59.5429 59.5429c 32.8847,0.0000 59.5429,-26.6583 59.5429 -59.5429Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.7369573772655632" fill="rgb(255,165,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 87.1052,151.2138 c 0.0000,-21.9231 -17.7722,-39.6953 -39.6953 -39.6953c -21.9231,-0.0000 -39.6953,17.7722 -39.6953 39.6953c -0.0000,21.9231 17.7722,39.6953 39.6953 39.6953c 21.9231,0.0000 39.6953,-17.7722 39.6953 -39.6953Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(255,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 51.0462,151.2138 c 0.0000,-2.0083 -1.6281,-3.6364 -3.6364 -3.6364c -2.0083,-0.0000 -3.6364,1.6281 -3.6364 3.6364c -0.0000,2.0083 1.6281,3.6364 3.6364 3.6364c 2.0083,0.0000 3.6364,-1.6281 3.6364 -3.6364Z"/></g></svg>

+ diagrams/src_Diagrams_Combinators_positionEx.svg view

@@ -0,0 +1,1 @@+<svg xmlns="http://www.w3.org/2000/svg" height="300.0000" stroke-opacity="1" viewBox="0 0 204 300" font-size="1" width="204.2553" xmlns:xlink="http://www.w3.org/1999/xlink" stroke="rgb(0,0,0)" version="1.1"><defs></defs><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.9901643964084406" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 204.2553,6.3830 c 0.0000,-3.5252 -2.8578,-6.3830 -6.3830 -6.3830c -3.5252,-0.0000 -6.3830,2.8578 -6.3830 6.3830c -0.0000,3.5252 2.8578,6.3830 6.3830 6.3830c 3.5252,0.0000 6.3830,-2.8578 6.3830 -6.3830Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.9901643964084406" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 197.8723,43.4043 c 0.0000,-3.5252 -2.8578,-6.3830 -6.3830 -6.3830c -3.5252,-0.0000 -6.3830,2.8578 -6.3830 6.3830c -0.0000,3.5252 2.8578,6.3830 6.3830 6.3830c 3.5252,0.0000 6.3830,-2.8578 6.3830 -6.3830Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.9901643964084406" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 191.4894,77.8723 c 0.0000,-3.5252 -2.8578,-6.3830 -6.3830 -6.3830c -3.5252,-0.0000 -6.3830,2.8578 -6.3830 6.3830c -0.0000,3.5252 2.8578,6.3830 6.3830 6.3830c 3.5252,0.0000 6.3830,-2.8578 6.3830 -6.3830Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.9901643964084406" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 185.1064,109.7872 c 0.0000,-3.5252 -2.8578,-6.3830 -6.3830 -6.3830c -3.5252,-0.0000 -6.3830,2.8578 -6.3830 6.3830c -0.0000,3.5252 2.8578,6.3830 6.3830 6.3830c 3.5252,0.0000 6.3830,-2.8578 6.3830 -6.3830Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.9901643964084406" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 178.7234,139.1489 c 0.0000,-3.5252 -2.8578,-6.3830 -6.3830 -6.3830c -3.5252,-0.0000 -6.3830,2.8578 -6.3830 6.3830c -0.0000,3.5252 2.8578,6.3830 6.3830 6.3830c 3.5252,0.0000 6.3830,-2.8578 6.3830 -6.3830Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.9901643964084406" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 172.3404,165.9574 c 0.0000,-3.5252 -2.8578,-6.3830 -6.3830 -6.3830c -3.5252,-0.0000 -6.3830,2.8578 -6.3830 6.3830c -0.0000,3.5252 2.8578,6.3830 6.3830 6.3830c 3.5252,0.0000 6.3830,-2.8578 6.3830 -6.3830Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.9901643964084406" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 165.9574,190.2128 c 0.0000,-3.5252 -2.8578,-6.3830 -6.3830 -6.3830c -3.5252,-0.0000 -6.3830,2.8578 -6.3830 6.3830c -0.0000,3.5252 2.8578,6.3830 6.3830 6.3830c 3.5252,0.0000 6.3830,-2.8578 6.3830 -6.3830Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.9901643964084406" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 159.5745,211.9149 c 0.0000,-3.5252 -2.8578,-6.3830 -6.3830 -6.3830c -3.5252,-0.0000 -6.3830,2.8578 -6.3830 6.3830c -0.0000,3.5252 2.8578,6.3830 6.3830 6.3830c 3.5252,0.0000 6.3830,-2.8578 6.3830 -6.3830Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.9901643964084406" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 153.1915,231.0638 c 0.0000,-3.5252 -2.8578,-6.3830 -6.3830 -6.3830c -3.5252,-0.0000 -6.3830,2.8578 -6.3830 6.3830c -0.0000,3.5252 2.8578,6.3830 6.3830 6.3830c 3.5252,0.0000 6.3830,-2.8578 6.3830 -6.3830Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.9901643964084406" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 146.8085,247.6596 c 0.0000,-3.5252 -2.8578,-6.3830 -6.3830 -6.3830c -3.5252,-0.0000 -6.3830,2.8578 -6.3830 6.3830c -0.0000,3.5252 2.8578,6.3830 6.3830 6.3830c 3.5252,0.0000 6.3830,-2.8578 6.3830 -6.3830Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.9901643964084406" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 140.4255,261.7021 c 0.0000,-3.5252 -2.8578,-6.3830 -6.3830 -6.3830c -3.5252,-0.0000 -6.3830,2.8578 -6.3830 6.3830c -0.0000,3.5252 2.8578,6.3830 6.3830 6.3830c 3.5252,0.0000 6.3830,-2.8578 6.3830 -6.3830Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.9901643964084406" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 134.0426,273.1915 c 0.0000,-3.5252 -2.8578,-6.3830 -6.3830 -6.3830c -3.5252,-0.0000 -6.3830,2.8578 -6.3830 6.3830c -0.0000,3.5252 2.8578,6.3830 6.3830 6.3830c 3.5252,0.0000 6.3830,-2.8578 6.3830 -6.3830Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.9901643964084406" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 127.6596,282.1277 c 0.0000,-3.5252 -2.8578,-6.3830 -6.3830 -6.3830c -3.5252,-0.0000 -6.3830,2.8578 -6.3830 6.3830c -0.0000,3.5252 2.8578,6.3830 6.3830 6.3830c 3.5252,0.0000 6.3830,-2.8578 6.3830 -6.3830Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.9901643964084406" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 121.2766,288.5106 c 0.0000,-3.5252 -2.8578,-6.3830 -6.3830 -6.3830c -3.5252,-0.0000 -6.3830,2.8578 -6.3830 6.3830c -0.0000,3.5252 2.8578,6.3830 6.3830 6.3830c 3.5252,0.0000 6.3830,-2.8578 6.3830 -6.3830Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.9901643964084406" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 114.8936,292.3404 c 0.0000,-3.5252 -2.8578,-6.3830 -6.3830 -6.3830c -3.5252,-0.0000 -6.3830,2.8578 -6.3830 6.3830c -0.0000,3.5252 2.8578,6.3830 6.3830 6.3830c 3.5252,0.0000 6.3830,-2.8578 6.3830 -6.3830Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.9901643964084406" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 108.5106,293.6170 c 0.0000,-3.5252 -2.8578,-6.3830 -6.3830 -6.3830c -3.5252,-0.0000 -6.3830,2.8578 -6.3830 6.3830c -0.0000,3.5252 2.8578,6.3830 6.3830 6.3830c 3.5252,0.0000 6.3830,-2.8578 6.3830 -6.3830Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.9901643964084406" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 102.1277,292.3404 c 0.0000,-3.5252 -2.8578,-6.3830 -6.3830 -6.3830c -3.5252,-0.0000 -6.3830,2.8578 -6.3830 6.3830c -0.0000,3.5252 2.8578,6.3830 6.3830 6.3830c 3.5252,0.0000 6.3830,-2.8578 6.3830 -6.3830Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.9901643964084406" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 95.7447,288.5106 c 0.0000,-3.5252 -2.8578,-6.3830 -6.3830 -6.3830c -3.5252,-0.0000 -6.3830,2.8578 -6.3830 6.3830c -0.0000,3.5252 2.8578,6.3830 6.3830 6.3830c 3.5252,0.0000 6.3830,-2.8578 6.3830 -6.3830Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.9901643964084406" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 89.3617,282.1277 c 0.0000,-3.5252 -2.8578,-6.3830 -6.3830 -6.3830c -3.5252,-0.0000 -6.3830,2.8578 -6.3830 6.3830c -0.0000,3.5252 2.8578,6.3830 6.3830 6.3830c 3.5252,0.0000 6.3830,-2.8578 6.3830 -6.3830Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.9901643964084406" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 82.9787,273.1915 c 0.0000,-3.5252 -2.8578,-6.3830 -6.3830 -6.3830c -3.5252,-0.0000 -6.3830,2.8578 -6.3830 6.3830c -0.0000,3.5252 2.8578,6.3830 6.3830 6.3830c 3.5252,0.0000 6.3830,-2.8578 6.3830 -6.3830Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.9901643964084406" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 76.5957,261.7021 c 0.0000,-3.5252 -2.8578,-6.3830 -6.3830 -6.3830c -3.5252,-0.0000 -6.3830,2.8578 -6.3830 6.3830c -0.0000,3.5252 2.8578,6.3830 6.3830 6.3830c 3.5252,0.0000 6.3830,-2.8578 6.3830 -6.3830Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.9901643964084406" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 70.2128,247.6596 c 0.0000,-3.5252 -2.8578,-6.3830 -6.3830 -6.3830c -3.5252,-0.0000 -6.3830,2.8578 -6.3830 6.3830c -0.0000,3.5252 2.8578,6.3830 6.3830 6.3830c 3.5252,0.0000 6.3830,-2.8578 6.3830 -6.3830Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.9901643964084406" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 63.8298,231.0638 c 0.0000,-3.5252 -2.8578,-6.3830 -6.3830 -6.3830c -3.5252,-0.0000 -6.3830,2.8578 -6.3830 6.3830c -0.0000,3.5252 2.8578,6.3830 6.3830 6.3830c 3.5252,0.0000 6.3830,-2.8578 6.3830 -6.3830Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.9901643964084406" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 57.4468,211.9149 c 0.0000,-3.5252 -2.8578,-6.3830 -6.3830 -6.3830c -3.5252,-0.0000 -6.3830,2.8578 -6.3830 6.3830c -0.0000,3.5252 2.8578,6.3830 6.3830 6.3830c 3.5252,0.0000 6.3830,-2.8578 6.3830 -6.3830Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.9901643964084406" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 51.0638,190.2128 c 0.0000,-3.5252 -2.8578,-6.3830 -6.3830 -6.3830c -3.5252,-0.0000 -6.3830,2.8578 -6.3830 6.3830c -0.0000,3.5252 2.8578,6.3830 6.3830 6.3830c 3.5252,0.0000 6.3830,-2.8578 6.3830 -6.3830Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.9901643964084406" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 44.6809,165.9574 c 0.0000,-3.5252 -2.8578,-6.3830 -6.3830 -6.3830c -3.5252,-0.0000 -6.3830,2.8578 -6.3830 6.3830c -0.0000,3.5252 2.8578,6.3830 6.3830 6.3830c 3.5252,0.0000 6.3830,-2.8578 6.3830 -6.3830Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.9901643964084406" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 38.2979,139.1489 c 0.0000,-3.5252 -2.8578,-6.3830 -6.3830 -6.3830c -3.5252,-0.0000 -6.3830,2.8578 -6.3830 6.3830c -0.0000,3.5252 2.8578,6.3830 6.3830 6.3830c 3.5252,0.0000 6.3830,-2.8578 6.3830 -6.3830Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.9901643964084406" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 31.9149,109.7872 c 0.0000,-3.5252 -2.8578,-6.3830 -6.3830 -6.3830c -3.5252,-0.0000 -6.3830,2.8578 -6.3830 6.3830c -0.0000,3.5252 2.8578,6.3830 6.3830 6.3830c 3.5252,0.0000 6.3830,-2.8578 6.3830 -6.3830Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.9901643964084406" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 25.5319,77.8723 c 0.0000,-3.5252 -2.8578,-6.3830 -6.3830 -6.3830c -3.5252,-0.0000 -6.3830,2.8578 -6.3830 6.3830c -0.0000,3.5252 2.8578,6.3830 6.3830 6.3830c 3.5252,0.0000 6.3830,-2.8578 6.3830 -6.3830Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.9901643964084406" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 19.1489,43.4043 c 0.0000,-3.5252 -2.8578,-6.3830 -6.3830 -6.3830c -3.5252,-0.0000 -6.3830,2.8578 -6.3830 6.3830c -0.0000,3.5252 2.8578,6.3830 6.3830 6.3830c 3.5252,0.0000 6.3830,-2.8578 6.3830 -6.3830Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.9901643964084406" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 12.7660,6.3830 c 0.0000,-3.5252 -2.8578,-6.3830 -6.3830 -6.3830c -3.5252,-0.0000 -6.3830,2.8578 -6.3830 6.3830c -0.0000,3.5252 2.8578,6.3830 6.3830 6.3830c 3.5252,0.0000 6.3830,-2.8578 6.3830 -6.3830Z"/></g></svg>

+ diagrams/src_Diagrams_Combinators_strutEx.svg view

@@ -0,0 +1,1 @@+<svg xmlns="http://www.w3.org/2000/svg" height="120.0000" stroke-opacity="1" viewBox="0 0 300 120" font-size="1" width="300.0000" xmlns:xlink="http://www.w3.org/1999/xlink" stroke="rgb(0,0,0)" version="1.1"><defs></defs><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.758946638440411" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 286.3636,60.0000 c 0.0000,-30.1246 -24.4208,-54.5455 -54.5455 -54.5455c -30.1246,-0.0000 -54.5455,24.4208 -54.5455 54.5455c -0.0000,30.1246 24.4208,54.5455 54.5455 54.5455c 30.1246,0.0000 54.5455,-24.4208 54.5455 -54.5455Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.758946638440411" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 122.7273,60.0000 c 0.0000,-30.1246 -24.4208,-54.5455 -54.5455 -54.5455c -30.1246,-0.0000 -54.5455,24.4208 -54.5455 54.5455c -0.0000,30.1246 24.4208,54.5455 54.5455 54.5455c 30.1246,0.0000 54.5455,-24.4208 54.5455 -54.5455Z"/></g></svg>

+ diagrams/src_Diagrams_Combinators_withEnvelopeEx.svg view

@@ -0,0 +1,1 @@+<svg xmlns="http://www.w3.org/2000/svg" height="166.6667" stroke-opacity="1" viewBox="0 0 300 167" font-size="1" width="300.0000" xmlns:xlink="http://www.w3.org/1999/xlink" stroke="rgb(0,0,0)" version="1.1"><defs></defs><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.8944271909999159" fill="rgb(0,0,255)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 261.1111,138.8889 l -0.0000,-111.1111 h -111.1111 l -0.0000,111.1111 Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(255,255,255)" stroke-width="0.8944271909999159" fill="rgb(0,0,0)" stroke-dashoffset="0.0" stroke-linecap="butt" stroke-miterlimit="10.0" stroke-dasharray="5.555555555555557,5.555555555555557"><path d="M 250.0000,83.3333 c 0.0000,-24.5460 -19.8985,-44.4444 -44.4444 -44.4444c -24.5460,-0.0000 -44.4444,19.8985 -44.4444 44.4444c -0.0000,24.5460 19.8985,44.4444 44.4444 44.4444c 24.5460,0.0000 44.4444,-19.8985 44.4444 -44.4444Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.8944271909999159" fill="rgb(0,128,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 161.1111,83.3333 c 0.0000,-30.6825 -24.8731,-55.5556 -55.5556 -55.5556c -30.6825,-0.0000 -55.5556,24.8731 -55.5556 55.5556c -0.0000,30.6825 24.8731,55.5556 55.5556 55.5556c 30.6825,0.0000 55.5556,-24.8731 55.5556 -55.5556Z"/></g></svg>

+ diagrams/src_Diagrams_CubicSpline_Boehm_bsplineEx.svg view

@@ -0,0 +1,1 @@+<svg xmlns="http://www.w3.org/2000/svg" height="184.6154" stroke-opacity="1" viewBox="0 0 300 185" font-size="1" width="300.0000" xmlns:xlink="http://www.w3.org/1999/xlink" stroke="rgb(0,0,0)" version="1.1"><defs></defs><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9413574486632834" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 135.5769,106.7308 c 0.0000,-0.0000 0.0000,-0.0000 9.6154 -14.4231c 9.6154,-14.4231 28.8462,-43.2692 52.8846 -33.6538c 24.0385,9.6154 52.8846,57.6923 24.0385 67.3077c -28.8462,9.6154 -115.3846,-19.2308 -139.4231 -43.2692c -24.0385,-24.0385 14.4231,-43.2692 33.6538 -52.8846c 19.2308,-9.6154 19.2308,-9.6154 19.2308 -9.6154"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,255)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 141.3462,20.1923 c 0.0000,-3.1863 -2.5830,-5.7692 -5.7692 -5.7692c -3.1863,-0.0000 -5.7692,2.5830 -5.7692 5.7692c -0.0000,3.1863 2.5830,5.7692 5.7692 5.7692c 3.1863,0.0000 5.7692,-2.5830 5.7692 -5.7692Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,255)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 25.9615,77.8846 c 0.0000,-3.1863 -2.5830,-5.7692 -5.7692 -5.7692c -3.1863,-0.0000 -5.7692,2.5830 -5.7692 5.7692c -0.0000,3.1863 2.5830,5.7692 5.7692 5.7692c 3.1863,0.0000 5.7692,-2.5830 5.7692 -5.7692Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,255)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 285.5769,164.4231 c 0.0000,-3.1863 -2.5830,-5.7692 -5.7692 -5.7692c -3.1863,-0.0000 -5.7692,2.5830 -5.7692 5.7692c -0.0000,3.1863 2.5830,5.7692 5.7692 5.7692c 3.1863,0.0000 5.7692,-2.5830 5.7692 -5.7692Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,255)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 199.0385,20.1923 c 0.0000,-3.1863 -2.5830,-5.7692 -5.7692 -5.7692c -3.1863,-0.0000 -5.7692,2.5830 -5.7692 5.7692c -0.0000,3.1863 2.5830,5.7692 5.7692 5.7692c 3.1863,0.0000 5.7692,-2.5830 5.7692 -5.7692Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,255)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 141.3462,106.7308 c 0.0000,-3.1863 -2.5830,-5.7692 -5.7692 -5.7692c -3.1863,-0.0000 -5.7692,2.5830 -5.7692 5.7692c -0.0000,3.1863 2.5830,5.7692 5.7692 5.7692c 3.1863,0.0000 5.7692,-2.5830 5.7692 -5.7692Z"/></g></svg>

+ diagrams/src_Diagrams_CubicSpline_cubicSplineEx.svg view

@@ -0,0 +1,1 @@+<svg xmlns="http://www.w3.org/2000/svg" height="150.9864" stroke-opacity="1" viewBox="0 0 600 151" font-size="1" width="600.0000" xmlns:xlink="http://www.w3.org/1999/xlink" stroke="rgb(0,0,0)" version="1.1"><defs></defs><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="1.2039392872038202" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 434.1254,88.5075 c -6.8945,-6.8945 6.8945,-85.0326 50.5599 -75.8399c 43.6654,9.1927 117.2071,105.7162 75.8399 126.3998c -41.3672,20.6836 -197.6433,-34.4727 -227.5197 -75.8399c -29.8763,-41.3672 66.6472,-68.9454 101.1199 -50.5599c 34.4727,18.3854 6.8945,82.7344 -0.0000 75.8399Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,255)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 439.1814,12.6676 c 0.0000,-2.7923 -2.2636,-5.0560 -5.0560 -5.0560c -2.7923,-0.0000 -5.0560,2.2636 -5.0560 5.0560c -0.0000,2.7923 2.2636,5.0560 5.0560 5.0560c 2.7923,0.0000 5.0560,-2.2636 5.0560 -5.0560Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,255)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 338.0615,63.2275 c 0.0000,-2.7923 -2.2636,-5.0560 -5.0560 -5.0560c -2.7923,-0.0000 -5.0560,2.2636 -5.0560 5.0560c -0.0000,2.7923 2.2636,5.0560 5.0560 5.0560c 2.7923,0.0000 5.0560,-2.2636 5.0560 -5.0560Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,255)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 565.5812,139.0674 c 0.0000,-2.7923 -2.2636,-5.0560 -5.0560 -5.0560c -2.7923,-0.0000 -5.0560,2.2636 -5.0560 5.0560c -0.0000,2.7923 2.2636,5.0560 5.0560 5.0560c 2.7923,0.0000 5.0560,-2.2636 5.0560 -5.0560Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,255)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 489.7413,12.6676 c 0.0000,-2.7923 -2.2636,-5.0560 -5.0560 -5.0560c -2.7923,-0.0000 -5.0560,2.2636 -5.0560 5.0560c -0.0000,2.7923 2.2636,5.0560 5.0560 5.0560c 2.7923,0.0000 5.0560,-2.2636 5.0560 -5.0560Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,255)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 439.1814,88.5075 c 0.0000,-2.7923 -2.2636,-5.0560 -5.0560 -5.0560c -2.7923,-0.0000 -5.0560,2.2636 -5.0560 5.0560c -0.0000,2.7923 2.2636,5.0560 5.0560 5.0560c 2.7923,0.0000 5.0560,-2.2636 5.0560 -5.0560Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="1.2039392872038202" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 139.8914,88.5075 c 5.4171,-48.3028 10.8343,-96.6056 50.5599 -75.8399c 39.7257,20.7657 113.7598,110.5998 75.8399 126.3998c -37.9199,15.8000 -187.7940,-42.4342 -227.5197 -75.8399c -39.7257,-33.4057 30.6971,-41.9828 101.1199 -50.5599"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,255)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 144.9474,12.6676 c 0.0000,-2.7923 -2.2636,-5.0560 -5.0560 -5.0560c -2.7923,-0.0000 -5.0560,2.2636 -5.0560 5.0560c -0.0000,2.7923 2.2636,5.0560 5.0560 5.0560c 2.7923,0.0000 5.0560,-2.2636 5.0560 -5.0560Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,255)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 43.8275,63.2275 c 0.0000,-2.7923 -2.2636,-5.0560 -5.0560 -5.0560c -2.7923,-0.0000 -5.0560,2.2636 -5.0560 5.0560c -0.0000,2.7923 2.2636,5.0560 5.0560 5.0560c 2.7923,0.0000 5.0560,-2.2636 5.0560 -5.0560Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,255)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 271.3472,139.0674 c 0.0000,-2.7923 -2.2636,-5.0560 -5.0560 -5.0560c -2.7923,-0.0000 -5.0560,2.2636 -5.0560 5.0560c -0.0000,2.7923 2.2636,5.0560 5.0560 5.0560c 2.7923,0.0000 5.0560,-2.2636 5.0560 -5.0560Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,255)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 195.5073,12.6676 c 0.0000,-2.7923 -2.2636,-5.0560 -5.0560 -5.0560c -2.7923,-0.0000 -5.0560,2.2636 -5.0560 5.0560c -0.0000,2.7923 2.2636,5.0560 5.0560 5.0560c 2.7923,0.0000 5.0560,-2.2636 5.0560 -5.0560Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,255)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 144.9474,88.5075 c 0.0000,-2.7923 -2.2636,-5.0560 -5.0560 -5.0560c -2.7923,-0.0000 -5.0560,2.2636 -5.0560 5.0560c -0.0000,2.7923 2.2636,5.0560 5.0560 5.0560c 2.7923,0.0000 5.0560,-2.2636 5.0560 -5.0560Z"/></g></svg>

+ diagrams/src_Diagrams_TrailLike_explodeTrailEx.svg view

@@ -0,0 +1,1 @@+<svg xmlns="http://www.w3.org/2000/svg" height="285.3170" stroke-opacity="1" viewBox="0 0 300 285" font-size="1" width="300.0000" xmlns:xlink="http://www.w3.org/1999/xlink" stroke="rgb(0,0,0)" version="1.1"><defs></defs><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,255)" stroke-width="1.17026551836112" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 65.7226,272.3480 l 168.5547,-0.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(255,0,0)" stroke-width="1.17026551836112" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 13.6364,112.0429 l 52.0863,160.3051 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(255,255,0)" stroke-width="1.17026551836112" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 150.0000,12.9690 l -136.3636,99.0740 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,128,0)" stroke-width="1.17026551836112" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 286.3636,112.0429 l -136.3636,-99.0740 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(255,165,0)" stroke-width="1.17026551836112" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 234.2774,272.3480 l 52.0863,-160.3051 "/></g></svg>

+ diagrams/src_Diagrams_TrailLike_fromOffsetsEx.svg view

@@ -0,0 +1,1 @@+<svg xmlns="http://www.w3.org/2000/svg" height="86.6025" stroke-opacity="1" viewBox="0 0 300 87" font-size="1" width="300.0000" xmlns:xlink="http://www.w3.org/1999/xlink" stroke="rgb(0,0,0)" version="1.1"><defs></defs><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.644741959094125" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 13.6364,82.6661 h 90.9091 l 45.4545,-78.7296 l 45.4545,78.7296 h 90.9091 "/></g></svg>

+ diagrams/src_Diagrams_TrailLike_fromSegmentsEx.svg view

@@ -0,0 +1,1 @@+<svg xmlns="http://www.w3.org/2000/svg" height="200.0000" stroke-opacity="1" viewBox="0 0 247 200" font-size="1" width="247.4874" xmlns:xlink="http://www.w3.org/1999/xlink" stroke="rgb(0,0,0)" version="1.1"><defs></defs><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.8899211172508118" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 11.2494,190.9091 l 128.5649,-128.5649 c 128.5649,-128.5649 128.5649,-0.0000 0.0000 128.5649h -128.5649 "/></g></svg>

+ diagrams/src_Diagrams_TrailLike_fromVerticesEx.svg view

@@ -0,0 +1,1 @@+<svg xmlns="http://www.w3.org/2000/svg" height="305.0220" stroke-opacity="1" viewBox="0 0 300 305" font-size="1" width="300.0000" xmlns:xlink="http://www.w3.org/1999/xlink" stroke="rgb(0,0,0)" version="1.1"><defs></defs><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="1.2100023771913093" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 198.0223,226.8357 l 52.5796,-15.5396 l 35.7617,-48.1977 l -52.8414,-45.5203 l 1.4689,-54.8082 l -34.7877,-48.9053 l -59.6213,36.1886 l -51.6718,-18.3337 l -57.2617,17.9725 l 15.9934,67.8861 l -33.4039,43.4773 l -0.6019,60.0129 l 69.5057,5.7673 l 31.0270,45.2042 l 56.8897,19.1175 Z"/></g></svg>

+ diagrams/src_Diagrams_TrailLike_twiddleEx.svg view

@@ -0,0 +1,1 @@+<svg xmlns="http://www.w3.org/2000/svg" height="259.8076" stroke-opacity="1" viewBox="0 0 300 260" font-size="1" width="300.0000" xmlns:xlink="http://www.w3.org/1999/xlink" stroke="rgb(0,0,0)" version="1.1"><defs></defs><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="1.1167258309225196" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 81.8182,247.9982 h 0.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="1.1167258309225196" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 81.8182,247.9982 l -68.1818,-118.0944 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="1.1167258309225196" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 81.8182,247.9982 l 0.0000,-236.1887 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="1.1167258309225196" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 81.8182,247.9982 l 136.3636,-236.1887 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="1.1167258309225196" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 81.8182,247.9982 l 204.5455,-118.0944 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="1.1167258309225196" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 81.8182,247.9982 l 136.3636,0.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="1.1167258309225196" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 13.6364,129.9038 l 68.1818,118.0944 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="1.1167258309225196" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 13.6364,129.9038 h 0.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="1.1167258309225196" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 13.6364,129.9038 l 68.1818,-118.0944 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="1.1167258309225196" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 13.6364,129.9038 l 204.5455,-118.0944 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="1.1167258309225196" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 13.6364,129.9038 l 272.7273,0.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="1.1167258309225196" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 13.6364,129.9038 l 204.5455,118.0944 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="1.1167258309225196" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 81.8182,11.8094 l -0.0000,236.1887 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="1.1167258309225196" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 81.8182,11.8094 l -68.1818,118.0944 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="1.1167258309225196" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 81.8182,11.8094 h 0.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="1.1167258309225196" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 81.8182,11.8094 l 136.3636,0.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="1.1167258309225196" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 81.8182,11.8094 l 204.5455,118.0944 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="1.1167258309225196" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 81.8182,11.8094 l 136.3636,236.1887 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="1.1167258309225196" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 218.1818,11.8094 l -136.3636,236.1887 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="1.1167258309225196" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 218.1818,11.8094 l -204.5455,118.0944 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="1.1167258309225196" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 218.1818,11.8094 l -136.3636,-0.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="1.1167258309225196" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 218.1818,11.8094 h 0.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="1.1167258309225196" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 218.1818,11.8094 l 68.1818,118.0944 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="1.1167258309225196" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 218.1818,11.8094 l -0.0000,236.1887 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="1.1167258309225196" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 286.3636,129.9038 l -204.5455,118.0944 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="1.1167258309225196" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 286.3636,129.9038 l -272.7273,-0.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="1.1167258309225196" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 286.3636,129.9038 l -204.5455,-118.0944 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="1.1167258309225196" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 286.3636,129.9038 l -68.1818,-118.0944 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="1.1167258309225196" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 286.3636,129.9038 h 0.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="1.1167258309225196" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 286.3636,129.9038 l -68.1818,118.0944 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="1.1167258309225196" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 218.1818,247.9982 l -136.3636,-0.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="1.1167258309225196" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 218.1818,247.9982 l -204.5455,-118.0944 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="1.1167258309225196" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 218.1818,247.9982 l -136.3636,-236.1887 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="1.1167258309225196" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 218.1818,247.9982 l 0.0000,-236.1887 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="1.1167258309225196" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 218.1818,247.9982 l 68.1818,-118.0944 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="1.1167258309225196" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 218.1818,247.9982 h 0.0000 "/></g></svg>

+ diagrams/src_Diagrams_Trail_closeLineEx.svg view

@@ -0,0 +1,1 @@+<svg xmlns="http://www.w3.org/2000/svg" height="68.1818" stroke-opacity="1" viewBox="0 0 500 68" font-size="1" width="500.0000" xmlns:xlink="http://www.w3.org/1999/xlink" stroke="rgb(0,0,0)" version="1.1"><defs></defs><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.7385489458759964" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 394.6281,3.0992 l 82.6446,41.3223 l -123.9669,20.6612 l -82.6446,-41.3223 l 41.3223,-20.6612 Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.7385489458759964" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 146.6942,3.0992 l 82.6446,41.3223 l -123.9669,20.6612 l -82.6446,-41.3223 l 41.3223,-20.6612 "/></g></svg>

+ diagrams/src_Diagrams_Trail_glueLineEx.svg view

@@ -0,0 +1,1 @@+<svg xmlns="http://www.w3.org/2000/svg" height="68.1818" stroke-opacity="1" viewBox="0 0 500 68" font-size="1" width="500.0000" xmlns:xlink="http://www.w3.org/1999/xlink" stroke="rgb(0,0,0)" version="1.1"><defs></defs><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.7385489458759964" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 384.2975,0.0000 l 82.6446,41.3223 l -123.9669,20.6612 l -82.6446,-41.3223 Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.7385489458759964" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 136.3636,0.0000 l 82.6446,41.3223 l -123.9669,20.6612 l -82.6446,-41.3223 l 41.3223,-20.6612 "/></g></svg>

+ diagrams/src_Diagrams_Trail_lineFromOffsetsEx.svg view

@@ -0,0 +1,1 @@+<svg xmlns="http://www.w3.org/2000/svg" height="50.0000" stroke-opacity="1" viewBox="0 0 300 50" font-size="1" width="300.0000" xmlns:xlink="http://www.w3.org/1999/xlink" stroke="rgb(0,0,0)" version="1.1"><defs></defs><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.5" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 0.0000,50.0000 l 100.0000,-50.0000 l 100.0000,50.0000 l 100.0000,-25.0000 "/></g></svg>

+ diagrams/src_Diagrams_Trail_lineFromVerticesEx.svg view

@@ -0,0 +1,1 @@+<svg xmlns="http://www.w3.org/2000/svg" height="120.0000" stroke-opacity="1" viewBox="0 0 300 120" font-size="1" width="300.0000" xmlns:xlink="http://www.w3.org/1999/xlink" stroke="rgb(0,0,0)" version="1.1"><defs></defs><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.7589466384404111" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 13.6364,114.5455 v -54.5455 l 54.5455,-54.5455 l 218.1818,54.5455 "/></g></svg>

+ diagrams/src_Diagrams_Trail_trailOffsetEx.svg view

@@ -0,0 +1,1 @@+<svg xmlns="http://www.w3.org/2000/svg" height="90.0000" stroke-opacity="1" viewBox="0 0 300 90" font-size="1" width="300.0000" xmlns:xlink="http://www.w3.org/1999/xlink" stroke="rgb(0,0,0)" version="1.1"><defs></defs><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(255,0,0)" stroke-width="0.6572670690061994" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 177.2727,4.0909 h -109.0909 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.6572670690061994" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 177.2727,4.0909 l 109.0909,54.5455 l -163.6364,27.2727 l -109.0909,-54.5455 l 54.5455,-27.2727 "/></g></svg>

+ diagrams/src_Diagrams_TwoD_Arc_annularWedgeEx.svg view

@@ -0,0 +1,1 @@+<svg xmlns="http://www.w3.org/2000/svg" height="178.5413" stroke-opacity="1" viewBox="0 0 400 179" font-size="1" width="400.0000" xmlns:xlink="http://www.w3.org/1999/xlink" stroke="rgb(0,0,0)" version="1.1"><defs></defs><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="1.0689548060277785" fill="rgb(0,0,255)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 364.6026,49.1012 l 17.2156,-17.2156 c -31.6930,-31.6930 -83.0775,-31.6930 -114.7704 -0.0000c -31.6930,31.6930 -31.6930,83.0775 -0.0000 114.7704c 31.6930,31.6930 83.0775,31.6930 114.7704 0.0000l -17.2156,-17.2156 c -22.1851,22.1851 -58.1542,22.1851 -80.3393 -0.0000c -22.1851,-22.1851 -22.1851,-58.1542 0.0000 -80.3393c 22.1851,-22.1851 58.1542,-22.1851 80.3393 -0.0000Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="1.0689548060277785" fill="rgb(0,0,255)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 196.7624,65.0577 l 5.9381,-56.4973 c -22.8740,-2.4042 -45.6939,5.0105 -62.7863 20.4005l 38.0123,42.2169 c 5.1277,-4.6170 11.9737,-6.8414 18.8359 -6.1201Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="1.0689548060277785" fill="rgb(0,0,255)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 58.7593,89.2708 h 40.5775 c 0.0000,-44.8206 -36.3343,-81.1550 -81.1550 -81.1550l -0.0000,40.5775 c 22.4103,0.0000 40.5775,18.1672 40.5775 40.5775Z"/></g></svg>

+ diagrams/src_Diagrams_TwoD_Arc_arc'Ex.svg view

@@ -0,0 +1,1 @@+<svg xmlns="http://www.w3.org/2000/svg" height="300.0000" stroke-opacity="1" viewBox="0 0 300 300" font-size="1" width="300.0000" xmlns:xlink="http://www.w3.org/1999/xlink" stroke="rgb(0,0,0)" version="1.1"><defs></defs><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="1.2" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 286.3636,286.3636 c 0.0000,-150.6231 -122.1042,-272.7273 -272.7273 -272.7273"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="1.2" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 195.4545,286.3636 c 0.0000,-100.4154 -81.4028,-181.8182 -181.8182 -181.8182"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="1.2" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 104.5455,286.3636 c 0.0000,-50.2077 -40.7014,-90.9091 -90.9091 -90.9091"/></g></svg>

+ diagrams/src_Diagrams_TwoD_Arc_arcBetweenEx.svg view

@@ -0,0 +1,1 @@+<svg xmlns="http://www.w3.org/2000/svg" height="150.0000" stroke-opacity="1" viewBox="0 0 300 150" font-size="1" width="300.0000" xmlns:xlink="http://www.w3.org/1999/xlink" stroke="rgb(0,0,0)" version="1.1"><defs></defs><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.8485281374238577" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 13.6364,143.1818 c 71.7377,-76.5246 168.4650,-124.8883 272.7273 -136.3636"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.8485281374238577" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 13.6364,143.1818 c 82.0507,-61.3532 174.4143,-107.5350 272.7273 -136.3636"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.8485281374238577" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 13.6364,143.1818 l 272.7273,-136.3636 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.8485281374238577" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 13.6364,143.1818 c 98.3130,-28.8286 190.6766,-75.0104 272.7273 -136.3636"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.8485281374238577" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 13.6364,143.1818 c 104.2623,-11.4754 200.9896,-59.8390 272.7273 -136.3636"/></g></svg>

+ diagrams/src_Diagrams_TwoD_Arc_wedgeEx.svg view

@@ -0,0 +1,1 @@+<svg xmlns="http://www.w3.org/2000/svg" height="178.5413" stroke-opacity="1" viewBox="0 0 400 179" font-size="1" width="400.0000" xmlns:xlink="http://www.w3.org/1999/xlink" stroke="rgb(0,0,0)" version="1.1"><defs></defs><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="1.0689548060277785" fill="rgb(0,0,255)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 324.4330,89.2708 l 57.3852,-57.3852 c -31.6930,-31.6930 -83.0775,-31.6930 -114.7704 -0.0000c -31.6930,31.6930 -31.6930,83.0775 -0.0000 114.7704c 31.6930,31.6930 83.0775,31.6930 114.7704 0.0000Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="1.0689548060277785" fill="rgb(0,0,255)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 194.2175,89.2708 l 8.4830,-80.7104 c -22.8740,-2.4042 -45.6939,5.0105 -62.7863 20.4005Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="1.0689548060277785" fill="rgb(0,0,255)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 18.1818,89.2708 h 81.1550 c 0.0000,-44.8206 -36.3343,-81.1550 -81.1550 -81.1550Z"/></g></svg>

+ diagrams/src_Diagrams_TwoD_Arrow_example1.svg view

@@ -0,0 +1,1 @@+<svg xmlns="http://www.w3.org/2000/svg" height="142.8571" stroke-opacity="1" viewBox="0 0 500 143" font-size="1" width="500.0000" xmlns:xlink="http://www.w3.org/1999/xlink" stroke="rgb(0,0,0)" version="1.1"><defs></defs><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(169,169,169)" stroke-width="5.345224838248488" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 461.0390,136.3636 l -0.0000,-129.8701 h -129.8701 l -0.0000,129.8701 Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(169,169,169)" stroke-width="0.0" fill="rgb(255,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 398.7013,71.4286 c 0.0000,-1.4345 -1.1629,-2.5974 -2.5974 -2.5974c -1.4345,-0.0000 -2.5974,1.1629 -2.5974 2.5974c -0.0000,1.4345 1.1629,2.5974 2.5974 2.5974c 1.4345,0.0000 2.5974,-1.1629 2.5974 -2.5974Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(169,169,169)" stroke-width="5.345224838248488" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 136.3636,136.3636 l -0.0000,-129.8701 h -129.8701 l -0.0000,129.8701 Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(169,169,169)" stroke-width="0.0" fill="rgb(255,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 74.0260,71.4286 c 0.0000,-1.4345 -1.1629,-2.5974 -2.5974 -2.5974c -1.4345,-0.0000 -2.5974,1.1629 -2.5974 2.5974c -0.0000,1.4345 1.1629,2.5974 2.5974 2.5974c 1.4345,0.0000 2.5974,-1.1629 2.5974 -2.5974Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="1.0690449676496976" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 89.9820,73.8309 c 61.4068,7.9510 122.8137,15.9021 138.7131 10.9542c 15.8994,-4.9479 -13.7086,-22.7947 2.1908 -27.7426c 15.8994,-4.9479 77.3063,3.0032 138.7131 10.9542"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 89.9820,73.8309 l -7.4663,-10.2070 l -19.3265,-2.5024 l 8.2394,10.3071 l -10.5928,7.8686 l 19.3265,2.5024 l 9.8198,-7.9687 Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 89.9820,73.8309 l 0.0686,-0.5301 l -0.5042,-0.0653 l 0.4355,0.5954 l -0.5728,0.4648 l 0.5042,0.0653 l 0.0686,-0.5301 Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 396.1039,71.4286 l -30.2984,-14.3723 l 4.0722,10.9765 l -6.7336,9.5773 Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 369.8777,68.0328 l -0.2787,-0.0361 l 0.0686,-0.5301 l 0.2101,0.5662 l -0.2787,-0.0361 l -0.0686,0.5301 Z"/></g></svg>

+ diagrams/src_Diagrams_TwoD_Arrow_example2.svg view

@@ -0,0 +1,1 @@+<svg xmlns="http://www.w3.org/2000/svg" height="191.6094" stroke-opacity="1" viewBox="0 0 500 192" font-size="1" width="500.0000" xmlns:xlink="http://www.w3.org/1999/xlink" stroke="rgb(0,0,0)" version="1.1"><defs></defs><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="1.238093280317519" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 92.8161,95.8047 l 0.0000,47.2301 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 92.8161,153.8681 l 4.1176,-12.6726 l -4.1176,2.1647 l -4.1176,-2.1647 Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 92.8161,143.3603 l -0.0000,-0.3255 l 0.6190,-0.0000 l -0.6190,0.3255 l -0.0000,-0.3255 l -0.6190,0.0000 Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(169,169,169)" stroke-width="6.190466401587595" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 477.2727,124.8364 l -0.0000,-58.0634 l -41.0571,-41.0571 l -58.0634,0.0000 l -41.0571,41.0571 l 0.0000,58.0634 l 41.0571,41.0571 l 58.0634,-0.0000 Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(255,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 409.9875,95.8047 c 0.0000,-1.5484 -1.2552,-2.8036 -2.8036 -2.8036c -1.5484,-0.0000 -2.8036,1.2552 -2.8036 2.8036c -0.0000,1.5484 1.2552,2.8036 2.8036 2.8036c 1.5484,0.0000 2.8036,-1.2552 2.8036 -2.8036Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(169,169,169)" stroke-width="6.190466401587595" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 162.9048,124.8364 l -0.0000,-58.0634 l -41.0571,-41.0571 l -58.0634,0.0000 l -41.0571,41.0571 l 0.0000,58.0634 l 41.0571,41.0571 l 58.0634,-0.0000 Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(255,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 95.6196,95.8047 c 0.0000,-1.5484 -1.2552,-2.8036 -2.8036 -2.8036c -1.5484,-0.0000 -2.8036,1.2552 -2.8036 2.8036c -0.0000,1.5484 1.2552,2.8036 2.8036 2.8036c 1.5484,0.0000 2.8036,-1.2552 2.8036 -2.8036Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="1.238093280317519" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 92.8161,95.8047 h 292.7013 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 407.1839,95.8047 l -25.7377,-8.3627 l 4.3965,8.3627 l -4.3965,8.3627 Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 385.8428,95.8047 h -0.3255 v -0.6190 l 0.3255,0.6190 h -0.3255 v 0.6190 Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="1.238093280317519" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 162.9048,124.8364 l 152.5237,-0.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 337.0952,124.8364 l -25.7377,-8.3627 l 4.3965,8.3627 l -4.3965,8.3627 Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 315.7540,124.8364 l -0.3255,0.0000 l -0.0000,-0.6190 l 0.3255,0.6190 l -0.3255,0.0000 l 0.0000,0.6190 Z"/></g></svg>

+ diagrams/src_Diagrams_TwoD_Arrowheads_blockEx.svg view

@@ -0,0 +1,1 @@+<svg xmlns="http://www.w3.org/2000/svg" height="63.6364" stroke-opacity="1" viewBox="0 0 100 64" font-size="1" width="100.0000" xmlns:xlink="http://www.w3.org/1999/xlink" stroke="rgb(0,0,0)" version="1.1"><defs></defs><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 54.5455,54.5455 l -0.0000,-45.4545 h -45.4545 l -0.0000,45.4545 Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 54.5455,31.8182 h 45.4545 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 54.5455,49.2129 l -0.0000,-34.7894 h -45.4545 l -0.0000,34.7894 Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"></g></svg>

+ diagrams/src_Diagrams_TwoD_Arrowheads_dart'Ex.svg view

@@ -0,0 +1,1 @@+<svg xmlns="http://www.w3.org/2000/svg" height="63.6364" stroke-opacity="1" viewBox="0 0 100 64" font-size="1" width="100.0000" xmlns:xlink="http://www.w3.org/1999/xlink" stroke="rgb(0,0,0)" version="1.1"><defs></defs><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 54.5455,54.5455 l -0.0000,-45.4545 h -45.4545 l -0.0000,45.4545 Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 54.5455,31.8182 h 45.4545 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 9.0909,31.8182 l 54.8187,-17.8117 l -9.3642,17.8117 l 9.3642,17.8117 Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 54.5455,31.8182 h 0.0000 h -0.0000 h 0.0000 h 0.0000 h 0.0000 Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"></g></svg>

+ diagrams/src_Diagrams_TwoD_Arrowheads_dartEx.svg view

@@ -0,0 +1,1 @@+<svg xmlns="http://www.w3.org/2000/svg" height="63.6364" stroke-opacity="1" viewBox="0 0 100 64" font-size="1" width="100.0000" xmlns:xlink="http://www.w3.org/1999/xlink" stroke="rgb(0,0,0)" version="1.1"><defs></defs><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 54.5455,54.5455 l -0.0000,-45.4545 h -45.4545 l -0.0000,45.4545 Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 9.0909,31.8182 h 45.4545 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 100.0000,31.8182 l -54.8187,-17.8117 l 9.3642,17.8117 l -9.3642,17.8117 Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 54.5455,31.8182 h -0.0000 h 0.0000 h 0.0000 h 0.0000 h 0.0000 Z"/></g></svg>

+ diagrams/src_Diagrams_TwoD_Arrowheads_halfDart'Ex.svg view

@@ -0,0 +1,1 @@+<svg xmlns="http://www.w3.org/2000/svg" height="63.6364" stroke-opacity="1" viewBox="0 0 100 64" font-size="1" width="100.0000" xmlns:xlink="http://www.w3.org/1999/xlink" stroke="rgb(0,0,0)" version="1.1"><defs></defs><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 54.5455,54.5455 l -0.0000,-45.4545 h -45.4545 l -0.0000,45.4545 Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 54.5455,31.8182 h 45.4545 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 9.0909,31.8182 l 54.8187,-17.8117 l -9.3642,17.8117 Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 54.5455,31.8182 h 0.0000 h -0.0000 Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"></g></svg>

+ diagrams/src_Diagrams_TwoD_Arrowheads_halfDartEx.svg view

@@ -0,0 +1,1 @@+<svg xmlns="http://www.w3.org/2000/svg" height="63.6364" stroke-opacity="1" viewBox="0 0 100 64" font-size="1" width="100.0000" xmlns:xlink="http://www.w3.org/1999/xlink" stroke="rgb(0,0,0)" version="1.1"><defs></defs><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 54.5455,54.5455 l -0.0000,-45.4545 h -45.4545 l -0.0000,45.4545 Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 9.0909,31.8182 h 45.4545 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 100.0000,31.8182 l -54.8187,-17.8117 l 9.3642,17.8117 Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 54.5455,31.8182 h -0.0000 h 0.0000 Z"/></g></svg>

+ diagrams/src_Diagrams_TwoD_Arrowheads_quillEx.svg view

@@ -0,0 +1,1 @@+<svg xmlns="http://www.w3.org/2000/svg" height="63.6364" stroke-opacity="1" viewBox="0 0 100 64" font-size="1" width="100.0000" xmlns:xlink="http://www.w3.org/1999/xlink" stroke="rgb(0,0,0)" version="1.1"><defs></defs><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 54.5455,54.5455 l -0.0000,-45.4545 h -45.4545 l -0.0000,45.4545 Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 54.5455,31.8182 h 45.4545 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 54.5455,31.8182 l -21.1749,-22.2646 h -47.3485 l 23.0688,22.2646 l -23.0688,22.2646 h 47.3485 l 21.1749,-22.2646 Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 54.5455,31.8182 h 0.0000 h 0.0000 h 0.0000 h 0.0000 h 0.0000 h 0.0000 Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"></g></svg>

+ diagrams/src_Diagrams_TwoD_Arrowheads_spike'Ex.svg view

@@ -0,0 +1,1 @@+<svg xmlns="http://www.w3.org/2000/svg" height="63.6364" stroke-opacity="1" viewBox="0 0 100 64" font-size="1" width="100.0000" xmlns:xlink="http://www.w3.org/1999/xlink" stroke="rgb(0,0,0)" version="1.1"><defs></defs><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 54.5455,54.5455 l -0.0000,-45.4545 h -45.4545 l -0.0000,45.4545 Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 54.5455,31.8182 h 45.4545 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 9.0909,31.8182 l 54.8685,-22.7273 c -12.5519,12.5519 -12.5519,32.9026 0.0000 45.4545l -54.8685,-22.7273 Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 54.5455,31.8182 Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"></g></svg>

+ diagrams/src_Diagrams_TwoD_Arrowheads_spikeEx.svg view

@@ -0,0 +1,1 @@+<svg xmlns="http://www.w3.org/2000/svg" height="63.6364" stroke-opacity="1" viewBox="0 0 100 64" font-size="1" width="100.0000" xmlns:xlink="http://www.w3.org/1999/xlink" stroke="rgb(0,0,0)" version="1.1"><defs></defs><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 54.5455,54.5455 l -0.0000,-45.4545 h -45.4545 l -0.0000,45.4545 Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 9.0909,31.8182 h 45.4545 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 100.0000,31.8182 l -54.8685,-22.7273 c 12.5519,12.5519 12.5519,32.9026 0.0000 45.4545l 54.8685,-22.7273 Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 54.5455,31.8182 Z"/></g></svg>

+ diagrams/src_Diagrams_TwoD_Arrowheads_thorn'Ex.svg view

@@ -0,0 +1,1 @@+<svg xmlns="http://www.w3.org/2000/svg" height="63.6364" stroke-opacity="1" viewBox="0 0 100 64" font-size="1" width="100.0000" xmlns:xlink="http://www.w3.org/1999/xlink" stroke="rgb(0,0,0)" version="1.1"><defs></defs><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 54.5455,54.5455 l -0.0000,-45.4545 h -45.4545 l -0.0000,45.4545 Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 54.5455,31.8182 h 45.4545 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 9.0909,31.8182 c 30.3030,0.0000 51.7305,-21.4275 51.7305 -21.4275l -6.2760,21.4275 h -45.4545 c 30.3030,0.0000 51.7305,21.4275 51.7305 21.4275l -6.2760,-21.4275 Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 54.5455,31.8182 h 0.0000 h -0.0000 h 0.0000 h 0.0000 h 0.0000 Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"></g></svg>

+ diagrams/src_Diagrams_TwoD_Arrowheads_thornEx.svg view

@@ -0,0 +1,1 @@+<svg xmlns="http://www.w3.org/2000/svg" height="63.6364" stroke-opacity="1" viewBox="0 0 100 64" font-size="1" width="100.0000" xmlns:xlink="http://www.w3.org/1999/xlink" stroke="rgb(0,0,0)" version="1.1"><defs></defs><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 54.5455,54.5455 l -0.0000,-45.4545 h -45.4545 l -0.0000,45.4545 Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 9.0909,31.8182 h 45.4545 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 100.0000,31.8182 c -30.3030,0.0000 -51.7305,-21.4275 -51.7305 -21.4275l 6.2760,21.4275 h 45.4545 c -30.3030,0.0000 -51.7305,21.4275 -51.7305 21.4275l 6.2760,-21.4275 Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 54.5455,31.8182 h -0.0000 h 0.0000 h 0.0000 h 0.0000 h 0.0000 Z"/></g></svg>

+ diagrams/src_Diagrams_TwoD_Arrowheads_tri'Ex.svg view

@@ -0,0 +1,1 @@+<svg xmlns="http://www.w3.org/2000/svg" height="63.6364" stroke-opacity="1" viewBox="0 0 100 64" font-size="1" width="100.0000" xmlns:xlink="http://www.w3.org/1999/xlink" stroke="rgb(0,0,0)" version="1.1"><defs></defs><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 54.5455,54.5455 l -0.0000,-45.4545 h -45.4545 l -0.0000,45.4545 Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 54.5455,31.8182 h 45.4545 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 9.0909,31.8182 l 45.4545,-26.2432 v 52.4864 Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"></g></svg>

+ diagrams/src_Diagrams_TwoD_Arrowheads_tri25Ex.svg view

@@ -0,0 +1,1 @@+<svg xmlns="http://www.w3.org/2000/svg" height="120.0000" stroke-opacity="1" viewBox="0 0 120 120" font-size="1" width="120.0000" xmlns:xlink="http://www.w3.org/1999/xlink" stroke="rgb(0,0,0)" version="1.1"><defs></defs><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 105.0000,105.0000 l -0.0000,-90.0000 h -90.0000 l -0.0000,90.0000 Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 15.0000,60.0000 h -0.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 90.0000,60.0000 l -75.0000,-24.3690 v 48.7380 Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"></g></svg>

+ diagrams/src_Diagrams_TwoD_Arrowheads_triEx.svg view

@@ -0,0 +1,1 @@+<svg xmlns="http://www.w3.org/2000/svg" height="63.6364" stroke-opacity="1" viewBox="0 0 100 64" font-size="1" width="100.0000" xmlns:xlink="http://www.w3.org/1999/xlink" stroke="rgb(0,0,0)" version="1.1"><defs></defs><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 54.5455,54.5455 l -0.0000,-45.4545 h -45.4545 l -0.0000,45.4545 Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 9.0909,31.8182 h 45.4545 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 100.0000,31.8182 l -45.4545,-26.2432 v 52.4864 Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"></g></svg>

+ diagrams/src_Diagrams_TwoD_Curvature_diagramA.svg view

@@ -0,0 +1,1 @@+<svg xmlns="http://www.w3.org/2000/svg" height="200.0000" stroke-opacity="1" viewBox="0 0 400 200" font-size="1" width="400.0000" xmlns:xlink="http://www.w3.org/1999/xlink" stroke="rgb(0,0,0)" version="1.1"><defs></defs><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="1.9284730395996748" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 18.1818,175.1315 c 218.1818,-0.0000 145.4545,-181.8182 363.6364 -145.4545"/></g></svg>

+ diagrams/src_Diagrams_TwoD_Curvature_diagramNeg.svg view

@@ -0,0 +1,1 @@+<svg xmlns="http://www.w3.org/2000/svg" height="200.0000" stroke-opacity="1" viewBox="0 0 400 200" font-size="1" width="400.0000" xmlns:xlink="http://www.w3.org/1999/xlink" stroke="rgb(0,0,0)" version="1.1"><defs></defs><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(255,0,0)" stroke-width="1.0285189544531599" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 281.1636,30.8406 l 37.7776,135.3699 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(255,0,0)" stroke-width="1.0285189544531599" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 459.4836,166.2104 c 0.0000,-77.6194 -62.9230,-140.5424 -140.5424 -140.5424c -77.6194,-0.0000 -140.5424,62.9230 -140.5424 140.5424c -0.0000,77.6194 62.9230,140.5424 140.5424 140.5424c 77.6194,0.0000 140.5424,-62.9230 140.5424 -140.5424Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="1.9284730395996748" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 18.1818,175.1315 c 218.1818,-0.0000 145.4545,-181.8182 363.6364 -145.4545"/></g></svg>

+ diagrams/src_Diagrams_TwoD_Curvature_diagramPos.svg view

@@ -0,0 +1,1 @@+<svg xmlns="http://www.w3.org/2000/svg" height="200.0000" stroke-opacity="1" viewBox="0 0 400 200" font-size="1" width="400.0000" xmlns:xlink="http://www.w3.org/1999/xlink" stroke="rgb(0,0,0)" version="1.1"><defs></defs><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(255,0,0)" stroke-width="1.0285189544531599" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 118.8364,156.5133 l -70.9117,-156.3695 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(255,0,0)" stroke-width="1.0285189544531599" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 219.6217,0.1438 c 0.0000,-94.8257 -76.8714,-171.6971 -171.6971 -171.6971c -94.8257,-0.0000 -171.6971,76.8714 -171.6971 171.6971c -0.0000,94.8257 76.8714,171.6971 171.6971 171.6971c 94.8257,0.0000 171.6971,-76.8714 171.6971 -171.6971Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="1.9284730395996748" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 18.1818,175.1315 c 218.1818,-0.0000 145.4545,-181.8182 363.6364 -145.4545"/></g></svg>

+ diagrams/src_Diagrams_TwoD_Curvature_diagramZero.svg view

@@ -0,0 +1,1 @@+<svg xmlns="http://www.w3.org/2000/svg" height="200.0000" stroke-opacity="1" viewBox="0 0 400 200" font-size="1" width="400.0000" xmlns:xlink="http://www.w3.org/1999/xlink" stroke="rgb(0,0,0)" version="1.1"><defs></defs><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(255,0,0)" stroke-width="1.0285189544531599" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 189.0182,101.1269 l -602.0741,-540.4758 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(255,0,0)" stroke-width="1.0285189544531599" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 396.0221,-439.3488 c 0.0000,-446.8415 -362.2366,-809.0780 -809.0780 -809.0780c -446.8415,-0.0000 -809.0780,362.2366 -809.0780 809.0780c -0.0000,446.8415 362.2366,809.0780 809.0780 809.0780c 446.8415,0.0000 809.0780,-362.2366 809.0780 -809.0780Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="1.9284730395996748" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 18.1818,175.1315 c 218.1818,-0.0000 145.4545,-181.8182 363.6364 -145.4545"/></g></svg>

+ diagrams/src_Diagrams_TwoD_Offset_cubicOffsetExample.svg view

@@ -0,0 +1,1 @@+<svg xmlns="http://www.w3.org/2000/svg" height="302.8588" stroke-opacity="1" viewBox="0 0 600 303" font-size="1" width="600.0000" xmlns:xlink="http://www.w3.org/1999/xlink" stroke="rgb(0,0,0)" version="1.1"><defs></defs><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,128,0)" stroke-width="3.197105416628175" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 511.9818,129.7571 c 10.6062,25.0693 34.2055,55.8255 80.4872 86.6800"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(255,0,0)" stroke-width="3.197105416628175" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 504.6600,99.6625 c 0.3347,8.2550 2.4134,18.4928 7.3218 30.0945"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,128,0)" stroke-width="3.197105416628175" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 506.4937,85.2663 c -1.4641,2.9282 -2.1083,7.6248 -1.8337 14.3963"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(255,0,0)" stroke-width="3.197105416628175" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 506.2084,85.5927 c 0.0678,-0.0768 0.2226,-0.2011 0.2853 -0.3265"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,128,0)" stroke-width="3.197105416628175" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 502.6579,87.9357 c 1.0997,-0.4144 2.4469,-1.0919 3.5505 -2.3430"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(255,0,0)" stroke-width="3.197105416628175" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 494.0623,87.5838 c 2.9458,1.3739 5.3820,1.5628 8.5956 0.3519"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,128,0)" stroke-width="3.197105416628175" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 489.6962,83.7630 c 1.2338,2.0880 2.8653,3.1208 4.3661 3.8208"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(255,0,0)" stroke-width="3.197105416628175" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 489.2796,82.9440 c 0.0773,0.3280 0.3025,0.6259 0.4166 0.8190"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,128,0)" stroke-width="3.197105416628175" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 489.5449,85.0947 c -0.0520,-0.8562 -0.1242,-1.5525 -0.2653 -2.1507"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(255,0,0)" stroke-width="3.197105416628175" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 488.8865,96.1054 c 0.6286,-4.6097 0.8286,-8.2083 0.6583 -11.0108"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,128,0)" stroke-width="3.197105416628175" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 441.8492,221.4998 c 31.9297,-63.8595 44.0440,-103.4426 47.0374 -125.3943"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,255)" stroke-width="3.197105416628175" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 453.6159,227.3831 c 131.5557,-263.1115 -65.7779,-131.5557 131.5557 -0.0000"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,128,0)" stroke-width="3.197105416628175" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 364.7622,85.9675 c 0.0000,15.3291 0.6082,77.3813 61.9247 138.6978"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(255,0,0)" stroke-width="3.197105416628175" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 364.7419,83.1393 c 0.0179,0.7021 0.0203,1.6834 0.0203 2.8282"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,128,0)" stroke-width="3.197105416628175" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 364.6602,81.5631 c 0.0351,0.4104 0.0661,0.9641 0.0817 1.5762"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(255,0,0)" stroke-width="3.197105416628175" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 364.0520,78.3408 c 0.1986,0.6455 0.4965,1.9158 0.6082 3.2223"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,128,0)" stroke-width="3.197105416628175" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 361.6159,73.7760 c 0.7783,0.9536 1.8212,2.5663 2.4361 4.5649"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(255,0,0)" stroke-width="3.197105416628175" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 357.1897,70.2580 c 1.5342,0.7533 3.0492,1.8307 4.4262 3.5179"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,128,0)" stroke-width="3.197105416628175" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 349.9173,68.9840 c 2.6564,-0.2922 4.8750,0.0970 7.2724 1.2741"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(255,0,0)" stroke-width="3.197105416628175" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 344.5074,70.8187 c 1.8905,-1.1435 3.6952,-1.6462 5.4099 -1.8348"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,128,0)" stroke-width="3.197105416628175" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 341.9037,72.8755 c 0.8843,-0.8971 1.7979,-1.5694 2.6036 -2.0568"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(255,0,0)" stroke-width="3.197105416628175" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 339.9429,75.3936 c 0.6567,-1.0763 1.4089,-1.9582 1.9608 -2.5180"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,128,0)" stroke-width="3.197105416628175" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 338.2153,79.1592 c 0.5976,-1.6435 1.3914,-3.2147 1.7276 -3.7656"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(255,0,0)" stroke-width="3.197105416628175" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 331.0209,99.9717 c 4.0362,-11.0996 6.1854,-18.0376 7.1945 -20.8125"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,128,0)" stroke-width="3.197105416628175" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 274.0621,228.0844 c 32.5251,-65.0502 48.8275,-105.7517 56.9588 -128.1127"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,255)" stroke-width="3.197105416628175" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 285.8288,233.9677 c 131.5557,-263.1115 0.0000,-131.5557 131.5557 -0.0000"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,128,0)" stroke-width="3.197105416628175" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 243.5067,119.7182 c -3.7564,1.2749 -8.5010,2.1111 -14.3292 2.1111"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(255,0,0)" stroke-width="3.197105416628175" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 255.1371,112.1979 c -2.6842,3.0676 -6.3579,5.7309 -11.6304 7.5203"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,128,0)" stroke-width="3.197105416628175" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 258.9677,87.6101 c 3.4875,9.2999 2.2725,17.6129 -3.8306 24.5878"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(255,0,0)" stroke-width="3.197105416628175" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 220.9552,62.6292 c 17.7972,-0.0000 33.5631,13.1160 38.0124 24.9808"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,128,0)" stroke-width="3.197105416628175" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 193.4371,72.6278 c 9.3825,-7.3588 18.6876,-9.9985 27.5182 -9.9985"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(255,0,0)" stroke-width="3.197105416628175" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 170.9681,103.1924 c 6.7677,-14.7658 14.6246,-24.4122 22.4689 -30.5647"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,128,0)" stroke-width="3.197105416628175" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 150.2440,240.2295 c 0.0000,-68.4467 8.9598,-111.3696 20.7241 -137.0371"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,255)" stroke-width="3.197105416628175" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 163.3996,240.2295 c 0.0000,-263.1115 131.5557,-131.5557 65.7779 -131.5557"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,128,0)" stroke-width="3.197105416628175" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 107.3604,38.6930 c 6.4325,-12.1696 14.7608,-20.4761 25.8873 -24.9267"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(255,0,0)" stroke-width="3.197105416628175" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 95.4239,75.6318 c 2.8371,-14.2991 6.6878,-27.0089 11.9365 -36.9388"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,128,0)" stroke-width="3.197105416628175" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 83.9792,165.6872 c 4.1423,-31.4811 6.2669,-63.9592 11.4447 -90.0554"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(255,0,0)" stroke-width="3.197105416628175" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 62.0575,244.9887 c 12.6186,-21.3546 18.0391,-49.7933 21.9218 -79.3015"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,128,0)" stroke-width="3.197105416628175" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 6.5778,275.9369 c 26.3331,-0.0000 44.7818,-12.8442 55.4797 -30.9482"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,255)" stroke-width="3.197105416628175" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 6.5778,289.0924 c 131.5557,-0.0000 65.7779,-236.8003 131.5557 -263.1115"/></g></svg>

+ diagrams/src_Diagrams_TwoD_Offset_expandLoopExample.svg view

@@ -0,0 +1,1 @@+<svg xmlns="http://www.w3.org/2000/svg" height="300.0000" stroke-opacity="1" viewBox="0 0 300 300" font-size="1" width="300.0000" xmlns:xlink="http://www.w3.org/1999/xlink" stroke="rgb(0,0,0)" version="1.1"><defs></defs><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,128,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 36.3636,286.3636 h 113.6364 c 6.0276,-0.0000 11.8084,-2.3945 16.0706 -6.6567l 113.6364,-113.6364 c 4.2622,-4.2622 6.6567,-10.0430 6.6567 -16.0706v -113.6364 c 0.0000,-12.5519 -10.1753,-22.7273 -22.7273 -22.7273c -6.0276,0.0000 -11.8084,2.3945 -16.0706 6.6567l -227.2727,227.2727 c -8.8756,8.8756 -8.8756,23.2657 -0.0000 32.1412c 4.2622,4.2622 10.0430,6.6567 16.0706 6.6567ZM 36.3636,240.9091 c -12.5519,0.0000 -22.7273,10.1753 -22.7273 22.7273c -0.0000,12.5519 10.1753,22.7273 22.7273 22.7273c 6.0276,-0.0000 11.8084,-2.3945 16.0706 -6.6567l 227.2727,-227.2727 c 8.8756,-8.8756 8.8756,-23.2657 0.0000 -32.1412c -8.8756,-8.8756 -23.2657,-8.8756 -32.1412 -0.0000c -4.2622,4.2622 -6.6567,10.0430 -6.6567 16.0706v 113.6364 c -0.0000,12.5519 10.1753,22.7273 22.7273 22.7273c 12.5519,0.0000 22.7273,-10.1753 22.7273 -22.7273c 0.0000,-12.5519 -10.1753,-22.7273 -22.7273 -22.7273c -6.0276,0.0000 -11.8084,2.3945 -16.0706 6.6567l -113.6364,113.6364 c -8.8756,8.8756 -8.8756,23.2657 0.0000 32.1412c 8.8756,8.8756 23.2657,8.8756 32.1412 -0.0000c 8.8756,-8.8756 8.8756,-23.2657 -0.0000 -32.1412c -4.2622,-4.2622 -10.0430,-6.6567 -16.0706 -6.6567Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(255,255,255)" stroke-width="3.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 36.3636,263.6364 h 113.6364 l 113.6364,-113.6364 v -113.6364 Z"/></g></svg>

+ diagrams/src_Diagrams_TwoD_Offset_expandTrailExample.svg view

@@ -0,0 +1,1 @@+<svg xmlns="http://www.w3.org/2000/svg" height="197.3830" stroke-opacity="1" viewBox="0 0 600 197" font-size="1" width="600.0000" xmlns:xlink="http://www.w3.org/1999/xlink" stroke="rgb(0,0,0)" version="1.1"><defs></defs><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" font-size="12.98696646675048px" stroke="rgb(0,0,0)" stroke-width="1.376545341172593" fill="rgb(0,0,0)" stroke-linecap="butt" font-family="Helvetica" stroke-miterlimit="10.0" font-weight="bold"><text dominant-baseline="middle" transform="matrix(1.0000,0.0000,0.0000,1.0000,481.8182,168.9306)" stroke="none" text-anchor="middle">LineCapSquare</text></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,128,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 416.8830,97.5017 h -25.9739 v 51.9479 h 25.9739 h 129.8697 c 14.3450,-0.0000 25.9739,-11.6289 25.9739 -25.9739c 0.0000,-6.0763 -2.1303,-11.9602 -6.0202 -16.6281l -64.9348,-77.9218 l -16.6281,-19.9537 l -39.9075,33.2562 l 16.6281,19.9537 l 64.9348,77.9218 c 9.1834,11.0201 25.5617,12.5091 36.5818 3.3256c 11.0201,-9.1834 12.5091,-25.5617 3.3256 -36.5818c -4.9349,-5.9219 -12.2452,-9.3458 -19.9537 -9.3458Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(255,255,255)" stroke-width="3.4413633529314827" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 416.8830,123.4756 h 129.8697 l -64.9348,-77.9218 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" font-size="12.98696646675048px" stroke="rgb(0,0,0)" stroke-width="1.376545341172593" fill="rgb(0,0,0)" stroke-linecap="butt" font-family="Helvetica" stroke-miterlimit="10.0" font-weight="bold"><text dominant-baseline="middle" transform="matrix(1.0000,0.0000,0.0000,1.0000,287.0130,163.6270)" stroke="none" text-anchor="middle">LineCapRound</text></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,128,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 222.0779,92.1980 c -14.3450,-0.0000 -25.9739,11.6289 -25.9739 25.9739c -0.0000,14.3450 11.6289,25.9739 25.9739 25.9739h 129.8697 c 14.3450,-0.0000 25.9739,-11.6289 25.9739 -25.9739c 0.0000,-6.0763 -2.1303,-11.9602 -6.0202 -16.6281l -64.9348,-77.9218 c -9.1834,-11.0201 -25.5617,-12.5091 -36.5818 -3.3256c -11.0201,9.1834 -12.5091,25.5617 -3.3256 36.5818l 64.9348,77.9218 c 9.1834,11.0201 25.5617,12.5091 36.5818 3.3256c 11.0201,-9.1834 12.5091,-25.5617 3.3256 -36.5818c -4.9349,-5.9219 -12.2452,-9.3458 -19.9537 -9.3458Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(255,255,255)" stroke-width="3.4413633529314827" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 222.0779,118.1720 h 129.8697 l -64.9348,-77.9218 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" font-size="12.98696646675048px" stroke="rgb(0,0,0)" stroke-width="1.376545341172593" fill="rgb(0,0,0)" stroke-linecap="butt" font-family="Helvetica" stroke-miterlimit="10.0" font-weight="bold"><text dominant-baseline="middle" transform="matrix(1.0000,0.0000,0.0000,1.0000,105.1949,158.9538)" stroke="none" text-anchor="middle">LineCapButt</text></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,128,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 27.2727,87.5248 v 51.9479 h 129.8697 c 14.3450,-0.0000 25.9739,-11.6289 25.9739 -25.9739c 0.0000,-6.0763 -2.1303,-11.9602 -6.0202 -16.6281l -64.9348,-77.9218 l -39.9075,33.2562 l 64.9348,77.9218 c 9.1834,11.0201 25.5617,12.5091 36.5818 3.3256c 11.0201,-9.1834 12.5091,-25.5617 3.3256 -36.5818c -4.9349,-5.9219 -12.2452,-9.3458 -19.9537 -9.3458Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(255,255,255)" stroke-width="3.4413633529314827" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 27.2727,113.4987 h 129.8697 l -64.9348,-77.9218 "/></g></svg>

+ diagrams/src_Diagrams_TwoD_Offset_offsetTrailExample.svg view

@@ -0,0 +1,1 @@+<svg xmlns="http://www.w3.org/2000/svg" height="185.1008" stroke-opacity="1" viewBox="0 0 600 185" font-size="1" width="600.0000" xmlns:xlink="http://www.w3.org/1999/xlink" stroke="rgb(0,0,0)" version="1.1"><defs></defs><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" font-size="13.702641330909062px" stroke="rgb(0,0,0)" stroke-width="3.0" fill="rgb(0,0,0)" stroke-linecap="butt" font-family="Helvetica" stroke-miterlimit="10.0" font-weight="bold"><text dominant-baseline="middle" transform="matrix(1.0000,0.0000,0.0000,1.0000,493.6874,156.1332)" stroke="none" text-anchor="middle">LineJoinBevel</text></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,128,0)" stroke-width="3.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 414.6475,135.5792 h 137.0264 l 21.0533,-44.9497 l -68.5132,-82.2158 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,255)" stroke-width="3.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 414.6475,108.1740 h 137.0264 l -68.5132,-82.2158 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" font-size="13.702641330909062px" stroke="rgb(0,0,0)" stroke-width="3.0" fill="rgb(0,0,0)" stroke-linecap="butt" font-family="Helvetica" stroke-miterlimit="10.0" font-weight="bold"><text dominant-baseline="middle" transform="matrix(1.0000,0.0000,0.0000,1.0000,318.7290,156.1332)" stroke="none" text-anchor="middle">LineJoinRound</text></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,128,0)" stroke-width="3.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 236.5132,135.5792 h 137.0264 c 15.1355,-0.0000 27.4053,-12.2698 27.4053 -27.4053c 0.0000,-6.4111 -2.2477,-12.6193 -6.3520 -17.5444l -68.5132,-82.2158 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,255)" stroke-width="3.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 236.5132,108.1740 h 137.0264 l -68.5132,-82.2158 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" font-size="13.702641330909062px" stroke="rgb(0,0,0)" stroke-width="3.0" fill="rgb(0,0,0)" stroke-linecap="butt" font-family="Helvetica" stroke-miterlimit="10.0" font-weight="bold"><text dominant-baseline="middle" transform="matrix(1.0000,0.0000,0.0000,1.0000,125.0416,156.1332)" stroke="none" text-anchor="middle">LineJoinMiter</text></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,128,0)" stroke-width="3.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 27.2727,135.5792 h 137.0264 h 58.5114 l -37.4581,-44.9497 l -68.5132,-82.2158 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,255)" stroke-width="3.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 27.2727,108.1740 h 137.0264 l -68.5132,-82.2158 "/></g></svg>

+ diagrams/src_Diagrams_TwoD_Offset_offsetTrailLeftExample.svg view

@@ -0,0 +1,1 @@+<svg xmlns="http://www.w3.org/2000/svg" height="154.6722" stroke-opacity="1" viewBox="0 0 200 155" font-size="1" width="200.0000" xmlns:xlink="http://www.w3.org/1999/xlink" stroke="rgb(0,0,0)" version="1.1"><defs></defs><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,128,0)" stroke-width="3.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 9.0909,7.0306 h 151.5145 c 7.0890,0.0000 13.9536,2.4853 19.3994 7.0236c 12.8568,10.7140 14.5939,29.8220 3.8799 42.6788l -75.7573,90.9087 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,255)" stroke-width="3.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 9.0909,37.3335 h 151.5145 l -75.7573,90.9087 "/></g></svg>

+ diagrams/src_Diagrams_TwoD_Offset_offsetTrailOuterExample.svg view

@@ -0,0 +1,1 @@+<svg xmlns="http://www.w3.org/2000/svg" height="271.2912" stroke-opacity="1" viewBox="0 0 300 271" font-size="1" width="300.0000" xmlns:xlink="http://www.w3.org/1999/xlink" stroke="rgb(0,0,0)" version="1.1"><defs></defs><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,128,0)" stroke-width="3.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 232.4425,239.4792 l 48.7013,-84.3531 c 6.9597,-12.0546 6.9597,-26.9065 -0.0000 -38.9610l -48.7013,-84.3531 c -6.9597,-12.0546 -19.8218,-19.4805 -33.7412 -19.4805h -97.4026 c -13.9194,-0.0000 -26.7815,7.4259 -33.7412 19.4805l -48.7013,84.3531 c -6.9597,12.0546 -6.9597,26.9065 -0.0000 38.9610l 48.7013,84.3531 c 6.9597,12.0546 19.8218,19.4805 33.7412 19.4805l 97.4026,-0.0000 c 13.9194,-0.0000 26.7815,-7.4259 33.7412 -19.4805Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,255)" stroke-width="3.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 198.7013,219.9987 l 48.7013,-84.3531 l -48.7013,-84.3531 h -97.4026 l -48.7013,84.3531 l 48.7013,84.3531 Z"/></g></svg>

+ diagrams/src_Diagrams_TwoD_Shapes_decagonEx.svg view

@@ -0,0 +1,1 @@+<svg xmlns="http://www.w3.org/2000/svg" height="95.1057" stroke-opacity="1" viewBox="0 0 100 95" font-size="1" width="100.0000" xmlns:xlink="http://www.w3.org/1999/xlink" stroke="rgb(0,0,0)" version="1.1"><defs></defs><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.5" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 86.7735,74.2703 l 8.6810,-26.7175 l -8.6810,-26.7175 l -22.7273,-16.5123 l -28.0925,0.0000 l -22.7273,16.5123 l -8.6810,26.7175 l 8.6810,26.7175 l 22.7273,16.5123 l 28.0925,-0.0000 Z"/></g></svg>

+ diagrams/src_Diagrams_TwoD_Shapes_dodecagonEx.svg view

@@ -0,0 +1,1 @@+<svg xmlns="http://www.w3.org/2000/svg" height="100.0000" stroke-opacity="1" viewBox="0 0 100 100" font-size="1" width="100.0000" xmlns:xlink="http://www.w3.org/1999/xlink" stroke="rgb(0,0,0)" version="1.1"><defs></defs><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.5" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 95.4545,62.1795 l -0.0000,-24.3590 l -12.1795,-21.0955 l -21.0955,-12.1795 l -24.3590,0.0000 l -21.0955,12.1795 l -12.1795,21.0955 l -0.0000,24.3590 l 12.1795,21.0955 l 21.0955,12.1795 l 24.3590,-0.0000 l 21.0955,-12.1795 Z"/></g></svg>

+ diagrams/src_Diagrams_TwoD_Shapes_hendecagonEx.svg view

@@ -0,0 +1,1 @@+<svg xmlns="http://www.w3.org/2000/svg" height="98.9821" stroke-opacity="1" viewBox="0 0 100 99" font-size="1" width="100.0000" xmlns:xlink="http://www.w3.org/1999/xlink" stroke="rgb(0,0,0)" version="1.1"><defs></defs><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.5" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 95.4545,57.0495 l -3.6825,-25.6121 l -16.9448,-19.5553 l -24.8273,-7.2899 l -24.8273,7.2899 l -16.9448,19.5553 l -3.6825,25.6121 l 10.7490,23.5371 l 21.7678,13.9893 l 25.8754,-0.0000 l 21.7678,-13.9893 Z"/></g></svg>

+ diagrams/src_Diagrams_TwoD_Shapes_heptagonEx.svg view

@@ -0,0 +1,1 @@+<svg xmlns="http://www.w3.org/2000/svg" height="97.4928" stroke-opacity="1" viewBox="0 0 100 97" font-size="1" width="100.0000" xmlns:xlink="http://www.w3.org/1999/xlink" stroke="rgb(0,0,0)" version="1.1"><defs></defs><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.5" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 95.4545,61.6605 l -9.0028,-39.4440 l -36.4517,-17.5542 l -36.4517,17.5542 l -9.0028,39.4440 l 25.2254,31.6316 l 40.4584,-0.0000 Z"/></g></svg>

+ diagrams/src_Diagrams_TwoD_Shapes_hexagonEx.svg view

@@ -0,0 +1,1 @@+<svg xmlns="http://www.w3.org/2000/svg" height="86.6025" stroke-opacity="1" viewBox="0 0 100 87" font-size="1" width="100.0000" xmlns:xlink="http://www.w3.org/1999/xlink" stroke="rgb(0,0,0)" version="1.1"><defs></defs><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.5" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 72.7273,82.6661 l 22.7273,-39.3648 l -22.7273,-39.3648 l -45.4545,-0.0000 l -22.7273,39.3648 l 22.7273,39.3648 Z"/></g></svg>

+ diagrams/src_Diagrams_TwoD_Shapes_hruleEx.svg view

@@ -0,0 +1,1 @@+<svg xmlns="http://www.w3.org/2000/svg" height="48.0000" stroke-opacity="1" viewBox="0 0 300 48" font-size="1" width="300.0000" xmlns:xlink="http://www.w3.org/1999/xlink" stroke="rgb(0,0,0)" version="1.1"><defs></defs><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.5" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 13.6364,45.8182 h 272.7273 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.5" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 40.9091,34.9091 h 218.1818 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.5" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 68.1818,24.0000 h 163.6364 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.5" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 95.4545,13.0909 h 109.0909 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.5" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 122.7273,2.1818 h 54.5455 "/></g></svg>

+ diagrams/src_Diagrams_TwoD_Shapes_nonagonEx.svg view

@@ -0,0 +1,1 @@+<svg xmlns="http://www.w3.org/2000/svg" height="98.4808" stroke-opacity="1" viewBox="0 0 100 98" font-size="1" width="100.0000" xmlns:xlink="http://www.w3.org/1999/xlink" stroke="rgb(0,0,0)" version="1.1"><defs></defs><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.5" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 89.9721,73.8492 l 5.4825,-31.0927 l -15.7862,-27.3425 l -29.6683,-10.7984 l -29.6683,10.7984 l -15.7862,27.3425 l 5.4825,31.0927 l 24.1859,20.2943 l 31.5724,0.0000 Z"/></g></svg>

+ diagrams/src_Diagrams_TwoD_Shapes_octagonEx.svg view

@@ -0,0 +1,1 @@+<svg xmlns="http://www.w3.org/2000/svg" height="100.0000" stroke-opacity="1" viewBox="0 0 100 100" font-size="1" width="100.0000" xmlns:xlink="http://www.w3.org/1999/xlink" stroke="rgb(0,0,0)" version="1.1"><defs></defs><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.5" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 95.4545,68.8279 l -0.0000,-37.6558 l -26.6267,-26.6267 l -37.6558,0.0000 l -26.6267,26.6267 l 0.0000,37.6558 l 26.6267,26.6267 l 37.6558,-0.0000 Z"/></g></svg>

+ diagrams/src_Diagrams_TwoD_Shapes_pentagonEx.svg view

@@ -0,0 +1,1 @@+<svg xmlns="http://www.w3.org/2000/svg" height="95.1057" stroke-opacity="1" viewBox="0 0 100 95" font-size="1" width="100.0000" xmlns:xlink="http://www.w3.org/1999/xlink" stroke="rgb(0,0,0)" version="1.1"><defs></defs><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.5" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 78.0925,91.2391 l 17.3621,-53.4350 l -45.4545,-33.0247 l -45.4545,33.0247 l 17.3621,53.4350 Z"/></g></svg>

+ diagrams/src_Diagrams_TwoD_Shapes_rectEx.svg view

@@ -0,0 +1,1 @@+<svg xmlns="http://www.w3.org/2000/svg" height="105.0000" stroke-opacity="1" viewBox="0 0 150 105" font-size="1" width="150.0000" xmlns:xlink="http://www.w3.org/1999/xlink" stroke="rgb(0,0,0)" version="1.1"><defs></defs><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.5019960159204453" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 143.1818,100.2273 l -0.0000,-95.4545 h -136.3636 l -0.0000,95.4545 Z"/></g></svg>

+ diagrams/src_Diagrams_TwoD_Shapes_roundedRectEx.svg view

@@ -0,0 +1,1 @@+<svg xmlns="http://www.w3.org/2000/svg" height="76.1905" stroke-opacity="1" viewBox="0 0 400 76" font-size="1" width="400.0000" xmlns:xlink="http://www.w3.org/1999/xlink" stroke="rgb(0,0,0)" version="1.1"><defs></defs><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.6982972487551757" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 381.8182,55.4113 v -17.3160 c -19.1267,-0.0000 -34.6320,-15.5053 -34.6320 -34.6320h -51.9481 c -19.1267,-0.0000 -34.6320,15.5053 -34.6320 34.6320v 34.6320 h 103.8961 c 9.5634,0.0000 17.3160,-7.7526 17.3160 -17.3160Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.6982972487551757" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 225.9740,55.4113 v -34.6320 c -9.5634,-0.0000 -17.3160,-7.7526 -17.3160 -17.3160h -51.9481 c -0.0000,9.5634 -7.7526,17.3160 -17.3160 17.3160v 34.6320 c 9.5634,0.0000 17.3160,7.7526 17.3160 17.3160h 51.9481 c 0.0000,-9.5634 7.7526,-17.3160 17.3160 -17.3160Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.6982972487551757" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 104.7619,55.4113 v -34.6320 c 0.0000,-9.5634 -7.7526,-17.3160 -17.3160 -17.3160h -51.9481 c -9.5634,-0.0000 -17.3160,7.7526 -17.3160 17.3160v 34.6320 c -0.0000,9.5634 7.7526,17.3160 17.3160 17.3160h 51.9481 c 9.5634,0.0000 17.3160,-7.7526 17.3160 -17.3160Z"/></g></svg>

+ diagrams/src_Diagrams_TwoD_Shapes_squareEx.svg view

@@ -0,0 +1,1 @@+<svg xmlns="http://www.w3.org/2000/svg" height="85.7143" stroke-opacity="1" viewBox="0 0 200 86" font-size="1" width="200.0000" xmlns:xlink="http://www.w3.org/1999/xlink" stroke="rgb(0,0,0)" version="1.1"><defs></defs><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.5237229365663817" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 190.9091,81.8182 l -0.0000,-77.9221 h -77.9221 l -0.0000,77.9221 Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.5237229365663817" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 100.0000,68.8312 l -0.0000,-51.9481 h -51.9481 l -0.0000,51.9481 Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.5237229365663817" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 35.0649,55.8442 l -0.0000,-25.9740 h -25.9740 l -0.0000,25.9740 Z"/></g></svg>

+ diagrams/src_Diagrams_TwoD_Shapes_triangleEx.svg view

@@ -0,0 +1,1 @@+<svg xmlns="http://www.w3.org/2000/svg" height="86.6025" stroke-opacity="1" viewBox="0 0 100 87" font-size="1" width="100.0000" xmlns:xlink="http://www.w3.org/1999/xlink" stroke="rgb(0,0,0)" version="1.1"><defs></defs><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.5" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 95.4545,83.9782 l -45.4545,-78.7296 l -45.4545,78.7296 Z"/></g></svg>

+ diagrams/src_Diagrams_TwoD_Shapes_unitSquareEx.svg view

@@ -0,0 +1,1 @@+<svg xmlns="http://www.w3.org/2000/svg" height="100.0000" stroke-opacity="1" viewBox="0 0 100 100" font-size="1" width="100.0000" xmlns:xlink="http://www.w3.org/1999/xlink" stroke="rgb(0,0,0)" version="1.1"><defs></defs><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.5" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 95.4545,95.4545 l -0.0000,-90.9091 h -90.9091 l -0.0000,90.9091 Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(255,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 52.0000,50.0000 c 0.0000,-1.1046 -0.8954,-2.0000 -2.0000 -2.0000c -1.1046,-0.0000 -2.0000,0.8954 -2.0000 2.0000c -0.0000,1.1046 0.8954,2.0000 2.0000 2.0000c 1.1046,0.0000 2.0000,-0.8954 2.0000 -2.0000Z"/></g></svg>

+ diagrams/src_Diagrams_TwoD_Shapes_vruleEx.svg view

@@ -0,0 +1,1 @@+<svg xmlns="http://www.w3.org/2000/svg" height="100.0000" stroke-opacity="1" viewBox="0 0 50 100" font-size="1" width="50.0000" xmlns:xlink="http://www.w3.org/1999/xlink" stroke="rgb(0,0,0)" version="1.1"><defs></defs><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.5" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 47.7273,4.5455 v 90.9091 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.5" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 38.6364,9.0909 v 81.8182 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.5" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 29.5455,13.6364 v 72.7273 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.5" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 20.4545,18.1818 v 63.6364 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.5" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 11.3636,22.7273 v 54.5455 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.5" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 2.2727,27.2727 v 45.4545 "/></g></svg>

− diagrams/trailOffsetEx.svg

@@ -1,4 +0,0 @@-<?xml version="1.0" encoding="UTF-8"?>-<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN"-    "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd">-<svg xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" version="1.1" width="300.0" height="90.00000000000001" font-size="1" viewBox="0 0 300 90"><g><g transform="matrix(54.54545454545455,0.0,0.0,54.54545454545455,150.0,45.00000000000001)"><g stroke="rgb(255,0,0)" stroke-opacity="1.0" fill="rgb(0,0,0)" fill-opacity="0.0" stroke-width="5.0e-2" font-size="1.0em"><path d="M 0.5,-0.75 h -2.0 " /></g></g><g transform="matrix(54.54545454545455,0.0,0.0,54.54545454545455,150.0,45.00000000000001)"><g stroke="rgb(0,0,0)" stroke-opacity="1.0" fill="rgb(0,0,0)" fill-opacity="0.0" stroke-width="1.0e-2" font-size="1.0em"><path d="M 0.5,-0.75 l 2.0,1.0 l -3.0,0.5 l -2.0,-1.0 l 1.0,-0.5 " /></g></g></g></svg>

− diagrams/triangleEx.svg

@@ -1,4 +0,0 @@-<?xml version="1.0" encoding="UTF-8"?>-<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN"-    "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd">-<svg xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" version="1.1" width="100.0" height="86.60254037844385" font-size="1" viewBox="0 0 100 87"><g><g transform="matrix(90.9090909090909,0.0,0.0,90.9090909090909,50.0,57.73502691896257)"><g stroke="rgb(0,0,0)" stroke-opacity="1.0" fill="rgb(0,0,0)" fill-opacity="0.0" stroke-width="1.0e-2" font-size="1.0em"><path d="M 0.5,0.28867513459481275 l -0.5000000000000002,-0.8660254037844385 l -0.4999999999999999,0.8660254037844386 l 1.0,-1.1102230246251565e-16 Z" /></g></g></g></svg>

− diagrams/unitSquareEx.svg

@@ -1,4 +0,0 @@-<?xml version="1.0" encoding="UTF-8"?>-<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN"-    "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd">-<svg xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" version="1.1" width="100.0" height="100.0" font-size="1" viewBox="0 0 100 100"><g><g transform="matrix(90.9090909090909,0.0,0.0,90.9090909090909,49.99999999999999,50.0)"><g stroke="rgb(0,0,0)" stroke-opacity="1.0" fill="rgb(0,0,0)" fill-opacity="0.0" stroke-width="1.0e-2" font-size="1.0em"><path d="M 0.5000000000000001,0.5 l -1.1102230246251565e-16,-1.0 h -1.0 l -1.1102230246251565e-16,1.0 h 1.0 Z" /></g></g><g transform="matrix(90.9090909090909,0.0,0.0,90.9090909090909,49.99999999999999,50.0)"><g stroke="rgb(0,0,0)" stroke-opacity="1.0" fill="rgb(255,0,0)" fill-opacity="1.0" stroke-width="0.0" font-size="1.0em"><path d="M 2.2000000000000002e-2,0.0 c 0.0,-1.2150264496277458e-2 -9.849735503722543e-3,-2.2000000000000002e-2 -2.2e-2 -2.2000000000000002e-2c -1.2150264496277458e-2,-7.439891262079958e-19 -2.2000000000000002e-2,9.849735503722541e-3 -2.2000000000000002e-2 2.1999999999999995e-2c -1.4879782524159916e-18,1.2150264496277458e-2 9.84973550372254e-3,2.2000000000000002e-2 2.1999999999999992e-2 2.2000000000000002e-2c 1.2150264496277458e-2,2.2319673786239874e-18 2.2000000000000002e-2,-9.84973550372254e-3 2.2000000000000006e-2 -2.1999999999999995e-2Z" /></g></g></g></svg>

− diagrams/vruleEx.svg

@@ -1,4 +0,0 @@-<?xml version="1.0" encoding="UTF-8"?>-<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN"-    "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd">-<svg xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" version="1.1" width="50.00000000000001" height="100.0" font-size="1" viewBox="0 0 50 100"><g><g transform="matrix(45.45454545454546,0.0,0.0,45.45454545454546,25.000000000000004,50.0)"><g stroke="rgb(0,0,0)" stroke-opacity="1.0" fill="rgb(0,0,0)" fill-opacity="0.0" stroke-width="1.0e-2" font-size="1.0em"><path d="M 0.5000000000000001,-0.9999999999999999 v 1.9999999999999998 " /></g></g><g transform="matrix(45.45454545454546,0.0,0.0,45.45454545454546,25.000000000000004,50.0)"><g stroke="rgb(0,0,0)" stroke-opacity="1.0" fill="rgb(0,0,0)" fill-opacity="0.0" stroke-width="1.0e-2" font-size="1.0em"><path d="M 0.3000000000000001,-0.8999999999999999 v 1.7999999999999998 " /></g></g><g transform="matrix(45.45454545454546,0.0,0.0,45.45454545454546,25.000000000000004,50.0)"><g stroke="rgb(0,0,0)" stroke-opacity="1.0" fill="rgb(0,0,0)" fill-opacity="0.0" stroke-width="1.0e-2" font-size="1.0em"><path d="M 0.10000000000000003,-0.7999999999999999 v 1.5999999999999999 " /></g></g><g transform="matrix(45.45454545454546,0.0,0.0,45.45454545454546,25.000000000000004,50.0)"><g stroke="rgb(0,0,0)" stroke-opacity="1.0" fill="rgb(0,0,0)" fill-opacity="0.0" stroke-width="1.0e-2" font-size="1.0em"><path d="M -9.999999999999998e-2,-0.7 v 1.4 " /></g></g><g transform="matrix(45.45454545454546,0.0,0.0,45.45454545454546,25.000000000000004,50.0)"><g stroke="rgb(0,0,0)" stroke-opacity="1.0" fill="rgb(0,0,0)" fill-opacity="0.0" stroke-width="1.0e-2" font-size="1.0em"><path d="M -0.3,-0.6 v 1.2 " /></g></g><g transform="matrix(45.45454545454546,0.0,0.0,45.45454545454546,25.000000000000004,50.0)"><g stroke="rgb(0,0,0)" stroke-opacity="1.0" fill="rgb(0,0,0)" fill-opacity="0.0" stroke-width="1.0e-2" font-size="1.0em"><path d="M -0.5,-0.5 v 1.0 " /></g></g></g></svg>

+ src/Diagrams.hs view

@@ -0,0 +1,153 @@+{-# OPTIONS_GHC -fno-warn-duplicate-exports #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Diagrams+-- Copyright   :  (c) 2015 diagrams-lib team (see LICENSE)+-- License     :  BSD-style (see LICENSE)+-- Maintainer  :  diagrams-discuss@googlegroups.com+--+-- This module only contains exports defined in @diagrams-lib@ or+-- @diagrams-core@. This module can be used if you want to avoid some+-- potential conflicts with other modules, but importing+-- "Diagrams.Prelude" (which includes re-exports from other packages)+-- is often more convenient.+--+-----------------------------------------------------------------------------++module Diagrams+  (+    -- * Core library+    -- | The core definitions of transformations, diagrams,+    --   backends, and so on.+    module Diagrams.Core++    -- * Standard library++    -- | Attributes (color, line style, etc.) and styles.+  , module Diagrams.Attributes++    -- | Alignment of diagrams relative to their envelopes.+  , module Diagrams.Align++    -- | Creating and using bounding boxes.+  , module Diagrams.BoundingBox++    -- | Combining multiple diagrams into one.+  , module Diagrams.Combinators++    -- | Giving concrete locations to translation-invariant things.+  , module Diagrams.Located++    -- | Linear and cubic bezier segments.+  , module Diagrams.Segment++    -- | Trails.+  , module Diagrams.Trail++    -- | Parametrization of segments and trails.+  , module Diagrams.Parametric++    -- | Adjusting the length of parameterized objects.+  , module Diagrams.Parametric.Adjust++    -- | Computing tangent and normal vectors of segments and+    --   trails.+  , module Diagrams.Tangent++    -- | Trail-like things.+  , module Diagrams.TrailLike++    -- | Paths.+  , module Diagrams.Path++    -- | Cubic splines.+  , module Diagrams.CubicSpline++    -- | Some additional transformation-related functions, like+    --   conjugation of transformations.+  , module Diagrams.Transform++    -- | Projective transformations and other deformations+    -- lacking an inverse.+  , module Diagrams.Deform++    -- | Giving names to subdiagrams and later retrieving+    --   subdiagrams by name.+  , module Diagrams.Names++    -- | Envelopes, aka functional bounding regions.+  , module Diagrams.Envelope++    -- | Traces, aka embedded raytracers, for finding points on+    --   the boundary of a diagram.+  , module Diagrams.Trace++    -- | A query is a function that maps points in a vector space+    --   to values in some monoid; they can be used to annotate+    --   the points of a diagram with some values.+  , module Diagrams.Query++    -- | Utilities for working with points.+  , module Diagrams.Points++    -- | Utilities for working with size.+  , module Diagrams.Size++    -- | Angles+  , module Diagrams.Angle++    -- | Convenience infix operators for working with coordinates.+  , module Diagrams.Coordinates++    -- | Directions, distinguished from angles or vectors+  , module Diagrams.Direction++    -- | A wide range of things (shapes, transformations,+    --   combinators) specific to creating two-dimensional+    --   diagrams.+  , module Diagrams.TwoD++    -- | Extra things for three-dimensional diagrams.+  , module Diagrams.ThreeD++    -- | Tools for making animations.+  , module Diagrams.Animation++    -- | Various utility definitions.+  , module Diagrams.Util++  ) where++import           Diagrams.Core++import           Diagrams.Align+import           Diagrams.Angle+import           Diagrams.Animation+import           Diagrams.Attributes+import           Diagrams.BoundingBox       hiding (contains, inside,+                                             intersection, outside, union)+import           Diagrams.Combinators+import           Diagrams.Coordinates+import           Diagrams.CubicSpline+import           Diagrams.Deform+import           Diagrams.Direction         hiding (dir)+import           Diagrams.Envelope+import           Diagrams.Located+import           Diagrams.Names+import           Diagrams.Parametric+import           Diagrams.Parametric.Adjust+import           Diagrams.Path              hiding (pathPoints)+import           Diagrams.Points+import           Diagrams.Query+import           Diagrams.Segment+import           Diagrams.Size+import           Diagrams.Tangent+import           Diagrams.ThreeD+import           Diagrams.Trace+import           Diagrams.Trail             hiding (linePoints, loopPoints,+                                             trailPoints)+import           Diagrams.TrailLike+import           Diagrams.Transform+import           Diagrams.TwoD+import           Diagrams.Util+

src/Diagrams/Align.hs view

@@ -1,6 +1,9 @@-{-# LANGUAGE FlexibleContexts     #-}-{-# LANGUAGE TypeFamilies         #-}-{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE ConstrainedClassMethods #-}+{-# LANGUAGE ConstraintKinds         #-}+{-# LANGUAGE FlexibleContexts        #-}+{-# LANGUAGE TypeFamilies            #-}+{-# LANGUAGE TypeOperators           #-}+{-# LANGUAGE UndecidableInstances    #-}  ----------------------------------------------------------------------------- -- |@@ -21,69 +24,151 @@        ( -- * Alignable class           Alignable(..)-       , alignByDefault+       , alignBy'Default+       , envelopeBoundary+       , traceBoundary           -- * General alignment functions         , align-       , center+       , snug+       , centerV, center+       , snugBy+       , snugCenterV, snugCenter         ) where  import           Diagrams.Core+import           Diagrams.Util    (applyAll) -import           Data.AffineSpace (alerp)-import           Data.VectorSpace+import           Data.Maybe       (fromMaybe)+import           Data.Ord         (comparing)+import           Data.Traversable+import           Prelude +import qualified Data.Foldable    as F import qualified Data.Map         as M import qualified Data.Set         as S +import           Linear.Affine+import           Linear.Metric+import           Linear.Vector        (negated)+import           Linear.Vector.Compat (lerp)+ -- | Class of things which can be aligned. class Alignable a where    -- | @alignBy v d a@ moves the origin of @a@ along the vector   --   @v@. If @d = 1@, the origin is moved to the edge of the-  --   envelope in the direction of @v@; if @d = -1@, it moves to the-  --   edge of the envelope in the direction of the negation of @v@.+  --   boundary in the direction of @v@; if @d = -1@, it moves to the+  --   edge of the boundary in the direction of the negation of @v@.   --   Other values of @d@ interpolate linearly (so for example, @d =   --   0@ centers the origin along the direction of @v@).-  alignBy :: V a -> Scalar (V a) -> a -> a+  alignBy' :: (InSpace v n a, Fractional n, HasOrigin a)+           => (v n -> a -> Point v n) -> v n -> n -> a -> a+  alignBy' = alignBy'Default +  defaultBoundary :: (V a ~ v, N a ~ n) => v n -> a -> Point v n++  alignBy :: (InSpace v n a, Fractional n, HasOrigin a)+          => v n -> n -> a -> a+  alignBy = alignBy' defaultBoundary+ -- | Default implementation of 'alignBy' for types with 'HasOrigin'---   and 'Enveloped' instances.-alignByDefault :: (HasOrigin a, Enveloped a, Num (Scalar (V a)))-               => V a -> Scalar (V a) -> a -> a-alignByDefault v d a = moveOriginTo (alerp (envelopeP (negateV v) a)-                                    (envelopeP v a)-                                    ((d + 1) / 2))-                             a+--   and 'AdditiveGroup' instances.+alignBy'Default :: (InSpace v n a, Fractional n, HasOrigin a)+                => (v n -> a -> Point v n) -> v n -> n -> a -> a+alignBy'Default boundary v d a = moveOriginTo (lerp ((d + 1) / 2)+                                                    (boundary (negated v) a)+                                                    (boundary v a)+                                              ) a+{-# ANN alignBy'Default ("HLint: ignore Use camelCase" :: String) #-} -instance (InnerSpace v, OrderedField (Scalar v)) => Alignable (Envelope v) where-  alignBy = alignByDefault -instance (Enveloped b, HasOrigin b) => Alignable [b] where-  alignBy = alignByDefault+-- | Some standard functions which can be used as the `boundary` argument to+--  `alignBy'`.+envelopeBoundary :: (V a ~ v, N a ~ n, Enveloped a) => v n -> a -> Point v n+envelopeBoundary = envelopeP -instance (Enveloped b, HasOrigin b, Ord b) => Alignable (S.Set b) where-  alignBy = alignByDefault+traceBoundary :: (V a ~ v, N a ~ n, Num n, Traced a) => v n -> a -> Point v n+traceBoundary v a = fromMaybe origin (maxTraceP origin v a) -instance (Enveloped b, HasOrigin b) => Alignable (M.Map k b) where-  alignBy = alignByDefault+combineBoundaries+  :: (InSpace v n a, Metric v, Ord n, F.Foldable f)+  => (v n -> a -> Point v n) -> v n -> f a -> Point v n+combineBoundaries b v fa+  = b v $ F.maximumBy (comparing (dot v . (.-.origin) . b v)) fa -instance ( HasLinearMap v, InnerSpace v, OrderedField (Scalar v)-         , Monoid' m-         ) => Alignable (QDiagram b v m) where-  alignBy = alignByDefault+instance (Metric v, OrderedField n) => Alignable (Envelope v n) where+  defaultBoundary = envelopeBoundary +instance (Metric v, OrderedField n) => Alignable (Trace v n) where+  defaultBoundary = traceBoundary++instance (V b ~ v, N b ~ n, Metric v, OrderedField n, Alignable b) => Alignable [b] where+  defaultBoundary = combineBoundaries defaultBoundary++instance (V b ~ v, N b ~ n, Metric v, OrderedField n, Alignable b)+    => Alignable (S.Set b) where+  defaultBoundary = combineBoundaries defaultBoundary++instance (V b ~ v, N b ~ n, Metric v, OrderedField n, Alignable b)+    => Alignable (M.Map k b) where+  defaultBoundary = combineBoundaries defaultBoundary++instance (Metric v, OrderedField n, Monoid' m)+    => Alignable (QDiagram b v n m) where+  defaultBoundary = envelopeBoundary++-- | Although the 'alignBy' method for the @(b -> a)@ instance is+--   sensible, there is no good implementation for+--   'defaultBoundary'. Instead, we provide a total method, but one that+--   is not sensible. This should not present a serious problem as long+--   as your use of 'Alignable' happens through 'alignBy'.+instance (InSpace v n a, HasOrigin a, Alignable a) => Alignable (b -> a) where+  alignBy v d f b     = alignBy v d (f b)+  defaultBoundary _ _ = origin+ -- | @align v@ aligns an enveloped object along the edge in the --   direction of @v@.  That is, it moves the local origin in the --   direction of @v@ until it is on the edge of the envelope.  (Note --   that if the local origin is outside the envelope to begin with, --   it may have to move \"backwards\".)-align :: (Alignable a, Num (Scalar (V a))) => V a -> a -> a+align :: (InSpace v n a, Fractional n, Alignable a, HasOrigin a) => v n -> a -> a align v = alignBy v 1 --- | @center v@ centers an enveloped object along the direction of+-- | Version of @alignBy@ specialized to use @traceBoundary@+snugBy :: (InSpace v n a, Fractional n, Alignable a, Traced a, HasOrigin a)+       => v n -> n -> a -> a+snugBy = alignBy' traceBoundary++-- | Like align but uses trace.+snug :: (InSpace v n a, Fractional n, Alignable a, Traced a, HasOrigin a)+      => v n -> a -> a+snug v = snugBy v 1++-- | @centerV v@ centers an enveloped object along the direction of --   @v@.-center :: (Alignable a, Num (Scalar (V a))) => V a -> a -> a-center v = alignBy v 0+centerV :: (InSpace v n a, Fractional n, Alignable a, HasOrigin a) => v n -> a -> a+centerV v = alignBy v 0++-- | @center@ centers an enveloped object along all of its basis vectors.+center :: (InSpace v n a, Fractional n, Traversable v, Alignable a, HasOrigin a) => a -> a+center = applyAll fs+  where+    fs = map centerV basis++-- | Like @centerV@ using trace.+snugCenterV+  :: (InSpace v n a, Fractional n, Alignable a, Traced a, HasOrigin a)+   => v n -> a -> a+snugCenterV v = alignBy' traceBoundary v 0++-- | Like @center@ using trace.+snugCenter :: (InSpace v n a, Traversable v, Fractional n, Alignable a, HasOrigin a, Traced a)+           => a -> a+snugCenter = applyAll fs+  where+    fs = map snugCenterV basis++{-# ANN module ("HLint: ignore Use camelCase" :: String) #-}

+ src/Diagrams/Angle.hs view

@@ -0,0 +1,284 @@+{-# LANGUAGE ConstraintKinds            #-}+{-# LANGUAGE DeriveFunctor              #-}+{-# LANGUAGE FlexibleContexts           #-}+{-# LANGUAGE FlexibleInstances          #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses      #-}+{-# LANGUAGE RankNTypes                 #-}+{-# LANGUAGE TypeFamilies               #-}+{-# LANGUAGE TypeOperators              #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Diagrams.Angle+-- Copyright   :  (c) 2013 diagrams-lib team (see LICENSE)+-- License     :  BSD-style (see LICENSE)+-- Maintainer  :  diagrams-discuss@googlegroups.com+--+-- Type for representing angles.+--+-----------------------------------------------------------------------------++module Diagrams.Angle+       ( -- * Angle type+         Angle++         -- ** Using angles+       , (@@), rad, turn, deg++         -- ** Common angles+       , fullTurn, halfTurn, quarterTurn++         -- ** Trigonometric functions+       , sinA, cosA, tanA+       , asinA, acosA, atanA, atan2A, atan2A'++         -- ** Angle utilities+       , angleBetween, angleRatio, normalizeAngle++         -- ** Classes+       , HasTheta(..)+       , HasPhi(..)++         -- * Rotation+       , rotation, rotate+       ) where++import           Control.Applicative+import           Control.Lens            (AReview, Iso', Lens', iso, over,+                                          review, (^.))+import           Data.Fixed+import           Data.Monoid             hiding ((<>))+import           Data.Monoid.Action+import           Data.Semigroup+import           Prelude+import           Text.Read++import           Diagrams.Core           (OrderedField)+import           Diagrams.Core.Transform+import           Diagrams.Core.V+import           Diagrams.Points+import           Linear.V2               (V2 (..))++import           Linear.Metric+import           Linear.Vector++-- | Angles can be expressed in a variety of units.  Internally,+--   they are represented in radians.+newtype Angle n = Radians n+  deriving (Eq, Ord, Enum, Functor)++instance Show n => Show (Angle n) where+  showsPrec d (Radians a) = showParen (d > 5) $+    showsPrec 6 a . showString " @@ rad"++instance Read n => Read (Angle n) where+  readPrec = parens . prec 5 $ do+    x <- readPrec+    Symbol "@@" <- lexP+    Ident "rad" <- lexP+    pure (Radians x)++type instance N (Angle n) = n++instance Applicative Angle where+  pure = Radians+  {-# INLINE pure #-}+  Radians f <*> Radians x = Radians (f x)+  {-# INLINE (<*>) #-}++instance Additive Angle where+  zero = pure 0+  {-# INLINE zero #-}++instance Num n => Semigroup (Angle n) where+  (<>) = (^+^)+  {-# INLINE (<>) #-}++instance Num n => Monoid (Angle n) where+  mappend = (<>)+  mempty  = Radians 0++-- | The radian measure of an 'Angle' @a@ can be accessed as @a '^.'+--   rad@. A new 'Angle' can be defined in radians as @pi \@\@+--   rad@.+rad :: Iso' (Angle n) n+rad = iso (\(Radians r) -> r) Radians+{-# INLINE rad #-}++-- | The measure of an 'Angle' @a@ in full circles can be accessed as+--   @a '^.' turn@.  A new 'Angle' of one-half circle can be defined in as+--   @1/2 \@\@ turn@.+turn :: Floating n => Iso' (Angle n) n+turn = iso (\(Radians r) -> r / (2*pi)) (Radians . (*(2*pi)))+{-# INLINE turn #-}++-- | The degree measure of an 'Angle' @a@ can be accessed as @a+--   '^.' deg@. A new 'Angle' can be defined in degrees as @180 \@\@+--   deg@.+deg :: Floating n => Iso' (Angle n) n+deg = iso (\(Radians r) -> r / (2*pi/360)) (Radians . ( * (2*pi/360)))+{-# INLINE deg #-}++-- | An angle representing one full turn.+fullTurn :: Floating v => Angle v+fullTurn = 1 @@ turn++-- | An angle representing a half turn.+halfTurn :: Floating v => Angle v+halfTurn = 0.5 @@ turn++-- | An angle representing a quarter turn.+quarterTurn :: Floating v => Angle v+quarterTurn = 0.25 @@ turn++-- | Calculate ratio between two angles.+angleRatio :: Floating n => Angle n -> Angle n -> n+angleRatio a b = (a ^. rad) / (b ^. rad)++-- | The sine of the given @Angle@.+sinA :: Floating n => Angle n -> n+sinA (Radians r) = sin r++-- | The cosine of the given @Angle@.+cosA :: Floating n => Angle n -> n+cosA (Radians r) = cos r++-- | The tangent function of the given @Angle@.+tanA :: Floating n => Angle n -> n+tanA (Radians r) = tan r++-- | The @Angle@ with the given sine.+asinA :: Floating n => n -> Angle n+asinA = Radians . asin++-- | The @Angle@ with the given cosine.+acosA :: Floating n => n -> Angle n+acosA = Radians . acos++-- | The @Angle@ with the given tangent.+atanA :: Floating n => n -> Angle n+atanA = Radians . atan++-- | @atan2A y x@ is the angle between the positive x-axis and the vector given+--   by the coordinates (x, y). The 'Angle' returned is in the [-pi,pi] range.+atan2A :: RealFloat n => n -> n -> Angle n+atan2A y x = Radians $ atan2 y x++-- | Similar to 'atan2A' but without the 'RealFloat' constraint. This means it+--   doesn't handle negative zero cases. However, for most geometric purposes,+--   the outcome will be the same.+atan2A' :: OrderedField n => n -> n -> Angle n+atan2A' y x = atan2' y x @@ rad++-- atan2 without negative zero tests+atan2' :: OrderedField n => n -> n -> n+atan2' y x+  | x > 0            =  atan (y/x)+  | x == 0 && y > 0  =  pi/2+  | x <  0 && y > 0  =  pi + atan (y/x)+  | x <= 0 && y < 0  = -atan2' (-y) x+  | y == 0 && x < 0  =  pi    -- must be after the previous test on zero y+  | x==0 && y==0     =  y     -- must be after the other double zero tests+  | otherwise        =  x + y -- x or y is a NaN, return a NaN (via +)++-- | @30 \@\@ deg@ is an 'Angle' of the given measure and units.+--+-- >>> pi @@ rad+-- 3.141592653589793 @@ rad+--+-- >>> 1 @@ turn+-- 6.283185307179586 @@ rad+--+-- >>> 30 @@ deg+-- 0.5235987755982988 @@ rad+--+--   For 'Iso''s, ('@@') reverses the 'Iso'' on its right, and applies+--   the 'Iso'' to the value on the left. 'Angle's are the motivating+--   example where this order improves readability.+--+--   This is the same as a flipped 'review'.+--+-- @+-- ('@@') :: a -> 'Iso''      s a -> s+-- ('@@') :: a -> 'Prism''    s a -> s+-- ('@@') :: a -> 'Review'    s a -> s+-- ('@@') :: a -> 'Equality'' s a -> s+-- @+(@@) :: b -> AReview a b -> a+a @@ i = review i a++infixl 5 @@++-- | Compute the positive angle between the two vectors in their common+--   plane in the [0,pi] range. For a signed angle see+--   'Diagrams.TwoD.Vector.signedAngleBetween'.+--+--   Returns NaN if either of the vectors are zero.+angleBetween  :: (Metric v, Floating n, Ord n) => v n -> v n -> Angle n+angleBetween v1 v2 = acosA (min 1 . max (-1) $ signorm v1 `dot` signorm v2)+-- N.B.: Currently discards the common plane information.++-- | Normalize an angle so that it lies in the [0,tau) range.+normalizeAngle :: (Floating n, Real n) => Angle n -> Angle n+normalizeAngle = over rad (`mod'` (2 * pi))++------------------------------------------------------------+-- Rotation++-- These functions are defined here (instead of in+-- Diagrams.TwoD.Transform) because the Action instance needs to go+-- here.++-- | Create a transformation which performs a rotation about the local+--   origin by the given angle.  See also 'rotate'.+rotation :: Floating n => Angle n -> Transformation V2 n+rotation theta = fromLinear r (linv r)+    where+    c = cosA theta+    s = sinA theta+    r               = rot c s <-> rot c (-s)+    rot co si (V2 x y) = V2 (co * x - si * y)+                            (si * x + co * y)++-- | 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 of the 'Iso's on+--   'Angle'.  For example, @rotate (1\/4 \@\@ 'turn')@, @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 'Angle' constructor,+--   will yield an error since GHC cannot figure out which sort of+--   angle you want to use.  In this common situation you can use+--   'rotateBy', which interprets its argument as a number of turns.++rotate :: (InSpace V2 n t, Transformable t, Floating n) => Angle n -> t -> t+rotate = transform . rotation++-- | Angles act on other things by rotation.+instance (V t ~ V2, N t ~ n, Transformable t, Floating n)+  => Action (Angle n) t where+  act = rotate++------------------------------------------------------------+-- Polar Coordinates++-- | The class of types with at least one angle coordinate, called '_theta'.+class HasTheta t where+  _theta :: RealFloat n => Lens' (t n) (Angle n)++-- | The class of types with at least two angle coordinates, the second called+--   '_phi'. '_phi' is the positive angle measured from the z axis.+class HasTheta t => HasPhi t where+  _phi :: RealFloat n => Lens' (t n) (Angle n)++-- Point instances+instance HasTheta v => HasTheta (Point v) where+  _theta = lensP . _theta+  {-# INLINE _theta #-}++instance HasPhi v => HasPhi (Point v) where+  _phi = lensP . _phi+  {-# INLINE _phi #-}

src/Diagrams/Animation.hs view

@@ -1,3 +1,4 @@+{-# LANGUAGE ConstraintKinds       #-} {-# LANGUAGE FlexibleContexts      #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeFamilies          #-}@@ -29,6 +30,9 @@         ) where +import           Data.Active+import           Data.Semigroup+ import           Diagrams.Core  import           Diagrams.Animation.Active ()@@ -38,18 +42,13 @@ import           Diagrams.TwoD.Shapes import           Diagrams.TwoD.Types -import           Data.Active-import           Data.Semigroup--import           Control.Applicative       ((<$>))-import           Data.Foldable             (foldMap)-import           Data.VectorSpace+import           Linear.Metric  -- | A value of type @QAnimation b v m@ is an animation (a --   time-varying diagram with start and end times) that can be---   rendered by backspace @b@, with vector space @v@ and monoidal+--   rendered by backend @b@, with vector space @v@ and monoidal --   annotations of type @m@.-type QAnimation b v m = Active (QDiagram b v m)+type QAnimation b v n m = Active (QDiagram b v n m)  -- | A value of type @Animation b v@ is an animation (a time-varying --   diagram with start and end times) in vector space @v@ that can be@@ -58,7 +57,7 @@ --   Note that @Animation@ is actually a synonym for @QAnimation@ --   where the type of the monoidal annotations has been fixed to --   'Any' (the default).-type Animation b v = QAnimation b v Any+type Animation b v n = QAnimation b v n Any  -- $animComb -- Most combinators for working with animations are to be found in the@@ -90,16 +89,16 @@ -- --   See also 'animRect' for help constructing a background to go --   behind an animation.-animEnvelope :: (Backend b v, OrderedField (Scalar v), InnerSpace v, Monoid' m)-           => QAnimation b v m -> QAnimation b v m+animEnvelope :: (OrderedField n, Metric v, Monoid' m)+           => QAnimation b v n m -> QAnimation b v n m animEnvelope = animEnvelope' 30  -- | Like 'animEnvelope', but with an adjustible sample rate.  The first --   parameter is the number of samples per time unit to use.  Lower --   rates will be faster but less accurate; higher rates are more --   accurate but slower.-animEnvelope' :: (Backend b v, OrderedField (Scalar v), InnerSpace v, Monoid' m)-            => Rational -> QAnimation b v m -> QAnimation b v m+animEnvelope' :: (OrderedField n, Metric v, Monoid' m)+            => Rational -> QAnimation b v n m -> QAnimation b v n m animEnvelope' r a = withEnvelope (simulate r a) <$> a  -- | @animRect@ works similarly to 'animEnvelope' for 2D diagrams, but@@ -109,16 +108,16 @@ -- --   Uses 30 samples per time unit by default; to adjust this number --   see 'animRect''.-animRect :: (TrailLike t, Enveloped t, Transformable t, Monoid t, V t ~ R2)-         => QAnimation b R2 m -> t+animRect :: (InSpace V2 n t, Monoid' m, TrailLike t, Enveloped t, Transformable t, Monoid t)+         => QAnimation b V2 n m -> t animRect = animRect' 30  -- | Like 'animRect', but with an adjustible sample rate.  The first --   parameter is the number of samples per time unit to use.  Lower --   rates will be faster but less accurate; higher rates are more --   accurate but slower.-animRect' :: (TrailLike t, Enveloped t, Transformable t, Monoid t, V t ~ R2)-          => Rational -> QAnimation b R2 m -> t+animRect' :: (InSpace V2 n t, Monoid' m, TrailLike t, Enveloped t, Transformable t, Monoid t)+          => Rational -> QAnimation b V2 n m -> t animRect' r anim     | null results = rect 1 1     | otherwise    = boxFit (foldMap boundingBox results) (rect 1 1)

src/Diagrams/Animation/Active.hs view

@@ -37,16 +37,13 @@  module Diagrams.Animation.Active where -import           Control.Applicative (pure, (<$>))--import           Diagrams.Align import           Diagrams.Core-import           Diagrams.Path import           Diagrams.TrailLike  import           Data.Active  type instance V (Active a) = V a+type instance N (Active a) = N a  -- Yes, these are all orphan instances. Get over it.  We don't want to -- put them in the 'active' package because 'active' is supposed to be@@ -97,5 +94,5 @@       )       a1 -instance Alignable a => Alignable (Active a) where-  alignBy v d a = alignBy v d <$> a+-- instance Alignable a => Alignable (Active a) where+--   alignBy v d a = alignBy v d <$> a

src/Diagrams/Attributes.hs view

@@ -1,11 +1,19 @@-{-# LANGUAGE DeriveDataTypeable-           , ExistentialQuantification-           , GeneralizedNewtypeDeriving-  #-}+{-# LANGUAGE ConstraintKinds            #-}+{-# LANGUAGE DeriveDataTypeable         #-}+{-# LANGUAGE DeriveFunctor              #-}+{-# LANGUAGE ExistentialQuantification  #-}+{-# LANGUAGE FlexibleInstances          #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE LambdaCase                 #-}+{-# LANGUAGE MultiParamTypeClasses      #-}+{-# LANGUAGE ScopedTypeVariables        #-}+{-# LANGUAGE TypeFamilies               #-}+{-# LANGUAGE TypeOperators              #-}+{-# LANGUAGE ViewPatterns               #-} ----------------------------------------------------------------------------- -- | -- Module      :  Diagrams.Attributes--- Copyright   :  (c) 2011 diagrams-lib team (see LICENSE)+-- Copyright   :  (c) 2011-2015 diagrams-lib team (see LICENSE) -- License     :  BSD-style (see LICENSE) -- Maintainer  :  diagrams-discuss@googlegroups.com --@@ -23,58 +31,220 @@ -----------------------------------------------------------------------------  module Diagrams.Attributes (+    -- ** Standard measures+    ultraThin, veryThin, thin, medium, thick, veryThick, ultraThick, none+  , tiny, verySmall, small, normal, large, veryLarge, huge++    -- ** Line width+  , LineWidth, getLineWidth+  , _LineWidth, _LineWidthM+  , lineWidth, lineWidthM+  , _lineWidth, _lw, _lineWidthU+  , lw, lwN, lwO, lwL, lwG++    -- ** Dashing+  , Dashing(..), getDashing+  , dashing, dashingN, dashingO, dashingL, dashingG+  , _dashing, _dashingU+   -- * Color   -- $color -    Color(..), SomeColor(..)+  , Color(..), SomeColor(..), _SomeColor, someToAlpha -  -- ** Line color-  , LineColor, getLineColor, lineColor, lineColorA, lc, lcA+  -- ** Opacity+  , Opacity, _Opacity+  , getOpacity, opacity, _opacity -  -- ** Fill color-  , FillColor, getFillColor, recommendFillColor, fillColor, fc, fcA+  , FillOpacity, _FillOpacity+  , getFillOpacity, fillOpacity, _fillOpacity -  -- ** Opacity-  , Opacity, getOpacity, opacity+  , StrokeOpacity, _StrokeOpacity+  , getStrokeOpacity, strokeOpacity, _strokeOpacity    -- ** Converting colors-  , toRGBAUsingSpace, colorToSRGBA, colorToRGBA--  -- * Lines-  -- ** Width-  , LineWidth, getLineWidth, lineWidth, lineWidthA, lw+  , colorToSRGBA, colorToRGBA +  -- * Line stuff   -- ** Cap style-  , LineCap(..), LineCapA, getLineCap, lineCap+  , LineCap(..)+  , getLineCap, lineCap, _lineCap    -- ** Join style-  , LineJoin(..), LineJoinA, getLineJoin, lineJoin+  , LineJoin(..)+  , getLineJoin, lineJoin, _lineJoin    -- ** Miter limit-  , LineMiterLimit(..), getLineMiterLimit, lineMiterLimit, lineMiterLimitA+  , LineMiterLimit(..), _LineMiterLimit+  , getLineMiterLimit, lineMiterLimit, lineMiterLimitA, _lineMiterLimit -  -- ** Dashing-  , Dashing(..), DashingA, getDashing, dashing+  -- * Recommend optics +  , _Recommend+  , _Commit+  , _recommend+  , isCommitted+  , committed+   ) where +import           Control.Lens          hiding (none, over)+import           Data.Colour+import           Data.Colour.RGBSpace  (RGB (..))+import           Data.Colour.SRGB      (toSRGB)+import           Data.Default+import           Data.Distributive+import           Data.Monoid.Recommend+import           Data.Semigroup+import           Data.Typeable+ import           Diagrams.Core -import           Data.Default.Class+------------------------------------------------------------------------+-- Standard measures+------------------------------------------------------------------------ -import           Data.Colour-import           Data.Colour.RGBSpace-import           Data.Colour.SRGB (sRGBSpace)+none, ultraThin, veryThin, thin, medium, thick, veryThick, ultraThick,+  tiny, verySmall, small, normal, large, veryLarge, huge+  :: OrderedField n => Measure n+none       = output 0+ultraThin  = normalized 0.0005 `atLeast` output 0.5+veryThin   = normalized 0.001  `atLeast` output 0.5+thin       = normalized 0.002  `atLeast` output 0.5+medium     = normalized 0.004  `atLeast` output 0.5+thick      = normalized 0.0075 `atLeast` output 0.5+veryThick  = normalized 0.01   `atLeast` output 0.5+ultraThick = normalized 0.02   `atLeast` output 0.5 -import           Data.Typeable+tiny      = normalized 0.01+verySmall = normalized 0.015+small     = normalized 0.023+normal    = normalized 0.035+large     = normalized 0.05+veryLarge = normalized 0.07+huge      = normalized 0.10 -import           Data.Monoid.Recommend-import           Data.Semigroup+------------------------------------------------------------------------+-- Line width+------------------------------------------------------------------------ ----------------------------------------------------------------  Color  --------------------------------------------------------------------------------------------------------------+-- | Line widths specified on child nodes always override line widths+--   specified at parent nodes.+newtype LineWidth n = LineWidth (Last n)+  deriving (Typeable, Semigroup) +_LineWidth :: Iso' (LineWidth n) n+_LineWidth = iso getLineWidth (LineWidth . Last)++_LineWidthM :: Iso' (LineWidthM n) (Measure n)+_LineWidthM = mapping _LineWidth++instance Typeable n => AttributeClass (LineWidth n)++type LineWidthM n = Measured n (LineWidth n)++instance OrderedField n => Default (LineWidthM n) where+  def = fmap (LineWidth . Last) medium++getLineWidth :: LineWidth n -> n+getLineWidth (LineWidth (Last w)) = w++-- | Set the line (stroke) width.+lineWidth :: (N a ~ n, HasStyle a, Typeable n) => Measure n -> a -> a+lineWidth = applyMAttr . fmap (LineWidth . Last)++-- | Apply a 'LineWidth' attribute.+lineWidthM :: (N a ~ n, HasStyle a, Typeable n) => LineWidthM n -> a -> a+lineWidthM = applyMAttr++-- | Default for 'lineWidth'.+lw :: (N a ~ n, HasStyle a, Typeable n) => Measure n -> a -> a+lw = lineWidth++-- | A convenient synonym for 'lineWidth (global w)'.+lwG :: (N a ~ n, HasStyle a, Typeable n, Num n) => n -> a -> a+lwG = lw . global++-- | A convenient synonym for 'lineWidth (normalized w)'.+lwN :: (N a ~ n, HasStyle a, Typeable n, Num n) => n -> a -> a+lwN = lw . normalized++-- | A convenient synonym for 'lineWidth (output w)'.+lwO :: (N a ~ n, HasStyle a, Typeable n) => n -> a -> a+lwO = lw . output++-- | A convenient sysnonym for 'lineWidth (local w)'.+lwL :: (N a ~ n, HasStyle a, Typeable n, Num n) => n -> a -> a+lwL = lw . local++-- | Lens onto a measured line width in a style.+_lineWidth, _lw :: (Typeable n, OrderedField n) => Lens' (Style v n) (Measure n)+_lineWidth = atMAttr . anon def (const False) . _LineWidthM+_lw = _lineWidth++-- | Lens onto the unmeasured linewith attribute. This is useful for+--   backends to use on styles once they have been unmeasured. Using on+--   a diagram style could lead to unexpected results.+_lineWidthU :: Typeable n => Lens' (Style v n) (Maybe n)+_lineWidthU = atAttr . mapping _LineWidth++------------------------------------------------------------------------+-- Dashing+------------------------------------------------------------------------++-- | Create lines that are dashing... er, dashed.+data Dashing n = Dashing [n] n+  deriving (Functor, Typeable, Eq)++instance Semigroup (Dashing n) where+  _ <> b = b++instance Typeable n => AttributeClass (Dashing n)++getDashing :: Dashing n -> Dashing n+getDashing = id++-- | Set the line dashing style.+dashing :: (N a ~ n, HasStyle a, Typeable n)+        => [Measure n]  -- ^ A list specifying alternate lengths of on+                        --   and off portions of the stroke.  The empty+                        --   list indicates no dashing.+        -> Measure n    -- ^ An offset into the dash pattern at which the+                        --   stroke should start.+        -> a -> a+dashing ds offs = applyMAttr . distribute $ Dashing ds offs++-- | A convenient synonym for 'dashing (global w)'.+dashingG :: (N a ~ n, HasStyle a, Typeable n, Num n) => [n] -> n -> a -> a+dashingG w v = dashing (map global w) (global v)++-- | A convenient synonym for 'dashing (normalized w)'.+dashingN :: (N a ~ n, HasStyle a, Typeable n, Num n) => [n] -> n -> a -> a+dashingN w v = dashing (map normalized w) (normalized v)++-- | A convenient synonym for 'dashing (output w)'.+dashingO :: (N a ~ n, HasStyle a, Typeable n) => [n] -> n -> a -> a+dashingO w v = dashing (map output w) (output v)++-- | A convenient sysnonym for 'dashing (local w)'.+dashingL :: (N a ~ n, HasStyle a, Typeable n, Num n) => [n] -> n -> a -> a+dashingL w v = dashing (map local w) (local v)++-- | Lens onto a measured dashing attribute in a style.+_dashing :: Typeable n+         => Lens' (Style v n) (Maybe (Measured n (Dashing n)))+_dashing = atMAttr++-- | Lens onto the unmeasured 'Dashing' attribute. This is useful for+--   backends to use on styles once they have been unmeasured. Using on+--   a diagram style could lead to unexpected results.+_dashingU :: Typeable n => Lens' (Style v n) (Maybe (Dashing n))+_dashingU = atAttr++------------------------------------------------------------------------+-- Color+------------------------------------------------------------------------+ -- $color -- Diagrams outsources all things color-related to Russell O\'Connor\'s -- very nice colour package@@ -88,123 +258,68 @@ --   both the 'Data.Colour.Colour' and 'Data.Colour.AlphaColour' types --   from the "Data.Colour" library. class Color c where-  -- | Convert a color to its standard representation, AlphaColour+  -- | Convert a color to its standard representation, AlphaColour.   toAlphaColour :: c -> AlphaColour Double +  -- | Convert from an AlphaColour Double.  Note that this direction+  --   may lose some information. For example, the instance for+  --   'Colour' drops the alpha channel.+  fromAlphaColour :: AlphaColour Double -> c+ -- | An existential wrapper for instances of the 'Color' class. data SomeColor = forall c. Color c => SomeColor c   deriving Typeable --- | The color with which lines (strokes) are drawn.  Note that child---   colors always override parent colors; that is, @'lineColor' c1---   . 'lineColor' c2 $ d@ is equivalent to @'lineColor' c2 $ d@.---   More precisely, the semigroup structure on line color attributes---   is that of 'Last'.-newtype LineColor = LineColor (Last SomeColor)-  deriving (Typeable, Semigroup)-instance AttributeClass LineColor--instance Default LineColor where-    def = LineColor (Last (SomeColor black))--getLineColor :: LineColor -> SomeColor-getLineColor (LineColor (Last c)) = c---- | Set the line (stroke) color.  This function is polymorphic in the---   color type (so it can be used with either 'Colour' or---   'AlphaColour'), but this can sometimes create problems for type---   inference, so the 'lc' and 'lcA' variants are provided with more---   concrete types.-lineColor :: (Color c, HasStyle a) => c -> a -> a-lineColor = applyAttr . LineColor . Last . SomeColor---- | Apply a 'lineColor' attribute.-lineColorA :: HasStyle a => LineColor -> a -> a-lineColorA = applyAttr---- | A synonym for 'lineColor', specialized to @'Colour' Double@---   (i.e. opaque colors).-lc :: HasStyle a => Colour Double -> a -> a-lc = lineColor---- | A synonym for 'lineColor', specialized to @'AlphaColour' Double@---   (i.e. colors with transparency).-lcA :: HasStyle a => AlphaColour Double -> a -> a-lcA = lineColor---- | The color with which shapes are filled. Note that child---   colors always override parent colors; that is, @'fillColor' c1---   . '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 (Recommend (Last SomeColor))-  deriving (Typeable, Semigroup)-instance AttributeClass FillColor---- | Set the fill color.  This function is polymorphic in the color---   type (so it can be used with either 'Colour' or 'AlphaColour'),---   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 . 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 c) = getLast . getRecommend $ c+instance Show SomeColor where+  showsPrec d (colorToSRGBA -> (r,g,b,a)) =+    showParen (d > 10) $ showString "SomeColor " .+      if a == 0+        then showString "transparent"+        else showString "(sRGB " . showsPrec 11 r . showChar ' '+                                 . showsPrec 11 g . showChar ' '+                                 . showsPrec 11 b .+                        (if a /= 1+                           then showString " `withOpacity` " . showsPrec 11 a+                           else id) . showChar ')' --- | A synonym for 'fillColor', specialized to @'Colour' Double@---   (i.e. opaque colors).-fc :: HasStyle a => Colour Double -> a -> a-fc = fillColor+-- | Isomorphism between 'SomeColor' and 'AlphaColour' 'Double'.+_SomeColor :: Iso' SomeColor (AlphaColour Double)+_SomeColor = iso toAlphaColour fromAlphaColour --- | A synonym for 'fillColor', specialized to @'AlphaColour' Double@---   (i.e. colors with transparency).-fcA :: HasStyle a => AlphaColour Double -> a -> a-fcA = fillColor+someToAlpha :: SomeColor -> AlphaColour Double+someToAlpha (SomeColor c) = toAlphaColour c -instance (Floating a, Real a) => Color (Colour a) where-  toAlphaColour = opaque . colourConvert+instance a ~ Double => Color (Colour a) where+  toAlphaColour   = opaque+  fromAlphaColour = (`over` black) -instance (Floating a, Real a) => Color (AlphaColour a) where-  toAlphaColour = alphaColourConvert+instance a ~ Double => Color (AlphaColour a) where+  toAlphaColour   = id+  fromAlphaColour = id  instance Color SomeColor where   toAlphaColour (SomeColor c) = toAlphaColour c--instance Color LineColor where-  toAlphaColour (LineColor (Last c)) = toAlphaColour c--instance Color FillColor where-  toAlphaColour (FillColor c) = toAlphaColour . getLast . getRecommend $ c---- | Convert to an RGB space while preserving the alpha channel.-toRGBAUsingSpace :: Color c => RGBSpace Double -> c-                            -> (Double, Double, Double, Double)-toRGBAUsingSpace s col = (r,g,b,a)-  where c' = toAlphaColour col-        c  = toRGBUsingSpace s (alphaToColour c')-        a  = alphaChannel  c'-        r  = channelRed   c-        g  = channelGreen c-        b  = channelBlue  c+  fromAlphaColour             = SomeColor  -- | Convert to sRGBA. colorToSRGBA, colorToRGBA :: Color c => c -> (Double, Double, Double, Double)-colorToSRGBA = toRGBAUsingSpace sRGBSpace+colorToSRGBA col = (r, g, b, a)+  where+    c' = toAlphaColour col+    c = alphaToColour c'+    a = alphaChannel c'+    RGB r g b = toSRGB c  colorToRGBA = colorToSRGBA {-# DEPRECATED colorToRGBA "Renamed to colorToSRGBA." #-} -alphaToColour :: (Floating a, Ord a, Fractional a) => AlphaColour a -> Colour a+alphaToColour :: (Floating a, Ord a) => AlphaColour a -> Colour a alphaToColour ac | alphaChannel ac == 0 = ac `over` black                  | otherwise = darken (recip (alphaChannel ac)) (ac `over` black) -------------------------------------------------------------+------------------------------------------------------------------------ -- Opacity+------------------------------------------------------------------------  -- | Although the individual colors in a diagram can have --   transparency, the opacity/transparency of a diagram as a whole@@ -218,6 +333,9 @@   deriving (Typeable, Semigroup) instance AttributeClass Opacity +_Opacity :: Iso' Opacity Double+_Opacity = iso getOpacity (Opacity . Product)+ getOpacity :: Opacity -> Double getOpacity (Opacity (Product d)) = d @@ -227,98 +345,139 @@ opacity :: HasStyle a => Double -> a -> a opacity = applyAttr . Opacity . Product ----------------------------------------------------------------  Lines and stuff    --------------------------------------------------------------------------------------------------+-- | Lens onto the opacity in a style.+_opacity :: Lens' (Style v n) Double+_opacity = atAttr . mapping _Opacity . non 1 --- | The width of lines.  By default, the line width is measured with---   respect to the /final/ coordinate system of a rendered diagram,---   as opposed to the local coordinate systems in effect at the time---   the line width was set for various subdiagrams.  This is so that---   it is easy to combine a variety of shapes (some created by---   scaling) and have them all drawn using a consistent line width.---   However, sometimes it is desirable for scaling to affect line---   width; the 'freeze' operation is provided for this purpose.  The---   line width of frozen diagrams is affected by transformations.------   Line widths specified on child nodes always override line widths---   specified at parent nodes.-newtype LineWidth = LineWidth (Last Double)+-- fill opacity --------------------------------------------------------++-- | Like 'Opacity', but set the opacity only for fills (as opposed to strokes).+--   As with 'Opacity', the fill opacity is a value between 1+--   (completely opaque, the default) and 0 (completely transparent),+--   and is multiplicative.+newtype FillOpacity = FillOpacity (Product Double)   deriving (Typeable, Semigroup)-instance AttributeClass LineWidth+instance AttributeClass FillOpacity -instance Default LineWidth where-    def = LineWidth (Last 0.01)+_FillOpacity :: Iso' FillOpacity Double+_FillOpacity = iso getFillOpacity (FillOpacity . Product) -getLineWidth :: LineWidth -> Double-getLineWidth (LineWidth (Last w)) = w+getFillOpacity :: FillOpacity -> Double+getFillOpacity (FillOpacity (Product d)) = d --- | Set the line (stroke) width.-lineWidth :: HasStyle a => Double -> a -> a-lineWidth = applyAttr . LineWidth . Last+-- | Multiply the fill opacity (see 'FillOpacity') by the given value.  For+--   example, @fillOpacity 0.8@ means \"decrease this diagram's fill opacity to+--   80% of its previous value\".+fillOpacity :: HasStyle a => Double -> a -> a+fillOpacity = applyAttr . FillOpacity . Product --- | Apply a 'LineWidth' attribute.-lineWidthA ::  HasStyle a => LineWidth -> a -> a-lineWidthA = applyAttr+-- | Lens onto the fill opacity in a style.+_fillOpacity :: Lens' (Style v n) Double+_fillOpacity = atAttr . mapping _FillOpacity . non 1 --- | A convenient synonym for 'lineWidth'.-lw :: HasStyle a => Double -> a -> a-lw = lineWidth+-- stroke opacity -------------------------------------------------------- +-- | Like 'Opacity', but set the opacity only for strokes (as opposed to fills).+--   As with 'Opacity', the fill opacity is a value between 1+--   (completely opaque, the default) and 0 (completely transparent),+--   and is multiplicative.+newtype StrokeOpacity = StrokeOpacity (Product Double)+  deriving (Typeable, Semigroup)+instance AttributeClass StrokeOpacity++_StrokeOpacity :: Iso' StrokeOpacity Double+_StrokeOpacity = iso getStrokeOpacity (StrokeOpacity . Product)++getStrokeOpacity :: StrokeOpacity -> Double+getStrokeOpacity (StrokeOpacity (Product d)) = d++-- | Multiply the stroke opacity (see 'StrokeOpacity') by the given value.  For+--   example, @strokeOpacity 0.8@ means \"decrease this diagram's+--   stroke opacity to 80% of its previous value\".+strokeOpacity :: HasStyle a => Double -> a -> a+strokeOpacity = applyAttr . StrokeOpacity . Product++-- | Lens onto the stroke opacity in a style.+_strokeOpacity :: Lens' (Style v n) Double+_strokeOpacity = atAttr . mapping _StrokeOpacity . non 1++------------------------------------------------------------------------+-- Line stuff+------------------------------------------------------------------------++-- line cap ------------------------------------------------------------+ -- | What sort of shape should be placed at the endpoints of lines? data LineCap = LineCapButt   -- ^ Lines end precisely at their endpoints.              | LineCapRound  -- ^ Lines are capped with semicircles                              --   centered on endpoints.              | LineCapSquare -- ^ Lines are capped with a squares                              --   centered on endpoints.-  deriving (Eq,Show,Typeable)--newtype LineCapA = LineCapA (Last LineCap)-  deriving (Typeable, Semigroup, Eq)-instance AttributeClass LineCapA+  deriving (Eq, Ord, Show, Typeable)  instance Default LineCap where-    def = LineCapButt+  def = LineCapButt -getLineCap :: LineCapA -> LineCap-getLineCap (LineCapA (Last c)) = c+instance AttributeClass LineCap +-- | Last semigroup structure.+instance Semigroup LineCap where+  _ <> b = b++getLineCap :: LineCap -> LineCap+getLineCap = id+ -- | Set the line end cap attribute. lineCap :: HasStyle a => LineCap -> a -> a-lineCap = applyAttr . LineCapA . Last+lineCap = applyAttr +-- | Lens onto the line cap in a style.+_lineCap :: Lens' (Style v n) LineCap+_lineCap = atAttr . non def +-- line join -----------------------------------------------------------+ -- | How should the join points between line segments be drawn? data LineJoin = LineJoinMiter    -- ^ Use a \"miter\" shape (whatever that is).               | LineJoinRound    -- ^ Use rounded join points.               | LineJoinBevel    -- ^ Use a \"bevel\" shape (whatever                                  --   that is).  Are these...                                  --   carpentry terms?-  deriving (Eq,Show,Typeable)+  deriving (Eq, Ord, Show, Typeable) -newtype LineJoinA = LineJoinA (Last LineJoin)-  deriving (Typeable, Semigroup, Eq)-instance AttributeClass LineJoinA+instance AttributeClass LineJoin +-- | Last semigroup structure.+instance Semigroup LineJoin where+  _ <> b = b+ instance Default LineJoin where-    def = LineJoinMiter+  def = LineJoinMiter -getLineJoin :: LineJoinA -> LineJoin-getLineJoin (LineJoinA (Last j)) = j+getLineJoin :: LineJoin -> LineJoin+getLineJoin = id  -- | Set the segment join style. lineJoin :: HasStyle a => LineJoin -> a -> a-lineJoin = applyAttr . LineJoinA . Last+lineJoin = applyAttr +-- | Lens onto the line join type in a style.+_lineJoin :: Lens' (Style v n) LineJoin+_lineJoin = atAttr . non def +-- miter limit ---------------------------------------------------------+ -- | Miter limit attribute affecting the 'LineJoinMiter' joins. --   For some backends this value may have additional effects. newtype LineMiterLimit = LineMiterLimit (Last Double)-  deriving (Typeable, Semigroup)+  deriving (Typeable, Semigroup, Eq, Ord) instance AttributeClass LineMiterLimit +_LineMiterLimit :: Iso' LineMiterLimit Double+_LineMiterLimit = iso getLineMiterLimit (LineMiterLimit . Last)+ instance Default LineMiterLimit where-    def = LineMiterLimit (Last 10)+  def = LineMiterLimit (Last 10)  getLineMiterLimit :: LineMiterLimit -> Double getLineMiterLimit (LineMiterLimit (Last l)) = l@@ -331,23 +490,39 @@ lineMiterLimitA :: HasStyle a => LineMiterLimit -> a -> a lineMiterLimitA = applyAttr --- | Create lines that are dashing... er, dashed.-data Dashing = Dashing [Double] Double-  deriving (Typeable, Eq)+-- | Lens onto the line miter limit in a style.+_lineMiterLimit :: Lens' (Style v n) Double+_lineMiterLimit = atAttr . non def . _LineMiterLimit -newtype DashingA = DashingA (Last Dashing)-  deriving (Typeable, Semigroup, Eq)-instance AttributeClass DashingA+------------------------------------------------------------------------+-- Recommend optics+------------------------------------------------------------------------ -getDashing :: DashingA -> Dashing-getDashing (DashingA (Last d)) = d+-- | Prism onto a 'Recommend'.+_Recommend :: Prism' (Recommend a) a+_Recommend = prism' Recommend $ \case (Recommend a) -> Just a; _ -> Nothing --- | Set the line dashing style.-dashing :: HasStyle a =>-           [Double]  -- ^ A list specifying alternate lengths of on-                     --   and off portions of the stroke.  The empty-                     --   list indicates no dashing.-        -> Double    -- ^ An offset into the dash pattern at which the-                     --   stroke should start.-        -> a -> a-dashing ds offs = applyAttr (DashingA (Last (Dashing ds offs)))+-- | Prism onto a 'Commit'.+_Commit :: Prism' (Recommend a) a+_Commit = prism' Commit $ \case (Commit a) -> Just a; _ -> Nothing++-- | Lens onto the value inside either a 'Recommend' or 'Commit'. Unlike+--   'committed', this is a valid lens.+_recommend :: Lens (Recommend a) (Recommend b) a b+_recommend f (Recommend a) = Recommend <$> f a+_recommend f (Commit a)    = Commit <$> f a++-- | Lens onto whether something is committed or not.+isCommitted :: Lens' (Recommend a) Bool+isCommitted f r@(Recommend a) = f False <&> \b -> if b then Commit a else r+isCommitted f r@(Commit a)    = f True  <&> \b -> if b then r else Recommend a++-- | 'Commit' a value for any 'Recommend'. This is *not* a valid 'Iso'+--   because the resulting @Recommend b@ is always a 'Commit'. This is+--   useful because it means any 'Recommend' styles set with a lens will+--   not be accidentally overridden. If you want a valid lens onto a+--   recommend value use '_recommend'.+--+--   Other lenses that use this are labeled with a warning.+committed :: Iso (Recommend a) (Recommend b) a b+committed = iso getRecommend Commit

+ src/Diagrams/Attributes/Compile.hs view

@@ -0,0 +1,127 @@+{-# LANGUAGE FlexibleContexts    #-}+{-# LANGUAGE GADTs               #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies        #-}++{-# OPTIONS_GHC -fno-warn-unused-imports #-}+  -- for Data.Semigroup++-----------------------------------------------------------------------------+-- |+-- Module      :  Diagrams.Attributes.Compile+-- Copyright   :  (c) 2014 diagrams-lib team (see LICENSE)+-- License     :  BSD-style (see LICENSE)+-- Maintainer  :  diagrams-discuss@googlegroups.com+--+-- XXX+--+-----------------------------------------------------------------------------++module Diagrams.Attributes.Compile (+    SplitAttribute(..), splitAttr+  ) where++import           Data.Typeable++import           Control.Arrow       (second)+import           Control.Lens        ((%~), (&), _Wrapping')+import           Data.Kind           (Type)+import qualified Data.HashMap.Strict as HM+import           Data.Semigroup+import           Data.Tree           (Tree (..))++import           Diagrams.Core+import           Diagrams.Core.Style (Style (..), attributeToStyle)+import           Diagrams.Core.Types (RNode (..), RTree)++------------------------------------------------------------++-- This is a sort of roundabout, overly-general way to define+-- splitFills; it's done this way to facilitate testing.++class (AttributeClass (AttrType code), Typeable (PrimType code)) => SplitAttribute code where+  type AttrType code :: Type+  type PrimType code :: Type++  primOK :: code -> PrimType code -> Bool++-- | Push certain attributes down until they are at the roots of trees+--   containing only "safe" nodes.  In particular this is used to push+--   fill attributes down until they are over only loops; see+--   'splitFills'.+splitAttr :: forall code b v n a. SplitAttribute code => code -> RTree b v n a -> RTree b v n a+splitAttr code = fst . splitAttr' Nothing+  where++  -- splitAttr' is where the most interesting logic happens.+  -- Mutually recursive with splitAttr'Forest. rebuildNode and+  -- applyMfc are helper functions.+  --+  -- Input: attribute to apply to "safe" subtrees.+  --+  -- Output: tree with attributes pushed down appropriately, and+  -- a Bool indicating whether the tree contains only "safe" prims (True) or+  -- contains some unsafe ones (False).+  splitAttr' :: Maybe (AttrType code) -> RTree b v n a -> (RTree b v n a, Bool)++  -- RStyle node: Check for the special attribute, and split it out of+  -- the style, combining it with the incoming attribute.  Recurse and+  -- rebuild. The tricky bit is that we use some knot-tying to+  -- determine the right attribute to pass down to the subtrees based+  -- on this computed Bool: if all subtrees are safe, then we will+  -- apply the attribute at the root of this tree, and pass Nothing to+  -- all the subtrees.  Otherwise, we pass the given attribute along.+  -- This works out because the attribute does not need to be+  -- pattern-matched until actually applying it at some root, so the+  -- recursion can proceed and the Bool values be computed with the+  -- actual value of the attributes nodes filled in lazily.+  splitAttr' mattr (Node (RStyle sty) cs) = (t', ok)+    where+      mattr' = mattr <> getAttr sty+      sty' = sty & _Wrapping' Style %~ HM.delete ty+      ty   = typeOf (undefined :: AttrType code)+      (cs', ok) = splitAttr'Forest mattr' cs+      t' | ok        = rebuildNode Nothing ok (RStyle sty) cs'+         | otherwise = rebuildNode mattr ok (RStyle sty') cs'++  -- RPrim node: check whether it+  --   * is some sort of prim not under consideration: don't apply the attribute; return True+  --   * is unsafe: don't apply the attribute; return False+  --   * is safe  :  do   apply the attribute; return True+  splitAttr' mattr (Node rp@(RPrim (Prim prm)) _) =+      case cast prm :: Maybe (PrimType code) of+        Nothing  -> (Node rp [], True)+        Just p ->+          if primOK code p+            then (rebuildNode mattr True rp [], True)+            else (Node rp [], False)++  -- RFrozenTr, RAnnot, REmpty cases: just recurse and rebuild.  Note+  -- we assume that transformations do not affect the attributes.+  splitAttr' mattr (Node nd cs)    = (t', ok)+    where+      (cs', ok) = splitAttr'Forest mattr cs+      t'        = rebuildNode mattr ok nd cs'++  -- Recursively call splitAttr' on all subtrees, returning the+  -- logical AND of the Bool results returned (the whole forest is+  -- safe iff all subtrees are).+  splitAttr'Forest :: Maybe (AttrType code) -> [RTree b v n a] -> ([RTree b v n a], Bool)+  splitAttr'Forest mattr cs = (cs', ok)+    where+      (cs', ok) = second and . unzip . map (splitAttr' mattr) $ cs++  -- Given a fill attribute, a Bool indicating whether the given+  -- subforest contains only loops, a node, and a subforest, rebuild a+  -- tree, applying the fill attribute as appropriate (only if the+  -- Bool is true and the attribute is not Nothing).+  rebuildNode :: Maybe (AttrType code) -> Bool -> RNode b v n a -> [RTree b v n a] -> RTree b v n a+  rebuildNode mattr ok nd cs+    | ok        = applyMattr mattr (Node nd cs)+    | otherwise = Node nd cs++  -- Prepend a new fill color node if Just; the identity function if+  -- Nothing.+  applyMattr :: Maybe (AttrType code) -> RTree b v n a -> RTree b v n a+  applyMattr Nothing  t = t+  applyMattr (Just a) t = Node (RStyle $ attributeToStyle (Attribute a)) [t]

+ src/Diagrams/Backend/CmdLine.hs view

@@ -0,0 +1,518 @@+{-# LANGUAGE CPP                       #-}+{-# LANGUAGE ConstrainedClassMethods   #-}+{-# LANGUAGE DeriveDataTypeable        #-}+{-# LANGUAGE FlexibleContexts          #-}+{-# LANGUAGE FlexibleInstances         #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE RankNTypes                #-}+{-# LANGUAGE TemplateHaskell           #-}+{-# LANGUAGE TypeFamilies              #-}+{-# LANGUAGE UndecidableInstances      #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Diagrams.Backend.CmdLine+-- Copyright   :  (c) 2013 Diagrams team (see LICENSE)+-- License     :  BSD-style (see LICENSE)+-- Maintainer  :  diagrams-discuss@googlegroups.com+--+-- Convenient creation of command-line-driven executables for rendering+-- diagrams.  This module provides a general framework and default+-- behaviors for parsing command-line arguments, records for diagram+-- creation options in various forms, and classes and instances for a+-- unified entry point to command-line-driven diagram creation+-- executables.+--+-- For a tutorial on command-line diagram creation see+-- <https://diagrams.github.io/doc/cmdline.html>.+--+-----------------------------------------------------------------------------++module Diagrams.Backend.CmdLine+  (++    -- * Options++    -- ** Standard options+    DiagramOpts(..)+  , diagramOpts+  , width+  , height+  , output++    -- ** Multi-diagram options+  , DiagramMultiOpts(..)+  , diagramMultiOpts+  , selection+  , list++    -- ** Animation options+  , DiagramAnimOpts(..)+  , diagramAnimOpts+  , fpu++    -- * Parsing+  , Parseable(..)+  , readHexColor++    -- * Command-line programs (@Mainable@)+    -- ** Arguments, rendering, and entry point+  , Mainable(..)++    -- ** General currying+  , ToResult(..)++    -- ** helper functions for implementing @mainRender@+  , defaultAnimMainRender+  , defaultMultiMainRender+  ) where++import           Control.Lens              (Lens', makeLenses, (&), (.~), (^.))+import           Diagrams.Animation+import           Diagrams.Attributes+import           Diagrams.Core             hiding (output)++import           Options.Applicative+import           Options.Applicative.Types (readerAsk)++import           Control.Monad             (forM_)++-- MonadFail comes from Prelude in base-4.13 and up+#if !MIN_VERSION_base(4,13,0)+import           Control.Monad.Fail        (MonadFail)+#endif++import           Data.Active               hiding (interval)+import           Data.Char                 (isDigit)+import           Data.Colour+import           Data.Colour.Names+import           Data.Colour.SRGB+import           Data.Data+import           Data.Functor.Identity+import           Data.Kind                 (Type)+import           Data.Monoid+import           Numeric++import           System.Environment        (getProgName)+import           System.FilePath           (addExtension, splitExtension)++import           Text.Printf++-- | Standard options most diagrams are likely to have.+data DiagramOpts = DiagramOpts+  { _width  :: Maybe Int -- ^ Final output width of diagram.+  , _height :: Maybe Int -- ^ Final output height of diagram.+  , _output :: FilePath  -- ^ Output file path, format is typically chosen by extension.+  }+  deriving (Show, Data, Typeable)++makeLenses ''DiagramOpts++-- | Extra options for a program that can offer a choice+--   between multiple diagrams.+data DiagramMultiOpts = DiagramMultiOpts+  { _selection :: Maybe String -- ^ Selected diagram to render.+  , _list      :: Bool         -- ^ Flag to indicate that a list of available diagrams should+                               --   be printed to standard out.+  }+  deriving (Show, Data, Typeable)++makeLenses ''DiagramMultiOpts++-- | Extra options for animations.+data DiagramAnimOpts = DiagramAnimOpts+  { _fpu :: Double -- ^ Number of frames per unit time to generate for the animation.+  }+  deriving (Show, Data, Typeable)++makeLenses ''DiagramAnimOpts++-- | Command line parser for 'DiagramOpts'.+--   Width is option @--width@ or @-w@.+--   Height is option @--height@ or @-h@ (note we change help to be @-?@ due to this).+--   Output is option @--output@ or @-o@.+diagramOpts :: Parser DiagramOpts+diagramOpts = DiagramOpts+  <$> (optional . option auto)+      ( long "width" <> short 'w'+     <> metavar "WIDTH"+     <> help "Desired WIDTH of the output image")+  <*> (optional . option auto)+      ( long "height" <> short 'h'+     <> metavar "HEIGHT"+     <> help "Desired HEIGHT of the output image")+  <*> strOption+      ( long "output" <> short 'o'+     <> value ""+     <> metavar "OUTPUT"+     <> help "OUTPUT file")++-- | Command line parser for 'DiagramMultiOpts'.+--   Selection is option @--selection@ or @-S@.+--   List is @--list@ or @-L@.+diagramMultiOpts :: Parser DiagramMultiOpts+diagramMultiOpts = DiagramMultiOpts+  <$> (optional . strOption)+      ( long "selection" <> short 'S'+     <> metavar "NAME"+     <> help "NAME of the diagram to render")+  <*> switch+      ( long "list" <> short 'L'+     <> help "List all available diagrams")++-- | Command line parser for 'DiagramAnimOpts'+--   Frames per unit is @--fpu@ or @-f@.+diagramAnimOpts :: Parser DiagramAnimOpts+diagramAnimOpts = DiagramAnimOpts+  <$> option auto+      ( long "fpu" <> short 'f'+     <> value 30.0+     <> help "Frames per unit time (for animations)")++-- | A hidden \"helper\" option which always fails.+--   Taken from Options.Applicative.Extra but without the+--   short option 'h'.  We want the 'h' for Height.+helper' :: Parser (a -> a)+helper' = abortOption param $ mconcat+  [ long "help"+  , short '?'+  , help "Show this help text"+  ]+  where+#if MIN_VERSION_optparse_applicative(0,16,0)+    param = ShowHelpText Nothing+#else+    param = ShowHelpText +#endif++-- | Apply a parser to the command line that includes the standard+--   program description and help behavior.  Results in parsed commands+--   or fails with a help message.+defaultOpts :: Parser a -> IO a+defaultOpts optsParser = do+  prog <- getProgName+  let p = info (helper' <*> optsParser)+              ( fullDesc+             <> progDesc "Command-line diagram generation."+             <> header prog)+  execParser p++-- | Parseable instances give a command line parser for a type.  If a custom+--   parser for a common type is wanted a newtype wrapper could be used to make+--   a new 'Parseable' instance.  Notice that we do /not/ want as many+--   instances as 'Read' because we want to limit ourselves to things that make+--   sense to parse from the command line.+class Parseable a where+  parser :: Parser a++-- The following instance would overlap with the product instance for+-- Parseable.  We can't tell if one wants to parse (a,b) as one argument or a+-- as one argument and b as another.  Since this is the command line we almost+-- certainly want the latter.  So we need to have less Read instances.+--+-- instance Read a => Parseable a where+--    parser = argument auto mempty++-- | Parse 'Int' according to its 'Read' instance.+instance Parseable Int where+  parser = argument auto mempty++-- | Parse 'Double' according to its 'Read' instance.+instance Parseable Double where+  parser = argument auto mempty++-- | Parse a string by just accepting the given string.+instance Parseable String where+  parser = argument str mempty++-- | Parse 'DiagramOpts' using the 'diagramOpts' parser.+instance Parseable DiagramOpts where+  parser = diagramOpts++-- | Parse 'DiagramMultiOpts' using the 'diagramMultiOpts' parser.+instance Parseable DiagramMultiOpts where+  parser = diagramMultiOpts++-- | Parse 'DiagramAnimOpts' using the 'diagramAnimOpts' parser.+instance Parseable DiagramAnimOpts where+  parser = diagramAnimOpts++-- | Parse @'Colour' Double@ as either a named color from "Data.Colour.Names"+--   or a hexadecimal color.+instance Parseable (Colour Double) where+  parser = argument (rc <|> rh) mempty+    where+      rh, rc :: ReadM (Colour Double)+      rh = f . colorToSRGBA <$> (readerAsk >>= readHexColor)+      rc = readerAsk >>= readColourName+      f (r,g,b,_) = sRGB r g b -- TODO: this seems unfortunate.  Should the alpha+                               -- value be applied to the r g b values?++-- | Parse @'AlphaColour' Double@ as either a named color from "Data.Colour.Names"+--   or a hexadecimal color.+instance Parseable (AlphaColour Double) where+  parser = argument (rc <|> rh) mempty+    where+      rh = readerAsk >>= readHexColor+      rc = opaque <$> (readerAsk >>= readColourName)++-- Addapted from the Clay.Color module of the clay package++-- | Parses a hexadecimal color.  The string can start with @\"0x\"@ or @\"#\"@+--   or just be a string of hexadecimal values.  If four or three digits are+--   given each digit is repeated to form a full 24 or 32 bit color.  For+--   example, @\"0xfc4\"@ is the same as @\"0xffcc44\"@.  When eight or six+--   digits are given each pair of digits is a color or alpha channel with the+--   order being red, green, blue, alpha.+readHexColor :: (Applicative m, MonadFail m) => String -> m (AlphaColour Double)+readHexColor cs = case cs of+  ('0':'x':hs) -> handle hs+  ('#':hs)     -> handle hs+  hs           -> handle hs+  where+    handle hs | length hs <= 8 && all isHexDigit hs+      = case hs of+        [a,b,c,d,e,f,g,h] -> withOpacity <$> (sRGB <$> hex a b <*> hex c d <*> hex e f) <*> hex g h+        [a,b,c,d,e,f    ] -> opaque      <$> (sRGB <$> hex a b <*> hex c d <*> hex e f)+        [a,b,c,d        ] -> withOpacity <$> (sRGB <$> hex a a <*> hex b b <*> hex c c) <*> hex d d+        [a,b,c          ] -> opaque      <$> (sRGB <$> hex a a <*> hex b b <*> hex c c)+        _                 -> fail $ "could not parse as a colour" ++ cs+    handle _ = fail $ "could not parse as a colour: " ++ cs++    isHexDigit c = isDigit c || c `elem` "abcdef"++    hex a b = (/ 255) <$> case readHex [a,b] of+                [(h,"")] -> return h+                _        -> fail $ "could not parse as a hex value" ++ [a,b]+++-- | This instance is needed to signal the end of a chain of+--   nested tuples, it always just results in the unit value+--   without consuming anything.+instance Parseable () where+  parser = pure ()++-- | Allow 'Parseable' things to be combined.+instance (Parseable a, Parseable b) => Parseable (a,b) where+  parser = (,) <$> parser <*> parser++-- | Triples of Parsebales should also be Parseable.+instance (Parseable a, Parseable b, Parseable c) => Parseable (a, b, c) where+  parser = (,,) <$> parser <*> parser <*> parser++instance (Parseable a, Parseable b, Parseable c, Parseable d) => Parseable (a, b, c, d) where+  parser = (,,,) <$> parser <*> parser <*> parser <*> parser++-- | This class allows us to abstract over functions that take some arguments+--   and produce a final value.  When some @d@ is an instance of+--   'ToResult' we get a type @'Args' d@ that is a type of /all/ the arguments+--   at once, and a type @'ResultOf' d@ that is the type of the final result from+--   some base case instance.+class ToResult d where+  type Args d :: Type+  type ResultOf d :: Type++  toResult :: d -> Args d -> ResultOf d++-- | A diagram can always produce a diagram when given @()@ as an argument.+--   This is our base case.+instance ToResult (QDiagram b v n Any) where+  type Args (QDiagram b v n Any) = ()+  type ResultOf (QDiagram b v n Any) = QDiagram b v n Any++  toResult d _ = d++-- | A list of diagrams can produce pages.+instance ToResult [QDiagram b v n Any] where+  type Args [QDiagram b v n Any] = ()+  type ResultOf [QDiagram b v n Any] = [QDiagram b v n Any]++  toResult ds _ = ds++-- | A list of named diagrams can give the multi-diagram interface.+instance ToResult [(String, QDiagram b v n Any)] where+  type Args [(String,QDiagram b v n Any)] = ()+  type ResultOf [(String,QDiagram b v n Any)] = [(String,QDiagram b v n Any)]++  toResult ds _ = ds++-- | An animation is another suitable base case.+instance ToResult (Animation b v n) where+  type Args (Animation b v n) = ()+  type ResultOf (Animation b v n) = Animation b v n++  toResult a _ = a++-- | Diagrams that require IO to build are a base case.+instance ToResult d => ToResult (IO d) where+  type Args (IO d) = Args d+  type ResultOf (IO d) = IO (ResultOf d)++  toResult d args = flip toResult args <$> d++-- | An instance for a function that, given some 'a', can produce a 'd' that is+--   also an instance of 'ToResult'.  For this to work we need both the+--   argument 'a' and all the arguments that 'd' will need.  Producing the+--   result is simply applying the argument to the producer and passing the+--   remaining arguments to the produced producer.++--   The previous paragraph stands as a witness to the fact that Haskell code+--   is clearer and easier to understand then paragraphs in English written by+--   me.+instance ToResult d => ToResult (a -> d) where+  type Args (a -> d) = (a, Args d)+  type ResultOf (a -> d) = ResultOf d++  toResult f (a,args) = toResult (f a) args+++-- | This class represents the various ways we want to support diagram creation+--   from the command line.  It has the right instances to select between creating+--   single static diagrams, multiple static diagrams, static animations, and+--   functions that produce diagrams as long as the arguments are 'Parseable'.+--+--   Backends are expected to create @Mainable@ instances for the types that are+--   suitable for generating output in the backend's format.  For instance,+--   Postscript can handle single diagrams, pages of diagrams, animations as+--   separate files, and association lists.  This implies instances for+--   @Diagram Postscript R2@, @[Diagram Postscript R2]@, @Animation Postscript R2@,+--   and @[(String,Diagram Postscript R2)]@.  We can consider these as the base+--   cases for the function instance.+--+--   The associated type 'MainOpts' describes the options which need to be parsed+--   from the command-line and passed to @mainRender@.+class Mainable d where+  -- | Associated type that describes the options which need to be parsed+  -- from the command-line and passed to @mainRender@.+  type MainOpts d :: Type++  -- | This method invokes the command-line parser resulting in an options+  -- value or ending the program with an error or help message.+  -- Typically the default instance will work.  If a different help message+  -- or parsing behavior is desired a new implementation is appropriate.+  mainArgs :: Parseable (MainOpts d) => proxy d -> IO (MainOpts d)+  mainArgs _ = defaultOpts parser++  -- | Backend specific work of rendering with the given options and mainable+  -- value is done here.  All backend instances should implement this method.+  mainRender :: MainOpts d -> d -> IO ()++  -- | Main entry point for command-line diagram creation.  This is the method+  -- that users will call from their program @main@.  For instance an expected+  -- user program would take the following form.+  --+  -- @+  -- import Diagrams.Prelude+  -- import Diagrams.Backend.TheBestBackend.CmdLine+  --+  -- d :: Diagram B R2+  -- d = ...+  --+  -- main = mainWith d+  -- @+  --+  -- Most backends should be able to use the default implementation.  A different+  -- implementation should be used to handle more complex interactions with the user.+  mainWith :: Parseable (MainOpts d) => d -> IO ()+  mainWith d = do+    opts <- mainArgs (Identity d)+    mainRender opts d++-- | This instance allows functions resulting in something that is 'Mainable' to+--   be 'Mainable'.  It takes a parse of collected arguments and applies them to+--   the given function producing the 'Mainable' result.+instance (ToResult d, Mainable (ResultOf d))+        => Mainable (a -> d) where+  type MainOpts (a -> d) = (MainOpts (ResultOf (a -> d)), Args (a -> d))++  mainRender (opts, a) f  = mainRender opts (toResult f a)+-- TODO: why can't we get away with: instance (Parseable (Args (a -> d)), Mainable (ResultOf d)) => ...+--       Doesn't `Args (a -> d)` imply `ToResult (a -> d)` which implies `ToResult d` ?++-- | With this instance we can perform IO to produce something+--   'Mainable' before rendering.+instance Mainable d => Mainable (IO d) where+  type MainOpts (IO d) = MainOpts d++  mainRender opts dio = dio >>= mainRender opts++-- | @defaultMultiMainRender@ is an implementation of 'mainRender' where+--   instead of a single diagram it takes a list of diagrams paired with names+--   as input.  The generated executable then takes a @--selection@ option+--   specifying the name of the diagram that should be rendered.  The list of+--   available diagrams may also be printed by passing the option @--list@.+--+--   Typically a backend can write its @[(String,QDiagram b v n Any)]@ instance as+--+--   @+--   instance Mainable [(String,QDiagram b v n Any)] where+--       type MainOpts [(String,QDiagram b v n Any)] = (DiagramOpts, DiagramMultiOpts)+--       mainRender = defaultMultiMainRender+--   @+--+--   We do not provide this instance in general so that backends can choose to+--   opt-in to this form or provide a different instance that makes more sense.+defaultMultiMainRender :: Mainable d => (MainOpts d, DiagramMultiOpts) -> [(String, d)] -> IO ()+defaultMultiMainRender (opts,multi) ds =+  if multi^.list+    then showDiaList (map fst ds)+    else case multi^.selection of+           Nothing  -> putStrLn "No diagram selected." >> showDiaList (map fst ds)+           Just sel -> case lookup sel ds of+                         Nothing -> putStrLn $ "Unknown diagram: " ++ sel+                         Just d  -> mainRender opts d++-- | Display the list of diagrams available for rendering.+showDiaList :: [String] -> IO ()+showDiaList ds = do+  putStrLn "Available diagrams:"+  putStrLn $ "  " ++ unwords ds++-- | @defaultAnimMainRender@ is an implementation of 'mainRender' which renders+--   an animation as numbered frames, named by extending the given output file+--   name by consecutive integers.  For example if the given output file name is+--   @foo\/blah.ext@, the frames will be saved in @foo\/blah001.ext@,+--   @foo\/blah002.ext@, and so on (the number of padding digits used depends on+--   the total number of frames).  It is up to the user to take these images and+--   stitch them together into an actual animation format (using, /e.g./+--   @ffmpeg@).+--+--   Of course, this is a rather crude method of rendering animations;+--   more sophisticated methods will likely be added in the future.+--+--   The @fpu@ option from 'DiagramAnimOpts' can be used to control how many frames will+--   be output for each second (unit time) of animation.+--+--   This function requires a lens into the structure that the particular backend+--   uses for its diagram base case.  If @MainOpts (QDiagram b v n Any) ~ DiagramOpts@+--   then this lens will simply be 'output'.  This lens is required because the+--   implementation works by modifying the output field and running the base @mainRender@.+--   Typically a backend can write its @Animation B V@ instance as+--+--   @+--   instance Mainable (Animation B V) where+--       type MainOpts (Animation B V) = (DiagramOpts, DiagramAnimOpts)+--       mainRender = defaultAnimMainRender output+--   @+--+--   We do not provide this instance in general so that backends can choose to+--   opt-in to this form or provide a different instance that makes more sense.++defaultAnimMainRender ::+    (opts -> QDiagram b v n Any -> IO ())+    -> Lens' opts FilePath -- ^ A lens into the output path.+    -> (opts, DiagramAnimOpts)+    -> Animation b v n+    -> IO ()+defaultAnimMainRender renderF out (opts,animOpts) anim = do+  let frames  = simulate (toRational $ animOpts^.fpu) anim+      nDigits = length . show . length $ frames+  forM_ (zip [1..] frames) $ \(i,d) -> renderF (indexize out nDigits i opts) d++-- | @indexize d n@ adds the integer index @n@ to the end of the+--   output file name, padding with zeros if necessary so that it uses+--   at least @d@ digits.+indexize :: Lens' s FilePath -> Int -> Integer -> s -> s+indexize out nDigits i opts = opts & out .~ output'+  where fmt         = "%0" ++ show nDigits ++ "d"+        output'     = addExtension (base ++ printf fmt i) ext+        (base, ext) = splitExtension (opts^.out)

− src/Diagrams/Backend/Show.hs

@@ -1,69 +0,0 @@-{-# LANGUAGE FlexibleContexts           #-}-{-# LANGUAGE FlexibleInstances          #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE MultiParamTypeClasses      #-}-{-# LANGUAGE ScopedTypeVariables        #-}-{-# LANGUAGE TypeFamilies               #-}-{-# LANGUAGE TypeSynonymInstances       #-}--------------------------------------------------------------------------------- |--- Module      :  Diagrams.Backend.Show--- Copyright   :  (c) 2011 diagrams-lib team (see LICENSE)--- License     :  BSD-style (see LICENSE)--- Maintainer  :  diagrams-discuss@googlegroups.com------ A simple Show-based diagrams backend, for testing purposes.----------------------------------------------------------------------------------module Diagrams.Backend.Show where--import           Diagrams.Core.Transform (onBasis)-import           Diagrams.Prelude-import           Diagrams.Trail--import           Data.Basis--import           Text.PrettyPrint        (Doc, empty, hsep, parens, ($+$))-import qualified Text.PrettyPrint        as PP--import           Data.List               (transpose)---- | Token for identifying this backend.-data ShowBackend = ShowBackend--instance HasLinearMap v => Backend ShowBackend v where-  data Render  ShowBackend v = SR Doc-  type Result  ShowBackend v = String-  data Options ShowBackend v = SBOpt--  withStyle _ _ _ r = r -- XXX FIXME--  doRender _ _ (SR r) = PP.render r--instance Monoid (Render ShowBackend v) where-  mempty = SR empty-  (SR d1) `mappend` (SR d2) = SR (d1 $+$ d2)--renderTransf :: forall v. (Num (Scalar v), HasLinearMap v, Show (Scalar v))-             => Transformation v -> Doc-renderTransf t = renderMat mat-  where vmat :: [v]-        (vmat, _) = onBasis t-        mat :: [[Scalar v]]-        mat = map decompV vmat---        mat' :: [[Scalar v]]---        mat'  = map (++[0]) mat ++ [decompV tr ++ [1]]-        decompV = map snd . decompose--renderMat :: Show a => [[a]] -> Doc-renderMat = PP.vcat . map renderRow . transpose-  where renderRow = parens . hsep . map (PP.text . show)--instance (Show v, HasLinearMap v) => Renderable (Segment o v) ShowBackend where-  render _ s = SR $ PP.text (show s)--instance (Show v, OrderedField (Scalar v), InnerSpace v, HasLinearMap v) => Renderable (Trail v) ShowBackend where-  render _ t = SR $ PP.text (show t)--instance (Show v, OrderedField (Scalar v), InnerSpace v, HasLinearMap v) => Renderable (Path v) ShowBackend where-  render _ p = SR $ PP.text (show p)

src/Diagrams/BoundingBox.hs view

@@ -1,17 +1,19 @@-{-# LANGUAGE DeriveDataTypeable-           , DeriveFunctor-           , FlexibleContexts-           , GeneralizedNewtypeDeriving-           , NoMonomorphismRestriction-           , ScopedTypeVariables-           , StandaloneDeriving-           , TypeFamilies-           , UndecidableInstances-  #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DeriveFunctor              #-}+{-# LANGUAGE FlexibleContexts           #-}+{-# LANGUAGE FlexibleInstances          #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses      #-}+{-# LANGUAGE NoMonomorphismRestriction  #-}+{-# LANGUAGE ScopedTypeVariables        #-}+{-# LANGUAGE StandaloneDeriving         #-}+{-# LANGUAGE TypeFamilies               #-}+{-# LANGUAGE ViewPatterns               #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  Diagrams.BoundingBox--- Copyright   :  (c) 2011 diagrams-lib team (see LICENSE)+-- Copyright   :  (c) 2011-2015 diagrams-lib team (see LICENSE) -- License     :  BSD-style (see LICENSE) -- Maintainer  :  diagrams-discuss@googlegroups.com --@@ -24,309 +26,309 @@ -----------------------------------------------------------------------------  module Diagrams.BoundingBox-       ( -- * Bounding boxes-         BoundingBox()--         -- * Constructing bounding boxes-       , emptyBox, fromCorners, fromPoint, fromPoints-       , boundingBox+  ( -- * Bounding boxes+    BoundingBox -         -- * Queries on bounding boxes-       , isEmptyBox-       , getCorners, getAllCorners-       , boxExtents, boxTransform, boxFit-       , contains, contains'-       , inside, inside', outside, outside'+    -- * Constructing bounding boxes+  , emptyBox, fromCorners, fromPoint, fromPoints+  , boundingBox -         -- * Operations on bounding boxes-       , union, intersection-       ) where+    -- * Queries on bounding boxes+  , isEmptyBox+  , getCorners, getAllCorners+  , boxExtents, boxCenter+  , mCenterPoint, centerPoint+  , boxTransform, boxFit+  , contains, contains'+  , inside, inside', outside, outside' -import Control.Applicative ((<$>))-import Control.Monad (join, liftM2)-import Data.Map (Map, fromList, toList, fromDistinctAscList, toAscList)-import qualified Data.Foldable as F+  , boxGrid -import Data.Maybe (fromMaybe)+    -- * Operations on bounding boxes+  , union, intersection+  ) where -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           Control.Lens            (AsEmpty (..), Each (..), nearly)+import           Data.Foldable           as F+import           Data.Maybe              (fromMaybe)+import           Data.Semigroup+import           Text.Read -import Data.Data (Data)-import Data.Typeable (Typeable)+import           Diagrams.Align+import           Diagrams.Core+import           Diagrams.Core.Transform+import           Diagrams.Path+import           Diagrams.Query+import           Diagrams.ThreeD.Shapes  (cube)+import           Diagrams.ThreeD.Types+import           Diagrams.TwoD.Path      ()+import           Diagrams.TwoD.Shapes+import           Diagrams.TwoD.Types -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, (<->))+import           Control.Applicative+import           Data.Traversable        as T+import           Linear.Affine+import           Linear.Metric+import           Linear.Vector           hiding (lerp)+import           Linear.Vector.Compat    (lerp)  -- Unexported utility newtype -newtype NonEmptyBoundingBox v = NonEmptyBoundingBox (Point v, Point v)-  deriving (Eq, Data, Typeable)+newtype NonEmptyBoundingBox v n = NonEmptyBoundingBox (Point v n, Point v n)+  deriving (Eq, Functor) -fromNonEmpty :: NonEmptyBoundingBox v -> BoundingBox v-fromNonEmpty = BoundingBox . Option . Just+type instance V (NonEmptyBoundingBox v n) = v+type instance N (NonEmptyBoundingBox v n) = n -fromMaybeEmpty :: Maybe (NonEmptyBoundingBox v) -> BoundingBox v+fromNonEmpty :: NonEmptyBoundingBox v n -> BoundingBox v n+fromNonEmpty = BoundingBox . Just++fromMaybeEmpty :: Maybe (NonEmptyBoundingBox v n) -> BoundingBox v n fromMaybeEmpty = maybe emptyBox fromNonEmpty -nonEmptyCorners :: NonEmptyBoundingBox v -> (Point v, Point v)+nonEmptyCorners :: NonEmptyBoundingBox v n -> (Point v n, Point v n) nonEmptyCorners (NonEmptyBoundingBox x) = x -instance (HasBasis v, Ord (Basis v), AdditiveGroup (Scalar v), Ord (Scalar v))-    => Semigroup (NonEmptyBoundingBox v) where+instance (Additive v, Ord n) => Semigroup (NonEmptyBoundingBox v n) where   (NonEmptyBoundingBox (ul, uh)) <> (NonEmptyBoundingBox (vl, vh))-    = NonEmptyBoundingBox-    $ mapT toPoint (combineP min ul vl, combineP max uh vh)-+    = NonEmptyBoundingBox (liftU2 min ul vl, liftU2 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)+newtype BoundingBox v n = BoundingBox (Maybe (NonEmptyBoundingBox v n))+  deriving (Eq, Functor) -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)+deriving instance (Additive v, Ord n) => Semigroup (BoundingBox v n)+deriving instance (Additive v, Ord n) => Monoid (BoundingBox v n) -type instance V (BoundingBox v) = v+instance AsEmpty (BoundingBox v n) where+  _Empty = nearly emptyBox isEmptyBox --- Map a function on a homogenous 2-tuple. (unexported utility)+-- | Only valid if the second point is not smaller than the first.+instance (Additive v', Foldable v', Ord n') =>+    Each (BoundingBox v n) (BoundingBox v' n') (Point v n) (Point v' n') where+  each f (getCorners -> Just (l, u)) = fromCorners <$> f l <*> f u+  each _ _                           = pure emptyBox++type instance V (BoundingBox v n) = v+type instance N (BoundingBox v n) = n++-- Map a function on a homogeneous 2-tuple. (unexported utility) mapT :: (a -> b) -> (a, a) -> (b, b) mapT f (x, y) = (f x, f y) -instance ( VectorSpace v, HasBasis v, Ord (Basis v)-         , AdditiveGroup (Scalar v), Ord (Scalar v)-         )  => HasOrigin (BoundingBox v) where+instance (Additive v, Num n) => HasOrigin (BoundingBox v n) where   moveOriginTo p b     = fromMaybeEmpty-    ( NonEmptyBoundingBox . mapT (moveOriginTo p) <$> getCorners b )+    (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+instance (Additive v, Foldable v, Ord n)+     => HasQuery (BoundingBox v n) Any where+  getQuery bb = Query $ Any . contains bb++instance (Metric v, Traversable v, OrderedField n)+     => Enveloped (BoundingBox v n) where   getEnvelope = getEnvelope . getAllCorners -instance Show v => Show (BoundingBox v) where-  show-    = maybe "emptyBox" (\(l, u) -> "fromCorners " ++ show l ++ " " ++ show u)-    . getCorners+-- Feels like cheating.+-- Should be possible to generalise this.+instance RealFloat n => Traced (BoundingBox V2 n) where+  getTrace = getTrace+           . ((`boxFit` rect 1 1) . boundingBox :: Envelope V2 n -> Path V2 n)+           . getEnvelope -{- TODO-instance Read v => Read (BoundingBox v) where-  read "emptyBox" = emptyBox--}+instance TypeableFloat n => Traced (BoundingBox V3 n) where+  getTrace bb = foldMap (\tr -> getTrace $ transform tr cube) $+                boxTransform (boundingBox cube) bb +instance (Metric v, Traversable v, OrderedField n) => Alignable (BoundingBox v n) where+  defaultBoundary = envelopeP++instance Show (v n) => Show (BoundingBox v n) where+  showsPrec d b = case getCorners b of+    Just (l, u) -> showParen (d > 10) $+      showString "fromCorners " . showsPrec 11 l . showChar ' ' . showsPrec 11 u+    Nothing     -> showString "emptyBox"++instance Read (v n) => Read (BoundingBox v n) where+  readPrec = parens $+    (do+      Ident "emptyBox" <- lexP+      pure emptyBox+    ) <|>+    (prec 10 $ do+      Ident "fromCorners" <- lexP+      l <- step readPrec+      h <- step readPrec+      pure . fromNonEmpty $ NonEmptyBoundingBox (l, h)+    )+ -- | 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+--   require the same type constraints that the @Monoid@ instance does.+emptyBox :: BoundingBox v n+emptyBox = BoundingBox 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+  :: (Additive v, Foldable v, Ord n)+  => Point v n -> Point v n -> BoundingBox v n fromCorners l h-  | F.and (combineP (<=) l h) = fromNonEmpty $ NonEmptyBoundingBox (l, h)-  | otherwise = mempty+  | F.and (liftI2 (<=) 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 :: Point v n -> BoundingBox v n 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] -> BoundingBox v+fromPoints :: (Additive v, Ord n) => [Point v n] -> BoundingBox v n fromPoints = mconcat . map fromPoint  -- | 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 :: (InSpace v n a, HasBasis v, Enveloped a)+            => a -> BoundingBox v n 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)+  env <- (appEnvelope . getEnvelope) a+  let h = fmap env eye+      l = negated $ fmap (env . negated) eye+  return $ NonEmptyBoundingBox (P l, P h)  -- | Queries whether the BoundingBox is empty.-isEmptyBox :: BoundingBox v -> Bool-isEmptyBox (BoundingBox (Option Nothing)) = True-isEmptyBox _ = False+isEmptyBox :: BoundingBox v n -> Bool+isEmptyBox (BoundingBox Nothing) = True+isEmptyBox _                              = False  -- | 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+getCorners :: BoundingBox v n -> Maybe (Point v n, Point v n)+getCorners (BoundingBox p) = nonEmptyCorners <$> 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 (Option Nothing)) = []-getAllCorners (BoundingBox (Option (Just (NonEmptyBoundingBox (l, u)))))-  = map (P . recompose)-  -- Enumerate all combinations of selections of lower / higher values. -  . mapM (\(b, (l', u')) -> [(b, l'), (b, u')])-  -- List of [(basis, (lower, upper))]-  . toList-  $ combineP (,) l u+getAllCorners :: (Additive v, Traversable v) => BoundingBox v n -> [Point v n]+getAllCorners (BoundingBox Nothing) = []+getAllCorners (BoundingBox (Just (NonEmptyBoundingBox (l, u))))+  = T.sequence (liftI2 (\a b -> [a,b]) l u)  -- | 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 = maybe zeroV (\(P l, P h) -> h ^-^ l) . getCorners+boxExtents :: (Additive v, Num n) => BoundingBox v n -> v n+boxExtents = maybe zero (\(l,u) -> u .-. 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 -> Maybe (Transformation v)+-- | Get the center point in a bounding box.+boxCenter :: (Additive v, Fractional n) => BoundingBox v n -> Maybe (Point v n)+boxCenter = fmap (uncurry (lerp 0.5)) . getCorners++-- | Get the center of a the bounding box of an enveloped object, return+--   'Nothing' for object with empty envelope.+mCenterPoint :: (InSpace v n a, HasBasis v, Enveloped a)+            => a -> Maybe (Point v n)+mCenterPoint = boxCenter . boundingBox++-- | Get the center of a the bounding box of an enveloped object, return+--   the origin for object with empty envelope.+centerPoint :: (InSpace v n a, HasBasis v, Enveloped a)+            => a -> Point v n+centerPoint = fromMaybe origin . mCenterPoint++-- | Create a transformation mapping points from one bounding box to the+--   other. Returns 'Nothing' if either of the boxes are empty.+boxTransform+  :: (Additive v, Fractional n)+  => BoundingBox v n -> BoundingBox v n -> Maybe (Transformation v n) 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)+  (P ul, _) <- getCorners u+  (P vl, _) <- getCorners v+  let i  = s (v, u) <-> s (u, v)+      s = liftU2 (*) . uncurry (liftU2 (/)) . mapT boxExtents+  return $ Transformation i i (vl ^-^ s (v, u) ul) --- | 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+-- | Transforms an enveloped thing to fit within a @BoundingBox@.  If the+--   bounding box is empty, then the result is also @mempty@.+boxFit+  :: (InSpace v n a, HasBasis v, Enveloped a, Transformable a, Monoid a)+  => BoundingBox v n -> a -> a 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 :: (Additive v, Foldable v, Ord n) => BoundingBox v n -> Point v n -> Bool contains b p = maybe False check $ getCorners b   where-    check (l, h) = F.and (combineP (<=) l p)-                && F.and (combineP (<=) p h)+    check (l, h) = F.and (liftI2 (<=) l p)+                && F.and (liftI2 (<=) 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' :: (Additive v, Foldable v, Ord n) => BoundingBox v n -> Point v n -> Bool contains' b p = maybe False check $ getCorners b   where-    check (l, h) = F.and (combineP (<) l p)-                && F.and (combineP (<) p h)+    check (l, h) = F.and (liftI2 (<) l p)+                && F.and (liftI2 (<) 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 :: (Additive v, Foldable v, Ord n) => BoundingBox v n -> BoundingBox v n -> Bool 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)+  return $ F.and (liftI2 (>=) ul vl)+        && F.and (liftI2 (<=) 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' :: (Additive v, Foldable v, Ord n) => BoundingBox v n -> BoundingBox v n -> Bool 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)+  return $ F.and (liftI2 (>) ul vl)+        && F.and (liftI2 (<) 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 :: (Additive v, Foldable v, Ord n) => BoundingBox v n -> BoundingBox v n -> Bool 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)+  return $ F.or (liftI2 (<=) uh vl)+        || F.or (liftI2 (>=) 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' :: (Additive v, Foldable v, Ord n) => BoundingBox v n -> BoundingBox v n -> Bool 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)+  return $ F.or (liftI2 (<) uh vl)+        || F.or (liftI2 (>) 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 -> BoundingBox v+  :: (Additive v, Foldable v, Ord n)+  => BoundingBox v n -> BoundingBox v n -> BoundingBox v n 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)+  return (liftI2 max ul vl, liftI2 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 :: (Additive v, Ord n) => BoundingBox v n -> BoundingBox v n -> BoundingBox v n union = mappend --- internals using Map (Basis v) (Scalar v)--- probably paranoia, but decompose might not always---   1. contain basis elements whose component is zero---   2. have basis elements in the same order--fromVector :: (HasBasis v, Ord (Basis v)) => v -> Map (Basis v) (Scalar v)-fromVector = fromList . decompose--toVector :: HasBasis v => Map (Basis v) (Scalar v) -> v-toVector = recompose . toList--toPoint :: HasBasis v => Map (Basis v) (Scalar v) -> Point v-toPoint = P . toVector--combineV :: (HasBasis v, Ord (Basis v), AdditiveGroup (Scalar v))-         => (Scalar v -> Scalar v -> a) -> v -> v -> Map (Basis v) a-combineV f u v = combineDefault zeroV zeroV f (fromVector u) (fromVector v)--combineP :: (HasBasis v, Ord (Basis v), AdditiveGroup (Scalar v))-         => (Scalar v -> Scalar v -> a) -> Point v -> Point v -> Map (Basis v) a-combineP f (P u) (P v) = combineV f u v--combineDefault :: Ord k => a -> b -> (a -> b -> c) -> Map k a -> Map k b -> Map k c-combineDefault a b f = combine g+-- | @boxGrid f box@ returns a grid of regularly spaced points inside+--   the box, such that there are @(1/f)@ points along each dimension.+--   For example, for a 3D box with corners at (0,0,0) and (2,2,2),+--   @boxGrid 0.1@ would yield a grid of approximately 1000 points (it+--   might actually be @11^3@ instead of @10^3@) spaced @0.2@ units+--   apart.+boxGrid+  :: (Traversable v, Additive v, Num n, Enum n)+  => n -> BoundingBox v n -> [Point v n]+boxGrid f = maybe [] (sequenceA . uncurry (liftI2 mkRange)) . getCorners   where-    g Nothing  Nothing  = f a b-    g Nothing  (Just y) = f a y-    g (Just x) Nothing  = f x b-    g (Just x) (Just y) = f x y+    mkRange lo hi = [lo, (1-f)*lo + f*hi .. hi] -combine :: Ord k => (Maybe a -> Maybe b -> c) -> Map k a -> Map k b -> Map k c-combine f am bm = fromDistinctAscList $ merge (toAscList am) (toAscList bm)-  where-    merge [] [] = []-    merge ((x,a):xs) [] = (x, f (Just a) Nothing) : merge xs []-    merge [] ((y,b):ys) = (y, f Nothing (Just b)) : merge [] ys-    merge xs0@((x,a):xs) ys0@((y,b):ys) = case compare x y of-      LT -> (x, f (Just a) Nothing ) : merge xs ys0-      EQ -> (x, f (Just a) (Just b)) : merge xs ys-      GT -> (y, f Nothing  (Just b)) : merge xs0 ys+    -- liftA2 mkRange on the two corner points creates a (Point V2+    -- [n]), where each component is the range of values for that+    -- dimension.  sequenceA then yields a grid of type [Point V2 n].

src/Diagrams/Combinators.hs view

@@ -1,5 +1,8 @@+{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE FlexibleContexts      #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE Rank2Types            #-}+{-# LANGUAGE TemplateHaskell       #-} {-# LANGUAGE TypeFamilies          #-} {-# LANGUAGE UndecidableInstances  #-} -----------------------------------------------------------------------------@@ -18,55 +21,76 @@           withEnvelope, withTrace        , phantom, strut-       , pad+       , pad, frame        , extrudeEnvelope, intrudeEnvelope           -- * Binary operations        , atop        , beneath        , beside+       , atDirection           -- * n-ary operations        , appends-       , position, decorateTrail, decorateLocatedTrail, decoratePath-       , cat, cat', CatOpts(..), CatMethod(..)+       , position, atPoints+       , cat, cat'+       , CatOpts(_catMethod, _sep), catMethod, sep+       , CatMethod(..)+       , composeAligned         ) where -import           Data.AdditiveGroup-import           Data.AffineSpace   ((.+^))-import           Data.Default.Class+import           Control.Lens          hiding (beside, ( # ))+import           Data.Default+import           Data.Maybe            (fromJust)+import           Data.Monoid.Deletable (toDeletable)+import           Data.Monoid.MList     (inj)+import           Data.Proxy import           Data.Semigroup-import           Data.VectorSpace+import qualified Data.Tree.DUAL        as D  import           Diagrams.Core-import           Diagrams.Located-import           Diagrams.Path-import           Diagrams.Segment   (Segment (..), straight)-import           Diagrams.Trail     (Trail, trailVertices)-import           Diagrams.TrailLike (fromOffsets)+import           Diagrams.Core.Types   (QDiagram (QD))+import           Diagrams.Direction+import           Diagrams.Names        (named)+import           Diagrams.Segment      (straight) import           Diagrams.Util +import           Linear.Affine+import           Linear.Metric+import           Linear.Vector+ ------------------------------------------------------------ -- Working with envelopes ------------------------------------------------------------  -- | Use the envelope from some object as the envelope for a --   diagram, in place of the diagram's default envelope.-withEnvelope :: (HasLinearMap (V a), Enveloped a, Monoid' m)-           => a -> QDiagram b (V a) m -> QDiagram b (V a) m+--+--   <<diagrams/src_Diagrams_Combinators_withEnvelopeEx.svg#diagram=withEnvelopeEx&width=300>>+--+--   > sqNewEnv =+--   >     circle 1 # fc green+--   >     |||+--   >     (    c # dashingG [0.1,0.1] 0 # lc white+--   >       <> square 2 # withEnvelope (c :: D V2 Double) # fc blue+--   >     )+--   > c = circle 0.8+--   > withEnvelopeEx = sqNewEnv # centerXY # pad 1.5+withEnvelope :: (InSpace v n a, Monoid' m, Enveloped a)+           => a -> QDiagram b v n m -> QDiagram b v n 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 :: (InSpace v n a, Metric v, OrderedField n, Monoid' m, Traced a)+          => a -> QDiagram b v n m -> QDiagram b v n m withTrace = setTrace . getTrace  -- | @phantom x@ produces a \"phantom\" diagram, which has the same --   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+phantom :: (InSpace v n a, Monoid' m, Enveloped a, Traced a) => a -> QDiagram b v n m+phantom a = QD $ D.leafU ((inj . toDeletable . getEnvelope $ a) <> (inj . toDeletable . getTrace $ a))  -- | @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,25 +98,32 @@ --   origin, so if the origin is not centered the padding may appear --   \"uneven\".  If this is not desired, the origin can be centered --   (using, e.g., 'centerXY' for 2D diagrams) before applying @pad@.-pad :: ( Backend b v-       , InnerSpace v, OrderedField (Scalar v)-       , Monoid' m )-    => Scalar v -> QDiagram b v m -> QDiagram b v m+pad :: (Metric v, OrderedField n, Monoid' m)+    => n -> QDiagram b v n m -> QDiagram b v n m pad s d = withEnvelope (d # scale s) d +-- | @frame s@ increases the envelope of a diagram by and absolute amount @s@,+--   s is in the local units of the diagram. This function is similar to @pad@,+--   only it takes an absolute quantity and pre-centering should not be+--   necessary.+frame :: (Metric v, OrderedField n, Monoid' m)+        => n -> QDiagram b v n m -> QDiagram b v n m+frame s = over envelope (onEnvelope $ \f x -> f x + s)+ -- | @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. (Note, however, that it has an empty trace; for 2D struts---   with a nonempty trace see 'strutR2', 'strutX', and 'strutY' from+--   with a nonempty trace see 'strutR2' 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 = mkQD nullPrim env mempty mempty mempty+--+--   <<diagrams/src_Diagrams_Combinators_strutEx.svg#diagram=strutEx&width=300>>+--+--   > strutEx = (circle 1 ||| strut unitX ||| circle 1) # centerXY # pad 1.1+strut :: (Metric v, OrderedField n)+      => v n -> QDiagram b v n m+strut v = QD $ D.leafU (inj . toDeletable $ env)   where env = translate ((-0.5) *^ v) . getEnvelope $ straight 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@@ -112,10 +143,9 @@ --   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+  :: (Metric v, OrderedField n, Monoid' m)+  => v n -> QDiagram b v n m -> QDiagram b v n m+extrudeEnvelope = deformEnvelope 1  -- | @intrudeEnvelope v d@ asymmetrically \"intrudes\" the envelope of --   a diagram away from the given direction.  All parts of the envelope@@ -125,24 +155,22 @@ --   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)+  :: (Metric v, OrderedField n, Monoid' m)+  => v n -> QDiagram b v n m -> QDiagram b v n m+intrudeEnvelope = deformEnvelope (-1)  -- 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+  :: (Metric v, OrderedField n, Monoid' m)+  => n -> v n -> QDiagram b v n m -> QDiagram b v n m+deformEnvelope s v = over (envelope . _Wrapping Envelope) deformE   where-    deform = Option . fmap deform' . getOption-    deform' env v'-        | dot > 0 = Max $ getMax (env v') + (dot * s) / magnitude v'+    deformE = fmap deformE'+    deformE' env v'+        | dp > 0    = Max $ getMax (env v') + (dp * s) / quadrance v'         | otherwise = env v'       where-        dot = v' <.> v+        dp = v' `dot` v  ------------------------------------------------------------ -- Combining two objects@@ -151,8 +179,8 @@ -- | @beneath@ is just a convenient synonym for @'flip' 'atop'@; that is, --   @d1 \`beneath\` d2@ is the diagram with @d2@ superimposed on top of --   @d1@.-beneath :: (HasLinearMap v, OrderedField (Scalar v), InnerSpace v, Monoid' m)-     => QDiagram b v m -> QDiagram b v m -> QDiagram b v m+beneath :: (Metric v, OrderedField n, Monoid' m)+     => QDiagram b v n m -> QDiagram b v n m -> QDiagram b v n m beneath = flip atop  infixl 6 `beneath`@@ -167,7 +195,7 @@ --   identity element, in which case the second object is returned --   unchanged). -----   <<diagrams/besideEx.svg#diagram=besideEx&height=200>>+--   <<diagrams/src_Diagrams_Combinators_besideEx.svg#diagram=besideEx&height=200>> -- --   > besideEx = beside (r2 (20,30)) --   >                   (circle 1 # fc orange)@@ -192,9 +220,18 @@ --   To get something like @beside v x1 x2@ whose local origin is --   identified with that of @x2@ instead of @x1@, use @beside --   (negateV v) x2 x1@.-beside :: (Juxtaposable a, Semigroup a) => V a -> a -> a -> a+beside :: (Juxtaposable a, Semigroup a) => Vn a -> a -> a -> a beside v d1 d2 = d1 <> juxtapose v d1 d2 +-- | Place two diagrams (or other juxtaposable objects) adjacent to+--   one another, with the second diagram placed in the direction 'd'+--   from the first.  The local origin of the resulting combined+--   diagram is the same as the local origin of the first.  See the+--   documentation of 'beside' for more information.+atDirection :: (InSpace v n a, Metric v, Floating n, Juxtaposable a, Semigroup a)+            => Direction v n -> a -> a -> a+atDirection = beside . fromDirection+ ------------------------------------------------------------ -- Combining multiple objects ------------------------------------------------------------@@ -203,42 +240,32 @@ --   @x@ in the corresponding direction.  Note that each object in --   @ys@ is positioned beside @x@ /without/ reference to the other --   objects in @ys@, so this is not the same as iterating 'beside'.-appends :: (Juxtaposable a, Monoid' a) => a -> [(V a,a)] -> a+--+--   <<diagrams/src_Diagrams_Combinators_appendsEx.svg#diagram=appendsEx&width=200>>+--+--   > appendsEx = appends c (zip (iterateN 6 (rotateBy (1/6)) unitX) (repeat c))+--   >             # centerXY # pad 1.1+--   >   where c = circle 1+appends :: (Juxtaposable a, Monoid' a) => a -> [(Vn a,a)] -> a appends d1 apps = d1 <> mconcat (map (\(v,d) -> juxtapose v d1 d) apps)  -- | Position things absolutely: combine a list of objects --   (e.g. diagrams or paths) by assigning them absolute positions in --   the vector space of the combined object.-position :: (HasOrigin a, Monoid' a) => [(Point (V a), a)] -> a+--+--   <<diagrams/src_Diagrams_Combinators_positionEx.svg#diagram=positionEx&height=300>>+--+--   > positionEx = position (zip (map mkPoint [-3, -2.8 .. 3]) (repeat spot))+--   >   where spot      = circle 0.2 # fc black+--   >         mkPoint :: Double -> P2 Double+--   >         mkPoint x = p2 (x,x*x)+position :: (InSpace v n a, HasOrigin a, Monoid' a) => [(Point v n, a)] -> a position = mconcat . map (uncurry moveTo) --- | Combine a list of diagrams (or paths) by using them to---   \"decorate\" a trail, placing the local origin of one object at---   each successive vertex of the trail.  The first vertex of the---   trail is placed at the origin.  If the trail and list of objects---   have different lengths, the extra tail of the longer one is---   ignored.-decorateTrail :: (InnerSpace (V a), OrderedField (Scalar (V a)), HasOrigin a, Monoid' a)-              => Trail (V a) -> [a] -> a-decorateTrail = decorateLocatedTrail . (`at` origin)---- | Combine a list of diagrams (or paths) by using them to---   \"decorate\" a concretely located trail, placing the local origin---   of one object at each successive vertex of the trail. If the---   trail and list of objects have different lengths, the extra tail---   of the longer one is ignored.-decorateLocatedTrail :: (InnerSpace (V a), OrderedField (Scalar (V a)), HasOrigin a, Monoid' a)-              => Located (Trail (V a)) -> [a] -> a-decorateLocatedTrail t = position . zip (trailVertices t)---- | Combine a list of diagrams (or paths) by using them to---   \"decorate\" a path, placing the local origin of one object at---   each successive vertex of the path.  If the path and list of objects---   have different lengths, the extra tail of the longer one is---   ignored.-decoratePath :: (InnerSpace (V a), OrderedField (Scalar (V a)), HasOrigin a, Monoid' a)-             => Path (V a) -> [a] -> a-decoratePath p = position . zip (concat $ pathVertices p)+-- | Curried version of @position@, takes a list of points and a list of+--   objects.+atPoints :: (InSpace v n a, HasOrigin a, Monoid' a) => [Point v n] -> [a] -> a+atPoints ps as = position $ zip ps as  -- | Methods for concatenating diagrams. data CatMethod = Cat     -- ^ Normal catenation: simply put diagrams@@ -257,36 +284,38 @@                          --   of separation, diagrams may overlap.  -- | Options for 'cat''.-data CatOpts v = CatOpts { catMethod       :: CatMethod-                             -- ^ Which 'CatMethod' should be used:-                             --   normal catenation (default), or-                             --   distribution?-                         , sep             :: Scalar v-                             -- ^ How much separation should be used-                             --   between successive diagrams-                             --   (default: 0)?  When @catMethod =-                             --   Cat@, this is the distance between-                             --   /envelopes/; when @catMethod =-                             --   Distrib@, this is the distance-                             --   between /origins/.-                         , catOptsvProxy__ :: Proxy v-                             -- ^ This field exists solely to aid type inference;-                             --   please ignore it.+data CatOpts n = CatOpts { _catMethod    :: CatMethod+                         , _sep          :: n+                         , catOptsvProxy :: Proxy n                          }  -- The reason the proxy field is necessary is that without it, -- altering the sep field could theoretically change the type of a--- CatOpts record.  This causes problems when writing an expression--- like @with { sep = 10 }@, because knowing the type of the whole+-- CatOpts record.  This causes problems when using record update, as+-- in @with { _sep = 10 }@, because knowing the type of the whole -- expression does not tell us anything about the type of @with@, and -- therefore the @Num (Scalar v)@ constraint cannot be satisfied.--- Adding the Proxy field constrains the type of @with@ in @with {sep--- = 10}@ to be the same as the type of the whole expression.+-- Adding the Proxy field constrains the type of @with@ in @with {_sep+-- = 10}@ to be the same as the type of the whole expression.  Note+-- this is not a problem when using the 'sep' lens, as its type is+-- more restricted. -instance Num (Scalar v) => Default (CatOpts v) where-  def = CatOpts { catMethod       = Cat-                , sep             = 0-                , catOptsvProxy__ = Proxy+makeLensesWith (lensRules & generateSignatures .~ False) ''CatOpts++-- | Which 'CatMethod' should be used:+--   normal catenation (default), or distribution?+catMethod :: Lens' (CatOpts n) CatMethod++-- | How much separation should be used between successive diagrams+--   (default: 0)?  When @catMethod = Cat@, this is the distance between+--   /envelopes/; when @catMethod = Distrib@, this is the distance+--   between /origins/.+sep :: Lens' (CatOpts n) n++instance Num n => Default (CatOpts n) where+  def = CatOpts { _catMethod    = Cat+                , _sep          = 0+                , catOptsvProxy = Proxy                 }  -- | @cat v@ positions a list of objects so that their local origins@@ -297,10 +326,8 @@ -- --   See also 'cat'', which takes an extra options record allowing --   certain aspects of the operation to be tweaked.-cat :: ( Juxtaposable a, Monoid' a, HasOrigin a-       , InnerSpace (V a), OrderedField (Scalar (V a))-       )-       => V a -> [a] -> a+cat :: (InSpace v n a, Metric v, Floating n, Juxtaposable a, Monoid' a, HasOrigin a)+       => v n -> [a] -> a cat v = cat' v def  -- | Like 'cat', but taking an extra 'CatOpts' arguments allowing the@@ -315,18 +342,58 @@ --     default is 0. -- --   'CatOpts' is an instance of 'Default', so 'with' may be used for---   the second argument, as in @cat' (1,2) with {sep = 2}@.+--   the second argument, as in @cat' (1,2) (with & sep .~ 2)@. -----   Note that @cat' v with {catMethod = Distrib} === mconcat@+--   Note that @cat' v (with & catMethod .~ Distrib) === mconcat@ --   (distributing with a separation of 0 is the same as --   superimposing).-cat' :: ( Juxtaposable a, Monoid' a, HasOrigin a-        , InnerSpace (V a), OrderedField (Scalar (V a))-        )-     => V a -> CatOpts (V a) -> [a] -> a-cat' v (CatOpts { catMethod = Cat, sep = s }) = foldB comb mempty+cat' :: (InSpace v n a, Metric v, Floating n, Juxtaposable a, Monoid' a, HasOrigin a)+     => v n -> CatOpts n -> [a] -> a+cat' v (CatOpts { _catMethod = Cat, _sep = s }) = foldB comb mempty   where comb d1 d2 = d1 <> (juxtapose v d1 d2 # moveOriginBy vs)-        vs = s *^ normalized (negateV v)+        vs = s *^ signorm (negated v) -cat' v (CatOpts { catMethod = Distrib, sep = s }) =-  position . zip (iterate (.+^ (s *^ normalized v)) origin)+cat' v (CatOpts { _catMethod = Distrib, _sep = s }) =+  position . zip (iterate (.+^ (s *^ signorm v)) origin)++-- | Compose a list of diagrams using the given composition function,+--   first aligning them all according to the given alignment, /but/+--   retain the local origin of the first diagram, as it would be if+--   the composition function were applied directly.  That is,+--   @composeAligned algn comp@ is equivalent to @translate v . comp+--   . map algn@ for some appropriate translation vector @v@.+--+--   Unfortunately, this only works for diagrams (and not, say, paths)+--   because there is no most general type for alignment functions,+--   and no generic way to find out what an alignment function does to+--   the origin of things.  (However, it should be possible to make a+--   version of this function that works /specifically/ on paths, if+--   such a thing were deemed useful.)+--+--   <<diagrams/src_Diagrams_Combinators_alignedEx1.svg#diagram=alignedEx1&width=400>>+--+--   > alignedEx1 = (hsep 2 # composeAligned alignT) (map circle [1,3,5,2])+--   >            # showOrigin+--   >            # frame 0.5+--+--   <<diagrams/src_Diagrams_Combinators_alignedEx2.svg#diagram=alignedEx2&width=400>>+--+--   > alignedEx2 = (mconcat # composeAligned alignTL) [circle 1, square 1, triangle 1, pentagon 1]+--   >            # showOrigin+--   >            # frame 0.1+composeAligned+  :: (Monoid' m, Floating n, Ord n, Metric v)+  => (QDiagram b v n m -> QDiagram b v n m)    -- ^ Alignment function+  -> ([QDiagram b v n m] -> QDiagram b v n m)  -- ^ Composition function+  -> ([QDiagram b v n m] -> QDiagram b v n m)+composeAligned _ combine [] = combine []+composeAligned algn comb (d:ds) = (comb $ map algn (d:ds)) # moveOriginTo l+  where+    mss = ( (() .>> d)   -- qualify first to avoid stomping on an existing () name+          # named ()     -- Mark the origin+          # algn         -- Apply the alignment function+          )+          -- then find out what happened to the origin+        ^. subMap . _Wrapped . Control.Lens.at (toName ())+    l   = location . head . fromJust $ mss+          -- the fromJust is Justified since we put the () name in

src/Diagrams/Coordinates.hs view

@@ -1,5 +1,7 @@-{-# LANGUAGE TypeFamilies  #-}-{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleContexts     #-}+{-# LANGUAGE TypeFamilies         #-}+{-# LANGUAGE TypeOperators        #-}+{-# LANGUAGE UndecidableInstances #-} ----------------------------------------------------------------------------- -- | -- Module      :  Diagrams.Coordinates@@ -10,28 +12,20 @@ -- Nice syntax for constructing and pattern-matching on literal -- points and vectors. ----- NOTE: to avoid clashing with the '(&)' operator from the @lens@--- package, this module is not re-exported by "Diagrams.Prelude".  To--- make use of the contents of this module, you must explicitly import--- it.--- -----------------------------------------------------------------------------  module Diagrams.Coordinates-    ( (:&)(..), 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 :&-+import           Data.Kind       (Type)+import           Diagrams.Points+import           Linear          (V2 (..), V3 (..), V4 (..))  -- | 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+--   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: --@@ -42,33 +36,53 @@ class Coordinates c where    -- | The type of the final coordinate.-  type FinalCoord c    :: *+  type FinalCoord c    :: Type    -- | The type of everything other than the final coordinate.-  type PrevDim c       :: *+  type PrevDim c       :: Type    -- | Decomposition of @c@ into applications of ':&'.-  type Decomposition c :: *+  type Decomposition c :: Type     -- 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,+  --   using @(^&)@) and a final coordinate.  For example,   --   -- @-  -- 2 & 3 :: P2-  -- 3 & 5 & 6 :: R3+  -- 2 ^& 3 :: P2+  -- 3 ^& 5 ^& 6 :: V3   -- @   ---  --   Note that @&@ is left-associative.-  (&)    :: PrevDim c -> FinalCoord c -> c+  --   Note that @^&@ is left-associative.+  (^&)    :: PrevDim c -> FinalCoord c -> c +  -- | Prefix synonym for @^&@. pr stands for pair of @PrevDim@, @FinalCoord@+  pr      :: PrevDim c -> FinalCoord c -> c+  pr = (^&)+   -- | Decompose a value of type @c@ into its constituent coordinates,   --   stored in a nested @(:&)@ structure.   coords :: c -> Decomposition c -infixl 7 &+infixl 7 ^& +-- | A pair of values, with a convenient infix (left-associative)+--   data constructor.+data a :& b = a :& b+  deriving (Eq, Ord, Show)++infixl 7 :&++-- Instance for :& (the buck stops here)+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++ -- Some standard instances for plain old tuples  instance Coordinates (a,b) where@@ -76,7 +90,7 @@   type PrevDim (a,b)       = a   type Decomposition (a,b) = a :& b -  x & y                    = (x,y)+  x ^& y                   = (x,y)   coords (x,y)             = x :& y  instance Coordinates (a,b,c) where@@ -84,7 +98,7 @@   type PrevDim (a,b,c)       = (a,b)   type Decomposition (a,b,c) = Decomposition (a,b) :& c -  (x,y) & z                  = (x,y,z)+  (x,y) ^& z                  = (x,y,z)   coords (x,y,z)             = coords (x,y) :& z  instance Coordinates (a,b,c,d) where@@ -92,5 +106,40 @@   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)+  (w,x,y)  ^& z                = (w,x,y,z)   coords (w,x,y,z)             = coords (w,x,y) :& z++instance Coordinates (v n) => Coordinates (Point v n) where+  type FinalCoord (Point v n)    = FinalCoord (v n)+  type PrevDim (Point v n)       = PrevDim (v n)+  type Decomposition (Point v n) = Decomposition (v n)++  x ^& y       = P (x ^& y)+  coords (P v) = coords v++-- instances for linear++instance Coordinates (V2 n) where+  type FinalCoord (V2 n)    = n+  type PrevDim (V2 n)       = n+  type Decomposition (V2 n) = n :& n++  x ^& y          = V2 x y+  coords (V2 x y) = x :& y++instance Coordinates (V3 n) where+  type FinalCoord (V3 n)    = n+  type PrevDim (V3 n)       = V2 n+  type Decomposition (V3 n) = n :& n :& n++  V2 x y ^& z       = V3 x y z+  coords (V3 x y z) = x :& y :& z++instance Coordinates (V4 n) where+  type FinalCoord (V4 n)    = n+  type PrevDim (V4 n)       = V3 n+  type Decomposition (V4 n) = n :& n :& n :& n++  V3 x y z ^& w       = V4 x y z w+  coords (V4 x y z w) = x :& y :& z :& w+

src/Diagrams/CubicSpline.hs view

@@ -1,6 +1,10 @@+{-# LANGUAGE ConstraintKinds  #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TypeFamilies     #-}+{-# LANGUAGE TypeOperators    #-}+ {-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  Diagrams.CubicSpline@@ -8,61 +12,68 @@ -- License     :  BSD-style (see LICENSE) -- Maintainer  :  diagrams-discuss@googlegroups.com ----- A /cubic spline/ is a smooth, connected sequence of cubic curves--- passing through a given sequence of points.  This module provides--- the 'cubicSpline' method, which can be used to create closed or--- open cubic splines from a list of points.  For access to the--- internals of the spline generation algorithm (including in--- particular a solver for cyclic tridiagonal systems of linear--- equations), see "Diagrams.CubicSpline.Internal".+-- A /cubic spline/ is a smooth, connected sequence of cubic curves.+-- This module provides two methods for constructing splines. --+-- The 'cubicSpline' method can be used to create closed or open cubic+-- splines from a list of points. The resulting splines /pass through/+-- all the control points, but depend on the control points in a+-- "global" way (that is, changing one control point may alter the+-- entire curve).  For access to the internals of the spline+-- generation algorithm, see "Diagrams.CubicSpline.Internal".+--+-- 'bspline' creates a cubic B-spline, which starts and ends at the+-- first and last control points, but does not necessarily pass+-- through any of the other control points.  It depends on the control+-- points in a "local" way, that is, changing one control point will+-- only affect a local portion of the curve near that control point.+-- ----------------------------------------------------------------------------- module Diagrams.CubicSpline        (          -- * Constructing paths from cubic splines          cubicSpline+       , BSpline+       , bspline        ) where +import           Control.Lens                  (view)+ import           Diagrams.Core-import           Diagrams.Core.Points+import           Diagrams.CubicSpline.Boehm import           Diagrams.CubicSpline.Internal-import           Diagrams.Located              (at)-import           Diagrams.Located-import           Diagrams.Path+import           Diagrams.Located              (Located, at, mapLoc) import           Diagrams.Segment import           Diagrams.Trail import           Diagrams.TrailLike            (TrailLike (..)) --- for e.g. the Fractional (Double, Double) instance-import           Data.NumInstances.Tuple       ()--import           Control.Newtype-import           Data.Semigroup-import           Data.VectorSpace+import           Linear.Affine+import           Linear.Metric  -- | Construct a spline path-like thing of cubic segments from a list of --   vertices, with the first vertex as the starting point.  The first --   argument specifies whether the path should be closed. -----   <<diagrams/cubicSplineEx.svg#diagram=cubicSplineEx&width=600>>+--   <<diagrams/src_Diagrams_CubicSpline_cubicSplineEx.svg#diagram=cubicSplineEx&width=600>> -- --   > pts = map p2 [(0,0), (2,3), (5,-2), (-4,1), (0,3)]---   > dot = circle 0.2 # fc blue # lw 0---   > mkPath closed = position (zip pts (repeat dot))---   >              <> cubicSpline closed pts # lw 0.05+--   > spot = circle 0.2 # fc blue # lw none+--   > mkPath closed = position (zip pts (repeat spot))+--   >              <> cubicSpline closed pts --   > cubicSplineEx = (mkPath False ||| strutX 2 ||| mkPath True) --   >               # centerXY # pad 1.1 -- --   For more information, see <http://mathworld.wolfram.com/CubicSpline.html>.-cubicSpline :: (TrailLike t, Fractional (V t)) => Bool -> [Point (V t)] -> t-cubicSpline c [] = trailLike . closeIf c $ emptyLine `at` origin-cubicSpline c ps = flattenBeziers . map f . solveCubicSplineCoefficients c . map unpack $ ps+cubicSpline :: (V t ~ v, N t ~ n, TrailLike t, Fractional (v n)) => Bool -> [Point v n] -> t+cubicSpline closed []  = trailLike . closeIf closed $ emptyLine `at` origin+cubicSpline closed [p] = trailLike . closeIf closed $ emptyLine `at` p+cubicSpline closed ps  = flattenBeziers . map f . solveCubicSplineCoefficients closed . map (view lensP) $ ps   where     f [a,b,c,d] = [a, (3*a+b)/3, (3*a+2*b+c)/3, a+b+c+d]     flattenBeziers bs@((b:_):_)-      = trailLike . closeIf c $ lineFromSegments (map bez bs) `at` P b+      = trailLike . closeIf closed $ lineFromSegments (map bez bs) `at` P b     bez [a,b,c,d] = bezier3 (b - a) (c - a) (d - a) -closeIf :: (InnerSpace v, OrderedField (Scalar v))-        => Bool -> Located (Trail' Line v) -> Located (Trail v)+closeIf :: (Metric v, OrderedField n)+        => Bool -> Located (Trail' Line v n) -> Located (Trail v n) closeIf c = mapLoc (if c then wrapLoop . glueLine else wrapLine)

+ src/Diagrams/CubicSpline/Boehm.hs view

@@ -0,0 +1,149 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies     #-}+{-# LANGUAGE TypeOperators    #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Diagrams.CubicSpline.Boehm+-- Copyright   :  (c) 2015 diagrams-lib team (see LICENSE)+-- License     :  BSD-style (see LICENSE)+-- Maintainer  :  diagrams-discuss@googlegroups.com+--+-- Boehm's algorithm for converting a cubic B-spline into a sequence+-- of cubic Bezier curves.+--+-- See+--+--   * Thomas W. Sederberg, /An Introduction to B-Spline Curves/,+--     <http://web.archive.org/web/20120227050519/http://tom.cs.byu.edu/~455/bs.pdf>+--+--   * Lyle Ramshaw, /Blossoming: A Connect-the-Dots Approach to Splines/,+--     <http://www.hpl.hp.com/techreports/Compaq-DEC/SRC-RR-19.pdf>+--+-----------------------------------------------------------------------------+module Diagrams.CubicSpline.Boehm+       ( BSpline+       , bsplineToBeziers+       , bspline+       ) where++import           Data.List          (sort, tails)+import           Diagrams.Core      (N, Point, V, origin)+import           Diagrams.Located   (at, loc, unLoc)+import           Diagrams.Segment   (FixedSegment (..), fromFixedSeg)+import           Diagrams.TrailLike (TrailLike, fromLocSegments)+import           Diagrams.Util      (iterateN)+import           Linear.Vector      (Additive)+import           Linear.Vector.Compat (lerp)++type BSpline v n = [Point v n]++-- | @affineCombo a b t x y@ computes an affine combination of x and y+--   which lies at parameter t, if x has parameter a and y has parameter b.+--   The usual @lerp@ arises by giving x parameter 0 and y parameter 1.+affineCombo :: (Additive f, Fractional a) => a -> a -> a -> f a -> f a -> f a+affineCombo a b t = lerp ((t-a)/(b-a))++-- | @windows k xs@ yields all the length-@k@ windows from @xs@, e.g.+--   @windows 3 [a,b,c,d,e] == [[a,b,c], [b,c,d], [c,d,e]]@.+windows :: Int -> [a] -> [[a]]+windows k = takeWhile ((==k) . length) . map (take k) . tails++-- | @extend k xs@ extends @xs@ on both ends by prepending @k@ copies+-- of its head and appending @k@ copies of its last element.  For example,+-- @extend 2 [1..5] == [1,1,1,2,3,4,5,5,5]@.+extend :: Int -> [a] -> [a]+extend k xs = replicate k (head xs) ++ xs ++ replicate k (last xs)++-- | A "polar point" is a point along with three knot values.+--   We consider the "blossom" of a cubic spline, a 3-ary symmetric+--   polynomial; a polar point consists of 3 values paired with the+--   output of the blossom at those input values.  Blossoms have nice+--   affine properties so this makes it easy to keep track of how+--   points may be combined to yield other points of interest.+--+--   Invariant: knot values are in nondecreasing order.+data PolarPt v n = PP { unPP :: Point v n, _knots :: [n] }++mkPolarPt :: Ord n => Point v n -> [n] -> PolarPt v n+mkPolarPt pt kts = PP pt (sort kts)++-- | Precondition: the knots of the two polar points overlap, like abc+--   and bcd.  The @Int@ should be 0 or 1, indicating which knot to+--   replicate (0 means to replicate b, yielding bbc, 1 means to+--   replicate c, yielding bcc).+combine+  :: (Additive v, Fractional n, Ord n)+  => Int -> PolarPt v n -> PolarPt v n -> PolarPt v n+combine k (PP pt1 kts1) (PP pt2 kts2)+  = mkPolarPt+      (affineCombo (head kts1) (last kts2) newKt pt1 pt2)+      (newKt : drop 1 kts1)+  where+    newKt = kts2 !! k++-- | Convert a uniform cubic B-spline to a sequence of cubic beziers.+--   (/Uniform/ refers to the fact that the knots are assumed to be+--   evenly spaced, with no duplicates.)  The knots at the end are+--   replicated so the cubic spline begins and ends at the first and+--   last control points, tangent to the line from the end control+--   point to the next.+bsplineToBeziers+  :: (Additive v, Fractional n, Num n, Ord n)+  => BSpline v n+  -> [FixedSegment v n]+bsplineToBeziers controls = beziers+  where+    n                            = length controls+    numKnots                     = n + 2+    knots                        = iterateN numKnots (+1/(fromIntegral numKnots - 1)) 0++    -- The control points are P(a,b,c), P(b,c,d), P(c,d,e), and so on.+    controls' = zipWith mkPolarPt (extend 2 controls) (windows 3 $ extend 2 knots)++    -- The bezier internal control points are affine combinations of+    -- the spline control points.+    bezierControls        = map combineC (windows 2 controls')+    combineC [pabc, pbcd] = (combine 0 pabc pbcd, combine 1 pabc pbcd)+    combineC _ = error "combineC must be called on a list of length 2"++    -- The bezier end points are affine combinations of the bezier+    -- control points.+    bezierEnds                   = map combineE (windows 2 bezierControls)+    combineE [(_,pabb),(pbbc,_)] = combine 0 pabb pbbc+    combineE _ = error "combineE must be called on a list of length 2"++    -- Finally, we actually put together the generated bezier segments.+    beziers                      = zipWith mkBezier (drop 1 bezierControls) (windows 2 bezierEnds)+      where+        mkBezier (paab,pabb) [paaa,pbbb]+          = FCubic (unPP paaa) (unPP paab) (unPP pabb) (unPP pbbb)+        mkBezier _ _ = error "mkBezier must be called on a list of length 2"++    -- Note that the above algorithm works in any dimension but is+    -- very specific to *cubic* splines.  This can of course be+    -- generalized to higher degree splines but keeping track of+    -- everything gets a bit more complicated; to be honest I am not+    -- quite sure how to do it.++-- | Generate a uniform cubic B-spline from the given control points.+--   The spline starts and ends at the first and last control points,+--   and is tangent to the line to the second(-to-last) control point.+--   It does not necessarily pass through any of the other control+--   points.+--+--   <<diagrams/src_Diagrams_CubicSpline_Boehm_bsplineEx.svg#diagram=bsplineEx&width=300>>+--+--   > pts = map p2 [(0,0), (2,3), (5,-2), (-4,1), (0,3)]+--   > spot = circle 0.2 # fc blue # lw none+--   > bsplineEx = mconcat+--   >   [ position (zip pts (repeat spot))+--   >   , bspline pts+--   >   ]+--   >   # frame 0.5++bspline :: (TrailLike t, V t ~ v, N t ~ n) => BSpline v n -> t+bspline = fromLocSegments . fixup . map fromFixedSeg . bsplineToBeziers+  where+    fixup []        = [] `at` origin+    fixup (b1:rest) = (unLoc b1 : map unLoc rest) `at` loc b1

src/Diagrams/CubicSpline/Internal.hs view

@@ -1,7 +1,3 @@-{-# LANGUAGE TypeFamilies-           , FlexibleContexts-  #-}-{-# OPTIONS_GHC -fno-warn-name-shadowing #-} ----------------------------------------------------------------------------- -- | -- Module      :  Diagrams.CubicSpline@@ -18,76 +14,19 @@ module Diagrams.CubicSpline.Internal        (          -- * Solving for spline coefficents-         solveTriDiagonal-       , solveCyclicTriDiagonal-       , solveCubicSplineDerivatives+         solveCubicSplineDerivatives        , solveCubicSplineDerivativesClosed        , solveCubicSplineCoefficients        ) where -import Data.List---- | Solves a system of the form 'A*X=D' for 'x' where 'A' is an ---   'n' by 'n' matrix with 'bs' as the main diagonal and ---   'as' the diagonal below and 'cs' the diagonal above.---   See: <http://en.wikipedia.org/wiki/Tridiagonal_matrix_algorithm>-solveTriDiagonal :: Fractional a => [a] -> [a] -> [a] -> [a] -> [a]-solveTriDiagonal as (b0:bs) (c0:cs) (d0:ds) = h cs' ds'-  where-    cs' = c0 / b0 : f cs' as bs cs-    f _ [_] _ _ = []-    f (c':cs') (a:as) (b:bs) (c:cs) = c / (b - c' * a) : f cs' as bs cs-    f _ _ _ _ = error "solveTriDiagonal.f: impossible!"--    ds' = d0 / b0 : g ds' as bs cs' ds -    g _ [] _ _ _ = []-    g (d':ds') (a:as) (b:bs) (c':cs') (d:ds) = (d - d' * a)/(b - c' * a) : g ds' as bs cs' ds-    g _ _ _ _ _ = error "solveTriDiagonal.g: impossible!"-    -    h _ [d] = [d]-    h (c:cs) (d:ds) = let xs@(x:_) = h cs ds in d - c * x : xs-    h _ _ = error "solveTriDiagonal.h: impossible!"--solveTriDiagonal _ _ _ _ = error "arguments 2,3,4 to solveTriDiagonal must be nonempty"---- Helper that applies the passed function only to the last element of a list-modifyLast :: (a -> a) -> [a] -> [a]-modifyLast _ []     = []-modifyLast f [a]    = [f a]-modifyLast f (a:as) = a : modifyLast f as---- Helper that builds a list of length n of the form: '[s,m,m,...,m,m,e]'-sparseVector :: Int -> a -> a -> a -> [a]-sparseVector n s m e -    | n < 1     = []-    | otherwise = s : h (n - 1)-  where -    h 1 = [e]-    h n = m : h (n - 1)-    --- | Solves a system similar to the tri-diagonal system using a special case---   of the Sherman-Morrison formula <http://en.wikipedia.org/wiki/Sherman-Morrison_formula>.---   This code is based on /Numerical Recpies in C/'s @cyclic@ function in section 2.7.-solveCyclicTriDiagonal :: Fractional a => [a] -> [a] -> [a] -> [a] -> a -> a -> [a]-solveCyclicTriDiagonal as (b0:bs) cs ds alpha beta = zipWith ((+) . (fact *)) zs xs-  where-    l = length ds-    gamma = -b0-    us = sparseVector l gamma 0 alpha-    -    bs' = (b0 - gamma) : modifyLast (subtract (alpha*beta/gamma)) bs-    -    xs@(x:_) = solveTriDiagonal as bs' cs ds-    zs@(z:_) = solveTriDiagonal as bs' cs us-    -    fact = -(x + beta * last xs / gamma) / (1.0 + z + beta * last zs / gamma)+import           Diagrams.Solve.Tridiagonal -solveCyclicTriDiagonal _ _ _ _ _ _ = error "second argument to solveCyclicTriDiagonal must be nonempty"+import           Data.List  -- | Use the tri-diagonal solver with the appropriate parameters for an open cubic spline. solveCubicSplineDerivatives :: Fractional a => [a] -> [a] solveCubicSplineDerivatives (x:xs) = solveTriDiagonal as bs as ds-  where +  where     as = replicate (l - 1) 1     bs = 2 : replicate (l - 2) 4 ++ [2]     l  = length ds@@ -99,7 +38,7 @@ -- | Use the cyclic-tri-diagonal solver with the appropriate parameters for a closed cubic spline. solveCubicSplineDerivativesClosed :: Fractional a => [a] -> [a] solveCubicSplineDerivativesClosed xs = solveCyclicTriDiagonal as bs as ds 1 1-  where +  where     as = replicate (l - 1) 1     bs = replicate l 4     l  = length xs@@ -109,11 +48,11 @@  -- | Use the cyclic-tri-diagonal solver with the appropriate parameters for a closed cubic spline. solveCubicSplineCoefficients :: Fractional a => Bool -> [a] -> [[a]]-solveCubicSplineCoefficients closed xs = +solveCubicSplineCoefficients closed xs =     [ [x,d,3*(x1-x)-2*d-d1,2*(x-x1)+d+d1]     | (x,x1,d,d1) <- zip4 xs' (tail xs') ds' (tail ds')     ]-  where +  where     ds | closed    = solveCubicSplineDerivativesClosed xs        | otherwise = solveCubicSplineDerivatives xs     close as | closed    = as ++ [head as]

+ src/Diagrams/Deform.hs view

@@ -0,0 +1,129 @@+{-# LANGUAGE ConstraintKinds       #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE TypeFamilies          #-}+{-# LANGUAGE TypeOperators         #-}+{-# LANGUAGE UndecidableInstances  #-}++module Diagrams.Deform+       ( Deformation(..)+       , Deformable(..)+       , asDeformation+       ) where++import           Control.Lens        (mapped, over, _Wrapped)+import           Data.Monoid         hiding ((<>))+import           Data.Semigroup+import           Prelude++import           Diagrams.Core+import           Diagrams.Located+import           Diagrams.Parametric+import           Diagrams.Path+import           Diagrams.Segment+import           Diagrams.Trail++import           Linear.Affine+import           Linear.Metric+import           Linear.Vector++------------------------------------------------------------+-- Deformations++-- | @Deformations@ are a superset of the affine transformations+--   represented by the 'Transformation' type.  In general they are not+--   invertible.  @Deformation@s include projective transformations.+--   @Deformation@ can represent other functions from points to points+--   which are "well-behaved", in that they do not introduce small wiggles.+newtype Deformation v u n = Deformation (Point v n -> Point u n)++instance Semigroup (Deformation v v n) where+  (Deformation p1) <> (Deformation p2) = Deformation (p1 . p2)++instance Monoid (Deformation v v n) where+  mappend = (<>)+  mempty = Deformation id++class Deformable a b where+  -- | @deform' epsilon d a@ transforms @a@ by the deformation @d@.+  -- If the type of @a@ is not closed under projection, approximate+  -- to accuracy @epsilon@.+  deform' :: N a -> Deformation (V a) (V b) (N a) -> a -> b++  -- | @deform d a@ transforms @a@ by the deformation @d@.+  -- If the type of @a@ is not closed under projection, @deform@+  -- should call @deform'@ with some reasonable default value of+  -- @epsilon@.+  deform :: Deformation (V a) (V b) (N a) -> a -> b++-- | @asDeformation@ converts a 'Transformation' to a 'Deformation' by+-- discarding the inverse transform.  This allows reusing+-- @Transformation@s in the construction of @Deformation@s.+asDeformation :: (Additive v, Num n) => Transformation v n -> Deformation v v n+asDeformation t = Deformation (papply t)++------------------------------------------------------------+-- Instances++instance r ~ Point u n => Deformable (Point v n) r where+  deform' = const deform++  deform (Deformation l) = l++-- | Cubic curves are not closed under perspective projections.+-- Therefore @Segment@s are not an instance of Deformable.  However,+-- the deformation of a @Segment@ can be approximated to arbitrary+-- precision by a series of @Segment@s.  @deformSegment@ does this,+-- which allows types built from lists of @Segment@s to themselves be+-- @Deformable@.+deformSegment :: (Metric v, Metric u, OrderedField n)+   => n -> Deformation v u n -> FixedSegment v n -> [FixedSegment u n]+deformSegment epsilon t = go (0::Int)+  where+    go n s+      | n == 100               = [approx t s]+      | goodEnough epsilon t s = [approx t s]+      | otherwise              = concatMap (go (n+1)) [s1, s2]+      where+        (s1, s2) = splitAtParam s 0.5+-- deformSegment epsilon t s+--     | goodEnough epsilon t s = [approx t s]+--     | otherwise              = concatMap (deformSegment epsilon t) [s1, s2]+--   where+--     (s1, s2) = splitAtParam s 0.5++approx :: Deformation v u n -> FixedSegment v n -> FixedSegment u n+approx t (FLinear p0 p1)      = FLinear (deform t p0) (deform t p1)+approx t (FCubic p0 c1 c2 p1) = FCubic (f p0) (f c1) (f c2) (f p1)+  where f = deform t++goodEnough :: (Metric v, Metric u, OrderedField n) => n -> Deformation v u n -> FixedSegment v n -> Bool+goodEnough e t s =+    all (< e) [norm $ deform t (s `atParam` u) .-. approx t s `atParam` u+              | u <- [0.25, 0.5, 0.75]]++instance (Metric v, Metric u, OrderedField n, r ~ Located (Trail u n))+    => Deformable (Located (Trail v n)) r where+  deform' eps p t+    | isLine $ unLoc t  = line `at` p0+    | otherwise = glueTrail line `at` p0+    where+      segs = concatMap (deformSegment eps p) $ fixTrail t+      p0 = case segs of+             (FLinear start _:_)    -> start+             (FCubic start _ _ _:_) -> start+             _                      -> deform p (loc t)+      line = trailFromSegments $ map (unLoc . fromFixedSeg) segs++  deform p t = deform' (0.01 * extent) p t+    where+      -- estimate the "size" of the Trail' as+      -- the maximum distance to any vertex+      extent = maximum . map dist . trailVertices $ t+      dist pt = norm $ pt .-. loc t++instance (Metric v, Metric u, OrderedField n, r ~ Path u n) => Deformable (Path v n) r where+  deform' eps p = over (_Wrapped . mapped) (deform' eps p)+  deform p      = over (_Wrapped . mapped) (deform p)

+ src/Diagrams/Direction.hs view

@@ -0,0 +1,86 @@+{-# LANGUAGE DeriveFunctor        #-}+{-# LANGUAGE FlexibleContexts     #-}+{-# LANGUAGE TypeFamilies         #-}+{-# LANGUAGE TypeOperators        #-}+{-# LANGUAGE UndecidableInstances #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Diagrams.Direction+-- Copyright   :  (c) 2014 diagrams-lib team (see LICENSE)+-- License     :  BSD-style (see LICENSE)+-- Maintainer  :  diagrams-discuss@googlegroups.com+--+-- Type for representing directions, polymorphic in vector space+--+-----------------------------------------------------------------------------++module Diagrams.Direction+       ( Direction+       , _Dir+       , direction, dir, fromDirection, fromDir+       , angleBetweenDirs+       , dirBetween+       ) where++import           Control.Lens   (Iso', iso)++import           Diagrams.Angle+import           Diagrams.Core++import           Linear.Affine+import           Linear.Metric+import           Linear.Vector++--------------------------------------------------------------------------------+-- Direction++-- | A vector is described by a @Direction@ and a magnitude.  So we+-- can think of a @Direction@ as a vector that has forgotten its+-- magnitude.  @Direction@s can be used with 'fromDirection' and the+-- lenses provided by its instances.+newtype Direction v n = Dir (v n)+  deriving (Read, Show, Eq, Ord, Functor) -- todo: special instances++type instance V (Direction v n) = v+type instance N (Direction v n) = n++instance (V (v n) ~ v, N (v n) ~ n, Transformable (v n)) => Transformable (Direction v n) where+  transform t (Dir v) = Dir (transform t v)++instance HasTheta v => HasTheta (Direction v) where+  _theta = _Dir . _theta++instance HasPhi v => HasPhi (Direction v) where+  _phi = _Dir . _phi++-- | _Dir is provided to allow efficient implementations of functions+--   in particular vector-spaces, but should be used with care as it+--   exposes too much information.+_Dir :: Iso' (Direction v n) (v n)+_Dir = iso (\(Dir v) -> v) Dir++-- | @direction v@ is the direction in which @v@ points.  Returns an+--   unspecified value when given the zero vector as input.+direction :: v n -> Direction v n+direction = Dir++-- | Synonym for 'direction'.+dir :: v n -> Direction v n+dir = Dir++-- | @fromDirection d@ is the unit vector in the direction @d@.+fromDirection :: (Metric v, Floating n) => Direction v n -> v n+fromDirection (Dir v) = signorm v++-- | Synonym for 'fromDirection'.+fromDir :: (Metric v, Floating n) => Direction v n -> v n+fromDir (Dir v) = signorm v++-- | compute the positive angle between the two directions in their common plane+angleBetweenDirs :: (Metric v, Floating n, Ord n)+  => Direction v n -> Direction v n -> Angle n+angleBetweenDirs d1 d2 = angleBetween (fromDirection d1) (fromDirection d2)++-- | @dirBetween p q@ returns the direction from @p@ to @q@.+dirBetween :: (Additive v, Num n) => Point v n -> Point v n -> Direction v n+dirBetween p q = dir $ q .-. p

+ src/Diagrams/LinearMap.hs view

@@ -0,0 +1,175 @@+{-# LANGUAGE ConstraintKinds       #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE GADTs                 #-}+{-# LANGUAGE ImpredicativeTypes    #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes            #-}+{-# LANGUAGE TypeFamilies          #-}+{-# LANGUAGE TypeOperators         #-}+{-# LANGUAGE UndecidableInstances  #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Diagrams.LinearMap+-- Copyright   :  (c) 2014-2015 diagrams team (see LICENSE)+-- License     :  BSD-style (see LICENSE)+-- Maintainer  :  diagrams-discuss@googlegroups.com+--+-- Linear maps. Unlike 'Transformation's these are not restricted to the+-- same space. In practice these are used for projections in+-- "Diagrams.ThreeD.Projection". Unless you want to work with+-- projections you're probably better off using 'Diagrams.Transform'.+--+-- Currently only path-like things can be projected. In the future we+-- hope to support projecting diagrams.+--+-----------------------------------------------------------------------------++module Diagrams.LinearMap+  ( -- * Linear maps+    LinearMap (..)+  , LinearMappable (..)+    -- ** Applying linear maps+  , linmap++    -- * Affine maps+  , AffineMap (..)+  , AffineMappable (..)++    -- ** Constructing affine maps+  , mkAffineMap+  , toAffineMap+  ) where++import           Control.Lens+import           Data.FingerTree         as FT+import qualified Data.Foldable           as F++import           Diagrams.Core+import           Diagrams.Core.Transform+import           Diagrams.Located+import           Diagrams.Path+import           Diagrams.Segment+import           Diagrams.Trail          hiding (offset)++import           Linear.Affine+import           Linear.Metric+import           Linear.Vector+++-- | Type for holding linear maps. Note that these are not affine transforms so+--   attemping apply a translation with 'LinearMap' will likely produce incorrect+--   results.+newtype LinearMap v u n = LinearMap { lapply :: v n -> u n }++toLinearMap :: Transformation v n -> LinearMap v v n+toLinearMap (Transformation (m :-: _) _ _) = LinearMap m++-- | Class of things that have vectors that can be mapped over.+class LinearMappable a b where+  -- | Apply a linear map to an object. If the map is not linear,+  --   behaviour will likely be wrong.+  vmap :: (Vn a -> Vn b) -> a -> b+  -- this uses a function instead of LinearMap so we can also use this+  -- class to change number types++-- Note: instances need to be of the form+--+-- r ~ A u m => LinearMappable (A v n) r+--+-- so ghc knows there's only one possible result from calling vmap.++-- | Apply a linear map.+linmap :: (InSpace v n a, LinearMappable a b, N b ~ n)+     => LinearMap v (V b) n -> a -> b+linmap = vmap . lapply++instance r ~ Offset c u m => LinearMappable (Offset c v n) r where+  vmap f (OffsetClosed v) = OffsetClosed (f v)+  vmap _ OffsetOpen       = OffsetOpen+  {-# INLINE vmap #-}++instance r ~ Segment c u m => LinearMappable (Segment c v n) r where+  vmap f (Linear offset)      = Linear (vmap f offset)+  vmap f (Cubic v1 v2 offset) = Cubic (f v1) (f v2) (vmap f offset)+  {-# INLINE vmap #-}++instance (Metric v, Metric u, OrderedField n, OrderedField m, r ~ SegTree u m)+    => LinearMappable (SegTree v n) r where+  vmap f = over _Wrapped (fmap' (vmap f))+  {-# INLINE vmap #-}++instance (Metric v, Metric u, OrderedField n, OrderedField m, r ~ Trail' l u m)+    => LinearMappable (Trail' l v n) r where+  vmap f (Line st)        = Line (vmap f st)+  vmap f (Loop st offset) = Loop (vmap f st) (vmap f offset)+  {-# INLINE vmap #-}++instance (Metric v, Metric u, OrderedField n, OrderedField m, r ~ Trail u m)+    => LinearMappable (Trail v n) r where+  vmap f (Trail (Line st))        = Trail $ Line (vmap f st)+  vmap f (Trail (Loop st offset)) = Trail $ Loop (vmap f st) (vmap f offset)+  {-# INLINE vmap #-}++instance LinearMappable (Point v n) (Point u m) where+  vmap f (P v) = P (f v)+  {-# INLINE vmap #-}++instance r ~ FixedSegment u m => LinearMappable (FixedSegment v n) r where+  vmap f (FLinear p0 p1)      = FLinear (vmap f p0) (vmap f p1)+  vmap f (FCubic p0 p1 p2 p3) = FCubic (vmap f p0) (vmap f p1)+                                       (vmap f p2) (vmap f p3)+  {-# INLINE vmap #-}++instance (LinearMappable a b, r ~ Located b) => LinearMappable (Located a) r where+  vmap f (Loc p a) = Loc (vmap f p) (vmap f a)+  {-# INLINE vmap #-}++instance (Metric v, Metric u, OrderedField n, OrderedField m, r ~ Path u m)+    => LinearMappable (Path v n) r where+  vmap f = _Wrapped . mapped %~ vmap f+  {-# INLINE vmap #-}++-- | Affine linear maps. Unlike 'Transformation' these do not have to be+--   invertible so we can map between spaces.+data AffineMap v u n = AffineMap (LinearMap v u n) (u n)++-- | Make an affine map from a linear function and a translation.+mkAffineMap :: (v n -> u n) -> u n -> AffineMap v u n+mkAffineMap f = AffineMap (LinearMap f)++toAffineMap :: Transformation v n -> AffineMap v v n+toAffineMap t = AffineMap (toLinearMap t) (transl t)++class (LinearMappable a b, N a ~ N b) => AffineMappable a b where+  -- | Affine map over an object. Has a default implimentation of only+  --   applying the linear map+  amap :: (Additive (V a), F.Foldable (V a), Additive (V b), Num (N b))+       => AffineMap (V a) (V b) (N b) -> a -> b+  amap (AffineMap f _) = linmap f+  {-# INLINE amap #-}++instance r ~ Offset c u n => AffineMappable (Offset c v n) r+instance r ~ Segment c u n => AffineMappable (Segment c v n) r+instance (Metric v, Metric u, OrderedField n, r ~ SegTree u n) => AffineMappable (SegTree v n) r+instance (Metric v, Metric u, OrderedField n, r ~ Trail' l u n) => AffineMappable (Trail' l v n) r+instance (Metric v, Metric u, OrderedField n, r ~ Trail u n) => AffineMappable (Trail v n) r++instance (Additive v, Num n, r ~ Point u n) => AffineMappable (Point v n) r where+  amap (AffineMap f v) p = linmap f p .+^ v+  {-# INLINE amap #-}++instance r ~ FixedSegment u n => AffineMappable (FixedSegment v n) r where+  amap m (FLinear p0 p1)      = FLinear (amap m p0) (amap m p1)+  amap m (FCubic p0 p1 p2 p3) = FCubic (amap m p0) (amap m p1) (amap m p2) (amap m p3)+  {-# INLINE amap #-}++instance (LinearMappable a b, N a ~ N b, r ~ Located b) => AffineMappable (Located a) r where+  amap m@(AffineMap l _) (Loc p x) = Loc (amap m p) (linmap l x)+  {-# INLINE amap #-}++instance (Metric v, Metric u, OrderedField n, r ~ Path u n)+    => AffineMappable (Path v n) r where+  amap m = _Wrapped . mapped %~ amap m+  {-# INLINE amap #-}

src/Diagrams/Located.hs view

@@ -1,12 +1,15 @@-{-# LANGUAGE FlexibleContexts     #-}-{-# LANGUAGE StandaloneDeriving   #-}-{-# LANGUAGE TypeFamilies         #-}-{-# LANGUAGE UndecidableInstances #-}-+{-# LANGUAGE ConstraintKinds       #-}+{-# LANGUAGE DeriveGeneric         #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE StandaloneDeriving    #-}+{-# LANGUAGE TypeFamilies          #-}+{-# LANGUAGE TypeOperators         #-}+{-# LANGUAGE UndecidableInstances  #-} ----------------------------------------------------------------------------- -- | -- Module      :  Diagrams.Located--- Copyright   :  (c) 2013 diagrams-lib team (see LICENSE)+-- Copyright   :  (c) 2013-2015 diagrams-lib team (see LICENSE) -- License     :  BSD-style (see LICENSE) -- Maintainer  :  diagrams-discuss@googlegroups.com --@@ -19,20 +22,25 @@ -----------------------------------------------------------------------------  module Diagrams.Located-    ( Located-    , at, viewLoc, unLoc, loc, mapLoc+    ( Located (..)+    , at, viewLoc, mapLoc, located, _loc     )     where -import           Data.AffineSpace-import           Data.VectorSpace+import           Control.Lens            (Lens, Lens')+import           Text.Read +import           Linear.Affine+import           Linear.Vector++import           Diagrams.Align import           Diagrams.Core-import           Diagrams.Core.Points import           Diagrams.Core.Transform import           Diagrams.Parametric-  -- for GHC 7.4 type family bug +import           Data.Serialize          (Serialize)+import           GHC.Generics            (Generic)+ -- | \"Located\" things, /i.e./ things with a concrete location: --   intuitively, @Located a ~ (Point, a)@.  Wrapping a translationally --   invariant thing (/e.g./ a 'Segment' or 'Trail') in 'Located' pins@@ -48,27 +56,30 @@ --   'HasOrigin', 'Transformable', 'Enveloped', 'Traced', and --   'TrailLike' instances are particularly useful; see the documented --   instances below for more information.-data Located a = Loc { loc   :: Point (V a)   -- ^ Project out the-                                              --   location of a @Located@-                                              --   value.-                     , unLoc :: a             -- ^ Project the value-                                              --   of type @a@ out of-                                              --   a @Located a@,-                                              --   discarding the-                                              --   location.-                     }+data Located a =+  Loc { loc   :: Point (V a) (N a)  -- ^ Project out the+                                --   location of a @Located@+                                --   value.+      , unLoc :: a              -- ^ Project the value+                                --   of type @a@ out of+                                --   a @Located a@,+                                --   discarding the+                                --   location.+      } deriving (Generic) +instance (Serialize a, Serialize (V a (N a))) => Serialize (Located a)+ infix 5 `at`  -- | Construct a @Located a@ from a value of type @a@ and a location. --   @at@ is intended to be used infix, like @x \`at\` origin@.-at :: a -> Point (V a) -> Located a+at :: a -> Point (V a) (N a) -> Located a at a p = Loc p a  -- | Deconstruct a @Located a@ into a location and a value of type --   @a@.  @viewLoc@ can be especially useful in conjunction with the --   @ViewPatterns@ extension.-viewLoc :: Located a -> (Point (V a), a)+viewLoc :: Located a -> (Point (V a) (N a), a) viewLoc (Loc p a) = (p,a)  -- | 'Located' is not a @Functor@, since changing the type could@@ -81,28 +92,49 @@ --   @Located@ is a little-f (endo)functor on the category of types --   with associated vector space @v@; but that is not covered by the --   standard @Functor@ class.)-mapLoc :: (V a ~ V b) => (a -> b) -> Located a -> Located b+mapLoc :: SameSpace a b => (a -> b) -> Located a -> Located b mapLoc f (Loc p a) = Loc p (f a) -deriving instance (Eq   (V a), Eq a  ) => Eq   (Located a)-deriving instance (Ord  (V a), Ord a ) => Ord  (Located a)-deriving instance (Show (V a), Show a) => Show (Located a)+-- | A lens giving access to the object within a 'Located' wrapper.+located :: SameSpace a b => Lens (Located a) (Located b) a b+located f (Loc p a) = Loc p <$> f a +-- | Lens onto the location of something 'Located'.+_loc :: Lens' (Located a) (Point (V a) (N a))+_loc f (Loc p a) = flip Loc a <$> f p++deriving instance (Eq   (V a (N a)), Eq a  ) => Eq   (Located a)+deriving instance (Ord  (V a (N a)), Ord a ) => Ord  (Located a)++instance (Show (V a (N a)), Show a) => Show (Located a) where+  showsPrec d (Loc p a) = showParen (d > 5) $+    showsPrec 6 a . showString " `at` " . showsPrec 6 p++instance (Read (V a (N a)), Read a) => Read (Located a) where+  readPrec = parens . prec 5 $ do+    a <- readPrec+    Punc "`"   <- lexP+    Ident "at" <- lexP+    Punc "`"   <- lexP+    p <- readPrec+    return (Loc p a)+ type instance V (Located a) = V a+type instance N (Located a) = N a  -- | @Located a@ is an instance of @HasOrigin@ whether @a@ is or not. --   In particular, translating a @Located a@ simply translates the --   associated point (and does /not/ affect the value of type @a@).-instance VectorSpace (V a) => HasOrigin (Located a) where+instance (Num (N a), Additive (V a)) => HasOrigin (Located a) where   moveOriginTo o (Loc p a) = Loc (moveOriginTo o p) a  -- | Applying a transformation @t@ to a @Located a@ results in the --   transformation being applied to the location, and the /linear/ --   /portion/ of @t@ being applied to the value of type @a@ (/i.e./ --   it is not translated).-instance Transformable a => Transformable (Located a) where+instance (Additive (V a), Num (N a), Transformable a) => Transformable (Located a) where   transform t@(Transformation t1 t2 _) (Loc p a)-    = Loc (transform t p) (transform (Transformation t1 t2 zeroV) a)+    = Loc (transform t p) (transform (Transformation t1 t2 zero) a)  -- | The envelope of a @Located a@ is the envelope of the @a@, --   translated to the location.@@ -114,31 +146,38 @@  -- | The trace of a @Located a@ is the trace of the @a@, --   translated to the location.-instance Traced a => Traced (Located a) where+instance (Traced a, Num (N a)) => Traced (Located a) where   getTrace (Loc p a) = moveTo p (getTrace a) +instance Alignable a => Alignable (Located a) where+  defaultBoundary v = defaultBoundary v . unLoc+ instance Qualifiable a => Qualifiable (Located a) where-  n |> (Loc p a) = Loc p (n |> a)+  n .>> Loc p a = Loc p (n .>> a) -type instance Codomain (Located a) = Located (Codomain a)+type instance Codomain (Located a) = Point (Codomain a) -instance (V a ~ V (Codomain a), Parametric a) => Parametric (Located a) where-  (Loc x a) `atParam` p = Loc x (a `atParam` p)+instance (InSpace v n a, Parametric a, Codomain a ~ v)+    => Parametric (Located a) where+  Loc x a `atParam` p = x .+^ (a `atParam` p)  instance DomainBounds a => DomainBounds (Located a) where   domainLower (Loc _ a) = domainLower a   domainUpper (Loc _ a) = domainUpper a -instance (V a ~ V (Codomain a), EndValues a) => EndValues (Located a)+instance (InSpace v n a, EndValues a, Codomain a ~ v) => EndValues (Located a) -instance ( Codomain a ~ V a, Fractional (Scalar (V a)), AdditiveGroup (V a)-         , Sectionable a, Parametric a-         )+instance (InSpace v n a, Fractional n, Parametric a, Sectionable a, Codomain a ~ v)     => Sectionable (Located a) where   splitAtParam (Loc x a) p = (Loc x a1, Loc (x .+^ (a `atParam` p)) a2)     where (a1,a2) = splitAtParam a p -instance (HasArcLength a, Fractional (Scalar (V a)), V a ~ V (Codomain a))+  section (Loc x a) p1 p2 = Loc (x .+^ (a `atParam` p1)) (section a p1 p2)++  reverseDomain (Loc x a) = Loc (x .+^ y) (reverseDomain a)+    where y = a `atParam` domainUpper a++instance (InSpace v n a, Fractional n, HasArcLength a, Codomain a ~ v)     => HasArcLength (Located a) where-  arcLengthBounded eps (Loc _ a)   = arcLengthBounded eps a-  arcLengthToParam eps (Loc _ a) l = arcLengthToParam eps a l+  arcLengthBounded eps (Loc _ a) = arcLengthBounded eps a+  arcLengthToParam eps (Loc _ a) = arcLengthToParam eps a

src/Diagrams/Names.hs view

@@ -1,4 +1,10 @@+{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE MonoLocalBinds   #-}++{-# OPTIONS_GHC -fno-warn-unused-imports #-}+  -- for Data.Semigroup+ ----------------------------------------------------------------------------- -- | -- Module      :  Diagrams.Names@@ -33,28 +39,28 @@       -- * Querying by name      , names+    , lookupName     , withName, withNameAll, withNames      ) where  import           Data.Semigroup-import           Data.VectorSpace -import           Diagrams.Core       (HasLinearMap, OrderedField, Point)+import           Diagrams.Core       (OrderedField, Point) import           Diagrams.Core.Names import           Diagrams.Core.Types +import           Linear.Metric+ -- | Attach an atomic name to a diagram.-named :: ( IsName n-         , HasLinearMap v, InnerSpace v, OrderedField (Scalar v), Semigroup m)-      => n -> QDiagram b v m -> QDiagram b v m+named :: (IsName nm, Metric v, OrderedField n, Semigroup m)+      => nm -> QDiagram b v n m -> QDiagram b v n m named = nameSub mkSubdiagram  -- | Attach an atomic name to a certain point (which may be computed --   from the given diagram), treated as a subdiagram with no content --   and a point envelope.-namePoint :: ( IsName n-             , HasLinearMap v, InnerSpace v, OrderedField (Scalar v), Semigroup m)-          => (QDiagram b v m -> Point v) -> n -> QDiagram b v m -> QDiagram b v m+namePoint :: (IsName nm , Metric v, OrderedField n, Semigroup m)+          => (QDiagram b v n m -> Point v n) -> nm -> QDiagram b v n m -> QDiagram b v n m namePoint p = nameSub (subPoint . p)

src/Diagrams/Parametric.hs view

@@ -15,28 +15,20 @@ ----------------------------------------------------------------------------- module Diagrams.Parametric   (-  -- * Parametric functions     stdTolerance   , Codomain, Parametric(..) -  , DomainBounds(..), EndValues(..), Sectionable(..), HasArcLength(..)--  -- * Adjusting-  , adjust-  , AdjustOpts(..), AdjustMethod(..), AdjustSide(..)+  , DomainBounds(..), domainBounds, EndValues(..), Sectionable(..), HasArcLength(..)    ) where -import           Diagrams.Core-import           Diagrams.Util--import           Data.Default.Class-import           Data.VectorSpace-import qualified Numeric.Interval   as I+import           Data.Kind (Type)+import           Diagrams.Core.V+import qualified Numeric.Interval.Kaucher as I  -- | Codomain of parametric classes.  This is usually either @(V p)@, for relative --   vector results, or @(Point (V p))@, for functions with absolute coordinates.-type family Codomain p :: *+type family Codomain p :: Type -> Type  -- | Type class for parametric functions. class Parametric p where@@ -44,7 +36,7 @@   -- | 'atParam' yields a parameterized view of an object as a   --   continuous function. It is designed to be used infix, like @path   --   ``atParam`` 0.5@.-  atParam :: p -> Scalar (V p) -> Codomain p+  atParam :: p -> N p -> Codomain p (N p)  -- | Type class for parametric functions with a bounded domain.  The --   default bounds are @[0,1]@.@@ -55,16 +47,16 @@ class DomainBounds p where   -- | 'domainLower' defaults to being constantly 0 (for vector spaces with   --   numeric scalars).-  domainLower :: p -> Scalar (V p)+  domainLower :: p -> N p -  default domainLower :: Num (Scalar (V p)) => p -> Scalar (V p)+  default domainLower :: Num (N p) => p -> N p   domainLower = const 0    -- | 'domainUpper' defaults to being constantly 1 (for vector spaces   --   with numeric scalars).-  domainUpper :: p -> Scalar (V p)+  domainUpper :: p -> N p -  default domainUpper :: Num (Scalar (V p)) => p -> Scalar (V p)+  default domainUpper :: Num (N p) => p -> N p   domainUpper = const 1  -- | Type class for querying the values of a parametric object at the@@ -76,7 +68,7 @@   --   --   This is the default implementation, but some representations will   --   have a more efficient and/or precise implementation.-  atStart :: p -> Codomain p+  atStart :: p -> Codomain p (N p)   atStart x = x `atParam` domainLower x    -- | 'atEnd' is the value at the end of the domain. That is,@@ -85,28 +77,31 @@   --   --   This is the default implementation, but some representations will   --   have a more efficient and/or precise implementation.-  atEnd :: p -> Codomain p+  atEnd :: p -> Codomain p (N p)   atEnd x = x `atParam` domainUpper x  -- | Return the lower and upper bounds of a parametric domain together --   as a pair.-domainBounds :: DomainBounds p => p -> (Scalar (V p), Scalar (V p))+domainBounds :: DomainBounds p => p -> (N p, N p) domainBounds x = (domainLower x, domainUpper x)  -- | Type class for parametric objects which can be split into --   subobjects. -----   Minimal definition: Either 'splitAtParam' or 'section'.+--   Minimal definition: Either 'splitAtParam' or 'section',+--   plus 'reverseDomain'. class DomainBounds p => Sectionable p where   -- | 'splitAtParam' splits an object @p@ into two new objects   --   @(l,r)@ at the parameter @t@, where @l@ corresponds to the   --   portion of @p@ for parameter values from @0@ to @t@ and @r@ for   --   to that from @t@ to @1@.  The following property should hold:   ---  -- > prop_splitAtParam f t u =-  -- >   | u < t     = atParam f u == atParam l (u / t)-  -- >   | otherwise = atParam f u == atParam f t ??? atParam l ((u - t) / (domainUpper f - t))-  -- >   where (l,r) = splitAtParam f t+  -- @+  --   prop_splitAtParam f t u =+  --     | u < t     = atParam f u == atParam l (u / t)+  --     | otherwise = atParam f u == atParam f t ??? atParam l ((u - t) / (domainUpper f - t))+  --     where (l,r) = splitAtParam f t+  -- @   --   --   where @(???) = (^+^)@ if the codomain is a vector type, or   --   @const flip@ if the codomain is a point type.  Stated more@@ -119,7 +114,7 @@   --   result paths where the first is the original path extended to   --   the parameter 2, and the second result path travels /backwards/   --   from the end of the first to the end of the original path.-  splitAtParam :: p -> Scalar (V p) -> (p, p)+  splitAtParam :: p -> N p -> (p, p)   splitAtParam x t     = ( section x (domainLower x) t       , section x t (domainUpper x))@@ -135,16 +130,12 @@   --   --   That is, the section should have the same domain as the   --   original, and the reparameterization should be linear.-  section :: p -> Scalar (V p) -> Scalar (V p) -> p-  default section :: Fractional (Scalar (V p)) => p -> Scalar (V p) -> Scalar (V p) -> p+  section :: p -> N p -> N p -> p+  default section :: Fractional (N p) => p -> N p -> N p -> p   section x t1 t2 = snd (splitAtParam (fst (splitAtParam x t2)) (t1/t2)) -  -- | Flip the parameterization on the domain.  This has the-  --   following default definition:-  ---  -- > reverse x = section x (domainUpper x) (domainLower x)+  -- | Flip the parameterization on the domain.   reverseDomain :: p -> p-  reverseDomain x = section x (domainUpper x) (domainLower x)  -- | The standard tolerance used by @std...@ functions (like --   'stdArcLength' and 'stdArcLengthToParam', currently set at@@ -158,18 +149,18 @@   -- | @arcLengthBounded eps x@ approximates the arc length of @x@.   --   The true arc length is guaranteed to lie within the interval   --   returned, which will have a size of at most @eps@.-  arcLengthBounded :: Scalar (V p) -> p -> I.Interval (Scalar (V p))+  arcLengthBounded :: N p -> p -> I.Interval (N p)    -- | @arcLength eps s@ approximates the arc length of @x@ up to the   --   accuracy @eps@ (plus or minus).-  arcLength :: Scalar (V p) -> p -> Scalar (V p)-  default arcLength :: Fractional (Scalar (V p)) => Scalar (V p ) -> p -> Scalar (V p)+  arcLength :: N p -> p -> N p+  default arcLength :: Fractional (N p) => N p -> p -> N p   arcLength eps = I.midpoint . arcLengthBounded eps    -- | Approximate the arc length up to a standard accuracy of   --   'stdTolerance' (@1e-6@).-  stdArcLength :: p -> Scalar (V p)-  default stdArcLength :: Fractional (Scalar (V p)) => p -> Scalar (V p)+  stdArcLength :: p -> N p+  default stdArcLength :: Fractional (N p) => p -> N p   stdArcLength = arcLength stdTolerance    -- | @'arcLengthToParam' eps s l@ converts the absolute arc length@@ -179,65 +170,11 @@   --   --   This should work for /any/ arc length, and may return any   --   parameter value (not just parameters in the domain).-  arcLengthToParam :: Scalar (V p) -> p -> Scalar (V p) -> Scalar (V p)+  arcLengthToParam :: N p -> p -> N p -> N p    -- | A simple interface to convert arc length to a parameter,   --   guaranteed to be accurate within 'stdTolerance', or @1e-6@.-  stdArcLengthToParam :: p -> Scalar (V p) -> Scalar (V p)-  default stdArcLengthToParam :: Fractional (Scalar (V p))-                              => p -> Scalar (V p) -> Scalar (V p)+  stdArcLengthToParam :: p -> N p -> N p+  default stdArcLengthToParam :: Fractional (N p) => p -> N p -> N p   stdArcLengthToParam = arcLengthToParam stdTolerance ------------------------------------------------------  Adjusting length------------------------------------------------------- | What method should be used for adjusting a segment, trail, or---   path?-data AdjustMethod v = ByParam (Scalar v)     -- ^ Extend by the given parameter value-                                             --   (use a negative parameter to shrink)-                    | ByAbsolute (Scalar v)  -- ^ Extend by the given arc length-                                             --   (use a negative length to shrink)-                    | ToAbsolute (Scalar v)  -- ^ Extend or shrink to the given-                                             --   arc length---- | Which side of a segment, trail, or path should be adjusted?-data AdjustSide = Start  -- ^ Adjust only the beginning-                | End    -- ^ Adjust only the end-                | Both   -- ^ Adjust both sides equally-  deriving (Show, Read, Eq, Ord, Bounded, Enum)---- | How should a segment, trail, or path be adjusted?-data AdjustOpts v = AO { adjMethod       :: AdjustMethod v-                       , adjSide         :: AdjustSide-                       , adjEps          :: Scalar v-                       , adjOptsvProxy__ :: Proxy v-                       }--instance Fractional (Scalar v) => Default (AdjustMethod v) where-  def = ByParam 0.2--instance Default AdjustSide where-  def = Both--instance Fractional (Scalar v) => Default (AdjustOpts v) where-  def = AO def def stdTolerance Proxy---- | Adjust the length of a parametric object such as a segment or---   trail.  The second parameter is an option record which controls how---   the adjustment should be performed; see 'AdjustOpts'.-adjust :: (DomainBounds a, Sectionable a, HasArcLength a, Fractional (Scalar (V a)))-       => a -> AdjustOpts (V a) -> a-adjust s opts = section s-  (if adjSide opts == End   then domainLower s else getParam s)-  (if adjSide opts == Start then domainUpper s else domainUpper s - getParam (reverseDomain s))- where-  getParam seg = case adjMethod opts of-    ByParam p -> -p * bothCoef-    ByAbsolute len -> param (-len * bothCoef)-    ToAbsolute len -> param (absDelta len * bothCoef)-   where-    param        = arcLengthToParam eps seg-    absDelta len = arcLength eps s - len-  bothCoef = if adjSide opts == Both then 0.5 else 1-  eps = adjEps opts

+ src/Diagrams/Parametric/Adjust.hs view

@@ -0,0 +1,99 @@+{-# LANGUAGE FlexibleContexts     #-}+{-# LANGUAGE TemplateHaskell      #-}+{-# LANGUAGE TypeFamilies         #-}+{-# LANGUAGE TypeOperators        #-}+{-# LANGUAGE UndecidableInstances #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Diagrams.Parametric.Adjust+-- Copyright   :  (c) 2013 diagrams-lib team (see LICENSE)+-- License     :  BSD-style (see LICENSE)+-- Maintainer  :  diagrams-discuss@googlegroups.com+--+-- Tools for adjusting the length of parametric objects such as+-- segments and trails.+--+-----------------------------------------------------------------------------+module Diagrams.Parametric.Adjust+    ( adjust+    , AdjustOpts(_adjMethod, _adjSide, _adjEps)+    , adjMethod, adjSide, adjEps+    , AdjustMethod(..), AdjustSide(..)++    ) where++import           Control.Lens        (Lens', generateSignatures, lensRules, makeLensesWith, (&),+                                      (.~), (^.))+import           Data.Proxy++import           Data.Default++import           Diagrams.Core.V+import           Diagrams.Parametric++-- | What method should be used for adjusting a segment, trail, or+--   path?+data AdjustMethod n = ByParam n     -- ^ Extend by the given parameter value+                                    --   (use a negative parameter to shrink)+                    | ByAbsolute n  -- ^ Extend by the given arc length+                                    --   (use a negative length to shrink)+                    | ToAbsolute n  -- ^ Extend or shrink to the given+                                    --   arc length++-- | Which side of a segment, trail, or path should be adjusted?+data AdjustSide = Start  -- ^ Adjust only the beginning+                | End    -- ^ Adjust only the end+                | Both   -- ^ Adjust both sides equally+  deriving (Show, Read, Eq, Ord, Bounded, Enum)++-- | How should a segment, trail, or path be adjusted?+data AdjustOpts n = AO { _adjMethod    :: AdjustMethod n+                       , _adjSide      :: AdjustSide+                       , _adjEps       :: n+                       , adjOptsvProxy :: Proxy n+                       }++-- See Diagrams.Combinators for reasoning behind 'Proxy'.++makeLensesWith (lensRules & generateSignatures .~ False) ''AdjustOpts++-- | Which method should be used for adjusting?+adjMethod :: Lens' (AdjustOpts n) (AdjustMethod n)++-- | Which end(s) of the object should be adjusted?+adjSide :: Lens' (AdjustOpts n) AdjustSide++-- | Tolerance to use when doing adjustment.+adjEps :: Lens' (AdjustOpts n) n++instance Fractional n => Default (AdjustMethod n) where+  def = ByParam 0.2++instance Default AdjustSide where+  def = Both++instance Fractional n => Default (AdjustOpts n) where+  def = AO { _adjMethod    = def+           , _adjSide      = def+           , _adjEps       = stdTolerance+           , adjOptsvProxy = Proxy+           }++-- | Adjust the length of a parametric object such as a segment or+--   trail.  The second parameter is an option record which controls how+--   the adjustment should be performed; see 'AdjustOpts'.+adjust :: (N t ~ n, Sectionable t, HasArcLength t, Fractional n)+       => t -> AdjustOpts n -> t+adjust s opts = section s+  (if opts^.adjSide == End   then domainLower s else getParam s)+  (if opts^.adjSide == Start then domainUpper s else domainUpper s - getParam (reverseDomain s))+ where+  getParam seg = case opts^.adjMethod of+    ByParam p -> -p * bothCoef+    ByAbsolute len -> param (-len * bothCoef)+    ToAbsolute len -> param (absDelta len * bothCoef)+   where+    param        = arcLengthToParam eps seg+    absDelta len = arcLength eps s - len+  bothCoef = if opts^.adjSide == Both then 0.5 else 1+  eps = opts^.adjEps

src/Diagrams/Path.hs view

@@ -1,4 +1,6 @@-{-# LANGUAGE DeriveFunctor              #-}+{-# LANGUAGE ConstraintKinds            #-}+{-# LANGUAGE DeriveDataTypeable         #-}+{-# LANGUAGE DeriveGeneric              #-} {-# LANGUAGE FlexibleContexts           #-} {-# LANGUAGE FlexibleInstances          #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}@@ -6,8 +8,13 @@ {-# LANGUAGE ScopedTypeVariables        #-} {-# LANGUAGE StandaloneDeriving         #-} {-# LANGUAGE TypeFamilies               #-}+{-# LANGUAGE TypeOperators              #-} {-# LANGUAGE UndecidableInstances       #-} {-# LANGUAGE ViewPatterns               #-}++{-# OPTIONS_GHC -fno-warn-unused-imports #-}+  -- for Data.Semigroup+ ----------------------------------------------------------------------------- -- | -- Module      :  Diagrams.Path@@ -28,21 +35,24 @@           -- * Paths -         Path(..)+         Path(..), pathTrails           -- * Constructing paths          -- $construct +       , ToPath (..)        , pathFromTrail        , pathFromTrailAt        , pathFromLocTrail           -- * Eliminating paths +       , pathPoints+       , pathVertices'        , pathVertices        , pathOffsets        , pathCentroid-       , fixPath+       , pathLocSegments, fixPath           -- * Modifying paths @@ -56,9 +66,15 @@         ) where +import           Control.Arrow      ((***))+import           Control.Lens       hiding (at, transform, ( # ))+import qualified Data.Foldable      as F+import           Data.List          (partition)+import           Data.Semigroup+import           Data.Typeable+ import           Diagrams.Align import           Diagrams.Core-import           Diagrams.Core.Points import           Diagrams.Located import           Diagrams.Points import           Diagrams.Segment@@ -66,14 +82,12 @@ import           Diagrams.TrailLike import           Diagrams.Transform -import           Control.Arrow        (first, second, (***))-import           Control.Newtype      hiding (under)-import           Data.AffineSpace-import qualified Data.Foldable        as F-import           Data.List            (mapAccumL, partition)-import           Data.Semigroup-import           Data.VectorSpace+import           Linear.Metric+import           Linear.Vector +import           Data.Serialize     (Serialize)+import           GHC.Generics       (Generic)+ ------------------------------------------------------------ --  Paths  ------------------------------------------------- ------------------------------------------------------------@@ -82,81 +96,136 @@ --   Hence, unlike trails, paths are not translationally invariant, --   and they form a monoid under /superposition/ (placing one path on --   top of another) rather than concatenation.-newtype Path v = Path { pathTrails :: [Located (Trail v)] }-  deriving (Semigroup, Monoid)+newtype Path v n = Path [Located (Trail v n)]+  deriving (Semigroup, Monoid, Generic+  , Typeable+  ) -deriving instance Show v => Show (Path v)-deriving instance Eq   v => Eq   (Path v)-deriving instance Ord  v => Ord  (Path v)+-- instance (OrderedField n, Metric v, Serialize (v n), Serialize (V n (N n))) =>+instance (OrderedField n, Metric v, Serialize (v n), Serialize (V (v n) (N (v n)))) =>+  Serialize (Path v n) -type instance V (Path v) = v+instance Wrapped (Path v n) where+  type Unwrapped (Path v n) = [Located (Trail v n)]+  _Wrapped' = iso (\(Path x) -> x) Path -instance Newtype (Path v) [Located (Trail v)] where-  pack   = Path-  unpack = pathTrails+instance Rewrapped (Path v n) (Path v' n') -instance VectorSpace v => HasOrigin (Path v) where-  moveOriginTo = over Path . map . moveOriginTo+instance Each (Path v n) (Path v' n') (Located (Trail v n)) (Located (Trail v' n')) where+  each = _Wrapped . traverse --- | Paths are trail-like; a trail can be used to construct a---   singleton path.-instance (InnerSpace v, OrderedField (Scalar v)) => TrailLike (Path v) where-  trailLike = Path . (:[])+instance AsEmpty (Path v n) where+  _Empty = _Wrapped' . _Empty --- See Note [Transforming paths]-instance (HasLinearMap v, InnerSpace v, OrderedField (Scalar v))-    => Transformable (Path v) where-  transform = over Path . map . transform+instance Cons (Path v n) (Path v' n') (Located (Trail v n)) (Located (Trail v' n')) where+  _Cons = _Wrapped . _Cons . bimapping id _Unwrapped+  {-# INLINE _Cons #-} -{- ~~~~ Note [Transforming paths]+instance Snoc (Path v n) (Path v' n') (Located (Trail v n)) (Located (Trail v' n')) where+  _Snoc = _Wrapped . _Snoc . bimapping _Unwrapped id+  {-# INLINE _Snoc #-} -Careful!  It's tempting to just define+-- | Extract the located trails making up a 'Path'.+pathTrails :: Path v n -> [Located (Trail v n)]+pathTrails = op Path -> transform = fmap . transform+deriving instance Show (v n) => Show (Path v n)+deriving instance Eq   (v n) => Eq   (Path v n)+deriving instance Ord  (v n) => Ord  (Path v n) -but that doesn't take into account the fact that some-of the v's are inside Points and hence ought to be translated.--}+type instance V (Path v n) = v+type instance N (Path v n) = n -instance (HasLinearMap v, InnerSpace v, OrderedField (Scalar v)) => IsPrim (Path v)+instance (Additive v, Num n) => HasOrigin (Path v n) where+  moveOriginTo = over _Wrapped' . map . moveOriginTo -instance (InnerSpace v, OrderedField (Scalar v)) => Enveloped (Path v) where-  getEnvelope = F.foldMap trailEnvelope . pathTrails+-- | Paths are trail-like; a trail can be used to construct a+--   singleton path.+instance (Metric v, OrderedField n) => TrailLike (Path v n) where+  trailLike = Path . (:[])++-- See Note [Transforming paths]+instance (HasLinearMap v, Metric v, OrderedField n)+    => Transformable (Path v n) where+  transform = over _Wrapped . map . transform++instance (Metric v, OrderedField n) => Enveloped (Path v n) where+  getEnvelope = F.foldMap trailEnvelope . op Path           -- this type signature is necessary to work around an apparent bug in ghc 6.12.1-    where trailEnvelope :: Located (Trail v) -> Envelope v+    where trailEnvelope :: Located (Trail v n) -> Envelope v n           trailEnvelope (viewLoc -> (p, t)) = moveOriginTo ((-1) *. p) (getEnvelope t) -instance (InnerSpace v, OrderedField (Scalar v)) => Juxtaposable (Path v) where+instance (Metric v, OrderedField n) => Juxtaposable (Path v n) where   juxtapose = juxtaposeDefault -instance (InnerSpace v, OrderedField (Scalar v)) => Alignable (Path v) where-  alignBy = alignByDefault+instance (Metric v, OrderedField n) => Alignable (Path v n) where+  defaultBoundary = envelopeBoundary -instance (HasLinearMap v, InnerSpace v, OrderedField (Scalar v))-    => Renderable (Path v) NullBackend where+instance (HasLinearMap v, Metric v, OrderedField n)+    => Renderable (Path v n) NullBackend where   render _ _ = mempty  ------------------------------------------------------------ --  Constructing paths  ------------------------------------ ------------------------------------------------------------ +-- | Type class for things that can be converted to a 'Path'.+--+--   Note that this class is very different from 'TrailLike'. 'TrailLike' is+--   usually the result of a library function to give you a convenient,+--   polymorphic result ('Path', 'Diagram' etc.).+--+class ToPath t where+  -- | 'toPath' takes something that can be converted to 'Path' and returns+  --    the 'Path'.+  toPath :: (Metric (V t), OrderedField (N t)) => t -> Path (V t) (N t)++instance ToPath (Path v n) where+  toPath = id++instance ToPath (Trail v n) where+  toPath = pathFromTrail++instance ToPath (Trail' l v n) where+  toPath t = Path [Trail t `at` origin]++instance ToPath (Located (Trail v n)) where+  toPath = pathFromLocTrail++instance ToPath (Located (Trail' l v n)) where+  toPath = pathFromLocTrail . mapLoc Trail++instance ToPath (Located (Segment Closed v n)) where+  toPath (viewLoc -> (p,seg))+    = Path [trailFromSegments [seg] `at` p]++instance ToPath (Located [Segment Closed v n]) where+  toPath (viewLoc -> (p,segs))+    = Path [trailFromSegments segs `at` p]++instance ToPath (FixedSegment v n) where+  toPath = toPath . fromFixedSeg++instance ToPath a => ToPath [a] where+  toPath = F.foldMap toPath+ -- $construct -- Since paths are 'TrailLike', any function producing a 'TrailLike' -- can be used to construct a (singleton) path.  The functions in this -- section are provided for convenience.  -- | Convert a trail to a path beginning at the origin.-pathFromTrail :: (InnerSpace v, OrderedField (Scalar v)) => Trail v -> Path v+pathFromTrail :: (Metric v, OrderedField n) => Trail v n -> Path v n pathFromTrail = trailLike . (`at` origin)  -- | Convert a trail to a path with a particular starting point.-pathFromTrailAt :: (InnerSpace v, OrderedField (Scalar v)) => Trail v -> Point v -> Path v+pathFromTrailAt :: (Metric v, OrderedField n) => Trail v n -> Point v n -> Path v n pathFromTrailAt t p = trailLike (t `at` p)  -- | Convert a located trail to a singleton path.  This is equivalent --   to 'trailLike', but provided with a more specific name and type --   for convenience.-pathFromLocTrail :: (InnerSpace v, OrderedField (Scalar v)) => Located (Trail v) -> Path v+pathFromLocTrail :: (Metric v, OrderedField n) => Located (Trail v n) -> Path v n pathFromLocTrail = trailLike  ------------------------------------------------------------@@ -164,33 +233,65 @@ ------------------------------------------------------------  -- | Extract the vertices of a path, resulting in a separate list of---   vertices for each component trail (see 'trailVertices').-pathVertices :: (InnerSpace v, OrderedField (Scalar v)) => Path v -> [[Point v]]-pathVertices = map trailVertices . pathTrails+--   vertices for each component trail.  Here a /vertex/ is defined as+--   a non-differentiable point on the trail, /i.e./ a sharp corner.+--   (Vertices are thus a subset of the places where segments join; if+--   you want all joins between segments, see 'pathPoints'.)  The+--   tolerance determines how close the tangents of two segments must be+--   at their endpoints to consider the transition point to be+--   differentiable.  See 'trailVertices' for more information.+pathVertices' :: (Metric v, OrderedField n) => n -> Path v n -> [[Point v n]]+pathVertices' toler = map (trailVertices' toler) . op Path +-- | Like 'pathVertices'', with a default tolerance.+pathVertices :: (Metric v, OrderedField n) => Path v n -> [[Point v n]]+pathVertices = map trailVertices . op Path++-- | Extract the points of a path, resulting in a separate list of+--   points for each component trail.  Here a /point/ is any place+--   where two segments join; see also 'pathVertices' and 'trailPoints'.+--+--   This function allows you "observe" the fact that trails are+--   implemented as lists of segments, which may be problematic if we+--   want to think of trails as parametric vector functions. This also+--   means that the behavior of this function may not be stable under+--   future changes to the implementation of trails and paths.  For an+--   unproblematic version which only yields vertices at which there+--   is a sharp corner, excluding points differentiable points, see+--   'pathVertices'.+--+--   This function is not re-exported from "Diagrams.Prelude"; to use+--   it, import "Diagrams.Path".+pathPoints :: (Metric v, OrderedField n) => Path v n -> [[Point v n]]+pathPoints = map trailPoints . op Path+ -- | Compute the total offset of each trail comprising a path (see 'trailOffset').-pathOffsets :: (InnerSpace v, OrderedField (Scalar v)) => Path v -> [v]-pathOffsets = map (trailOffset . unLoc) . pathTrails+pathOffsets :: (Metric v, OrderedField n) => Path v n -> [v n]+pathOffsets = map (trailOffset . unLoc) . op Path  -- | Compute the /centroid/ of a path (/i.e./ the average location of---   its vertices).-pathCentroid :: (InnerSpace v, OrderedField (Scalar v)) => Path v -> Point v+--   its /vertices/; see 'pathVertices').+pathCentroid :: (Metric v, OrderedField n) => Path v n -> Point v n pathCentroid = centroid . concat . pathVertices +-- | Convert a path into a list of lists of located segments.+pathLocSegments :: (Metric v, OrderedField n) => Path v n -> [[Located (Segment Closed v n)]]+pathLocSegments = map trailLocSegments . op Path+ -- | Convert a path into a list of lists of 'FixedSegment's.-fixPath :: (InnerSpace v, OrderedField (Scalar v)) => Path v -> [[FixedSegment v]]-fixPath = map fixTrail . unpack+fixPath :: (Metric v, OrderedField n) => Path v n -> [[FixedSegment v n]]+fixPath = map fixTrail . op Path  -- | \"Explode\" a path by exploding every component trail (see --   'explodeTrail').-explodePath :: (VectorSpace (V t), TrailLike t) => Path (V t) -> [[t]]-explodePath = map explodeTrail . pathTrails+explodePath :: (V t ~ v, N t ~ n, TrailLike t) => Path v n -> [[t]]+explodePath = map explodeTrail . op Path  -- | Partition a path into two paths based on a predicate on trails: --   the first containing all the trails for which the predicate returns --   @True@, and the second containing the remaining trails.-partitionPath :: (Located (Trail v) -> Bool) -> Path v -> (Path v, Path v)-partitionPath p = (pack *** pack) . partition p . unpack+partitionPath :: (Located (Trail v n) -> Bool) -> Path v n -> (Path v n, Path v n)+partitionPath p = (view _Unwrapped' *** view _Unwrapped') . partition p . op Path  ------------------------------------------------------------ --  Modifying paths  ---------------------------------------@@ -198,10 +299,13 @@  -- | Scale a path using its centroid (see 'pathCentroid') as the base --   point for the scale.-scalePath :: (HasLinearMap v, InnerSpace v, OrderedField (Scalar v))-          => Scalar v -> Path v -> Path v-scalePath d p = (scale d `under` translation (origin .-. pathCentroid p)) p+scalePath :: (HasLinearMap v, Metric v, OrderedField n) => n -> Path v n -> Path v n+scalePath d p = under (movedFrom (pathCentroid p)) (scale d) p  -- | Reverse all the component trails of a path.-reversePath :: (InnerSpace v, OrderedField (Scalar v)) => Path v -> Path v-reversePath = (over Path . map) reverseLocTrail+reversePath :: (Metric v, OrderedField n) => Path v n -> Path v n+reversePath = _Wrapped . mapped %~ reverseLocTrail++-- | Same as 'reversePath'.+instance (Metric v, OrderedField n) => Reversing (Path v n) where+  reversing = _Wrapped' . mapped %~ reversing

src/Diagrams/Points.hs view

@@ -1,6 +1,3 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE TypeFamilies     #-}- ----------------------------------------------------------------------------- -- | -- Module      :  Diagrams.Points@@ -9,36 +6,36 @@ -- Maintainer  :  diagrams-discuss@googlegroups.com -- -- Points in space.  For more tools for working with points and--- vectors, see "Data.AffineSpace" and "Diagrams.Coordinates".+-- vectors, see "Linear.Affine". -- -----------------------------------------------------------------------------  module Diagrams.Points        ( -- * Points-         Point, origin, (*.)+         Point (..), origin, (*.)           -- * Point-related utilities        , centroid-+       , pointDiagram+       , _Point, lensP        ) where -import           Diagrams.Coordinates+import           Diagrams.Core        (pointDiagram) import           Diagrams.Core.Points -import           Control.Newtype--import           Control.Arrow        ((&&&))+import           Data.Foldable        as F -import           Data.VectorSpace+import           Linear.Affine+import           Linear.Vector  -- | 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+--   Returns the origin for an empty list of points.+centroid :: (Additive v, Fractional n) => [Point v n] -> Point v n+centroid [] = origin+centroid ps = meanV ps+{-# INLINE centroid #-} -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+meanV :: (Foldable f, Additive v, Fractional a) => f (v a) -> v a+meanV = uncurry (^/) . F.foldl' (\(s,c) e -> (e ^+^ s,c+1)) (zero,0)+{-# INLINE meanV #-} -  x & y        = P (x & y)-  coords (P v) = coords v

src/Diagrams/Prelude.hs view

@@ -1,8 +1,9 @@ {-# OPTIONS_GHC -fno-warn-duplicate-exports #-}+{-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- | -- Module      :  Diagrams.Prelude--- Copyright   :  (c) 2011 diagrams-lib team (see LICENSE)+-- Copyright   :  (c) 2011-2015 diagrams-lib team (see LICENSE) -- License     :  BSD-style (see LICENSE) -- Maintainer  :  diagrams-discuss@googlegroups.com --@@ -12,129 +13,93 @@ -----------------------------------------------------------------------------  module Diagrams.Prelude-       (-         -- * Core library-         -- | The core definitions of transformations, diagrams,-         --   backends, and so on.-         module Diagrams.Core--         -- * Standard library--         -- | Attributes (color, line style, etc.) and styles.-       , module Diagrams.Attributes--         -- | Alignment of diagrams relative to their envelopes.-       , module Diagrams.Align--         -- | Combining multiple diagrams into one.-       , module Diagrams.Combinators--         -- | Giving concrete locations to translation-invariant things.-       , module Diagrams.Located--         -- | Linear and cubic bezier segments.-       , module Diagrams.Segment--         -- | Trails.-       , module Diagrams.Trail--         -- | Parametrization of segments and trails.-       , module Diagrams.Parametric--         -- | Trail-like things.-       , module Diagrams.TrailLike--         -- | Paths.-       , module Diagrams.Path--         -- | Cubic splines.-       , module Diagrams.CubicSpline+  (+    -- * Diagrams library+    -- | Exports from this library for working with diagrams.+    module Diagrams -         -- | Some additional transformation-related functions, like-         --   conjugation of transformations.-       , module Diagrams.Transform+    -- * Convenience re-exports from other packages -         -- | Convenient definitions and utilities for working with-         --   good old-fashioned, axis-aligned bounding boxes.-       , module Diagrams.BoundingBox+    -- | For working with default values. Diagrams also exports 'with',+    --   an alias for 'def'.+  , module Data.Default -         -- | Giving names to subdiagrams and later retrieving-         --   subdiagrams by name.-       , module Diagrams.Names+    -- | For representing and operating on colors.+  , module Data.Colour -         -- | Envelopes, aka functional bounding regions.-       , module Diagrams.Envelope+    -- | A large list of color names.+  , module Data.Colour.Names -         -- | Traces, aka embedded raytracers, for finding points on-         --   the boundary of a diagram.-       , module Diagrams.Trace+    -- | Specify your own colours.+  , module Data.Colour.SRGB -         -- | A query is a function that maps points in a vector space-         --   to values in some monoid; they can be used to annotate-         --   the points of a diagram with some values.-       , module Diagrams.Query+    -- | Semigroups and monoids show up all over the place, so things from+    --   Data.Semigroup and Data.Monoid often come in handy.+  , module Data.Semigroup -         -- | Utilities for working with points.-       , module Diagrams.Points+    -- | For computing with vectors.+  , module Linear.Vector -         -- | A wide range of things (shapes, transformations,-         --   combinators) specific to creating two-dimensional-         --   diagrams.-       , module Diagrams.TwoD+    -- | For computing with points and vectors.+  , module Linear.Affine -         -- | Tools for making animations.-       , module Diagrams.Animation+    -- | For computing with dot products and norm.+  , module Linear.Metric -         -- | Various utility definitions.-       , module Diagrams.Util+    -- | For working with 'Active' (i.e. animated) things.+  , module Data.Active -         -- * 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-         --   Data.Semigroup and Data.Monoid often come in handy.-       , module Data.Semigroup-         -- | For computing with vectors.-       , module Data.VectorSpace-         -- | For computing with points and vectors.-       , module Data.AffineSpace+    -- | Most of the lens package. The following functions are not+    --   exported from lens because they either conflict with+    --   diagrams or may conflict with other libraries:+    --+    --   * 'Control.Lens.At.at'+    --   * 'Control.Lens.At.contains'+    --   * 'Control.Lens.Indexed..>'+    --   * 'Control.Lens.Indexed.<.>'+    --   * 'Control.Lens.Indexed.index'+    --   * 'Control.Lens.Indexed.indices'+    --   * 'Control.Lens.Indexed.none'+    --   * 'Control.Lens.Internal.Getter.coerce'+    --   * 'Control.Lens.Internal.Indexed.indexed'+    --   * 'Control.Lens.Lens.inside'+    --   * 'Control.Lens.Level.levels'+    --   * 'Control.Lens.Plated....'+    --   * 'Control.Lens.Plated.children'+    --   * 'Control.Lens.Plated.transform'+    --   * 'Control.Lens.Prism.outside'+    --   * 'Control.Lens.Setter.argument'+    --   * 'Control.Lens.Traversal.beside'+    --   * 'Control.Lens.Traversal.singular'+  , module Control.Lens -         -- | For working with 'Active' (i.e. animated) things.-       , module Data.Active+  , Applicative(..), (*>), (<*), (<$>), (<$), liftA, liftA2, liftA3+  ) where -       , Applicative(..), (*>), (<*), (<$>), (<$), liftA, liftA2, liftA3-       ) where+import           Diagrams -import           Diagrams.Core+import           Control.Applicative -import           Diagrams.Align-import           Diagrams.Animation-import           Diagrams.Attributes-import           Diagrams.BoundingBox-import           Diagrams.Combinators-import           Diagrams.Coordinates-import           Diagrams.CubicSpline-import           Diagrams.Envelope-import           Diagrams.Located-import           Diagrams.Names-import           Diagrams.Parametric-import           Diagrams.Path-import           Diagrams.Points-import           Diagrams.Query-import           Diagrams.Segment-import           Diagrams.Trace-import           Diagrams.Trail-import           Diagrams.TrailLike-import           Diagrams.Transform-import           Diagrams.TwoD-import           Diagrams.Util+#if MIN_VERSION_lens(4,13,0)+import           Control.Lens        hiding (argument, at, backwards, beside,+                                      children, contains, indexed, indices,+                                      inside, levels, none, outside, singular,+                                      transform, ( # ), (...), (.>), (<.>))+#else+import           Control.Lens        hiding (argument, at, backwards, beside,+                                      children, coerce, contains, indexed,+                                      indices, inside, levels, none, outside,+                                      singular, transform, ( # ), (...), (.>),+                                      (<.>))+#endif -import           Control.Applicative import           Data.Active-import           Data.AffineSpace-import           Data.Colour          hiding (AffineSpace (..), atop)-import           Data.Colour.Names+import           Data.Colour         hiding (AffineSpace (..), atop, over)+import           Data.Colour.Names   hiding (tan)+import           Data.Colour.SRGB+import           Data.Default import           Data.Semigroup-import           Data.VectorSpace     hiding (Sum (..))++import           Linear.Affine+import           Linear.Metric+import           Linear.Vector

src/Diagrams/Query.hs view

@@ -1,3 +1,7 @@+{-# LANGUAGE FlexibleContexts       #-}+{-# LANGUAGE FlexibleInstances      #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE MultiParamTypeClasses  #-} ----------------------------------------------------------------------------- -- | -- Module      :  Diagrams.Query@@ -12,8 +16,78 @@ -----------------------------------------------------------------------------  module Diagrams.Query-    ( Query(..), query, sample, value, resetValue, clearValue+  ( -- * Queries+    Query(..)+  , HasQuery (..)+  , sample+  , inquire -    ) where+    -- ** Queries on diagrams+  , query+  , value+  , resetValue+  , clearValue+  ) where +import           Data.Monoid+ import           Diagrams.Core++-- | Types which can answer a 'Query' about points inside the geometric+--   object.+--+--   If @t@ and @m@ are both a 'Semigroup's, 'getQuery' should satisfy+--+-- @+-- 'getQuery' (t1 <> t2) = 'getQuery' t1 <> 'getQuery' t2+-- @+class HasQuery t m | t -> m where+  -- | Extract the query of an object.+  getQuery :: t -> Query (V t) (N t) m++instance HasQuery (Query v n m) m where+  getQuery = id++instance Monoid m => HasQuery (QDiagram b v n m) m where+  getQuery = query++-- | Test if a point is not equal to 'mempty'.+--+-- @+-- 'inquire' :: 'QDiagram' b v n 'Any' -> 'Point' v n -> 'Bool'+-- 'inquire' :: 'Query' v n 'Any'      -> 'Point' v n -> 'Bool'+-- 'inquire' :: 'Diagrams.BoundingBox.BoundingBox' v n  -> 'Point' v n -> 'Bool'+-- @+inquire :: HasQuery t Any => t -> Point (V t) (N t) -> Bool+inquire t = getAny . sample t++-- | Sample a diagram's query function at a given point.+--+-- @+-- 'sample' :: 'QDiagram' b v n m -> 'Point' v n -> m+-- 'sample' :: 'Query' v n m      -> 'Point' v n -> m+-- 'sample' :: 'Diagrams.BoundingBox.BoundingBox' v n  -> 'Point' v n -> 'Any'+-- 'sample' :: 'Diagrams.Path.Path' 'V2' 'Double'   -> 'Point' v n -> 'Diagrams.TwoD.Path.Crossings'+-- @+sample :: HasQuery t m => t -> Point (V t) (N t) -> m+sample = runQuery . getQuery++-- | Set the query value for 'True' points in a diagram (/i.e./ points+--   \"inquire\" the diagram); 'False' points will be set to 'mempty'.+value :: Monoid m => m -> QDiagram b v n Any -> QDiagram b v n m+value m = fmap fromAny+  where fromAny (Any True)  = m+        fromAny (Any False) = mempty++-- | Reset the query values of a diagram to @True@/@False@: any values+--   equal to 'mempty' are set to 'False'; any other values are set to+--   'True'.+resetValue :: (Eq m, Monoid m) => QDiagram b v n m -> QDiagram b v n Any+resetValue = fmap toAny+  where toAny m | m == mempty = Any False+                | otherwise   = Any True++-- | Set all the query values of a diagram to 'False'.+clearValue :: QDiagram b v n m -> QDiagram b v n Any+clearValue = fmap (const (Any False))+

src/Diagrams/Segment.hs view

@@ -1,3 +1,5 @@+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE BangPatterns               #-} {-# LANGUAGE DeriveFunctor              #-} {-# LANGUAGE EmptyDataDecls             #-} {-# LANGUAGE FlexibleContexts           #-}@@ -6,10 +8,10 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses      #-} {-# LANGUAGE StandaloneDeriving         #-}+{-# LANGUAGE TemplateHaskell            #-} {-# LANGUAGE TypeFamilies               #-} {-# LANGUAGE TypeOperators              #-} {-# LANGUAGE UndecidableInstances       #-}-{-# LANGUAGE ViewPatterns               #-}  ----------------------------------------------------------------------------- -- |@@ -40,43 +42,50 @@           -- * Segment offsets -       , Offset(..), segOffset+       , Offset(..) , segOffset           -- * Constructing and modifying segments -       , Segment(..), straight, bezier3, bézier3, reverseSegment+       , Segment(..), straight, bezier3, bézier3, reverseSegment, mapSegmentVectors+       , openLinear, openCubic           -- * Fixed (absolutely located) segments        , FixedSegment(..)        , mkFixedSeg, fromFixedSeg+       , fixedSegIso           -- * Segment measures          -- $segmeas         , SegCount(..)-       , ArcLength(..), getArcLengthCached, getArcLengthFun, getArcLengthBounded+       , ArcLength(..)+       , getArcLengthCached, getArcLengthFun, getArcLengthBounded        , TotalOffset(..)-       , OffsetEnvelope(..)+       , OffsetEnvelope(..), oeOffset, oeEnvelope        , SegMeasure         ) where -import           Control.Applicative (liftA2)-import           Data.AffineSpace-import           Data.Default.Class+import           Control.Lens              hiding (at, transform) import           Data.FingerTree import           Data.Monoid.MList import           Data.Semigroup-import           Data.VectorSpace    hiding (Sum (..))-import           Numeric.Interval    (Interval (..))-import qualified Numeric.Interval    as I+import           Numeric.Interval.Kaucher  (Interval (..))+import qualified Numeric.Interval.Kaucher  as I -import           Diagrams.Core+import           Linear.Affine+import           Linear.Metric+import           Linear.Vector             hiding (lerp)+import           Linear.Vector.Compat      (lerp)++import           Control.Applicative+import           Diagrams.Core             hiding (Measured) import           Diagrams.Located import           Diagrams.Parametric-import           Diagrams.Solve-import           Diagrams.Util+import           Diagrams.Solve.Polynomial +import           Data.Serialize            (Serialize)+import qualified Data.Serialize            as Serialize  ------------------------------------------------------------ --  Open/closed type tags  ---------------------------------@@ -100,23 +109,35 @@ --   the context, /i.e./ its endpoint is not fixed.  The offset for a --   /closed/ segment is stored explicitly, /i.e./ its endpoint is at --   a fixed offset from its start.-data Offset c v where-  OffsetOpen   :: Offset Open v-  OffsetClosed :: v -> Offset Closed v+data Offset c v n where+  OffsetOpen   :: Offset Open v n+  OffsetClosed :: v n -> Offset Closed v n -deriving instance Show v => Show (Offset c v)-deriving instance Eq   v => Eq   (Offset c v)-deriving instance Ord  v => Ord  (Offset c v)+deriving instance Show (v n) => Show (Offset c v n)+deriving instance Eq   (v n) => Eq   (Offset c v n)+deriving instance Ord  (v n) => Ord  (Offset c v n) -instance Functor (Offset c) where+instance Functor v => Functor (Offset c v) where   fmap _ OffsetOpen       = OffsetOpen-  fmap f (OffsetClosed v) = OffsetClosed (f v)+  fmap f (OffsetClosed v) = OffsetClosed (fmap f v) -type instance V (Offset c v) = v+instance Each (Offset c v n) (Offset c v' n') (v n) (v' n') where+  each f (OffsetClosed v) = OffsetClosed <$> f v+  each _ OffsetOpen       = pure OffsetOpen+  {-# INLINE each #-} -instance HasLinearMap v => Transformable (Offset c v) where-  transform = fmap . apply+-- | Reverses the direction of closed offsets.+instance (Additive v, Num n) => Reversing (Offset c v n) where+  reversing (OffsetClosed off) = OffsetClosed $ negated off+  reversing a@OffsetOpen       = a +type instance V (Offset c v n) = v+type instance N (Offset c v n) = n++instance Transformable (Offset c v n) where+  transform _ OffsetOpen       = OffsetOpen+  transform t (OffsetClosed v) = OffsetClosed (apply t v)+ ------------------------------------------------------------ --  Constructing segments  --------------------------------- ------------------------------------------------------------@@ -128,34 +149,62 @@ --   \"location\" and are unaffected by translations.  They are, --   however, affected by other transformations such as rotations and --   scales.-data Segment c v-    = Linear (Offset c v)+data Segment c v n+    = Linear !(Offset c v n)       -- ^ A linear segment with given offset. -    | Cubic v v (Offset c v)+    | Cubic !(v n) !(v n) !(Offset c v n)       -- ^ A cubic Bézier segment specified by       --   three offsets from the starting       --   point to the first control point,       --   second control point, and ending       --   point, respectively. -  deriving (Show, Functor, Eq, Ord)+  deriving (Functor, Eq, Ord) +instance Show (v n) => Show (Segment c v n) where+  showsPrec d seg = case seg of+    Linear (OffsetClosed v)       -> showParen (d > 10) $+      showString "straight " . showsPrec 11 v+    Cubic v1 v2 (OffsetClosed v3) -> showParen (d > 10) $+      showString "bézier3  " . showsPrec 11 v1 . showChar ' '+                             . showsPrec 11 v2 . showChar ' '+                             . showsPrec 11 v3+    Linear OffsetOpen             -> showString "openLinear"+    Cubic v1 v2 OffsetOpen        -> showParen (d > 10) $+      showString "openCubic " . showsPrec 11 v1 . showChar ' '+                              . showsPrec 11 v2+++instance Each (Segment c v n) (Segment c v' n') (v n) (v' n') where+  each f (Linear offset)      = Linear <$> each f offset+  each f (Cubic v1 v2 offset) = Cubic  <$> f v1 <*> f v2 <*> each f offset+  {-# INLINE each #-}++-- | Reverse the direction of a segment.+instance (Additive v, Num n) => Reversing (Segment Closed v n) where+  reversing = reverseSegment++-- | Map over the vectors of each segment.+mapSegmentVectors :: (v n -> v' n') -> Segment c v n -> Segment c v' n'+mapSegmentVectors = over each+ -- Note, can't yet have Haddock comments on GADT constructors; see -- http://trac.haskell.org/haddock/ticket/43. For now we don't need -- Segment to be a GADT but we might in the future. (?) -type instance V (Segment c v) = v+type instance V (Segment c v n) = v+type instance N (Segment c v n) = n -instance HasLinearMap v => Transformable (Segment c v) where-  transform = fmap . apply+instance Transformable (Segment c v n) where+  transform = mapSegmentVectors . apply -instance HasLinearMap v => Renderable (Segment c v) NullBackend where+instance Renderable (Segment c v n) NullBackend where   render _ _ = mempty  -- | @'straight' v@ constructs a translationally invariant linear --   segment with direction and length given by the vector @v@.-straight :: v -> Segment Closed v+straight :: v n -> Segment Closed v n straight = Linear . OffsetClosed  -- Note, if we didn't have a Linear constructor we could also create@@ -167,40 +216,50 @@ --   Bézier curve where the offsets from the first endpoint to the --   first and second control point and endpoint are respectively --   given by @c1@, @c2@, and @x@.-bezier3 :: v -> v -> v -> Segment Closed v+bezier3 :: v n -> v n -> v n -> Segment Closed v n bezier3 c1 c2 x = Cubic c1 c2 (OffsetClosed x)  -- | @bézier3@ is the same as @bezier3@, but with more snobbery.-bézier3 :: v -> v -> v -> Segment Closed v+bézier3 :: v n -> v n -> v n -> Segment Closed v n bézier3 = bezier3 -type instance Codomain (Segment Closed v) = v+type instance Codomain (Segment Closed v n) = v  -- | 'atParam' yields a parametrized view of segments as continuous --   functions @[0,1] -> v@, which give the offset from the start of --   the segment for each value of the parameter between @0@ and @1@. --   It is designed to be used infix, like @seg ``atParam`` 0.5@.-instance (VectorSpace v, Num (Scalar v)) => Parametric (Segment Closed v) where+instance (Additive v, Num n) => Parametric (Segment Closed v n) where   atParam (Linear (OffsetClosed x)) t       = t *^ x   atParam (Cubic c1 c2 (OffsetClosed x2)) t =     (3 * t'*t'*t ) *^ c1                                               ^+^ (3 * t'*t *t ) *^ c2                                               ^+^ (    t *t *t ) *^ x2     where t' = 1-t -instance Num (Scalar v) => DomainBounds (Segment Closed v)+instance Num n => DomainBounds (Segment Closed v n) -instance (VectorSpace v, Num (Scalar v)) => EndValues (Segment Closed v) where-  atStart                            = const zeroV+instance (Additive v, Num n) => EndValues (Segment Closed v n) where+  atStart                            = const zero   atEnd (Linear (OffsetClosed v))    = v   atEnd (Cubic _ _ (OffsetClosed v)) = v  -- | Compute the offset from the start of a segment to the --   end.  Note that in the case of a Bézier segment this is /not/ the --   same as the length of the curve itself; for that, see 'arcLength'.-segOffset :: Segment Closed v -> v+segOffset :: Segment Closed v n -> v n segOffset (Linear (OffsetClosed v))    = v segOffset (Cubic _ _ (OffsetClosed v)) = v +-- | An open linear segment. This means the trail makes a straight line+-- from the last segment the beginning to form a loop.+openLinear :: Segment Open v n+openLinear = Linear OffsetOpen++-- | An open cubic segment. This means the trail makes a cubic bézier+-- with control vectors @v1@ and @v2@ to form a loop.+openCubic :: v n -> v n -> Segment Open v n+openCubic v1 v2 = Cubic v1 v2 OffsetOpen+ ------------------------------------------------------------ --  Computing segment envelope  ------------------------------ ------------------------------------------------------------@@ -228,63 +287,68 @@ -}  -- | The envelope for a segment is based at the segment's start.-instance (InnerSpace v, OrderedField (Scalar v)) => Enveloped (Segment Closed v) where+instance (Metric v, OrderedField n) => Enveloped (Segment Closed v n) where    getEnvelope (s@(Linear {})) = mkEnvelope $ \v ->-    maximum . map (\t -> ((s `atParam` t) <.> v) / magnitudeSq v) $ [0,1]+    maximum (map (\t -> (s `atParam` t) `dot` v) [0,1]) / quadrance v    getEnvelope (s@(Cubic c1 c2 (OffsetClosed x2))) = mkEnvelope $ \v ->     maximum .-    map (\t -> ((s `atParam` t) <.> v) / magnitudeSq v) $+    map (\t -> ((s `atParam` t) `dot` v) / quadrance v) $     [0,1] ++     filter (liftA2 (&&) (>0) (<1))-      (quadForm (3 * ((3 *^ c1 ^-^ 3 *^ c2 ^+^ x2) <.> v))-                (6 * (((-2) *^ c1 ^+^ c2) <.> v))-                ((3 *^ c1) <.> v))+      (quadForm (3 * ((3 *^ c1 ^-^ 3 *^ c2 ^+^ x2) `dot` v))+                (6 * (((-2) *^ c1 ^+^ c2) `dot` v))+                ((3 *^ c1) `dot` v))  ------------------------------------------------------------ --  Manipulating segments ------------------------------------------------------------ -instance (VectorSpace v, Fractional (Scalar v)) => Sectionable (Segment Closed v) where+instance (Additive v, Fractional n) => Sectionable (Segment Closed v n) where   splitAtParam (Linear (OffsetClosed x1)) t = (left, right)     where left  = straight p           right = straight (x1 ^-^ p)-          p = lerp zeroV x1 t+          p = lerp t zero x1   splitAtParam (Cubic c1 c2 (OffsetClosed x2)) t = (left, right)     where left  = bezier3 a b e           right = bezier3 (c ^-^ e) (d ^-^ e) (x2 ^-^ e)-          p = lerp c1    c2 t-          a = lerp zeroV c1 t-          b = lerp a     p  t-          d = lerp c2    x2 t-          c = lerp p     d  t-          e = lerp b     c  t+          p = lerp t c1 c2+          a = lerp t zero c1+          b = lerp t a p+          d = lerp t c2 x2+          c = lerp t p d+          e = lerp t b c    reverseDomain = reverseSegment  -- | Reverse the direction of a segment.-reverseSegment :: AdditiveGroup v => Segment Closed v -> Segment Closed v-reverseSegment (Linear (OffsetClosed v))       = straight (negateV v)-reverseSegment (Cubic c1 c2 (OffsetClosed x2)) = bezier3 (c2 ^-^ x2) (c1 ^-^ x2) (negateV x2)+reverseSegment :: (Num n, Additive v) => Segment Closed v n -> Segment Closed v n+reverseSegment (Linear (OffsetClosed v))       = straight (negated v)+reverseSegment (Cubic c1 c2 (OffsetClosed x2)) = bezier3 (c2 ^-^ x2) (c1 ^-^ x2) (negated x2) -instance (InnerSpace v, Floating (Scalar v), Ord (Scalar v), AdditiveGroup v)-      => HasArcLength (Segment Closed v) where+-- Imitates I.elem for intervals<0.8 and I.member for intervals>=0.8+member :: Ord a => a -> I.Interval a -> Bool+member x (I.I a b) = x >= a && x <= b+{-# INLINE member #-} -  arcLengthBounded _ (Linear (OffsetClosed x1)) = I.singleton $ magnitude x1+instance (Metric v, OrderedField n)+      => HasArcLength (Segment Closed v n) where++  arcLengthBounded _ (Linear (OffsetClosed x1)) = I.singleton $ norm x1   arcLengthBounded m s@(Cubic c1 c2 (OffsetClosed x2))     | ub - lb < m = I lb ub     | otherwise   = arcLengthBounded (m/2) l + arcLengthBounded (m/2) r    where (l,r) = s `splitAtParam` 0.5-         ub    = sum (map magnitude [c1, c2 ^-^ c1, x2 ^-^ c2])-         lb    = magnitude x2+         ub    = sum (map norm [c1, c2 ^-^ c1, x2 ^-^ c2])+         lb    = norm x2    arcLengthToParam m s _ | arcLength m s == 0 = 0.5   arcLengthToParam m s@(Linear {}) len = len / arcLength m s   arcLengthToParam m s@(Cubic {})  len-    | len `I.elem` (I (-m/2) (m/2)) = 0+    | len `member` I (-m/2) (m/2) = 0     | len < 0              = - arcLengthToParam m (fst (splitAtParam s (-1))) (-len)-    | len `I.elem` slen    = 1+    | len `member` slen    = 1     | len > I.sup slen     = 2 * arcLengthToParam m (fst (splitAtParam s 2)) len     | len < I.sup llen     = (*0.5) $ arcLengthToParam m l len     | otherwise            = (+0.5) . (*0.5)@@ -306,39 +370,30 @@ --   (Segment Closed v)@, as witnessed by 'mkFixedSeg' and --   'fromFixedSeg', but @FixedSegment@ is convenient when one needs --   the absolute locations of the vertices and control points.-data FixedSegment v = FLinear (Point v) (Point v)-                    | FCubic (Point v) (Point v) (Point v) (Point v)-  deriving Show+data FixedSegment v n = FLinear (Point v n) (Point v n)+                      | FCubic (Point v n) (Point v n) (Point v n) (Point v n)+  deriving (Eq, Ord, Show) -type instance V (FixedSegment v) = v+type instance V (FixedSegment v n) = v+type instance N (FixedSegment v n) = n -instance HasLinearMap v => Transformable (FixedSegment v) where-  transform t (FLinear p1 p2)-    = FLinear-      (transform t p1)-      (transform t p2)+instance Each (FixedSegment v n) (FixedSegment v' n') (Point v n) (Point v' n') where+  each f (FLinear p0 p1)      = FLinear <$> f p0 <*> f p1+  each f (FCubic p0 p1 p2 p3) = FCubic  <$> f p0 <*> f p1 <*> f p2 <*> f p3+  {-# INLINE each #-} -  transform t (FCubic p1 c1 c2 p2)-    = FCubic-      (transform t p1)-      (transform t c1)-      (transform t c2)-      (transform t p2)+-- | Reverses the control points.+instance Reversing (FixedSegment v n) where+  reversing (FLinear p0 p1)      = FLinear p1 p0+  reversing (FCubic p0 p1 p2 p3) = FCubic p3 p2 p1 p0 -instance VectorSpace v => HasOrigin (FixedSegment v) where-  moveOriginTo o (FLinear p1 p2)-    = FLinear-      (moveOriginTo o p1)-      (moveOriginTo o p2)+instance (Additive v, Num n) => Transformable (FixedSegment v n) where+  transform t = over each (papply t) -  moveOriginTo o (FCubic p1 c1 c2 p2)-    = FCubic-      (moveOriginTo o p1)-      (moveOriginTo o c1)-      (moveOriginTo o c2)-      (moveOriginTo o p2)+instance (Additive v, Num n) => HasOrigin (FixedSegment v n) where+  moveOriginTo o = over each (moveOriginTo o) -instance (InnerSpace v, OrderedField (Scalar v)) => Enveloped (FixedSegment v) where+instance (Metric v, OrderedField n) => Enveloped (FixedSegment v n) where   getEnvelope f = moveTo p (getEnvelope s)     where (p, s) = viewLoc $ fromFixedSeg f @@ -347,32 +402,71 @@     -- Envelope, and implement the Segment instance in terms of it,     -- instead of the other way around +instance (Metric v, OrderedField n)+      => HasArcLength (FixedSegment v n) where+  arcLengthBounded m s = arcLengthBounded m (fromFixedSeg s)+  arcLengthToParam m s = arcLengthToParam m (fromFixedSeg s)+ -- | Create a 'FixedSegment' from a located 'Segment'.-mkFixedSeg :: AdditiveGroup v => Located (Segment Closed v) -> FixedSegment v-mkFixedSeg (viewLoc -> (p, Linear (OffsetClosed v)))-  = FLinear p (p .+^ v)-mkFixedSeg (viewLoc -> (p, Cubic c1 c2 (OffsetClosed x2)))-  = FCubic  p (p .+^ c1) (p .+^ c2) (p .+^ x2)+mkFixedSeg :: (Num n, Additive v) => Located (Segment Closed v n) -> FixedSegment v n+mkFixedSeg ls =+  case viewLoc ls of+    (p, Linear (OffsetClosed v))       -> FLinear p (p .+^ v)+    (p, Cubic c1 c2 (OffsetClosed x2)) -> FCubic  p (p .+^ c1) (p .+^ c2) (p .+^ x2)  -- | Convert a 'FixedSegment' back into a located 'Segment'.-fromFixedSeg :: AdditiveGroup v => FixedSegment v -> Located (Segment Closed v)+fromFixedSeg :: (Num n, Additive v) => FixedSegment v n -> Located (Segment Closed v n) fromFixedSeg (FLinear p1 p2)      = straight (p2 .-. p1) `at` p1 fromFixedSeg (FCubic x1 c1 c2 x2) = bezier3 (c1 .-. x1) (c2 .-. x1) (x2 .-. x1) `at` x1 -type instance Codomain (FixedSegment v) = Point v+-- | Use a 'FixedSegment' to make an 'Iso' between an+-- a fixed segment and a located segment.+fixedSegIso :: (Num n, Additive v) => Iso' (FixedSegment v n) (Located (Segment Closed v n))+fixedSegIso = iso fromFixedSeg mkFixedSeg -instance VectorSpace v => Parametric (FixedSegment v) where-  atParam (FLinear p1 p2) t = alerp p1 p2 t+type instance Codomain (FixedSegment v n) = Point v++instance (Additive v, Num n) => Parametric (FixedSegment v n) where+  atParam (FLinear p1 p2) t = lerp t p1 p2   atParam (FCubic x1 c1 c2 x2) t = p3-    where p11 = alerp x1 c1 t-          p12 = alerp c1 c2 t-          p13 = alerp c2 x2 t+    where p11 = lerp t x1 c1+          p12 = lerp t c1 c2+          p13 = lerp t c2 x2 -          p21 = alerp p11 p12 t-          p22 = alerp p12 p13 t+          p21 = lerp t p11 p12+          p22 = lerp t p12 p13 -          p3  = alerp p21 p22 t+          p3  = lerp t p21 p22 +instance Num n => DomainBounds (FixedSegment v n)++instance (Additive v, Num n) => EndValues (FixedSegment v n) where+  atStart (FLinear p0 _)     = p0+  atStart (FCubic  p0 _ _ _) = p0+  atEnd   (FLinear _ p1)     = p1+  atEnd   (FCubic _ _ _ p1 ) = p1++instance (Additive v, Fractional n) => Sectionable (FixedSegment v n) where+  splitAtParam (FLinear p0 p1) t = (left, right)+    where left  = FLinear p0 p+          right = FLinear p  p1+          p = lerp t p0 p1+  splitAtParam (FCubic p0 c1 c2 p1) t = (left, right)+    where left  = FCubic p0 a b cut+          right = FCubic cut c d p1+          -- first round+          a   = lerp t p0 c1+          p   = lerp t c1 c2+          d   = lerp t c2 p1+          -- second round+          b   = lerp t a p+          c   = lerp t p d+          -- final round+          cut = lerp t b c++  reverseDomain (FLinear p0 p1) = FLinear p1 p0+  reverseDomain (FCubic p0 c1 c2 p1) = FCubic p1 c2 c1 p0+ ------------------------------------------------------------ --  Segment measures  -------------------------------------- ------------------------------------------------------------@@ -382,94 +476,161 @@ -- automatically track various monoidal \"measures\" on segments.  -- | A type to track the count of segments in a 'Trail'.-newtype SegCount = SegCount { getSegCount :: Sum Int }+newtype SegCount = SegCount (Sum Int)   deriving (Semigroup, Monoid) +instance Wrapped SegCount where+  type Unwrapped SegCount = Sum Int+  _Wrapped' = iso (\(SegCount x) -> x) SegCount++instance Rewrapped SegCount SegCount+ -- | A type to represent the total arc length of a chain of --   segments. The first component is a \"standard\" arc length, --   computed to within a tolerance of @10e-6@.  The second component is --   a generic arc length function taking the tolerance as an --   argument.-newtype ArcLength v = ArcLength-  { getArcLength :: (Sum (Interval (Scalar v)), Scalar v -> Sum (Interval (Scalar v))) } +newtype ArcLength n+  = ArcLength (Sum (Interval n), n -> Sum (Interval n))++instance Wrapped (ArcLength n) where+  type Unwrapped (ArcLength n) = (Sum (Interval n), n -> Sum (Interval n))+  _Wrapped' = iso (\(ArcLength x) -> x) ArcLength++instance Rewrapped (ArcLength n) (ArcLength n')+ -- | Project out the cached arc length, stored together with error --   bounds.-getArcLengthCached :: ArcLength v -> Interval (Scalar v)-getArcLengthCached = getSum . fst . getArcLength+getArcLengthCached :: ArcLength n -> Interval n+getArcLengthCached = getSum . fst . op ArcLength  -- | Project out the generic arc length function taking the tolerance as --   an argument.-getArcLengthFun :: ArcLength v -> Scalar v -> Interval (Scalar v)-getArcLengthFun = fmap getSum . snd . getArcLength+getArcLengthFun :: ArcLength n -> n -> Interval n+getArcLengthFun = fmap getSum . snd . op ArcLength  -- | Given a specified tolerance, project out the cached arc length if --   it is accurate enough; otherwise call the generic arc length --   function with the given tolerance.-getArcLengthBounded :: (Num (Scalar v), Ord (Scalar v))-                    => Scalar v -> ArcLength v -> Interval (Scalar v)+getArcLengthBounded :: (Num n, Ord n)+                    => n -> ArcLength n -> Interval n getArcLengthBounded eps al   | I.width cached <= eps = cached   | otherwise             = getArcLengthFun al eps   where     cached = getArcLengthCached al-deriving instance (Num (Scalar v), Ord (Scalar v)) => Semigroup (ArcLength v)-deriving instance (Num (Scalar v), Ord (Scalar v)) => Monoid    (ArcLength v)+deriving instance (Num n, Ord n) => Semigroup (ArcLength n)+deriving instance (Num n, Ord n) => Monoid    (ArcLength n)  -- | A type to represent the total cumulative offset of a chain of --   segments.-newtype TotalOffset v = TotalOffset { getTotalOffset :: v }+newtype TotalOffset v n = TotalOffset (v n) -instance AdditiveGroup v => Semigroup (TotalOffset v) where+instance Wrapped (TotalOffset v n) where+  type Unwrapped (TotalOffset v n) = v n+  _Wrapped' = iso (\(TotalOffset x) -> x) TotalOffset++instance Rewrapped (TotalOffset v n) (TotalOffset v' n')++instance (Num n, Additive v) => Semigroup (TotalOffset v n) where   TotalOffset v1 <> TotalOffset v2 = TotalOffset (v1 ^+^ v2) -instance AdditiveGroup v => Monoid (TotalOffset v) where-  mempty  = TotalOffset zeroV+instance (Num n, Additive v) => Monoid (TotalOffset v n) where+  mempty  = TotalOffset zero   mappend = (<>)  -- | A type to represent the offset and envelope of a chain of --   segments.  They have to be paired into one data structure, since --   combining the envelopes of two consecutive chains needs to take---   the offset of the the offset of the first into account.-data OffsetEnvelope v = OffsetEnvelope-  { oeOffset   :: TotalOffset v-  , oeEnvelope :: Envelope v+--   the offset of the first into account.+data OffsetEnvelope v n = OffsetEnvelope+  { _oeOffset   :: !(TotalOffset v n)+  , _oeEnvelope :: Envelope v n   } -instance (InnerSpace v, OrderedField (Scalar v)) => Semigroup (OffsetEnvelope v) where+makeLenses ''OffsetEnvelope++instance (Metric v, OrderedField n) => Semigroup (OffsetEnvelope v n) where   (OffsetEnvelope o1 e1) <> (OffsetEnvelope o2 e2)-    = OffsetEnvelope-        (o1 <> o2)-        (e1 <> moveOriginBy (negateV . getTotalOffset $ o1) e2)+    = let !negOff = negated . op TotalOffset $ o1+          e2Off = moveOriginBy negOff e2+          !_unused = maybe () (\f -> f `seq` ()) $ appEnvelope e2Off+      in OffsetEnvelope+          (o1 <> o2)+          (e1 <> e2Off)  -- | @SegMeasure@ collects up all the measurements over a chain of --   segments.-type SegMeasure v = SegCount-                ::: ArcLength v-                ::: OffsetEnvelope v-                ::: ()+type SegMeasure v n = SegCount+                  ::: ArcLength n+                  ::: OffsetEnvelope v n+                  ::: ()   -- unfortunately we can't cache Trace, since there is not a generic   -- instance Traced (Segment Closed v), only Traced (Segment Closed R2). -instance (InnerSpace v, OrderedField (Scalar v))-    => Measured (SegMeasure v) (SegMeasure v) where+instance (Metric v, OrderedField n)+    => Measured (SegMeasure v n) (SegMeasure v n) where   measure = id -instance (OrderedField (Scalar v), InnerSpace v)-    => Measured (SegMeasure v) (Segment Closed v) where-  measure s = (SegCount . Sum $ 1)+instance (OrderedField n, Metric v)+    => Measured (SegMeasure v n) (Segment Closed v n) where+  measure s = (SegCount . Sum) 1              -- cache arc length with two orders of magnitude more             -- accuracy than standard, so we have a hope of coming out             -- with an accurate enough total arc length for             -- reasonable-length trails-           *: (ArcLength $ ( Sum $ arcLengthBounded (stdTolerance/100) s-                           , Sum . flip arcLengthBounded s-                           )-              )+            *: ArcLength ( Sum $ arcLengthBounded (stdTolerance/100) s+                         , Sum . flip arcLengthBounded s               ) -           *: (OffsetEnvelope-                (TotalOffset . segOffset $ s)-                (getEnvelope s)-              )-           *: ()+            *: OffsetEnvelope (TotalOffset . segOffset $ s)+                              (getEnvelope s)++            *: ()++------------------------------------------------------------+--  Serialize instances+------------------------------------------------------------++instance (Serialize (v n)) => Serialize (Segment Open v n) where+  {-# INLINE put #-}+  put segment = case segment of+    Linear OffsetOpen    -> Serialize.put True+    Cubic v w OffsetOpen -> do+      Serialize.put False+      Serialize.put v+      Serialize.put w++  {-# INLINE get #-}+  get = do+    isLinear <- Serialize.get+    case isLinear of+      True  -> return (Linear OffsetOpen)+      False -> do+        v <- Serialize.get+        w <- Serialize.get+        return (Cubic v w OffsetOpen)++instance (Serialize (v n)) => Serialize (Segment Closed v n) where+  {-# INLINE put #-}+  put segment = case segment of+    Linear (OffsetClosed z)    -> do+      Serialize.put z+      Serialize.put True+    Cubic v w (OffsetClosed z) -> do+      Serialize.put z+      Serialize.put False+      Serialize.put v+      Serialize.put w++  {-# INLINE get #-}+  get = do+    z <- Serialize.get+    isLinear <- Serialize.get+    case isLinear of+      True  -> return (Linear (OffsetClosed z))+      False -> do+        v <- Serialize.get+        w <- Serialize.get+        return (Cubic v w (OffsetClosed z))

+ src/Diagrams/Size.hs view

@@ -0,0 +1,157 @@+{-# LANGUAGE ConstraintKinds            #-}+{-# LANGUAGE DeriveDataTypeable         #-}+{-# LANGUAGE DeriveFunctor              #-}+{-# LANGUAGE DeriveGeneric              #-}+{-# LANGUAGE FlexibleContexts           #-}+{-# LANGUAGE FlexibleInstances          #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE RankNTypes                 #-}+{-# LANGUAGE ScopedTypeVariables        #-}+{-# LANGUAGE TypeFamilies               #-}+{-# LANGUAGE UndecidableInstances       #-}+{-# LANGUAGE ViewPatterns               #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Diagrams.Size+-- Copyright   :  (c) 2014 diagrams-lib team (see LICENSE)+-- License     :  BSD-style (see LICENSE)+-- Maintainer  :  diagrams-discuss@googlegroups.com+--+-- Utilities for working with sizes of objects.+--+-----------------------------------------------------------------------------+module Diagrams.Size+  ( -- * Size spec+    SizeSpec++    -- ** Making size spec+  , mkSizeSpec+  , dims+  , absolute++    -- ** Extracting size specs+  , getSpec+  , specToSize++    -- ** Functions on size specs+  , requiredScale+  , requiredScaling+  , sized+  , sizedAs+  , sizeAdjustment+  ) where++import           Control.Applicative+import           Control.Lens         hiding (transform)+import           Control.Monad+import           Data.Foldable        as F+import           Data.Hashable+import           Data.Maybe+import           Data.Semigroup+import           Data.Typeable+import           GHC.Generics         (Generic)+import           Prelude++import           Diagrams.BoundingBox+import           Diagrams.Core++import           Linear.Affine+import           Linear.Vector++------------------------------------------------------------+-- Computing diagram sizes+------------------------------------------------------------++-- | A 'SizeSpec' is a way of specifying a size without needed lengths for all+--   the dimensions.+newtype SizeSpec v n = SizeSpec (v n)+  deriving (+  Eq,+  Typeable,+  Functor,+  Generic,+  Hashable,+  Show)++type instance V (SizeSpec v n) = v+type instance N (SizeSpec v n) = n++-- | Retrieve a size spec as a vector of maybe values. Only positive sizes are+--   returned.+getSpec :: (Functor v, Num n, Ord n) => SizeSpec v n -> v (Maybe n)+getSpec (SizeSpec sp) = mfilter (>0) . Just <$> sp++-- | Make a 'SizeSpec' from a vector of maybe values. Any negative values will+--   be ignored. For 2D 'SizeSpec's see 'mkWidth' and 'mkHeight' from+--   "Diagrams.TwoD.Size".+mkSizeSpec :: (Functor v, Num n) => v (Maybe n) -> SizeSpec v n+mkSizeSpec = dims . fmap (fromMaybe 0)++-- | Make a 'SizeSpec' from a vector. Any negative values will be ignored.+dims :: v n -> SizeSpec v n+dims = SizeSpec++-- | A size spec with no hints to the size.+absolute :: (Additive v, Num n) => SizeSpec v n+absolute = SizeSpec zero++-- | @specToSize n spec@ extracts a size from a 'SizeSpec' @sz@. Any values not+--   specified in the spec are replaced by the smallest of the values that are+--   specified. If there are no specified values (i.e. 'absolute') then @n@ is+--   used.+specToSize :: (Foldable v, Functor v, Num n, Ord n) => n -> SizeSpec v n -> v n+specToSize n (getSpec -> spec) = fmap (fromMaybe smallest) spec+  where+    smallest = fromMaybe n $ minimumOf (folded . _Just) spec++-- | @requiredScale spec sz@ returns the largest scaling factor to make+--   something of size @sz@ fit the requested size @spec@ without changing the+--   aspect ratio. @sz@ should be non-zero (otherwise a scale of 1 is+--   returned). For non-uniform scaling see 'boxFit'.+requiredScale :: (Additive v, Foldable v, Fractional n, Ord n)+              => SizeSpec v n -> v n -> n+requiredScale (getSpec -> spec) sz+  | allOf (folded . _Just) (<= 0) usedSz = 1+  | otherwise                            = fromMaybe 1 mScale+  where+    usedSz = liftI2 (<$) sz spec+    scales = liftI2 (^/) spec sz+    mScale = minimumOf (folded . _Just) scales++-- | Return the 'Transformation' calcuated from 'requiredScale'.+requiredScaling :: (Additive v, Foldable v, Fractional n, Ord n)+  => SizeSpec v n -> v n -> Transformation v n+requiredScaling spec = scaling . requiredScale spec++-- | Uniformly scale any enveloped object so that it fits within the+--   given size. For non-uniform scaling see 'boxFit'.+sized :: (InSpace v n a, HasLinearMap v, Transformable a, Enveloped a)+      => SizeSpec v n -> a -> a+sized spec a = transform (requiredScaling spec (size 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 :: (InSpace v n a, SameSpace a b, HasLinearMap v, Transformable a,+            Enveloped a, Enveloped b)+        => b -> a -> a+sizedAs other = sized (dims $ size other)++-- | Get the adjustment to fit a 'BoundingBox' in the given 'SizeSpec'. The+--   vector is the new size and the transformation to position the lower+--   corner at the origin and scale to the size spec.+sizeAdjustment :: (Additive v, Foldable v, OrderedField n)+  => SizeSpec v n -> BoundingBox v n -> (v n, Transformation v n)+sizeAdjustment spec bb = (sz', t)+  where+    v = (0.5 *^ P sz') .-. (s *^ fromMaybe origin (boxCenter bb))++    sz  = boxExtents bb+    sz' = if allOf folded isJust (getSpec spec)+            then specToSize 0 spec+            else s *^ sz++    s = requiredScale spec sz++    t = translation v <> scaling s

− src/Diagrams/Solve.hs

@@ -1,118 +0,0 @@-{-# OPTIONS_GHC -fno-warn-unused-binds #-}--------------------------------------------------------------------------------- |--- Module      :  Diagrams.Solve--- Copyright   :  (c) 2011 diagrams-lib team (see LICENSE)--- License     :  BSD-style (see LICENSE)--- Maintainer  :  diagrams-discuss@googlegroups.com------ Exact solving of low-degree (n <= 3) polynomials.----------------------------------------------------------------------------------module Diagrams.Solve-       ( quadForm-       , cubForm-       ) where--import           Data.List     (maximumBy)-import           Data.Ord      (comparing)--import           Diagrams.Util (tau)----------------------------------------------------------------- Quadratic formula----------------------------------------------------------------- | The quadratic formula.-quadForm :: (Floating d, Ord d) => d -> d -> d -> [d]-quadForm a b c--    -- There are infinitely many solutions in this case,-    -- so arbitrarily return 0-  | a == 0 && b == 0 && c == 0 = [0]--    -- c /= 0-  | a == 0 && b == 0 = []--    -- linear-  | a == 0    = [-c/b]--    -- no real solutions-  | d < 0     = []--    -- ax^2 + c = 0-  | b == 0    = [sqrt (-c/a), -sqrt (-c/a)]--    -- multiplicity 2 solution-  | d == 0    = [-b/(2*a)]--    -- see http://www.mpi-hd.mpg.de/astrophysik/HEA/internal/Numerical_Recipes/f5-6.pdf-  | otherwise = [q/a, c/q]- where d = b*b - 4*a*c-       q = -1/2*(b + signum b * sqrt d)--quadForm_prop :: Double -> Double -> Double -> Bool-quadForm_prop a b c = all (aboutZero . eval) (quadForm a b c)-  where eval x = a*x*x + b*x + c-        aboutZero x = abs x < tolerance-        tolerance = 1e-10----------------------------------------------------------------- Cubic formula----------------------------------------------------------------- See http://en.wikipedia.org/wiki/Cubic_formula#General_formula_of_roots---- | Solve the cubic equation ax^3 + bx^2 + cx + d = 0, returning a---   list of all real roots.-cubForm :: (Floating d, Ord d) => d -> d -> d -> d -> [d]-cubForm a b c d-  | aboutZero a             = quadForm b c d--    -- three real roots, use trig method to avoid complex numbers-  | delta >  0              = map trig [0,1,2]--    -- one real root of multiplicity 3-  | delta == 0 && disc == 0 = [ -b/(3*a) ]--    -- two real roots, one of multiplicity 2-  | delta == 0 && disc /= 0 = [ (b*c - 9*a*d)/(2*disc)-                              , (9*a*a*d - 4*a*b*c + b*b*b)/(a * disc)-                              ]--    -- one real root (and two complex)-  | otherwise               = [-b/(3*a) - cc/(3*a) + disc/(3*a*cc)]-- where delta  = 18*a*b*c*d - 4*b*b*b*d + b*b*c*c - 4*a*c*c*c - 27*a*a*d*d-       disc   = 3*a*c - b*b-       qq     = sqrt(-27*a*a*delta)-       qq'    | aboutZero disc = maximumBy (comparing (abs . (+xx))) [qq, -qq]-              | otherwise = qq-       cc     = cubert (1/2*(qq' + xx))-       xx     = 2*b*b*b - 9*a*b*c + 27*a*a*d-       p      = disc/(3*a*a)-       q      = xx/(27*a*a*a)-       trig k = 2 * sqrt(-p/3) * cos(1/3*acos(3*q/(2*p)*sqrt(-3/p)) - k*tau/3)-                - b/(3*a)--       cubert x | x < 0     = -((-x)**(1/3))-                | otherwise = x**(1/3)--       aboutZero x = abs x < toler-       toler = 1e-10--cubForm_prop :: Double -> Double -> Double -> Double -> Bool-cubForm_prop a b c d = all (aboutZero . eval) (cubForm a b c d)-  where eval x = a*x*x*x + b*x*x + c*x + d-        aboutZero x = abs x < tolerance-        tolerance = 1e-5-           -- Basically, however large you set the tolerance it seems-           -- that quickcheck can always come up with examples where-           -- the returned solutions evaluate to something near zero-           -- but larger than the tolerance (but it takes it more-           -- tries the larger you set the tolerance). Wonder if this-           -- is an inherent limitation or (more likely) a problem-           -- with numerical stability.  If this turns out to be an-           -- issue in practice we could, say, use the solutions-           -- generated here as very good guesses to a numerical-           -- solver which can give us a more precise answer?

+ src/Diagrams/Tangent.hs view

@@ -0,0 +1,150 @@+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE GADTs                #-} -- for ghc < 7.8, TypeFamilies covers GADT patten mathcing in > 7.8+{-# LANGUAGE FlexibleContexts     #-}+{-# LANGUAGE FlexibleInstances    #-}+{-# LANGUAGE TypeFamilies         #-}+{-# LANGUAGE UndecidableInstances #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Diagrams.Tangent+-- Copyright   :  (c) 2013 diagrams-lib team (see LICENSE)+-- License     :  BSD-style (see LICENSE)+-- Maintainer  :  diagrams-discuss@googlegroups.com+--+-- Computing tangent and normal vectors for segments and trails.+--+-----------------------------------------------------------------------------+module Diagrams.Tangent+    ( -- ** Tangents+      tangentAtParam+    , tangentAtStart+    , tangentAtEnd++      -- ** Normals+    , normalAtParam+    , normalAtStart+    , normalAtEnd++      -- ** Tangent newtype+    , Tangent(..)+    )+    where++import           Diagrams.Core+import           Diagrams.Located+import           Diagrams.Parametric+import           Diagrams.Segment++import           Linear.Vector+import           Linear.Metric+import           Linear.V2++------------------------------------------------------------+-- Tangent+------------------------------------------------------------++-- | A newtype wrapper used to give different instances of+--   'Parametric' and 'EndValues' that compute tangent vectors.+newtype Tangent t = Tangent t++type instance V (Tangent t) = V t+type instance N (Tangent t) = N t+type instance Codomain (Tangent t) = V t++instance DomainBounds t => DomainBounds (Tangent t) where+  domainLower (Tangent t) = domainLower t+  domainUpper (Tangent t) = domainUpper t++instance Parametric (Tangent t) => Parametric (Tangent (Located t)) where+  Tangent l `atParam` p = Tangent (unLoc l) `atParam` p++instance (DomainBounds t, EndValues (Tangent t))+    => EndValues (Tangent (Located t)) where+  atStart (Tangent l) = atStart (Tangent (unLoc l))+  atEnd   (Tangent l) = atEnd   (Tangent (unLoc l))++-- | Compute the tangent vector to a segment or trail at a particular+--   parameter.+--+--   Examples of more specific types this function can have include+--+--   * @Segment Closed V2 -> Double -> V2 Double@+--+--   * @Trail' Line V2 -> Double -> V2 Double@+--+--   * @Located (Trail V2) -> Double -> V2 Double@+--+--   See the instances listed for the 'Tangent' newtype for more.+tangentAtParam :: Parametric (Tangent t) => t -> N t -> Vn t+tangentAtParam t p = Tangent t `atParam` p++-- | Compute the tangent vector at the start of a segment or trail.+tangentAtStart :: EndValues (Tangent t) => t -> Vn t+tangentAtStart = atStart . Tangent++-- | Compute the tangent vector at the end of a segment or trail.+tangentAtEnd :: EndValues (Tangent t) => t -> Vn t+tangentAtEnd = atEnd . Tangent++--------------------------------------------------+-- Segment++instance (Additive v, Num n)+    => Parametric (Tangent (Segment Closed v n)) where+  Tangent (Linear (OffsetClosed v)) `atParam` _ = v+  Tangent (Cubic c1 c2 (OffsetClosed x2)) `atParam` p+    = (3*(3*p*p-4*p+1))*^c1 ^+^ (3*(2-3*p)*p)*^c2 ^+^ (3*p*p)*^x2++instance (Additive v, Num n)+    => EndValues (Tangent (Segment Closed v n)) where+  atStart (Tangent (Linear (OffsetClosed v)))      = v+  atStart (Tangent (Cubic c1 _ _))                 = c1+  atEnd   (Tangent (Linear (OffsetClosed v)))      = v+  atEnd   (Tangent (Cubic _ c2 (OffsetClosed x2))) = x2 ^-^ c2++instance (Additive v, Num n)+    => Parametric (Tangent (FixedSegment v n)) where+  atParam (Tangent fSeg) = atParam $ Tangent (fromFixedSeg fSeg)++instance (Additive v, Num n)+    => EndValues (Tangent (FixedSegment v n)) where+  atStart (Tangent fSeg) = atStart $ Tangent (fromFixedSeg fSeg)+  atEnd (Tangent fSeg)   = atEnd $ Tangent (fromFixedSeg fSeg)++------------------------------------------------------------+-- Normal+------------------------------------------------------------++-- | Compute the (unit) normal vector to a segment or trail at a+--   particular parameter.+--+--   Examples of more specific types this function can have include+--+--   * @Segment Closed V2 Double -> Double -> V2 Double@+--+--   * @Trail' Line V2 Double -> Double -> V2 Double@+--+--   * @Located (Trail V2 Double) -> Double -> V2 Double@+--+--   See the instances listed for the 'Tangent' newtype for more.+normalAtParam+  :: (InSpace V2 n t, Parametric (Tangent t), Floating n)+  => t -> n -> V2 n+normalAtParam t p = normize (t `tangentAtParam` p)++-- | Compute the normal vector at the start of a segment or trail.+normalAtStart+  :: (InSpace V2 n t, EndValues (Tangent t), Floating n)+  => t -> V2 n+normalAtStart = normize . tangentAtStart++-- | Compute the normal vector at the end of a segment or trail.+normalAtEnd+  :: (InSpace V2 n t, EndValues (Tangent t), Floating n)+  => t -> V2 n+normalAtEnd = normize . tangentAtEnd++-- | Construct a normal vector from a tangent.+normize :: Floating n => V2 n -> V2 n+normize = negated . perp . signorm

+ src/Diagrams/ThreeD.hs view

@@ -0,0 +1,62 @@+{-# LANGUAGE FlexibleContexts     #-}+{-# LANGUAGE TypeFamilies         #-}+{-# LANGUAGE TypeSynonymInstances #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Diagrams.ThreeD+-- Copyright   :  (c) 2013-2015 diagrams-lib team (see LICENSE)+-- License     :  BSD-style (see LICENSE)+-- Maintainer  :  diagrams-discuss@googlegroups.com+--+-- This module defines the three-dimensional vector space R^3,+-- three-dimensional transformations, and various predefined+-- three-dimensional shapes.  This module re-exports useful+-- functionality from a group of more specific modules:+--+--   * "Diagrams.ThreeD.Types" defines basic types for two-dimensional+--     diagrams, including types representing the 3D Euclidean vector+--     space and various systems of representing directions.+--+--   * "Diagrams.ThreeD.Transform" defines R^3-specific+--     transformations such as rotation by an angle, and scaling,+--     translation, and reflection in the X, Y, and Z directions.+--     "Diagrams.ThreeD.Deform" defines several R^3-specific+--     non-affine transformations, such as projections.+--+--   * "Diagrams.ThreeD.Shapes" defines three-dimensional solids,+--     e.g. spheres and cubes.+--+--   * "Diagrams.ThreeD.Vector" defines some special 3D vectors and+--     functions for converting between vectors and directions.+--+--   * "Diagrams.ThreeD.Light" and "Diagrams.ThreeD.Camera" define types needed+--     for rendering 3D geometry to (2D) images.+--+--   * "Diagrams.ThreeD.Align" defines many alignment combinators+--     specialized to three dimensions.+--+--   * "Diagrams.ThreeD.Attributes" defines 3D-specific attributes+--     such as surface color, diffuse reflectance, and specular+--     highlights.+-----------------------------------------------------------------------------+module Diagrams.ThreeD+  ( module Diagrams.ThreeD.Align+  , module Diagrams.ThreeD.Attributes+  , module Diagrams.ThreeD.Camera+  , module Diagrams.ThreeD.Deform+  , module Diagrams.ThreeD.Light+  , module Diagrams.ThreeD.Shapes+  , module Diagrams.ThreeD.Transform+  , module Diagrams.ThreeD.Types+  , module Diagrams.ThreeD.Vector+  ) where++import           Diagrams.ThreeD.Align+import           Diagrams.ThreeD.Attributes+import           Diagrams.ThreeD.Camera+import           Diagrams.ThreeD.Deform+import           Diagrams.ThreeD.Light+import           Diagrams.ThreeD.Shapes+import           Diagrams.ThreeD.Transform+import           Diagrams.ThreeD.Types+import           Diagrams.ThreeD.Vector

+ src/Diagrams/ThreeD/Align.hs view

@@ -0,0 +1,140 @@+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE TypeFamilies    #-}+{-# LANGUAGE TypeOperators   #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Diagrams.ThreeD.Align+-- Copyright   :  (c) 2013 diagrams-lib team (see LICENSE)+-- License     :  BSD-style (see LICENSE)+-- Maintainer  :  diagrams-discuss@googlegroups.com+--+-- Alignment combinators specialized for three dimensions.  See+-- "Diagrams.Align" for more general alignment combinators.+--+-- The basic idea is that alignment is achieved by moving diagrams'+-- local origins relative to their envelopes or traces (or some other+-- sort of boundary).  For example, to align several diagrams along+-- their tops, we first move their local origins to the upper edge of+-- their boundary (using e.g. @map 'alignZMax'@), and then put them+-- together with their local origins along a line (using e.g. 'cat'+-- from "Diagrams.Combinators").+--+-----------------------------------------------------------------------------++module Diagrams.ThreeD.Align+    ( -- * Absolute alignment+      -- ** Align by envelope+      alignXMin, alignXMax, alignYMin, alignYMax, alignZMin, alignZMax++      -- ** Align by trace+    , snugXMin, snugXMax, snugYMin, snugYMax, snugZMin, snugZMax++      -- * Relative alignment+    , alignX, snugX, alignY, snugY, alignZ, snugZ++      -- * Centering+    , centerX, centerY, centerZ+    , centerXY, centerXZ, centerYZ, centerXYZ+    , snugCenterX, snugCenterY, snugCenterZ+    , snugCenterXY, snugCenterXZ, snugCenterYZ, snugCenterXYZ++    ) where++import           Diagrams.Core++import           Diagrams.Align+import           Diagrams.ThreeD.Types+import           Diagrams.ThreeD.Vector+import           Diagrams.TwoD.Align++-- | Translate the diagram along unitX so that all points have+--   positive x-values.+alignXMin :: (InSpace v n a, R1 v, Fractional n, Alignable a, HasOrigin a) => a -> a+alignXMin = align unit_X++snugXMin :: (InSpace v n a, R1 v, Fractional n, Alignable a, HasOrigin a, Traced a) => a -> a+snugXMin = snug unit_X++-- | Translate the diagram along unitX so that all points have+-- negative x-values.+alignXMax :: (InSpace v n a, R1 v, Fractional n, Alignable a, HasOrigin a) => a -> a+alignXMax = align unitX++snugXMax :: (InSpace v n a, R1 v, Fractional n, Alignable a, HasOrigin a, Traced a) => a -> a+snugXMax = snug unitX+++-- | Translate the diagram along unitY so that all points have+--   positive y-values.+alignYMin :: (InSpace v n a, R2 v, Fractional n, Alignable a, HasOrigin a) => a -> a+alignYMin = align unit_Y++snugYMin :: (InSpace v n a, R2 v, Fractional n, Alignable a, HasOrigin a, Traced a) => a -> a+snugYMin = snug unit_Y++-- | Translate the diagram along unitY so that all points have+-- negative y-values.+alignYMax :: (InSpace v n a, R2 v, Fractional n, Alignable a, HasOrigin a) => a -> a+alignYMax = align unitY++snugYMax :: (InSpace v n a, R2 v, Fractional n, Alignable a, HasOrigin a, Traced a) => a -> a+snugYMax = snug unitY+++-- | Translate the diagram along unitZ so that all points have+--   positive z-values.+alignZMin :: (InSpace v n a, R3 v, Fractional n, Alignable a, HasOrigin a) => a -> a+alignZMin = align unit_Z++snugZMin :: (InSpace v n a, R3 v, Fractional n, Alignable a, HasOrigin a, Traced a) => a -> a+snugZMin = snug unit_Z++-- | Translate the diagram along unitZ so that all points have+-- negative z-values.+alignZMax :: (InSpace v n a, R3 v, Fractional n, Alignable a, HasOrigin a) => a -> a+alignZMax = align unitZ++snugZMax :: (InSpace v n a, R3 v, Fractional n, Alignable a, HasOrigin a, Traced a) => a -> a+snugZMax = snug unitZ++-- | Like 'alignX', but moving the local origin in the Z direction, with an+--   argument of @1@ corresponding to the top edge and @(-1)@ corresponding+--   to the bottom edge.+alignZ :: (InSpace v n a, R3 v, Fractional n, Alignable a, HasOrigin a) => n -> a -> a+alignZ = alignBy unitZ++-- | See the documentation for 'alignZ'.+snugZ :: (V a ~ v, N a ~ n, Alignable a, Traced a, HasOrigin a,+          R3 v, Fractional n) => n -> a -> a+snugZ = snugBy unitZ+++-- | Center the local origin along the Z-axis.+centerZ :: (InSpace v n a, R3 v, Fractional n, Alignable a, HasOrigin a) => a -> a+centerZ = alignBy unitZ 0++snugCenterZ :: (InSpace v n a, R3 v, Fractional n, Alignable a, HasOrigin a, Traced a) => a -> a+snugCenterZ = snugBy unitZ 0++-- | Center along both the X- and Z-axes.+centerXZ :: (InSpace v n a, R3 v, Fractional n, Alignable a, HasOrigin a) => a -> a+centerXZ = centerX . centerZ++snugCenterXZ :: (InSpace v n a, R3 v, Fractional n, Alignable a, HasOrigin a, Traced a) => a -> a+snugCenterXZ = snugCenterX . snugCenterZ+++-- | Center along both the Y- and Z-axes.+centerYZ :: (InSpace v n a, R3 v, Fractional n, Alignable a, HasOrigin a) => a -> a+centerYZ = centerZ . centerY++snugCenterYZ :: (InSpace v n a, R3 v, Fractional n, Alignable a, HasOrigin a, Traced a) => a -> a+snugCenterYZ = snugCenterZ . snugCenterY++-- | Center an object in three dimensions.+centerXYZ :: (InSpace v n a, R3 v, Fractional n, Alignable a, HasOrigin a) => a -> a+centerXYZ = centerX . centerY . centerZ++snugCenterXYZ :: (InSpace v n a, R3 v, Fractional n, Alignable a, HasOrigin a, Traced a) => a -> a+snugCenterXYZ = snugCenterX . snugCenterY . snugCenterZ

+ src/Diagrams/ThreeD/Attributes.hs view

@@ -0,0 +1,138 @@+{-# LANGUAGE DeriveDataTypeable         #-}+{-# LANGUAGE FlexibleContexts           #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses      #-}+{-# LANGUAGE TemplateHaskell            #-}+{-# LANGUAGE TypeFamilies               #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Diagrams.ThreeD.Attributes+-- Copyright   :  (c) 2014 diagrams-lib team (see LICENSE)+-- License     :  BSD-style (see LICENSE)+-- Maintainer  :  diagrams-discuss@googlegroups.com+--+-- Diagrams may have /attributes/ which affect the way they are+-- rendered.  This module defines some common attributes relevant in+-- 3D; particular backends may also define more backend-specific+-- attributes.+--+-- Every attribute type must have a /semigroup/ structure, that is, an+-- associative binary operation for combining two attributes into one.+-- Unless otherwise noted, all the attributes defined here use the+-- 'Last' structure, that is, combining two attributes simply keeps+-- the second one and throws away the first.  This means that child+-- attributes always override parent attributes.+--+-----------------------------------------------------------------------------++module Diagrams.ThreeD.Attributes where++import           Control.Lens+import           Data.Semigroup+import           Data.Typeable++import           Data.Colour++import           Diagrams.Core++-- | @SurfaceColor@ is the inherent pigment of an object, assumed to+-- be opaque.+newtype SurfaceColor = SurfaceColor (Last (Colour Double))+  deriving (Typeable, Semigroup, Show)++instance AttributeClass SurfaceColor++_SurfaceColor :: Iso' SurfaceColor (Colour Double)+_SurfaceColor = iso (\(SurfaceColor (Last c)) -> c) (SurfaceColor . Last)++-- | Set the surface color.+sc :: HasStyle d => Colour Double -> d -> d+sc = applyAttr . review _SurfaceColor++-- | Lens onto the surface colour of a style.+_sc :: Lens' (Style v n) (Maybe (Colour Double))+_sc = atAttr . mapping _SurfaceColor++-- | @Diffuse@ is the fraction of incident light reflected diffusely,+-- that is, in all directions.  The actual light reflected is the+-- product of this value, the incident light, and the @SurfaceColor@+-- Attribute.  For physical reasonableness, @Diffuse@ should have a+-- value between 0 and 1; this is not checked.+newtype Diffuse = Diffuse (Last Double)+  deriving (Typeable, Semigroup, Show)++instance AttributeClass Diffuse++-- | Isomorphism between 'Diffuse' and 'Double'+_Diffuse :: Iso' Diffuse Double+_Diffuse = iso (\(Diffuse (Last d)) -> d) (Diffuse . Last)++-- | Set the diffuse reflectance.+diffuse :: HasStyle d => Double -> d -> d+diffuse = applyAttr . review _Diffuse++-- | Lens onto the possible diffuse reflectance in a style.+_diffuse :: Lens' (Style v n) (Maybe Double)+_diffuse = atAttr . mapping _Diffuse++-- | @Ambient@ is an ad-hoc representation of indirect lighting.  The+-- product of @Ambient@ and @SurfaceColor@ is added to the light+-- leaving an object due to diffuse and specular terms.  @Ambient@ can+-- be set per-object, and can be loosely thought of as the product of+-- indirect lighting incident on that object and the diffuse+-- reflectance.+newtype Ambient = Ambient (Last Double)+  deriving (Typeable, Semigroup, Show)++instance AttributeClass Ambient++_Ambient :: Iso' Ambient Double+_Ambient = iso (\(Ambient (Last d)) -> d) (Ambient . Last)++-- | Set the emittance due to ambient light.+ambient :: HasStyle d => Double -> d -> d+ambient = applyAttr . review _Ambient++-- | Lens onto the possible ambience in a style.+_ambient :: Lens' (Style v n) (Maybe Double)+_ambient = atAttr . mapping _Ambient++-- | A specular highlight has two terms, the intensity, between 0 and+-- 1, and the size.  The highlight size is assumed to be the exponent+-- in a Phong shading model (though Backends are free to use a+-- different shading model).  In this model, reasonable values are+-- between 1 and 50 or so, with higher values for shinier objects.+-- Physically, the intensity and the value of @Diffuse@ must add up to+-- less than 1; this is not enforced.+data Specular = Specular+  { _specularIntensity :: Double+  , _specularSize      :: Double+  } deriving Show++makeLenses ''Specular++newtype Highlight = Highlight (Last Specular)+  deriving (Typeable, Semigroup, Show)++instance AttributeClass Highlight++_Highlight :: Iso' Highlight Specular+_Highlight = iso (\(Highlight (Last s)) -> s) (Highlight . Last)++-- | Set the specular highlight.+highlight :: HasStyle d => Specular -> d -> d+highlight = applyAttr . review _Highlight++-- | Lens onto the possible specular highlight in a style+_highlight :: Lens' (Style v n) (Maybe Specular)+_highlight = atAttr . mapping _Highlight++-- | Traversal over the highlight intensity of a style. If the style has+--   no 'Specular', setting this will do nothing.+highlightIntensity :: Traversal' (Style v n) Double+highlightIntensity = _highlight . _Just . specularSize++-- | Traversal over the highlight size in a style. If the style has no+--   'Specular', setting this will do nothing.+highlightSize :: Traversal' (Style v n) Double+highlightSize = _highlight . _Just . specularSize

+ src/Diagrams/ThreeD/Camera.hs view

@@ -0,0 +1,146 @@+{-# LANGUAGE DeriveDataTypeable    #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE TemplateHaskell       #-}+{-# LANGUAGE TypeFamilies          #-}+{-# LANGUAGE UndecidableInstances  #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Diagrams.ThreeD.Camera+-- Copyright   :  (c) 2013 diagrams-lib team (see LICENSE)+-- License     :  BSD-style (see LICENSE)+-- Maintainer  :  diagrams-discuss@googlegroups.com+--+-- Types to specify viewpoint for 3D rendering.+--+-----------------------------------------------------------------------------++module Diagrams.ThreeD.Camera+       ( Camera  -- do not export constructor+        -- These are safe to construct manually+       , PerspectiveLens(..), OrthoLens(..)+       , horizontalFieldOfView, verticalFieldOfView+       , orthoWidth, orthoHeight+       , camLoc, camForward, camUp, camRight, camLens+       , facing_ZCamera, mm50Camera+       , mm50, mm50Wide, mm50Narrow+       , aspect, camAspect+       )+       where++import           Control.Lens           (makeLenses)+import           Data.Monoid+import           Data.Typeable++import           Diagrams.Angle+import           Diagrams.Core+import           Diagrams.Direction+import           Diagrams.ThreeD.Vector++import           Linear.V3++-- Parameterize Camera on the lens type, so that Backends can express which+-- lenses they handle.+data Camera l n = Camera+    { camLoc  :: Point V3 n+    , forward :: V3 n+    , up      :: V3 n+    , lens    :: l n+    }+  deriving Typeable++type instance V (Camera l n) = V3+type instance N (Camera l n) = n++class Typeable l => CameraLens l where+  -- | The natural aspect ratio of the projection.+  aspect :: Floating n => l n -> n++-- | A perspective projection+data PerspectiveLens n = PerspectiveLens+  { _horizontalFieldOfView :: Angle n -- ^ Horizontal field of view.+  , _verticalFieldOfView   :: Angle n -- ^ Vertical field of view.+  }+  deriving Typeable++makeLenses ''PerspectiveLens++type instance V (PerspectiveLens n) = V3+type instance N (PerspectiveLens n) = n++instance CameraLens PerspectiveLens where+  aspect (PerspectiveLens h v) = angleRatio h v++-- | An orthographic projection+data OrthoLens n = OrthoLens+               { _orthoWidth  :: n -- ^ Width+               , _orthoHeight :: n -- ^ Height+               }+  deriving Typeable++makeLenses ''OrthoLens++type instance V (OrthoLens n) = V3+type instance N (OrthoLens n) = n++instance CameraLens OrthoLens where+  aspect (OrthoLens h v) = h / v++instance Num n => Transformable (Camera l n) where+  transform t (Camera p f u l) =+      Camera (transform t p)+             (transform t f)+             (transform t u)+             l++instance Num n => Renderable (Camera l n) NullBackend where+  render _ _ = mempty++-- | A camera at the origin facing along the negative Z axis, with its+-- up-axis coincident with the positive Y axis.  The field of view is+-- chosen to match a 50mm camera on 35mm film. Note that Cameras take+-- up no space in the Diagram.+mm50Camera :: (Typeable n, Floating n, Ord n, Renderable (Camera PerspectiveLens n) b)+           => QDiagram b V3 n Any+mm50Camera = facing_ZCamera mm50++-- | 'facing_ZCamera l' is a camera at the origin facing along the+-- negative Z axis, with its up-axis coincident with the positive Y+-- axis, with the projection defined by l.+facing_ZCamera :: (Floating n, Ord n, Typeable n, CameraLens l, Renderable (Camera l n) b) =>+                  l n -> QDiagram b V3 n Any+facing_ZCamera l = mkQD (Prim $ Camera origin unit_Z unitY l)+        mempty mempty mempty (Query . const . Any $ False)+{-# ANN facing_ZCamera ("HLint: ignore Use camelCase" :: String) #-}++mm50, mm50Wide, mm50Narrow :: Floating n => PerspectiveLens n++-- | mm50 has the field of view of a 50mm lens on standard 35mm film,+-- hence an aspect ratio of 3:2.+mm50 = PerspectiveLens (40.5 @@ deg) (27 @@ deg)++-- | mm50blWide has the same vertical field of view as mm50, but an+-- aspect ratio of 1.6, suitable for wide screen computer monitors.+mm50Wide = PerspectiveLens (43.2 @@ deg)  (27 @@ deg)++-- | mm50Narrow has the same vertical field of view as mm50, but an+-- aspect ratio of 4:3, for VGA and similar computer resolutions.+mm50Narrow = PerspectiveLens (36 @@ deg) (27 @@ deg)++camForward :: Camera l n -> Direction V3 n+camForward = direction . forward++camUp :: Camera l n -> Direction V3 n+camUp = direction . up++camRight :: Fractional n => Camera l n -> Direction V3 n+camRight c = direction right where+  right = cross (forward c) (up c)++camLens :: Camera l n -> l n+camLens = lens++camAspect :: (Floating n, CameraLens l) => Camera l n -> n+camAspect = aspect . camLens

+ src/Diagrams/ThreeD/Deform.hs view

@@ -0,0 +1,28 @@+module Diagrams.ThreeD.Deform+  ( parallelX0, perspectiveX1, facingX+  , parallelY0, perspectiveY1, facingY+  , parallelZ0, perspectiveZ1, facingZ+  ) where++import           Control.Lens++import           Diagrams.Deform+import           Diagrams.TwoD.Deform++import           Linear.V3+import           Linear.Vector++-- | The parallel projection onto the plane z=0+parallelZ0 :: (R3 v, Num n) => Deformation v v n+parallelZ0 = Deformation (_z .~ 0)++-- | The perspective division onto the plane z=1 along lines going+--   through the origin.+perspectiveZ1 :: (R3 v, Functor v, Fractional n) => Deformation v v n+perspectiveZ1 = Deformation $ \p -> p ^/ (p ^. _z)++facingZ :: (R3 v, Functor v, Fractional n) => Deformation v v n+facingZ = Deformation $+  \p -> let z = p ^. _z+        in  p ^/ z & _z .~ z+

+ src/Diagrams/ThreeD/Light.hs view

@@ -0,0 +1,65 @@+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DeriveDataTypeable    #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies          #-}+{-# LANGUAGE UndecidableInstances  #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Diagrams.ThreeD.Render+-- Copyright   :  (c) 2013 diagrams-lib team (see LICENSE)+-- License     :  BSD-style (see LICENSE)+-- Maintainer  :  diagrams-discuss@googlegroups.com+--+-- Types to specify lighting for 3D rendering.+--+-----------------------------------------------------------------------------++module Diagrams.ThreeD.Light where++import           Data.Colour+import           Data.Monoid+import           Data.Typeable++import           Diagrams.Core+import           Diagrams.Direction+import           Diagrams.ThreeD.Types++-- | A @PointLight@ radiates uniformly in all directions from a given+-- point.+data PointLight n = PointLight (Point V3 n) (Colour Double)+  deriving Typeable++type instance V (PointLight n) = V3+type instance N (PointLight n) = n++-- | A @ParallelLight@ casts parallel rays in the specified direction,+-- from some distant location outside the scene.+data ParallelLight n = ParallelLight (V3 n) (Colour Double)+  deriving Typeable++type instance V (ParallelLight n) = V3+type instance N (ParallelLight n) = n++instance Fractional n => Transformable (PointLight n) where+  transform t (PointLight p c) = PointLight (transform t p) c++instance Transformable (ParallelLight n) where+  transform t (ParallelLight v c) = ParallelLight (transform t v) c++-- | Construct a Diagram with a single PointLight at the origin, which+-- takes up no space.+pointLight :: (Typeable n, Num n, Ord n, Renderable (PointLight n) b)+              => Colour Double -- ^ The color of the light+              -> QDiagram b V3 n Any+pointLight c = mkQD (Prim $ PointLight origin c) mempty mempty mempty+               (Query . const . Any $ False)++-- | Construct a Diagram with a single ParallelLight, which takes up no space.+parallelLight :: (Typeable n, OrderedField n, Renderable (ParallelLight n) b)+                 => Direction V3 n -- ^ The direction in which the light travels.+                 -> Colour Double  -- ^ The color of the light.+                 -> QDiagram b V3 n Any+parallelLight d c = mkQD (Prim $ ParallelLight (fromDirection d) c)+                    mempty mempty mempty (Query . const . Any $ False)

+ src/Diagrams/ThreeD/Projection.hs view

@@ -0,0 +1,168 @@+{-# LANGUAGE ConstraintKinds       #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes            #-}+{-# LANGUAGE TypeFamilies          #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Diagrams.ThreeD.Projection+-- Copyright   :  (c) 2014 diagrams team (see LICENSE)+-- License     :  BSD-style (see LICENSE)+-- Maintainer  :  diagrams-discuss@googlegroups.com+--+-- 3D projections are a way of viewing a three-dimensional objects on a+-- two-dimensional plane.+--+-- This module can be used with the functions in "Linear.Projection".+--+-- Disclaimer: This module should be considered experimental and is+-- likely to change.+--+-----------------------------------------------------------------------------++module Diagrams.ThreeD.Projection+  ( -- * Orthographic projections++    -- $orthographic+    -- ** Parallel projections+    facingXY+  , facingXZ+  , facingYZ++    -- ** axonometric+    -- $axonometric++    -- *** Isometric projections+    -- $isometric+  , isometricApply+  , isometric++  , lookingAt++    -- ** Affine maps+  , m44AffineApply+  , m44AffineMap+  , m33AffineApply+  , m33AffineMap++    -- * Perspective projections+    -- $perspective+    -- ** Perspective deformations+  , m44Deformation+  , module Linear.Projection+  ) where++import           Control.Lens           hiding (transform)+import           Data.Functor.Rep++import           Diagrams.Core+import           Diagrams.Deform+import           Diagrams.Direction+import           Diagrams.LinearMap+import           Diagrams.ThreeD.Types  (P3)+import           Diagrams.ThreeD.Vector++import           Linear                 as L+import           Linear.Affine+import           Linear.Projection++------------------------------------------------------------------------+-- Orthographic projections+------------------------------------------------------------------------++-- $orthographic+-- Orthographic projections are a form of parallel projections where are+-- projection lines are orthogonal to the projection plane.++-- Parallel projections++-- | Look at the xy-plane with y as the up direction.+facingXY :: (Epsilon n, Floating n) => AffineMap V3 V2 n+facingXY = lookingAt unitZ origin yDir++-- | Look at the xz-plane with z as the up direction.+facingXZ :: (Epsilon n, Floating n) => AffineMap V3 V2 n+facingXZ = lookingAt unitY origin zDir++-- | Look at the yz-plane with z as the up direction.+facingYZ :: (Epsilon n, Floating n) => AffineMap V3 V2 n+facingYZ = lookingAt unitX origin zDir++-- $axonometric+-- Axonometric projections are a type of orthographic projection where+-- the object is rotated along one or more of its axes relative to the+-- plane of projection.++-- $isometric+-- Isometric projections are when the scale along each axis of the+-- projection is the same and the angle between any axis is 120+-- degrees.++-- | Apply an isometric projection given the up direction+isometricApply :: (InSpace V3 n a, InSpace V2 n b, AffineMappable a b, Floating n, Epsilon n)+               => Direction V3 n -> a -> b+isometricApply up = amap (isometric up)++-- | Make an isometric affine map with the given up direction.+isometric :: (Floating n, Epsilon n) => Direction V3 n -> AffineMap V3 V2 n+isometric up = m44AffineMap m+  where+    m = lookAt (V3 1 1 1) zero (fromDirection up)++lookingAt :: (Epsilon n, Floating n)+          => P3 n -- ^ Eye+          -> P3 n -- ^ Center+          -> Direction V3 n -- ^ Up+          -> AffineMap V3 V2 n+lookingAt (P cam) (P center) d = m44AffineMap m+  where+    m = lookAt cam center (d^._Dir)++-- | Apply the affine part of a homogeneous matrix.+m44AffineApply :: (InSpace V3 n a, InSpace V2 n b, AffineMappable a b)+               => M44 n -> a -> b+m44AffineApply = amap . m44AffineMap++-- | Create an 'AffineMap' from a 4x4 homogeneous matrix, ignoring any+--   perspective transforms.+m44AffineMap :: Num n => M44 n -> AffineMap V3 V2 n+m44AffineMap m = AffineMap (LinearMap f) (f v)+  where+    f  = view _xy . (m' !*)+    m' = m ^. linearTransform+    v  = m ^. L.translation++-- | Apply a transformation matrix and translation.+m33AffineApply :: (InSpace V3 n a, InSpace V2 n b, AffineMappable a b)+               => M33 n -> V2 n -> a -> b+m33AffineApply m = amap . m33AffineMap m++-- | Create an 'AffineMap' from a 3x3 transformation matrix and a+--   translation vector.+m33AffineMap :: Num n => M33 n -> V2 n -> AffineMap V3 V2 n+m33AffineMap m = AffineMap (LinearMap f)+  where+    f = view _xy . (m !*)++-- | Extract the linear transform part of a homogeneous matrix.+linearTransform :: (Representable u, R3 v, R3 u) => Lens' (u (v n)) (M33 n)+linearTransform = column _xyz . _xyz++------------------------------------------------------------------------+-- Perspective transforms+------------------------------------------------------------------------++-- For the time being projective transforms use the deformable class.+-- Eventually we would like to replace this with a more specialised+-- method.++-- $perspective+-- Perspective projections are when closer objects appear bigger.++-- | Make a deformation from a 4x4 homogeneous matrix.+m44Deformation :: Fractional n => M44 n -> Deformation V3 V2 n+m44Deformation m =+  Deformation (P . view _xy . normalizePoint . (m !*) . point . view _Point)+

src/Diagrams/ThreeD/Shapes.hs view

@@ -1,8 +1,11 @@-{-# LANGUAGE TypeFamilies-           , FlexibleContexts-           , MultiParamTypeClasses-           , ViewPatterns-  #-}+{-# LANGUAGE ConstraintKinds       #-}+{-# LANGUAGE DeriveDataTypeable    #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes            #-}+{-# LANGUAGE TypeFamilies          #-}+{-# LANGUAGE TypeOperators         #-}+{-# LANGUAGE UndecidableInstances  #-} ----------------------------------------------------------------------------- -- | -- Module      :  Diagrams.ThreeD.Shapes@@ -15,45 +18,307 @@ -----------------------------------------------------------------------------  module Diagrams.ThreeD.Shapes-       (-         Ellipsoid(..)-       , sphere-       ) where+  (+    -- * Skinned class+    Skinned(..) -import Prelude hiding (minimum)-import Data.Semigroup+    -- * Basic 3D shapes+  , Ellipsoid(..)+  , sphere -import Data.AffineSpace-import Data.Monoid.Inf (minimum)-import Data.VectorSpace+  , Box(..)+  , cube -import Diagrams.Core+  , Frustum(..)+  , frustum+  , cone+  , cylinder -import Diagrams.ThreeD.Types-import Diagrams.Solve+    -- * Constructive solid geometry+  , CSG(..)+  , union+  , intersection+  , difference+  ) where -data Ellipsoid = Ellipsoid T3+import           Control.Lens              (review, (^.), _1)+import           Data.Typeable -type instance V Ellipsoid = R3+import           Data.Semigroup+import           Diagrams.Angle+import           Diagrams.Core+import           Diagrams.Core.Trace+import           Diagrams.Points+import           Diagrams.Query+import           Diagrams.Solve.Polynomial+import           Diagrams.ThreeD.Types+import           Diagrams.ThreeD.Vector -instance Transformable Ellipsoid where+import           Linear.Affine+import           Linear.Metric+import           Linear.Vector++data Ellipsoid n = Ellipsoid (Transformation V3 n)+  deriving Typeable++type instance V (Ellipsoid n) = V3+type instance N (Ellipsoid n) = n++instance Fractional n => Transformable (Ellipsoid n) where   transform t1 (Ellipsoid t2) = Ellipsoid (t1 <> t2) -instance IsPrim Ellipsoid+instance Fractional n => Renderable (Ellipsoid n) NullBackend where+  render _ _ = mempty -instance Renderable Ellipsoid NullBackend where+instance OrderedField n => Enveloped (Ellipsoid n) where+  getEnvelope (Ellipsoid tr) = transform tr . mkEnvelope $ \v -> 1 / norm v++instance OrderedField n => Traced (Ellipsoid n) where+  getTrace (Ellipsoid tr) = transform tr . mkTrace $ \(P p) v -> let+    a  =    v `dot` v+    b  = 2 * (p `dot` v)+    c  =    (p `dot` p) - 1+    in+     mkSortedList $ quadForm a b c++-- | A sphere of radius 1 with its center at the origin.+sphere :: Num n => Ellipsoid n+sphere = Ellipsoid mempty++data Box n = Box (Transformation V3 n)+  deriving Typeable++type instance V (Box n) = V3+type instance N (Box n) = n++instance Fractional n => Transformable (Box n) where+  transform t1 (Box t2) = Box (t1 <> t2)++instance Fractional n => Renderable (Box n) 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 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+instance OrderedField n => Enveloped (Box n) where+  getEnvelope (Box tr) = transform tr . mkEnvelope $ \v ->+    maximum (map (v `dot`) corners) / quadrance v where+      corners = mkR3 <$> [0,1] <*> [0,1] <*> [0,1]++instance (Fractional n, Ord n) => Traced (Box n) where+  getTrace (Box tr) = transform tr . mkTrace $ \p v -> let+    (x0, y0, z0) = unp3 p+    (vx, vy, vz) = unr3 v+    intersections f d = case d of+      0 -> []+      _ -> [-f/d, (1-f)/d]+    ts = concat $ zipWith intersections [x0,y0,z0] [vx,vy,vz]+    atT t = p .+^ (t*^v)+    range u = and [x >= 0, x <= 1, y >= 0, y <= 1, z >= 0, z <= 1] where+      (x, y, z) = unp3 u+    in+     -- ts gives all intersections with the planes forming the box+     -- filter keeps only those actually on the box surface+     mkSortedList . filter (range . atT) $ ts where++-- | A cube with side length 1, in the positive octant, with one+-- vertex at the origin.+cube :: Num n => Box n+cube = Box mempty++data Frustum n = Frustum n n (Transformation V3 n)+  deriving Typeable++type instance V (Frustum n) = V3+type instance N (Frustum n) = n++instance Fractional n => Transformable (Frustum n) where+  transform t1 (Frustum r0 r1 t2) = Frustum r0 r1 (t1 <> t2)++instance Fractional n => Renderable (Frustum n) NullBackend where+  render _ _ = mempty++instance (OrderedField n, RealFloat n) => Enveloped (Frustum n) where+  -- The plane containing v and the z axis intersects the frustum in a trapezoid+  -- Test the four corners of this trapezoid; one must determine the Envelope+  getEnvelope (Frustum r0 r1 tr) = transform tr . mkEnvelope $ \v ->let+    θ = v ^. _theta+    corners = [(r1,θ,1), (-r1,θ,1), (r0,θ,0), (-r0,θ,0)]+    in+     maximum . map (norm . project v . review r3CylindricalIso) $ corners++instance (RealFloat n, Ord n) => Traced (Frustum n) where+  -- The trace can intersect the sides of the cone or one of the end+  -- caps The sides are described by a quadric equation; substitute+  -- in the parametric form of the ray but disregard any+  -- intersections outside z = [0,1] Similarly, find intersections+  -- with the planes z=0, z=1, but disregard any r>r0, r>r1+  getTrace (Frustum r0 r1 tr) = transform tr . mkTrace $ \p v -> let+    (px, py, pz) = unp3 p+    (vx, vy, vz) = unr3 v+    ray t = p .+^ t *^ v+    dr = r1 - r0+    a = vx**2 + vy**2 - vz**2 * dr**2+    b = 2 * (px * vx + py * vy - (r0+pz*dr) * dr  * vz)+    c = px**2 + py**2 - (r0 + dr*pz)**2+    zbounds t = ray t ^. _z >= 0+         && ray t ^. _z <= 1+    ends = concatMap cap [0,1]+    cap z = [ t | ray t ^. lensP . r3CylindricalIso . _1 < r0 + z * dr ]+      where+      t = (z - pz) / vz+    in+     mkSortedList $ filter zbounds (quadForm a b c) ++ ends++-- | A frustum of a right circular cone.  It has height 1 oriented+-- along the positive z axis, and radii r0 and r1 at Z=0 and Z=1.+-- 'cone' and 'cylinder' are special cases.+frustum :: Num n => n -> n -> Frustum n+frustum r0 r1 = Frustum r0 r1 mempty++-- | A cone with its base centered on the origin, with radius 1 at the+-- base, height 1, and it's apex on the positive Z axis.+cone :: Num n => Frustum n+cone = frustum 1 0++-- | A circular cylinder of radius 1 with one end cap centered on the+-- origin, and extending to Z=1.+cylinder :: Num n => Frustum n+cylinder = frustum 1 1++-- | Types which can be rendered as 3D Diagrams.+class Skinned t where+  skin :: (Renderable t b, N t ~ n, TypeableFloat n) => t -> QDiagram b V3 n Any++instance (Num n, Ord n) => HasQuery (Ellipsoid n) Any where+  getQuery (Ellipsoid tr) = transform tr $+    Query $ \v -> Any $ quadrance (v .-. origin) <= 1++instance OrderedField n => Skinned (Ellipsoid n) where+  skin s = mkQD (Prim s) (getEnvelope s) (getTrace s) mempty (getQuery s)++instance (Num n, Ord n) => HasQuery (Box n) Any where+  getQuery (Box tr) = transform tr . Query $ Any . range where+    range u = and [x >= 0, x <= 1, y >= 0, y <= 1, z >= 0, z <= 1] where+      (x, y, z) = unp3 u++instance OrderedField n => Skinned (Box n) where+  skin s = mkQD (Prim s) (getEnvelope s) (getTrace s) mempty (getQuery s)++instance (OrderedField n) => HasQuery (Frustum n) Any where+  getQuery (Frustum r0 r1 tr)= transform tr $+    Query $ \p -> let+      z = p^._z+      r = r0 + (r1 - r0)*z+      v = p .-. origin+      a = norm $ projectXY v+      projectXY u = u ^-^ project unitZ u+      in+       Any $ z >= 0 && z <= 1 && a <= r++instance Skinned (Frustum n) where+  skin s = mkQD (Prim s) (getEnvelope s) (getTrace s) mempty (getQuery s)++-- The CSG type needs to form a tree to be useful.  This+-- implementation requires Backends to support all the included+-- primitives.  If that turns out to be a problem, we have several+-- options:+-- a) accept runtime errors for unsupported primitives+-- b) carry the set of primitives in a row type in the CSG type+-- c) implement CSG in Haskell, so Backends supporting triangle meshes+--    can fall back to those.+-- (c) is worth doing anyway; I'm ambivalent about the others.  -DMB++-- | A tree of Constructive Solid Geometry operations and the primitives that+-- can be used in them.+data CSG n+  = CsgEllipsoid (Ellipsoid n)+  | CsgBox (Box n)+  | CsgFrustum (Frustum n)+  | CsgUnion [CSG n]+  | CsgIntersection [CSG n]+  | CsgDifference (CSG n) (CSG n)+  deriving Typeable++type instance V (CSG n) = V3+type instance N (CSG n) = n++instance Fractional n => Transformable (CSG n) where+  transform t (CsgEllipsoid p) = CsgEllipsoid $ transform t p+  transform t (CsgBox p) = CsgBox $ transform t p+  transform t (CsgFrustum p) = CsgFrustum $ transform t p+  transform t (CsgUnion ps) = CsgUnion $ map (transform t) ps+  transform t (CsgIntersection ps) = CsgIntersection $ map (transform t) ps+  transform t (CsgDifference p1 p2) = CsgDifference (transform t p1) (transform t p2)++-- | The Envelope for an Intersection or Difference is simply the+-- Envelope of the Union.  This is wrong but easy to implement.+instance RealFloat n => Enveloped (CSG n) where+  getEnvelope (CsgEllipsoid p)      = getEnvelope p+  getEnvelope (CsgBox p)            = getEnvelope p+  getEnvelope (CsgFrustum p)        = getEnvelope p+  getEnvelope (CsgUnion ps)         = foldMap getEnvelope ps+  getEnvelope (CsgIntersection ps)  = foldMap getEnvelope ps+  getEnvelope (CsgDifference p1 p2) = getEnvelope p1 <> getEnvelope p2+-- TODO after implementing some approximation scheme, calculate+-- correct (approximate) envelopes for intersections and difference.++instance (Floating n, Ord n) => HasQuery (CSG n) Any where+  getQuery (CsgEllipsoid prim) = getQuery prim+  getQuery (CsgBox prim) = getQuery prim+  getQuery (CsgFrustum prim) = getQuery prim+  getQuery (CsgUnion ps) = foldMap getQuery ps+  getQuery (CsgIntersection ps) =+    Any . getAll <$> foldMap (fmap (All . getAny) . getQuery) ps+  getQuery (CsgDifference p1 p2) = inOut <$> getQuery p1 <*> getQuery p2 where+    inOut (Any a) (Any b) = Any $ a && not b++instance (RealFloat n, Ord n) => Traced (CSG n) where+  getTrace (CsgEllipsoid p) = getTrace p+  getTrace (CsgBox p) = getTrace p+  getTrace (CsgFrustum p) = getTrace p+  -- on surface of some p, and not inside any of the others+  getTrace (CsgUnion []) = mempty+  getTrace (CsgUnion (s:ss)) = mkTrace t where+    t pt v = onSortedList (filter $ without s) (appTrace (getTrace (CsgUnion ss)) pt v)+         <> onSortedList (filter $ without (CsgUnion ss)) (appTrace (getTrace s) pt v) where+      newPt dist = pt .+^ v ^* dist+      without prim = not . inquire prim . newPt+  -- on surface of some p, and inside all the others+  getTrace (CsgIntersection []) = mempty+  getTrace (CsgIntersection (s:ss)) = mkTrace t where+    t pt v = onSortedList (filter $ within s) (appTrace (getTrace (CsgIntersection ss)) pt v)+         <> onSortedList (filter $ within (CsgIntersection ss)) (appTrace (getTrace s) pt v) where+      newPt dist = pt .+^ v ^* dist+      within prim = inquire prim . newPt+  -- on surface of p1, outside p2, or on surface of p2, inside p1+  getTrace (CsgDifference s1 s2) = mkTrace t where+    t pt v = onSortedList (filter $ not . within s2) (appTrace (getTrace s1) pt v)+         <> onSortedList (filter $ within s1) (appTrace (getTrace s2) pt v) where+      newPt dist = pt .+^ v ^* dist+      within prim = inquire prim . newPt++instance (RealFloat n, Ord n) => Skinned (CSG n) where+  skin s = mkQD (Prim s) (getEnvelope s) (getTrace s) mempty (getQuery s)++-- | Types which can be included in CSG trees.+class CsgPrim a where+  toCsg :: a n -> CSG n++instance CsgPrim Ellipsoid where+  toCsg = CsgEllipsoid++instance CsgPrim Box where+  toCsg = CsgBox++instance CsgPrim Frustum where+  toCsg = CsgFrustum++instance CsgPrim CSG where+  toCsg = id++union :: (CsgPrim a, CsgPrim b) => a n -> b n -> CSG n+union a b = CsgUnion [toCsg a, toCsg b]++intersection :: (CsgPrim a, CsgPrim b) => a n -> b n -> CSG n+intersection a b = CsgIntersection [toCsg a, toCsg b]++difference :: (CsgPrim a, CsgPrim b) => a n -> b n -> CSG n+difference a b = CsgDifference (toCsg a) (toCsg b)

+ src/Diagrams/ThreeD/Size.hs view

@@ -0,0 +1,50 @@+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies     #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Diagrams.ThreeD.Size+-- Copyright   :  (c) 2014 diagrams-lib team (see LICENSE)+-- License     :  BSD-style (see LICENSE)+-- Maintainer  :  diagrams-discuss@googlegroups.com+--+-- Utilities for working with sizes of three-dimensional objects.+--+-----------------------------------------------------------------------------+module Diagrams.ThreeD.Size+       (+         -- ** Computing sizes+         extentX, extentY, extentZ++         -- ** Specifying sizes+       , mkSizeSpec3D+       , dims3D++       ) where++import           Diagrams.Core+import           Diagrams.Core.Envelope+import           Diagrams.Size+import           Diagrams.TwoD.Size+import           Diagrams.ThreeD.Types+import           Diagrams.ThreeD.Vector++------------------------------------------------------------+-- Computing diagram sizes+------------------------------------------------------------++-- | Compute the absolute z-coordinate range of an enveloped object in+--   the form @(lo,hi)@. Return @Nothing@ for objects with an empty+--   envelope.+extentZ :: (InSpace v n a, R3 v, Enveloped a) => a -> Maybe (n, n)+extentZ = extent unitZ++-- | Make a 'SizeSpec' from possibly-specified width and height.+mkSizeSpec3D :: Num n => Maybe n -> Maybe n -> Maybe n -> SizeSpec V3 n+mkSizeSpec3D x y z = mkSizeSpec (V3 x y z)++-- | Make a 'SizeSpec' from a width and height.+dims3D :: n -> n -> n -> SizeSpec V3 n+dims3D x y z = dims (V3 x y z)+

+ src/Diagrams/ThreeD/Transform.hs view

@@ -0,0 +1,223 @@+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE TypeFamilies          #-}+{-# LANGUAGE TypeOperators         #-}+{-# LANGUAGE ViewPatterns          #-}++{-# OPTIONS_GHC -fno-warn-unused-imports #-}+  -- for Data.Semigroup++-----------------------------------------------------------------------------+-- |+-- Module      :  Diagrams.ThreeD.Transform+-- Copyright   :  (c) 2013 diagrams-lib team (see LICENSE)+-- License     :  BSD-style (see LICENSE)+-- Maintainer  :  diagrams-discuss@googlegroups.com+--+-- Transformations specific to three dimensions, with a few generic+-- transformations (uniform scaling, translation) also re-exported for+-- convenience.+--+-----------------------------------------------------------------------------++module Diagrams.ThreeD.Transform+       ( T3++         -- * Rotation+       , aboutX, aboutY, aboutZ+       , rotationAbout, rotateAbout+       , pointAt, pointAt'++       -- * Scaling+       , scalingX, scalingY, scalingZ+       , scaleX, scaleY, scaleZ+       , scaling, scale++       -- * Translation+       , translationX, translateX+       , translationY, translateY+       , translationZ, translateZ+       , translation, translate++         -- * Reflection+       , reflectionX, reflectX+       , reflectionY, reflectY+       , reflectionZ, reflectZ+       , reflectionAcross, reflectAcross++       ) where++import           Diagrams.Core+import           Diagrams.Core.Transform++import           Diagrams.Angle+import           Diagrams.Direction+import           Diagrams.Points+import           Diagrams.ThreeD.Types+import           Diagrams.Transform++import           Control.Lens            (view, (&), (*~), (.~), (//~))+import           Data.Semigroup+import           Diagrams.TwoD.Transform++import           Linear.Affine+import           Linear.Metric+import           Linear.V3               (cross)+import           Linear.Vector++-- | Create a transformation which rotates by the given angle about+--   a line parallel the Z axis passing through the local origin.+--   A positive angle brings positive x-values towards the positive-y axis.+--+--   The angle can be expressed using any type which is an+--   instance of 'Angle'.  For example, @aboutZ (1\/4 \@\@+--   'turn')@, @aboutZ (tau\/4 \@\@ 'rad')@, and @aboutZ (90 \@\@+--   'deg')@ all represent the same transformation, namely, a+--   counterclockwise rotation by a right angle.  For more general rotations,+--   see 'rotationAbout'.+--+--   Note that writing @aboutZ (1\/4)@, with no type annotation, will+--   yield an error since GHC cannot figure out which sort of angle+--   you want to use.+aboutZ :: Floating n => Angle n -> Transformation V3 n+aboutZ (view rad -> a) = fromOrthogonal r where+  r = rot a <-> rot (-a)+  rot θ (V3 x y z) = V3 (cos θ * x - sin θ * y)+                        (sin θ * x + cos θ * y)+                        z++-- | Like 'aboutZ', but rotates about the X axis, bringing positive y-values+-- towards the positive z-axis.+aboutX :: Floating n => Angle n -> Transformation V3 n+aboutX (view rad -> a) = fromOrthogonal r where+  r = rot a <-> rot (-a)+  rot θ (V3 x y z) = V3 x+                        (cos θ * y - sin θ * z)+                        (sin θ * y + cos θ * z)++-- | Like 'aboutZ', but rotates about the Y axis, bringing postive+-- x-values towards the negative z-axis.+aboutY :: Floating n => Angle n -> Transformation V3 n+aboutY (view rad -> a) = fromOrthogonal r where+  r = rot a <-> rot (-a)+  rot θ (V3 x y z) = V3 (cos θ * x + sin θ * z)+                        y+                        (-sin θ * x + cos θ * z)++-- | @rotationAbout p d a@ is a rotation about a line parallel to @d@+--   passing through @p@.+rotationAbout+  :: Floating n+  => Point V3 n         -- ^ origin of rotation+  -> Direction V3 n     -- ^ direction of rotation axis+  -> Angle n            -- ^ angle of rotation+  -> Transformation V3 n+rotationAbout (P t) d (view rad -> a)+  = mconcat [translation (negated t),+             fromOrthogonal r,+             translation t] where+    r = rot a <-> rot (-a)+    w = fromDirection d++    rot θ v =          v ^* cos θ+           ^+^ cross w v ^* sin θ+           ^+^         w ^* ((w `dot` v) * (1 - cos θ))++-- | @rotationAbout p d a@ is a rotation about a line parallel to @d@+--   passing through @p@.+rotateAbout+  :: (InSpace V3 n t, Floating n, Transformable t)+  => Point V3 n         -- ^ origin of rotation+  -> Direction V3 n     -- ^ direction of rotation axis+  -> Angle n            -- ^ angle of rotation+  -> t -> t+rotateAbout p d theta = transform (rotationAbout p d theta)++-- | @pointAt about initial final@ produces a rotation which brings+-- the direction @initial@ to point in the direction @final@ by first+-- panning around @about@, then tilting about the axis perpendicular+-- to @about@ and @final@.  In particular, if this can be accomplished+-- without tilting, it will be, otherwise if only tilting is+-- necessary, no panning will occur.  The tilt will always be between+-- ± 1/4 turn.+pointAt :: (Floating n, Ord n)+        => Direction V3 n -> Direction V3 n -> Direction V3 n+        -> Transformation V3 n+pointAt a i f = pointAt' (fromDirection a) (fromDirection i) (fromDirection f)++-- | pointAt' has the same behavior as 'pointAt', but takes vectors+-- instead of directions.+pointAt' :: (Floating n, Ord n) => V3 n -> V3 n -> V3 n -> Transformation V3 n+pointAt' about initial final = pointAtUnit (signorm about) (signorm initial) (signorm final)++-- | pointAtUnit has the same behavior as @pointAt@, but takes unit vectors.+pointAtUnit :: (Floating n, Ord n) => V3 n -> V3 n -> V3 n -> Transformation V3 n+pointAtUnit about initial final = tilt <> pan where+  -- rotating u by (signedAngle rel u v) about rel gives a vector in the direction of v+  signedAngle rel u v = signum (cross u v `dot` rel) *^ angleBetween u v+  inPanPlaneF = final ^-^ project about final+  inPanPlaneI = initial ^-^ project about initial+  panAngle    = signedAngle about inPanPlaneI inPanPlaneF+  pan         = rotationAbout origin (direction about) panAngle+  tiltAngle   = signedAngle tiltAxis (transform pan initial) final+  tiltAxis    = cross final about+  tilt        = rotationAbout origin (direction tiltAxis) tiltAngle++-- Scaling -------------------------------------------------++-- | Construct a transformation which scales by the given factor in+--   the z direction.+scalingZ :: (Additive v, R3 v, Fractional n) => n -> Transformation v n+scalingZ c = fromSymmetric $ (_z *~ c) <-> (_z //~ c)++-- | Scale a diagram by the given factor in the z direction.  To scale+-- uniformly, use 'scale'.+scaleZ :: (InSpace v n t, R3 v, Fractional n, Transformable t) => n -> t -> t+scaleZ = transform . scalingZ++-- Translation ----------------------------------------++-- | Construct a transformation which translates by the given distance+--   in the z direction.+translationZ :: (Additive v, R3 v, Num n) => n -> Transformation v n+translationZ z = translation (zero & _z .~ z)++-- | Translate a diagram by the given distance in the y+--   direction.+translateZ :: (InSpace v n t, R3 v, Transformable t) => n -> t -> t+translateZ = transform . translationZ++-- Reflection ----------------------------------------------++-- | Construct a transformation which flips a diagram across z=0,+-- i.e. sends the point (x,y,z) to (x,y,-z).+reflectionZ :: (Additive v, R3 v, Num n) => Transformation v n+reflectionZ = fromSymmetric $ (_z *~ (-1)) <-> (_z *~ (-1))++-- | Flip a diagram across z=0, i.e. send the point (x,y,z) to+-- (x,y,-z).+reflectZ :: (InSpace v n t, R3 v, Transformable t) => t -> t+reflectZ = transform reflectionZ++-- | @reflectionAcross p v@ is a reflection across the plane through+--   the point @p@ and normal to vector @v@. This also works as a 2D+--   transform where @v@ is the normal to the line passing through point+--   @p@.+reflectionAcross :: (Metric v, Fractional n)+  => Point v n -> v n -> Transformation v n+reflectionAcross p v =+  conjugate (translation (origin .-. p)) reflect+    where+      reflect = fromLinear t (linv t)+      t       = f v <-> f (negated v)+      f u w   = w ^-^ 2 *^ project u w++-- | @reflectAcross p v@ reflects a diagram across the plane though+--   the point @p@ and the vector @v@. This also works as a 2D transform+--   where @v@ is the normal to the line passing through point @p@.+reflectAcross :: (InSpace v n t, Metric v, Fractional n, Transformable t)+  => Point v n -> v n -> t -> t+reflectAcross p v = transform (reflectionAcross p v)

src/Diagrams/ThreeD/Types.hs view

@@ -1,11 +1,4 @@-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE TypeSynonymInstances #-}-{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE ViewPatterns #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}- {-# OPTIONS_GHC -fno-warn-orphans #-}  -----------------------------------------------------------------------------@@ -21,77 +14,85 @@  module Diagrams.ThreeD.Types        ( -- * 3D Euclidean space-         R3, r3, unr3-       , P3, p3, unp3-       , T3+         r3, unr3, mkR3+       , p3, unp3, mkP3+       , r3Iso, p3Iso, project+       , r3SphericalIso, r3CylindricalIso+       , V3 (..), P3,      T3+       , R1 (..), R2 (..), R3 (..)         ) where -import Diagrams.Coordinates-import Diagrams.TwoD.Types-import Diagrams.Core+import           Control.Lens        (Iso', iso, _1, _2, _3) -import Control.Newtype+import           Diagrams.Angle+import           Diagrams.Core+import           Diagrams.Points+import           Diagrams.TwoD.Types -import Data.Basis-import Data.VectorSpace+import           Linear.Metric+import           Linear.V3           as V  ------------------------------------------------------------ -- 3D Euclidean space --- | The three-dimensional Euclidean vector space R^3.-newtype R3 = R3 { unR3 :: (Double, Double, Double) }-  deriving (AdditiveGroup, Eq, Ord, Show, Read)+-- Basic R3 types -instance Newtype R3 (Double, Double, Double) where-  pack   = R3-  unpack = unR3+type P3 = Point V3+type T3 = Transformation V3 +r3Iso :: Iso' (V3 n) (n, n, n)+r3Iso = iso unr3 r3+ -- | Construct a 3D vector from a triple of components.-r3 :: (Double, Double, Double) -> R3-r3 = pack+r3 :: (n, n, n) -> V3 n+r3 (x,y,z) = V3 x y z +-- | Curried version of `r3`.+mkR3 :: n -> n -> n -> V3 n+mkR3 = V3+ -- | Convert a 3D vector back into a triple of components.-unr3 :: R3 -> (Double, Double, Double)-unr3 = unpack+unr3 :: V3 n -> (n, n, n)+unr3 (V3 x y z) = (x,y,z) -type instance V R3 = R3+-- | Construct a 3D point from a triple of coordinates.+p3 :: (n, n, n) -> P3 n+p3 = P . r3 -instance VectorSpace R3 where-  type Scalar R3 = Double-  (*^) = over R3 . (*^)+-- | Convert a 3D point back into a triple of coordinates.+unp3 :: P3 n -> (n, n, n)+unp3 (P (V3 x y z)) = (x,y,z) -instance HasBasis R3 where-  type Basis R3 = Either () (Either () ()) -- = Basis (Double, Double, Double)-  basisValue = R3 . basisValue-  decompose  = decompose  . unR3-  decompose' = decompose' . unR3+p3Iso :: Iso' (P3 n) (n, n, n)+p3Iso = iso unp3 p3 -instance InnerSpace R3 where-  (unR3 -> vec1) <.> (unR3 -> vec2) = vec1 <.> vec2+-- | Curried version of `r3`.+mkP3 :: n -> n -> n -> P3 n+mkP3 x y z = p3 (x, y, z) -instance Coordinates R3 where-  type FinalCoord R3       = Double-  type PrevDim R3          = R2-  type Decomposition R3    = Double :& Double :& Double+type instance V (V3 n) = V3+type instance N (V3 n) = n -  (coords -> x :& y) & z   = r3 (x,y,z)-  coords (unR3 -> (x,y,z)) = x :& y :& z+instance Transformable (V3 n) where+  transform = apply --- | Points in R^3.-type P3 = Point R3+r3SphericalIso :: RealFloat n => Iso' (V3 n) (n, Angle n, Angle n)+r3SphericalIso = iso+  (\v@(V3 x y z) -> (norm v, atan2A y x, acosA (z / norm v)))+  (\(r,θ,φ)   -> V3 (r * cosA θ * sinA φ) (r * sinA θ * sinA φ) (r * cosA φ)) --- | Construct a 3D point from a triple of coordinates.-p3 :: (Double, Double, Double) -> P3-p3 = pack . pack+r3CylindricalIso :: RealFloat n => Iso' (V3 n) (n, Angle n, n)+r3CylindricalIso = iso+  (\(V3 x y z) -> (sqrt $ x*x + y*y, atan2A y x, z))+  (\(r,θ,z)    -> V3 (r*cosA θ) (r*sinA θ) z) --- | Convert a 2D point back into a triple of coordinates.-unp3 :: P3 -> (Double, Double, Double)-unp3 = unpack . unpack+instance HasR V3 where+  _r = r3SphericalIso . _1 --- | Transformations in R^3.-type T3 = Transformation R3+instance HasTheta V3 where+  _theta = r3CylindricalIso . _2 -instance Transformable R3 where-  transform = apply+instance HasPhi V3 where+  _phi = r3SphericalIso . _3

+ src/Diagrams/ThreeD/Vector.hs view

@@ -0,0 +1,35 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Diagrams.ThreeD.Vector+-- Copyright   :  (c) 2013 diagrams-lib team (see LICENSE)+-- License     :  BSD-style (see LICENSE)+-- Maintainer  :  diagrams-discuss@googlegroups.com+--+-- Three-dimensional vectors.+--+-----------------------------------------------------------------------------+module Diagrams.ThreeD.Vector+       ( -- * Special 3D vectors+         unitX, unitY, unitZ, unit_X, unit_Y, unit_Z+       , xDir, yDir, zDir+       ) where++import           Control.Lens          ((&), (.~))++import           Diagrams.ThreeD.Types+import           Diagrams.TwoD.Vector+import           Diagrams.Direction++import           Linear.Vector++-- | The unit vector in the positive Y direction.+unitZ :: (R3 v, Additive v, Num n) => v n+unitZ = zero & _z .~ 1++-- | The unit vector in the negative X direction.+unit_Z :: (R3 v, Additive v, Num n) => v n+unit_Z = zero & _z .~ (-1)++-- | A 'Direction' pointing in the Z direction.+zDir :: (R3 v, Additive v, Num n) => Direction v n+zDir = dir unitZ

src/Diagrams/Trace.hs view

@@ -1,4 +1,10 @@+{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE MonoLocalBinds   #-}++{-# OPTIONS_GHC -fno-warn-unused-imports #-}+  -- for Data.Semigroup+ ----------------------------------------------------------------------------- -- | -- Module      :  Diagrams.Trace@@ -27,24 +33,30 @@      ) where -import           Diagrams.Core        (HasLinearMap, Point, Subdiagram,-                                       location, origin, setTrace, trace)+import           Diagrams.Core        (OrderedField, Point, Subdiagram, location,+                                       origin, setTrace, trace) import           Diagrams.Core.Trace  import           Data.Maybe-import           Data.VectorSpace     (Scalar, negateV)+import           Data.Semigroup import           Diagrams.Combinators (withTrace) +import           Linear.Metric+import           Linear.Vector+ -- | Compute the furthest point on the boundary of a subdiagram, --   beginning from the location (local origin) of the subdiagram and --   moving in the direction of the given vector.  If there is no such --   point, the origin is returned; see also 'boundaryFromMay'.-boundaryFrom :: (HasLinearMap v, Ord (Scalar v)) => Subdiagram b v m -> v -> Point v+boundaryFrom :: (OrderedField n, Metric v, Semigroup m)+              => Subdiagram b v n m -> v n -> Point v n boundaryFrom s v = fromMaybe origin $ boundaryFromMay s v  -- | Compute the furthest point on the boundary of a subdiagram, --   beginning from the location (local origin) of the subdiagram and --   moving in the direction of the given vector, or @Nothing@ if --   there is no such point.-boundaryFromMay :: (HasLinearMap v, Ord (Scalar v)) => Subdiagram b v m -> v -> Maybe (Point v)-boundaryFromMay s v = traceP (location s) (negateV v) s+boundaryFromMay :: (Metric v, OrderedField n, Semigroup m)+                => Subdiagram b v n m -> v n -> Maybe (Point v n)+boundaryFromMay s v = traceP (location s) (negated v) s+

src/Diagrams/Trail.hs view

@@ -1,880 +1,1396 @@-{-# LANGUAGE DeriveFunctor              #-}-{-# LANGUAGE EmptyDataDecls             #-}-{-# LANGUAGE FlexibleContexts           #-}-{-# LANGUAGE FlexibleInstances          #-}-{-# LANGUAGE GADTs                      #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE MultiParamTypeClasses      #-}-{-# LANGUAGE ScopedTypeVariables        #-}-{-# LANGUAGE StandaloneDeriving         #-}-{-# LANGUAGE TypeFamilies               #-}-{-# LANGUAGE TypeOperators              #-}-{-# LANGUAGE UndecidableInstances       #-}-{-# LANGUAGE ViewPatterns               #-}--------------------------------------------------------------------------------- |--- Module      :  Diagrams.Trail--- Copyright   :  (c) 2013 diagrams-lib team (see LICENSE)--- License     :  BSD-style (see LICENSE)--- Maintainer  :  diagrams-discuss@googlegroups.com------ This module defines /trails/, translationally invariant paths--- through space.  Trails form a central part of the diagrams-lib API,--- so the documentation for this module merits careful study.------ Related modules include:------ * The 'TrailLike' class ("Diagrams.TrailLike") exposes a generic---   API for building a wide range of things out of trails.------ * 'Path's ("Diagrams.Path") are collections of 'Located'---   ("Diagrams.Located") trails.------ * Trails are composed of 'Segment's (see "Diagrams.Segment"),---   though most users should not need to work with segments directly.-----------------------------------------------------------------------------------module Diagrams.Trail-       (-         -- * Type definitions--         -- ** Lines and loops--         Trail'(..)--       , glueLine-       , closeLine-       , cutLoop--         -- ** Generic trails--       , Trail(..)-       , wrapTrail, wrapLine, wrapLoop-       , onTrail, onLine--       , glueTrail, closeTrail, cutTrail--         -- * Constructing trails--       , emptyLine, emptyTrail-       , lineFromVertices, trailFromVertices-       , lineFromOffsets,  trailFromOffsets-       , lineFromSegments, trailFromSegments--         -- * Eliminating trails--       , withTrail', withTrail, withLine-       , isLineEmpty, isTrailEmpty-       , isLine, isLoop-       , trailSegments, lineSegments, loopSegments-       , onLineSegments-       , trailOffsets, trailOffset-       , lineOffsets, lineOffset, loopOffsets-       , trailVertices, lineVertices, loopVertices-       , fixTrail--         -- * Modifying trails--       , reverseTrail, reverseLocTrail-       , reverseLine, reverseLocLine-       , reverseLoop, reverseLocLoop--         -- * Internals-         -- $internals--         -- ** Type tags--       , Line, Loop--         -- ** Segment trees--       , SegTree(..), trailMeasure, numSegs, offset--       ) where--import           Control.Arrow       ((***))-import           Data.AffineSpace-import           Data.FingerTree     (FingerTree, ViewL (..), ViewR (..), (<|),-                                      (|>))-import qualified Data.FingerTree     as FT-import qualified Data.Foldable       as F-import           Data.Monoid.MList-import           Data.Semigroup-import           Data.VectorSpace    hiding (Sum (..))-import qualified Numeric.Interval    as I--import           Diagrams.Core       hiding ((|>))-import           Diagrams.Located-import           Diagrams.Parametric-import           Diagrams.Segment---- $internals------ Most users of diagrams should not need to use anything in this--- section directly, but they are exported on the principle that we--- can't forsee what uses people might have for them.-----------------------------------------------------------------  FingerTree instances---------------------------------------------------------------type instance V (FingerTree m a) = V a--instance ( HasLinearMap (V a), InnerSpace (V a), OrderedField (Scalar (V a))-         , FT.Measured m a, Transformable a-         )-    => Transformable (FingerTree m a) where-  transform = FT.fmap' . transform-----------------------------------------------------------------  Segment trees  ---------------------------------------------------------------------------------------------------------- | A @SegTree@ represents a sequence of closed segments, stored in a---   fingertree so we can easily recover various monoidal measures of---   the segments (number of segments, arc length, envelope...) and---   also easily slice and dice them according to the measures---   (/e.g./, split off the smallest number of segments from the---   beginning which have a combined arc length of at least 5).-newtype SegTree v = SegTree-                  { getSegTree :: FingerTree (SegMeasure v) (Segment Closed v) }-  deriving (Eq, Ord, Show)--type instance V (SegTree v) = v--deriving instance (OrderedField (Scalar v), InnerSpace v)-  => Monoid (SegTree v)-deriving instance (OrderedField (Scalar v), InnerSpace v)-  => FT.Measured (SegMeasure v) (SegTree v)-deriving instance (HasLinearMap v, InnerSpace v, OrderedField (Scalar v))-  => Transformable (SegTree v)--type instance Codomain (SegTree v) = v--instance (InnerSpace v, OrderedField (Scalar v), RealFrac (Scalar v))-    => Parametric (SegTree v) where-  atParam t p = offset . fst $ splitAtParam t p--instance Num (Scalar v) => DomainBounds (SegTree v)--instance (InnerSpace v, OrderedField (Scalar v), RealFrac (Scalar v), Num (Scalar v))-    => EndValues (SegTree v)--instance (InnerSpace v, RealFrac (Scalar v), Floating (Scalar v))-    => Sectionable (SegTree v) where-  splitAtParam (SegTree t) p-    | p < 0     = case FT.viewl t of-                    EmptyL    -> emptySplit-                    seg :< t' ->-                      case seg `splitAtParam` (p * tSegs) of-                        (seg1, seg2) -> ( SegTree $ FT.singleton seg1-                                        , SegTree $ seg2 <| t'-                                        )-    | p >= 1    = case FT.viewr t of-                    EmptyR    -> emptySplit-                    t' :> seg ->-                      case seg `splitAtParam` (1 - (1 - p)*tSegs) of-                        (seg1, seg2) -> ( SegTree $ t' |> seg1-                                        , SegTree $ FT.singleton seg2-                                        )-    | otherwise = case FT.viewl after of-                    EmptyL    -> emptySplit-                    seg :< after' ->-                      case seg `splitAtParam` (snd . properFraction $ p * tSegs) of-                        (seg1, seg2) -> ( SegTree $ before |> seg1-                                        , SegTree $ seg2   <| after'-                                        )-    where-      (before, after) = FT.split ((p * tSegs <) . numSegs) t-      tSegs           = numSegs t-      emptySplit      = (SegTree t, SegTree t)--  -- XXX seems like it should be possible to collapse some of the-  -- above cases into one?--instance (InnerSpace v, OrderedField (Scalar v), RealFrac (Scalar v))-    => HasArcLength (SegTree v) where-  arcLengthBounded eps t-    -- Use the cached value if it is accurate enough; otherwise fall-    -- back to recomputing a more accurate value-    | I.width i <= eps = i-    | otherwise        = fun (eps / numSegs t)-    where-      i   = trailMeasure (I.singleton 0)-              (getArcLengthCached :: ArcLength v -> I.Interval (Scalar v))-              t-      fun = trailMeasure (const 0)-              (getArcLengthFun :: ArcLength v -> Scalar v -> I.Interval (Scalar v))-              t--  arcLengthToParam eps st@(SegTree t) l-    | l < 0        = case FT.viewl t of-                       EmptyL   -> 0-                       seg :< _ -> arcLengthToParam eps seg l / tSegs-    | l >= totalAL = case FT.viewr t of-                       EmptyR    -> 0-                       t' :> seg ->-                         let p = arcLengthToParam (eps/2) seg-                                   (l - arcLength (eps/2) (SegTree t'))-                         in  (p - 1)/tSegs + 1-    | otherwise    = case FT.viewl after of-                       EmptyL    -> 0-                       seg :< after' ->-                         let p = arcLengthToParam (eps/2) seg-                                   (l - arcLength (eps/2) (SegTree before))-                         in  (numSegs before + p) / tSegs-    where-      totalAL         = arcLength eps st-      tSegs           = numSegs t-      before, after :: FingerTree (SegMeasure v) (Segment Closed v)-      (before, after) = FT.split ((>= l) . trailMeasure 0 (I.midpoint . (getArcLengthBounded eps :: ArcLength v -> I.Interval (Scalar v)))) t---- | Given a default result (to be used in the case of an empty---   trail), and a function to map a single measure to a result,---   extract the given measure for a trail and use it to compute a---   result.  Put another way, lift a function on a single measure---   (along with a default value) to a function on an entire trail.-trailMeasure :: ( InnerSpace v, OrderedField (Scalar v)-                , SegMeasure v :>: m, FT.Measured (SegMeasure v) t-                )-             => a -> (m -> a) -> t -> a-trailMeasure d f = option d f . get . FT.measure---- | Compute the number of segments of anything measured by---   'SegMeasure' (/e.g./ @SegMeasure@ itself, @Segment@, @SegTree@,---   @Trail@s...)-numSegs :: ( Floating (Scalar v), Num c, Ord (Scalar v), InnerSpace v,-             FT.Measured (SegMeasure v) a-           )-        => a -> c-numSegs = fromIntegral . trailMeasure 0 (getSum . getSegCount)---- | Compute the total offset of anything measured by 'SegMeasure'.-offset :: ( Floating (Scalar v), Ord (Scalar v), InnerSpace v,-            FT.Measured (SegMeasure v) t-          )-       => t -> v-offset = trailMeasure zeroV (getTotalOffset . oeOffset)-----------------------------------------------------------------  Trails  ----------------------------------------------------------------------------------------------------------------- Eventually we should use DataKinds for this, but not until we drop--- support for GHC 7.4.---- | Type tag for trails with distinct endpoints.-data Line---- | Type tag for \"loopy\" trails which return to their starting---   point.-data Loop------------------------------------------------------- The Trail' type---- | Intuitively, a trail is a single, continuous path through space.---   However, a trail has no fixed starting point; it merely specifies---   /how/ to move through space, not /where/.  For example, \"take---   three steps forward, then turn right twenty degrees and take two---   more steps\" is an intuitive analog of a trail; these---   instructions specify a path through space from any given starting---   location.  To be precise, trails are /translation-invariant/;---   applying a translation to a trail has no effect.------   A @'Located' Trail@, on the other hand, is a trail paired with---   some concrete starting location (\"start at the big tree on the---   corner, then take three steps forward, ...\").  See the---   "Diagrams.Located" module for help working with 'Located' values.------   Formally, the semantics of a trail is a continuous (though not---   necessarily differentiable) function from the real interval [0,1]---   to vectors in some vector space.  (In contrast, a 'Located' trail---   is a continuous function from [0,1] to /points/ in some /affine/---   space.)------   There are two types of trails:------   * A \"line\" (think of the \"train\", \"subway\", or \"bus\"---     variety, rather than the \"straight\" variety...) is a trail---     with two distinct endpoints.  Actually, a line can have the---     same start and end points, but it is still /drawn/ as if it had---     distinct endpoints: the two endpoints will have the appropriate---     end caps, and the trail will not be filled.  Lines have a---     @Monoid@ instance where @mappend@ corresponds to concatenation,---     /i.e./ chaining one line after the other.------   * A \"loop\" is required to end in the same place it starts (that---     is, t(0) = t(1)).  Loops are filled and are drawn as one---     continuous loop, with the appropriate join at the---     start/endpoint rather than end caps.  Loops do not have a---     @Monoid@ instance.------   To convert between lines and loops, see 'glueLine',---   'closeLine', and 'cutLoop'.------   To construct trails, see 'emptyTrail', 'trailFromSegments',---   'trailFromVertices', 'trailFromOffsets', and friends.  You can---   also get any type of trail from any function which returns a---   'TrailLike' (/e.g./ functions in "Diagrams.TwoD.Shapes", and many---   others; see "Diagrams.TrailLike").------   To extract information from trails, see 'withLine', 'isLoop',---   'trailSegments', 'trailOffsets', 'trailVertices', and friends.--data Trail' l v where-  Line :: SegTree v                   -> Trail' Line v-  Loop :: SegTree v -> Segment Open v -> Trail' Loop v---- | A generic eliminator for 'Trail'', taking functions specifying---   what to do in the case of a line or a loop.-withTrail' :: (Trail' Line v -> r) -> (Trail' Loop v -> r) -> Trail' l v -> r-withTrail' line loop t@(Line{}) = line t-withTrail' line loop t@(Loop{}) = loop t--deriving instance Show v => Show (Trail' l v)-deriving instance Eq   v => Eq   (Trail' l v)-deriving instance Ord  v => Ord  (Trail' l v)--type instance V (Trail' l v) = v--type instance Codomain (Trail' l v) = v--instance (OrderedField (Scalar v), InnerSpace v) => Semigroup (Trail' Line v) where-  (Line t1) <> (Line t2) = Line (t1 `mappend` t2)---- | The empty trail is constantly the zero vector.  Trails are---   composed via concatenation.  Note that only lines have a monoid---   instance (and not loops).-instance (OrderedField (Scalar v), InnerSpace v) => Monoid (Trail' Line v) where-  mempty  = emptyLine-  mappend = (<>)--instance (HasLinearMap v, InnerSpace v, OrderedField (Scalar v))-    => Transformable (Trail' l v) where-  transform tr (Line t  ) = Line (transform tr t)-  transform tr (Loop t s) = Loop (transform tr t) (transform tr s)---- | The envelope for a trail is based at the trail's start.-instance (InnerSpace v, OrderedField (Scalar v)) => Enveloped (Trail' l v) where-  getEnvelope = withTrail' ftEnv (ftEnv . cutLoop)-    where-      ftEnv :: Trail' Line v -> Envelope v-      ftEnv (Line t) = trailMeasure mempty oeEnvelope $ t--instance (HasLinearMap v, InnerSpace v, OrderedField (Scalar v))-    => Renderable (Trail' o v) NullBackend where-  render _ _ = mempty--instance (InnerSpace v, OrderedField (Scalar v), RealFrac (Scalar v))-    => Parametric (Trail' l v) where-  atParam t p = withTrail'-                  (\(Line segT) -> segT `atParam` p)-                  (\l -> cutLoop l `atParam` p')-                  t-    where-      pf = snd . properFraction $ p-      p' | p >= 0    = pf-         | otherwise = 1 + pf--instance Num (Scalar v) => DomainBounds (Trail' l v)--instance (InnerSpace v, OrderedField (Scalar v), RealFrac (Scalar v))-  => EndValues (Trail' l v)--instance (InnerSpace v, RealFrac (Scalar v), Floating (Scalar v))-    => Sectionable (Trail' Line v) where-  splitAtParam (Line t) p = (Line t1, Line t2)-    where-      (t1, t2) = splitAtParam t p--instance (InnerSpace v, OrderedField (Scalar v), RealFrac (Scalar v))-    => HasArcLength (Trail' l v) where-  arcLengthBounded eps =-    withTrail'-      (\(Line t) -> arcLengthBounded eps t)-      (arcLengthBounded eps . cutLoop)--  arcLengthToParam eps tr l =-    withTrail'-      (\(Line t) -> arcLengthToParam eps t l)-      (\lp -> arcLengthToParam eps (cutLoop lp) l)-      tr------------------------------------------------------- The Trail type---- | @Trail@ is a wrapper around @Trail'@, hiding whether the---   underlying @Trail'@ is a line or loop (though which it is can be---   recovered; see /e.g./ 'withTrail').-data Trail v where-  Trail :: Trail' l v -> Trail v--deriving instance Show v => Show (Trail v)--instance Eq v => Eq (Trail v) where-  t1 == t2 =-    withTrail-      (\ln1 -> withTrail (\ln2 -> ln1 == ln2) (const False) t2)-      (\lp1 -> withTrail (const False) (\lp2 -> lp1 == lp2) t2)-      t1--instance Ord v => Ord (Trail v) where-  compare t1 t2 =-    withTrail-      (\ln1 -> withTrail (\ln2 -> compare ln1 ln2) (const LT) t2)-      (\lp1 -> withTrail (const GT) (\lp2 -> compare lp1 lp2) t2)-      t1---- | Two @Trail@s are combined by first ensuring they are both lines---   (using 'cutTrail' on loops) and then concatenating them.  The---   result, in general, is a line.  However, there is a special case---   for the empty line, which acts as the identity (so combining the---   empty line with a loop results in a loop).-instance (OrderedField (Scalar v), InnerSpace v) => Semigroup (Trail v) where-  (Trail (Line (SegTree ft))) <> t2 | FT.null ft = t2-  t1 <> (Trail (Line (SegTree ft))) | FT.null ft = t1-  t1 <> t2 = flip withLine t1 $ \l1 ->-             flip withLine t2 $ \l2 ->-             wrapLine (l1 <> l2)---- | @Trail@s are combined as described in the 'Semigroup' instance;---   the empty line is the identity element, with special cases so---   that combining the empty line with a loop results in the---   unchanged loop (in all other cases loops will be cut).  Note that---   this does, in fact, satisfy the monoid laws, though it is a bit---   strange.  Mostly it is provided for convenience, so one can work---   directly with @Trail@s instead of working with @Trail' Line@s and---   then wrapping.-instance (OrderedField (Scalar v), InnerSpace v) => Monoid (Trail v) where-  mempty  = wrapLine emptyLine-  mappend = (<>)--type instance V (Trail v) = v--type instance Codomain (Trail v) = v--instance (HasLinearMap v, InnerSpace v, OrderedField (Scalar v))-    => Transformable (Trail v) where-  transform t = onTrail (transform t) (transform t)--instance (InnerSpace v, OrderedField (Scalar v)) => Enveloped (Trail v) where-  getEnvelope = withTrail getEnvelope getEnvelope--instance (InnerSpace v, OrderedField (Scalar v), RealFrac (Scalar v))-    => Parametric (Trail v) where-  atParam t p = withTrail (`atParam` p) (`atParam` p) t--instance Num (Scalar v) => DomainBounds (Trail v)--instance (InnerSpace v, OrderedField (Scalar v), RealFrac (Scalar v))-  => EndValues (Trail v)---- | Note that there is no @Sectionable@ instance for @Trail' Loop@,---   because it does not make sense (splitting a loop at a parameter---   results in a single line, not two loops).  However, it's---   convenient to have a @Sectionable@ instance for @Trail@; if the---   @Trail@ contains a loop the loop will first be cut and then---   @splitAtParam@ called on the resulting line.  This is---   semantically a bit silly, so please don't rely on it. (*E.g.* if---   this is really the behavior you want, consider first calling---   'cutLoop' yourself.)-instance (InnerSpace v, RealFrac (Scalar v), Floating (Scalar v))-    => Sectionable (Trail v) where-  splitAtParam t p = withLine ((wrapLine *** wrapLine) . (`splitAtParam` p)) t--instance (InnerSpace v, OrderedField (Scalar v), RealFrac (Scalar v))-    => HasArcLength (Trail v) where-  arcLengthBounded = withLine . arcLengthBounded-  arcLengthToParam eps tr al = withLine (\ln -> arcLengthToParam eps ln al) tr------------------------------------------------------- Constructors and eliminators for Trail---- | A generic eliminator for 'Trail', taking functions specifying---   what to do in the case of a line or a loop.-withTrail :: (Trail' Line v -> r) -> (Trail' Loop v -> r) -> Trail v -> r-withTrail line loop (Trail t) = withTrail' line loop t---- | Modify a @Trail@, specifying two separate transformations for the---   cases of a line or a loop.-onTrail :: (Trail' Line v -> Trail' l1 v) -> (Trail' Loop v -> Trail' l2 v)-        -> (Trail v -> Trail v)-onTrail o c = withTrail (wrapTrail . o) (wrapTrail . c)---- | An eliminator for @Trail@ based on eliminating lines: if the---   trail is a line, the given function is applied; if it is a loop, it---   is first converted to a line with 'cutLoop'.  That is,------ @--- withLine f === 'withTrail' f (f . 'cutLoop')--- @-withLine :: (InnerSpace v, OrderedField (Scalar v))-              => (Trail' Line v -> r) -> Trail v -> r-withLine f = withTrail f (f . cutLoop)---- | Modify a @Trail@ by specifying a transformation on lines.  If the---   trail is a line, the transformation will be applied directly.  If---   it is a loop, it will first be cut using 'cutLoop', the---   transformation applied, and then glued back into a loop with---   'glueLine'.  That is,------   @---   onLine f === onTrail f (glueLine . f . cutLoop)---   @------   Note that there is no corresponding @onLoop@ function, because---   there is no nice way in general to convert a line into a loop,---   operate on it, and then convert back.-onLine :: (InnerSpace v, OrderedField (Scalar v))-            => (Trail' Line v -> Trail' Line v) -> Trail v -> Trail v-onLine f = onTrail f (glueLine . f . cutLoop)---- | Convert a 'Trail'' into a 'Trail', hiding the type-level---   distinction between lines and loops.-wrapTrail :: Trail' l v -> Trail v-wrapTrail = Trail---- | Convert a line into a 'Trail'.  This is the same as 'wrapTrail',---   but with a more specific type, which can occasionally be---   convenient for fixing the type of a polymorphic expression.-wrapLine :: Trail' Line v -> Trail v-wrapLine = wrapTrail---- | Convert a loop into a 'Trail'.  This is the same as 'wrapTrail',---   but with a more specific type, which can occasionally be---   convenient for fixing the type of a polymorphic expression.-wrapLoop :: Trail' Loop v -> Trail v-wrapLoop = wrapTrail-----------------------------------------------------------------  Constructing trails  ---------------------------------------------------------------------------------------------------- | The empty line, which is the identity for concatenation of lines.-emptyLine :: (InnerSpace v, OrderedField (Scalar v)) => Trail' Line v-emptyLine = Line mempty---- | A wrapped variant of 'emptyLine'.-emptyTrail :: (InnerSpace v, OrderedField (Scalar v)) => Trail v-emptyTrail = wrapLine emptyLine---- | Construct a line from a list of closed segments.-lineFromSegments :: (InnerSpace v, OrderedField (Scalar v))-                   => [Segment Closed v] -> Trail' Line v-lineFromSegments = Line . SegTree . FT.fromList---- | @trailFromSegments === 'wrapTrail' . 'lineFromSegments'@, for---   conveniently constructing a @Trail@ instead of a @Trail'@.-trailFromSegments :: (InnerSpace v, OrderedField (Scalar v))-                  => [Segment Closed v] -> Trail v-trailFromSegments = wrapTrail . lineFromSegments---- | Construct a line containing only linear segments from a list of---   vectors, where each vector represents the offset from one vertex---   to the next.  See also 'fromOffsets'.------   <<diagrams/lineFromOffsetsEx.svg#diagram=lineFromOffsetsEx&width=300>>------   > import Diagrams.Coordinates---   > lineFromOffsetsEx = strokeLine $ lineFromOffsets [ 2 & 1, 2 & (-1), 2 & 0.5 ]-lineFromOffsets :: (InnerSpace v, OrderedField (Scalar v))-                  => [v] -> Trail' Line v-lineFromOffsets = lineFromSegments . map straight---- | @trailFromOffsets === 'wrapTrail' . 'lineFromOffsets'@, for---   conveniently constructing a @Trail@ instead of a @Trail' Line@.-trailFromOffsets :: (InnerSpace v, OrderedField (Scalar v))-                 => [v] -> Trail v-trailFromOffsets = wrapTrail . lineFromOffsets---- | Construct a line containing only linear segments from a list of---   vertices.  Note that only the relative offsets between the---   vertices matters; the information about their absolute position---   will be discarded.  That is, for all vectors @v@,------ @--- lineFromVertices === lineFromVertices . 'translate' v--- @------   If you want to retain the position information, you should---   instead use the more general 'fromVertices' function to---   construct, say, a @'Located' ('Trail'' 'Line' v)@ or a @'Located'---   ('Trail' v)@.------   <<diagrams/lineFromVerticesEx.svg#diagram=lineFromVerticesEx&width=300>>------   > import Diagrams.Coordinates---   > lineFromVerticesEx = pad 1.1 . centerXY . strokeLine---   >   $ lineFromVertices [origin, 0 & 1, 1 & 2, 5 & 1]-lineFromVertices :: (InnerSpace v, OrderedField (Scalar v))-                   => [Point v] -> Trail' Line v-lineFromVertices []  = emptyLine-lineFromVertices [_] = emptyLine-lineFromVertices ps  = lineFromSegments . map straight $ zipWith (.-.) (tail ps) ps----- | @trailFromVertices === 'wrapTrail' . 'lineFromVertices'@, for---   conveniently constructing a @Trail@ instead of a @Trail' Line@.-trailFromVertices :: (InnerSpace v, OrderedField (Scalar v))-                  => [Point v] -> Trail v-trailFromVertices = wrapTrail . lineFromVertices-----------------------------------------------------------------  Converting between lines and loops  ------------------------------------------------------------------------------------- | Make a line into a loop by \"gluing\" the endpoint to the---   starting point.  In particular, the offset of the final segment---   is modified so that it ends at the starting point of the entire---   trail.  Typically, you would first construct a line which you---   know happens to end where it starts, and then call 'glueLine' to---   turn it into a loop.------   <<diagrams/glueLineEx.svg#diagram=glueLineEx&width=500>>------   > import Diagrams.Coordinates---   > glueLineEx = pad 1.1 . hcat' with {sep = 1}---   >   $ [almostClosed # strokeLine, almostClosed # glueLine # strokeLoop]---   >---   > almostClosed :: Trail' Line R2---   > almostClosed = fromOffsets [2 & (-1), (-3) & (-0.5), (-2) & 1, 1 & 0.5]------   @glueLine@ is left inverse to 'cutLoop', that is,------   @---   glueLine . cutLoop === id---   @-glueLine :: (InnerSpace v, OrderedField (Scalar v)) => Trail' Line v -> Trail' Loop v-glueLine (Line (SegTree t)) =-  case FT.viewr t of-    FT.EmptyR             -> Loop mempty (Linear OffsetOpen)-    t' :> (Linear _)      -> Loop (SegTree t') (Linear OffsetOpen)-    t' :> (Cubic c1 c2 _) -> Loop (SegTree t') (Cubic c1 c2 OffsetOpen)---- | @glueTrail@ is a variant of 'glueLine' which works on 'Trail's.---   It performs 'glueLine' on lines and is the identity on loops.-glueTrail :: (InnerSpace v, OrderedField (Scalar v)) => Trail v -> Trail v-glueTrail = onTrail glueLine id---- | Make a line into a loop by adding a new linear segment from the---   line's end to its start.------   @closeLine@ does not have any particularly nice theoretical---   properties, but can be useful /e.g./ when you want to make a---   closed polygon out of a list of points where the initial point is---   not repeated at the end.  To use 'glueLine', one would first have---   to duplicate the initial vertex, like------ @--- 'glueLine' . 'lineFromVertices' $ ps ++ [head ps]--- @------   Using @closeLine@, however, one can simply------ @--- closeLine . lineFromVertices $ ps--- @------   <<diagrams/closeLineEx.svg#diagram=closeLineEx&width=500>>------   > closeLineEx = pad 1.1 . centerXY . hcat' with {sep = 1}---   >   $ [almostClosed # strokeLine, almostClosed # closeLine # strokeLoop]-closeLine :: Trail' Line v -> Trail' Loop v-closeLine (Line t) = Loop t (Linear OffsetOpen)---- | @closeTrail@ is a variant of 'closeLine' for 'Trail', which---   performs 'closeLine' on lines and is the identity on loops.-closeTrail :: Trail v -> Trail v-closeTrail = onTrail closeLine id---- | Turn a loop into a line by \"cutting\" it at the common start/end---   point, resulting in a line which just happens to start and end at---   the same place.------   @cutLoop@ is right inverse to 'glueLine', that is,------   @---   glueLine . cutLoop === id---   @-cutLoop :: forall v. (InnerSpace v, OrderedField (Scalar v))-         => Trail' Loop v -> Trail' Line v-cutLoop (Loop (SegTree t) c) =-  case (FT.null t, c) of-    (True, Linear OffsetOpen)      -> emptyLine-    (_   , Linear OffsetOpen)      -> Line (SegTree (t |> Linear off))-    (_   , Cubic c1 c2 OffsetOpen) -> Line (SegTree (t |> Cubic c1 c2 off))-  where-    offV :: v-    offV = negateV . trailMeasure zeroV (getTotalOffset . oeOffset) $ t-    off = OffsetClosed offV---- | @cutTrail@ is a variant of 'cutLoop' for 'Trail'; it is the is---   the identity on lines and performs 'cutLoop' on loops.-cutTrail :: (InnerSpace v, OrderedField (Scalar v))-         => Trail v -> Trail v-cutTrail = onTrail id cutLoop-----------------------------------------------------------------  Eliminating trails  ----------------------------------------------------------------------------------------------------- | Test whether a line is empty.-isLineEmpty :: (InnerSpace v, OrderedField (Scalar v)) => Trail' Line v -> Bool-isLineEmpty (Line (SegTree t)) = FT.null t---- | Test whether a trail is empty.  Note that loops are never empty.-isTrailEmpty :: (InnerSpace v, OrderedField (Scalar v)) => Trail v -> Bool-isTrailEmpty = withTrail isLineEmpty (const False)---- | Determine whether a trail is a line.-isLine :: Trail v -> Bool-isLine = not . isLoop---- | Determine whether a trail is a loop.-isLoop :: Trail v -> Bool-isLoop = withTrail (const False) (const True)---- | Extract the segments comprising a line.-lineSegments :: Trail' Line v -> [Segment Closed v]-lineSegments (Line (SegTree t)) = F.toList t---- | Modify a line by applying a function to its list of segments.-onLineSegments-  :: (InnerSpace v, OrderedField (Scalar v))-  => ([Segment Closed v] -> [Segment Closed v])-  -> Trail' Line v -> Trail' Line v-onLineSegments f = lineFromSegments . f . lineSegments---- | Extract the segments comprising a loop: a list of closed---   segments, and one final open segment.-loopSegments :: Trail' Loop v -> ([Segment Closed v], Segment Open v)-loopSegments (Loop (SegTree t) c) = (F.toList t, c)---- | Extract the segments of a trail.  If the trail is a loop it will---   first have 'cutLoop' applied.-trailSegments :: (InnerSpace v, OrderedField (Scalar v))-              => Trail v -> [Segment Closed v]-trailSegments = withLine lineSegments---- | Extract the offsets of the segments of a trail.-trailOffsets :: (InnerSpace v, OrderedField (Scalar v)) => Trail v -> [v]-trailOffsets = withLine lineOffsets---- | Compute the offset from the start of a trail to the end.  Satisfies------   @---   trailOffset === sumV . trailOffsets---   @------   but is more efficient.------   <<diagrams/trailOffsetEx.svg#diagram=trailOffsetEx&width=300>>------   > trailOffsetEx = (strokeLine almostClosed <> showOffset) # centerXY # pad 1.1---   >   where showOffset = fromOffsets [trailOffset (wrapLine almostClosed)]---   >                    # stroke # lc red # lw 0.05-trailOffset :: (InnerSpace v, OrderedField (Scalar v)) => Trail v -> v-trailOffset = withLine lineOffset---- | Extract the offsets of the segments of a line.-lineOffsets :: (InnerSpace v, OrderedField (Scalar v)) => Trail' Line v -> [v]-lineOffsets = map segOffset . lineSegments---- | Extract the offsets of the segments of a loop.-loopOffsets :: (InnerSpace v, OrderedField (Scalar v)) => Trail' Loop v -> [v]-loopOffsets = lineOffsets . cutLoop---- | Compute the offset from the start of a line to the end.  (Note,---   there is no corresponding @loopOffset@ function because by---   definition it would be constantly zero.)-lineOffset :: (InnerSpace v, OrderedField (Scalar v)) => Trail' Line v -> v-lineOffset (Line t) = trailMeasure zeroV (getTotalOffset . oeOffset) t---- | Extract the vertices of a concretely located trail.  Note that---   for loops, the starting vertex will /not/ be repeated at the end.---   If you want this behavior, you can use 'cutTrail' to make the---   loop into a line first, which happens to repeat the same vertex---   at the start and end, /e.g./ with @trailVertices . mapLoc---   cutTrail@.------   Note that it does not make sense to ask for the vertices of a---   'Trail' by itself; if you want the vertices of a trail---   with the first vertex at, say, the origin, you can use---   @trailVertices . (`at` origin)@.-trailVertices :: (InnerSpace v, OrderedField (Scalar v))-              => Located (Trail v) -> [Point v]-trailVertices (viewLoc -> (p,t))-  = withTrail (lineVertices . (`at` p)) (loopVertices . (`at` p)) t---- | Extract the vertices of a concretely located line.  See---   'trailVertices' for more information.-lineVertices :: (InnerSpace v, OrderedField (Scalar v))-             => Located (Trail' Line v) -> [Point v]-lineVertices (viewLoc -> (p,t))-  = segmentVertices p . lineSegments $ t---- | Extract the vertices of a concretely located loop.  Note that the---   initial vertex is not repeated at the end.  See 'trailVertices' for---   more information.-loopVertices :: (InnerSpace v, OrderedField (Scalar v))-             => Located (Trail' Loop v) -> [Point v]-loopVertices (viewLoc -> (p,t))-  = segmentVertices p . fst . loopSegments $ t--segmentVertices :: AdditiveGroup v => Point v -> [Segment Closed v] -> [Point v]-segmentVertices p = scanl (.+^) p . map segOffset---- | Convert a concretely located trail into a list of fixed segments.-fixTrail :: (InnerSpace v, OrderedField (Scalar v))-         => Located (Trail v) -> [FixedSegment v]-fixTrail t = zipWith ((mkFixedSeg .) . at)-               (trailSegments (unLoc t)) (trailVertices t)-----------------------------------------------------------------  Modifying trails  ------------------------------------------------------------------------------------------------------- | Reverse a trail.  Semantically, if a trail given by a function t---   from [0,1] to vectors, then the reverse of t is given by t'(s) =---   t(1-s).  @reverseTrail@ is an involution, that is,------   @---   reverseTrail . reverseTrail === id---   @-reverseTrail :: (InnerSpace v, OrderedField (Scalar v)) => Trail v -> Trail v-reverseTrail = onTrail reverseLine reverseLoop---- | Reverse a concretely located trail.  The endpoint of the original---   trail becomes the starting point of the reversed trail, so the---   original and reversed trails comprise exactly the same set of---   points.  @reverseLocTrail@ is an involution, /i.e./------   @---   reverseLocTrail . reverseLocTrail === id---   @-reverseLocTrail :: (InnerSpace v, OrderedField (Scalar v))-                => Located (Trail v) -> Located (Trail v)-reverseLocTrail (viewLoc -> (p, t)) = reverseTrail t `at` (p .+^ trailOffset t)---- | Reverse a line.  See 'reverseTrail'.-reverseLine :: (InnerSpace v, OrderedField (Scalar v))-            => Trail' Line v -> Trail' Line v-reverseLine = onLineSegments (reverse . map reverseSegment)---- | Reverse a concretely located line.  See 'reverseLocTrail'.-reverseLocLine :: (InnerSpace v, OrderedField (Scalar v))-               => Located (Trail' Line v) -> Located (Trail' Line v)-reverseLocLine (viewLoc -> (p,l)) = reverseLine l `at` (p .+^ lineOffset l)---- | Reverse a loop.  See 'reverseTrail'.-reverseLoop :: (InnerSpace v, OrderedField (Scalar v))-            => Trail' Loop v -> Trail' Loop v-reverseLoop = glueLine . reverseLine . cutLoop---- | Reverse a concretely located loop.  See 'reverseLocTrail'.  Note---   that this is guaranteed to preserve the location.-reverseLocLoop :: (InnerSpace v, OrderedField (Scalar v))-               => Located (Trail' Loop v) -> Located (Trail' Loop v)-reverseLocLoop = mapLoc reverseLoop+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE CPP                        #-}+{-# LANGUAGE EmptyDataDecls             #-}+{-# LANGUAGE FlexibleContexts           #-}+{-# LANGUAGE FlexibleInstances          #-}+{-# LANGUAGE GADTs                      #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE LambdaCase                 #-}+{-# LANGUAGE MultiParamTypeClasses      #-}+{-# LANGUAGE ScopedTypeVariables        #-}+{-# LANGUAGE StandaloneDeriving         #-}+{-# LANGUAGE TypeFamilies               #-}+{-# LANGUAGE TypeOperators              #-}+{-# LANGUAGE UndecidableInstances       #-}+{-# LANGUAGE ViewPatterns               #-}++{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+-- We have an orphan Transformable FingerTree instance here.++-----------------------------------------------------------------------------+-- |+-- Module      :  Diagrams.Trail+-- Copyright   :  (c) 2013-2015 diagrams-lib team (see LICENSE)+-- License     :  BSD-style (see LICENSE)+-- Maintainer  :  diagrams-discuss@googlegroups.com+--+-- This module defines /trails/, translationally invariant paths+-- through space.  Trails form a central part of the diagrams-lib API,+-- so the documentation for this module merits careful study.+--+-- Related modules include:+--+-- * The 'TrailLike' class ("Diagrams.TrailLike") exposes a generic+--   API for building a wide range of things out of trails.+--+-- * 'Path's ("Diagrams.Path") are collections of 'Located'+--   ("Diagrams.Located") trails.+--+-- * Trails are composed of 'Segment's (see "Diagrams.Segment"),+--   though most users should not need to work with segments directly.+--+-----------------------------------------------------------------------------++module Diagrams.Trail+       (+         -- * Type definitions++         -- ** Lines and loops++         Trail'(..)++       , glueLine+       , closeLine+       , cutLoop++         -- ** Generic trails++       , Trail(..)+       , _Line, _Loop+       , _LocLine, _LocLoop+       , wrapTrail, wrapLine, wrapLoop+       , onTrail, onLine++       , glueTrail, closeTrail, cutTrail++         -- * Constructing trails++       , emptyLine, emptyTrail+       , lineFromVertices, trailFromVertices+       , lineFromOffsets,  trailFromOffsets+       , lineFromSegments, trailFromSegments+       , loopFromSegments++         -- * Eliminating trails++       , withTrail', withTrail, withLine+       , isLineEmpty, isTrailEmpty+       , isLine, isLoop+       , trailSegments, lineSegments, loopSegments+       , onLineSegments+       , trailOffsets, trailOffset+       , lineOffsets, lineOffset, loopOffsets+       , trailPoints, linePoints, loopPoints+       , trailVertices', lineVertices', loopVertices'+       , trailVertices, lineVertices, loopVertices+       , trailLocSegments, fixTrail, unfixTrail++         -- * Modifying trails++       , reverseTrail, reverseLocTrail+       , reverseLine, reverseLocLine+       , reverseLoop, reverseLocLoop++         -- * Internals+         -- $internals++         -- ** Type tags++       , Line, Loop++         -- ** Segment trees++       , SegTree(..), trailMeasure, numSegs, offset++         -- ** Extracting segments++       , GetSegment(..), getSegment, GetSegmentCodomain(..)++       ) where++import           Control.Arrow            ((***))+import           Control.Lens             hiding (at, transform, (<|), (|>))+import           Data.FingerTree          (FingerTree, ViewL (..), ViewR (..),+                                           viewl, (<|), (|>))+import qualified Data.FingerTree          as FT+import           Data.Fixed+import qualified Data.Foldable            as F+import           Data.Monoid.MList+import           Data.Semigroup+import qualified Numeric.Interval.Kaucher as I++import           Diagrams.Core+import           Diagrams.Located+import           Diagrams.Parametric+import           Diagrams.Segment+import           Diagrams.Tangent++import           Linear.Affine+import           Linear.Metric+import           Linear.Vector++import           Data.Serialize            (Serialize)+import qualified Data.Serialize            as Serialize++-- $internals+--+-- Most users of diagrams should not need to use anything in this+-- section directly, but they are exported on the principle that we+-- can't forsee what uses people might have for them.++------------------------------------------------------------+--  FingerTree instances+------------------------------------------------------------++type instance V (FingerTree m a) = V a+type instance N (FingerTree m a) = N a++instance (FT.Measured m a, Transformable a)+    => Transformable (FingerTree m a) where+  transform = FT.fmap' . transform++instance (FT.Measured m a, FT.Measured n b)+  => Cons (FingerTree m a) (FingerTree n b) a b where+  _Cons = prism (uncurry (FT.<|)) $ \aas -> case FT.viewl aas of+    a FT.:< as -> Right (a, as)+    EmptyL     -> Left mempty+  {-# INLINE _Cons #-}++instance (FT.Measured m a, FT.Measured n b)+  => Snoc (FingerTree m a) (FingerTree n b) a b where+  _Snoc = prism (uncurry (FT.|>)) $ \aas -> case FT.viewr aas of+    as FT.:> a -> Right (as, a)+    EmptyR  -> Left mempty+  {-# INLINE _Snoc #-}++------------------------------------------------------------+--  Segment trees  -----------------------------------------+------------------------------------------------------------++-- | A @SegTree@ represents a sequence of closed segments, stored in a+--   fingertree so we can easily recover various monoidal measures of+--   the segments (number of segments, arc length, envelope...) and+--   also easily slice and dice them according to the measures+--   (/e.g./, split off the smallest number of segments from the+--   beginning which have a combined arc length of at least 5).++newtype SegTree v n = SegTree (FingerTree (SegMeasure v n) (Segment Closed v n))+  deriving (Eq, Ord, Show, Monoid, Transformable, FT.Measured (SegMeasure v n))++-- Only derive the Semigroup instance for versions of base that+-- include Semigroup.  This is because the fingertree package has+-- similar CPP to only export a Semigroup instance for those versions+-- of base, so for GHC 7.10 and earlier we get a 'no instance found'+-- error when trying to derive the Semigroup instance for SegTree.  It+-- would also be possible to depend on the 'semigroups' package in+-- order to get the Semigroup class regardless of base version, but+-- presumably fingertree didn't want to add a dependency.+#if MIN_VERSION_base(4,9,0)+deriving instance (Ord n, Floating n, Metric v) => Semigroup (SegTree v n)+#endif++instance Wrapped (SegTree v n) where+  type Unwrapped (SegTree v n) = FingerTree (SegMeasure v n) (Segment Closed v n)+  _Wrapped' = iso (\(SegTree x) -> x) SegTree+  {-# INLINE _Wrapped' #-}++instance (Metric v, OrderedField n, Metric u, OrderedField n')+  => Cons (SegTree v n) (SegTree u n') (Segment Closed v n) (Segment Closed u n') where+  _Cons = _Wrapped . _Cons . bimapping id _Unwrapped+  {-# INLINE _Cons #-}++instance (Metric v, OrderedField n, Metric u, OrderedField n')+  => Snoc (SegTree v n) (SegTree u n') (Segment Closed v n) (Segment Closed u n') where+  _Snoc = _Wrapped . _Snoc . bimapping _Unwrapped id+  {-# INLINE _Snoc #-}++instance Rewrapped (SegTree v n) (SegTree v' n')++type instance V (SegTree v n) = v+type instance N (SegTree v n) = n++type instance Codomain (SegTree v n) = v++instance (Metric v, OrderedField n, Real n)+    => Parametric (SegTree v n) where+  atParam t p = offset . fst $ splitAtParam t p++instance Num n => DomainBounds (SegTree v n)++instance (Metric v, OrderedField n, Real n)+    => EndValues (SegTree v n)++splitAtParam' :: (Metric v, OrderedField n, Real n)+              => SegTree v n -> n -> ((SegTree v n, SegTree v n), n -> n)+splitAtParam' (SegTree t) p+  | tSegs == 0 = ((mempty       , mempty       ), id)+  | otherwise  = ((SegTree treeL, SegTree treeR), rescale)+  where+    tSegs  = numSegs t+    splitParam q | q <  0    = (0        , q           * tSegs)+                 | q >= 1    = (tSegs - 1, 1 + (q - 1) * tSegs)+                 | otherwise = propFrac $  q           * tSegs+      where propFrac x = let m = mod1 x in (x - m, m)+    (pSegs, pParam) = splitParam p+    (before, viewl -> seg FT.:< after) = FT.split ((pSegs <) . numSegs) t+    (segL, segR) = seg `splitAtParam` pParam+    (treeL, treeR) | pParam == 0 = (before        , seg  <| after)+                   | pParam == 1 = (before |> seg ,         after)+                   | otherwise   = (before |> segL, segR <| after)+    -- section uses rescale to find the new value of p1 after the split at p2+    rescale u | pSegs' == uSegs = (uSegs + uParam / pParam' {-'1-}) / (pSegs' + 1) {-'2-}+              | otherwise       = u * tSegs / (pSegs' + 1) {-'3-}+      where+        -- param 0 on a segment is param 1 on the previous segment+        (pSegs', pParam') | pParam == 0 = (pSegs-1, 1)+                          | otherwise   = (pSegs  , pParam)+        (uSegs , uParam ) = splitParam u+        -- '1 (pParam ≠ 0 → pParam' = pParam) ∧ (pParam = 0 → pParam' = 1) → pParam' ≠ 0+        -- '2 uSegs ≥ 0 ∧ pSegs' = uSegs → pSegs' ≥ 0 → pSegs' + 1 > 0+        -- '3 pSegs' + 1 = 0 → pSegs' = -1 → pSegs = 0 ∧ pParam = 0 → p = 0+        --    → rescale is not called++instance (Metric v, OrderedField n, Real n) => Sectionable (SegTree v n) where+  splitAtParam tree p = fst $ splitAtParam' tree p++  reverseDomain (SegTree t) = SegTree $ FT.reverse t'+    where t' = FT.fmap' reverseSegment t++  section x p1 p2 | p2 == 0   = reverseDomain . fst $ splitAtParam x p1+                  | p1 <= p2  = let ((a, _), rescale) = splitAtParam' x p2+                                in  snd $ splitAtParam a (rescale p1)+                  | otherwise = reverseDomain $ section x p2 p1++instance (Metric v, OrderedField n, Real n)+    => HasArcLength (SegTree v n) where+  arcLengthBounded eps t+    -- Use the cached value if it is accurate enough; otherwise fall+    -- back to recomputing a more accurate value+    | I.width i <= eps = i+    | otherwise        = fun (eps / numSegs t)+    where+      i   = trailMeasure (I.singleton 0)+              getArcLengthCached+              t+      fun = trailMeasure (const 0)+              getArcLengthFun+              t++  arcLengthToParam eps st@(SegTree t) l+    | l < 0        = case FT.viewl t of+                       EmptyL   -> 0+                       seg FT.:< _ -> arcLengthToParam eps seg l / tSegs+    | l >= totalAL = case FT.viewr t of+                       EmptyR    -> 0+                       t' FT.:> seg ->+                         let p = arcLengthToParam (eps/2) seg+                                   (l - arcLength (eps/2) (SegTree t'))+                         in  (p - 1)/tSegs + 1+    | otherwise    = case FT.viewl after of+                       EmptyL    -> 0+                       seg FT.:< _  ->+                         let p = arcLengthToParam (eps/2) seg+                                   (l - arcLength (eps/2) (SegTree before))+                         in  (numSegs before + p) / tSegs+    where+      totalAL         = arcLength eps st+      tSegs           = numSegs t+      before, after :: FingerTree (SegMeasure v n) (Segment Closed v n)+      (before, after) =+        FT.split ((>= l)+                 . trailMeasure+                 0+                 (I.midpoint . getArcLengthBounded eps))+                 t++-- | Given a default result (to be used in the case of an empty+--   trail), and a function to map a single measure to a result,+--   extract the given measure for a trail and use it to compute a+--   result.  Put another way, lift a function on a single measure+--   (along with a default value) to a function on an entire trail.+trailMeasure :: ( SegMeasure v n :>: m, FT.Measured (SegMeasure v n) t )+             => a -> (m -> a) -> t -> a+trailMeasure d f = maybe d f . get . FT.measure++-- | Compute the number of segments of anything measured by+--   'SegMeasure' (/e.g./ @SegMeasure@ itself, @Segment@, @SegTree@,+--   @Trail@s...)+numSegs :: (Num c, FT.Measured (SegMeasure v n) a)+        => a -> c+numSegs = fromIntegral . trailMeasure 0 (getSum . op SegCount)++-- | Compute the total offset of anything measured by 'SegMeasure'.+offset :: ( OrderedField n, Metric v,+            FT.Measured (SegMeasure v n) t+          )+       => t -> v n+offset = trailMeasure zero (op TotalOffset . view oeOffset)++------------------------------------------------------------+--  Trails  ------------------------------------------------+------------------------------------------------------------++-- Eventually we should use DataKinds for this, but not until we drop+-- support for GHC 7.4.++-- | Type tag for trails with distinct endpoints.+data Line++-- | Type tag for \"loopy\" trails which return to their starting+--   point.+data Loop++--------------------------------------------------+-- The Trail' type++-- | Intuitively, a trail is a single, continuous path through space.+--   However, a trail has no fixed starting point; it merely specifies+--   /how/ to move through space, not /where/.  For example, \"take+--   three steps forward, then turn right twenty degrees and take two+--   more steps\" is an intuitive analog of a trail; these+--   instructions specify a path through space from any given starting+--   location.  To be precise, trails are /translation-invariant/;+--   applying a translation to a trail has no effect.+--+--   A @'Located' Trail@, on the other hand, is a trail paired with+--   some concrete starting location (\"start at the big tree on the+--   corner, then take three steps forward, ...\").  See the+--   "Diagrams.Located" module for help working with 'Located' values.+--+--   Formally, the semantics of a trail is a continuous (though not+--   necessarily differentiable) function from the real interval [0,1]+--   to vectors in some vector space.  (In contrast, a 'Located' trail+--   is a continuous function from [0,1] to /points/ in some /affine/+--   space.)+--+--   There are two types of trails:+--+--   * A \"line\" (think of the \"train\", \"subway\", or \"bus\"+--     variety, rather than the \"straight\" variety...) is a trail+--     with two distinct endpoints.  Actually, a line can have the+--     same start and end points, but it is still /drawn/ as if it had+--     distinct endpoints: the two endpoints will have the appropriate+--     end caps, and the trail will not be filled.  Lines have a+--     @Monoid@ instance where @mappend@ corresponds to concatenation,+--     /i.e./ chaining one line after the other.+--+--   * A \"loop\" is required to end in the same place it starts (that+--     is, t(0) = t(1)).  Loops are filled and are drawn as one+--     continuous loop, with the appropriate join at the+--     start/endpoint rather than end caps.  Loops do not have a+--     @Monoid@ instance.+--+--   To convert between lines and loops, see 'glueLine',+--   'closeLine', and 'cutLoop'.+--+--   To construct trails, see 'emptyTrail', 'trailFromSegments',+--   'trailFromVertices', 'trailFromOffsets', and friends.  You can+--   also get any type of trail from any function which returns a+--   'TrailLike' (/e.g./ functions in "Diagrams.TwoD.Shapes", and many+--   others; see "Diagrams.TrailLike").+--+--   To extract information from trails, see 'withLine', 'isLoop',+--   'trailSegments', 'trailOffsets', 'trailVertices', and friends.++data Trail' l v n where+  Line :: SegTree v n                     -> Trail' Line v n+  Loop :: SegTree v n -> Segment Open v n -> Trail' Loop v n++-- | A generic eliminator for 'Trail'', taking functions specifying+--   what to do in the case of a line or a loop.+withTrail' :: (Trail' Line v n -> r) -> (Trail' Loop v n -> r) -> Trail' l v n -> r+withTrail' line _    t@(Line{}) = line t+withTrail' _    loop t@(Loop{}) = loop t++deriving instance Eq  (v n) => Eq   (Trail' l v n)+deriving instance Ord (v n) => Ord  (Trail' l v n)++instance Show (v n) => Show (Trail' l v n) where+  showsPrec d (Line (SegTree ft)) = showParen (d > 10) $+    showString "lineFromSegments " . showList (F.toList ft)++  showsPrec d (Loop (SegTree ft) o) = showParen (d > 10) $+    showString "loopFromSegments " . showList (F.toList ft) .+    showChar ' ' . showsPrec 11 o++type instance V (Trail' l v n) = v+type instance N (Trail' l v n) = n++type instance Codomain (Trail' l v n) = v++instance (OrderedField n, Metric v) => Semigroup (Trail' Line v n) where+  (Line t1) <> (Line t2) = Line (t1 `mappend` t2)++-- | The empty trail is constantly the zero vector.  Trails are+--   composed via concatenation.  Note that only lines have a monoid+--   instance (and not loops).+instance (Metric v, OrderedField n) => Monoid (Trail' Line v n) where+  mempty  = emptyLine+  mappend = (<>)++instance (Metric v, OrderedField n) => AsEmpty (Trail' Line v n) where+  _Empty = nearly emptyLine isLineEmpty++instance (HasLinearMap v, Metric v, OrderedField n)+    => Transformable (Trail' l v n) where+  transform tr (Line t  ) = Line (transform tr t)+  transform tr (Loop t s) = Loop (transform tr t) (transform tr s)++-- | The envelope for a trail is based at the trail's start.+instance (Metric v, OrderedField n) => Enveloped (Trail' l v n) where+  getEnvelope = withTrail' ftEnv (ftEnv . cutLoop)+    where+      ftEnv :: Trail' Line v n -> Envelope v n+      ftEnv (Line t) = trailMeasure mempty (view oeEnvelope) t++instance (HasLinearMap v, Metric v, OrderedField n)+    => Renderable (Trail' o v n) NullBackend where+  render _ _ = mempty++instance (Metric v, OrderedField n, Real n)+    => Parametric (Trail' l v n) where+  atParam t p = withTrail'+                  (\(Line segT) -> segT `atParam` p)+                  (\l -> cutLoop l `atParam` mod1 p)+                  t++instance (Parametric (GetSegment (Trail' c v n)), Additive v, Num n)+    => Parametric (Tangent (Trail' c v n)) where+  Tangent tr `atParam` p =+    case GetSegment tr `atParam` p of+      GetSegmentCodomain Nothing                  -> zero+      GetSegmentCodomain (Just (_, seg, reparam)) -> Tangent seg `atParam` (p ^. cloneIso reparam)++instance ( Parametric (GetSegment (Trail' c v n))+         , EndValues (GetSegment (Trail' c v n))+         , Additive v+         , Num n+         )+    => EndValues (Tangent (Trail' c v n)) where+  atStart (Tangent tr) =+    case atStart (GetSegment tr) of+      GetSegmentCodomain Nothing            -> zero+      GetSegmentCodomain (Just (_, seg, _)) -> atStart (Tangent seg)+  atEnd (Tangent tr) =+    case atEnd (GetSegment tr) of+      GetSegmentCodomain Nothing            -> zero+      GetSegmentCodomain (Just (_, seg, _)) -> atEnd (Tangent seg)++instance (Metric v , OrderedField n, Real n)+    => Parametric (Tangent (Trail v n)) where+  Tangent tr `atParam` p+    = withTrail+        ((`atParam` p) . Tangent)+        ((`atParam` p) . Tangent)+        tr++instance (Metric v, OrderedField n, Real n)+    => EndValues (Tangent (Trail v n)) where+  atStart (Tangent tr) = withTrail (atStart . Tangent) (atStart . Tangent) tr+  atEnd   (Tangent tr) = withTrail (atEnd   . Tangent) (atEnd   . Tangent) tr++-- | Compute the remainder mod 1.  Convenient for constructing loop+--   parameterizations that wrap around.+mod1 :: Real a => a -> a+mod1 = (`mod'` 1)++instance Num n => DomainBounds (Trail' l v n)++instance (Metric v, OrderedField n, Real n)+  => EndValues (Trail' l v n)++instance (Metric v, OrderedField n, Real n)+    => Sectionable (Trail' Line v n) where+  splitAtParam (Line t) p = (Line t1, Line t2)+    where+      (t1, t2) = splitAtParam t p++  section (Line t) p1 p2 = Line (section t p1 p2)++  reverseDomain = reverseLine++instance (Metric v, OrderedField n, Real n)+    => HasArcLength (Trail' l v n) where+  arcLengthBounded eps =+    withTrail'+      (\(Line t) -> arcLengthBounded eps t)+      (arcLengthBounded eps . cutLoop)++  arcLengthToParam eps tr l =+    withTrail'+      (\(Line t) -> arcLengthToParam eps t l)+      (\lp -> arcLengthToParam eps (cutLoop lp) l)+      tr++instance Rewrapped (Trail' Line v n) (Trail' Line v' n')+instance Wrapped (Trail' Line v n) where+  type Unwrapped (Trail' Line v n) = SegTree v n+  _Wrapped' = iso (\(Line x) -> x) Line+  {-# INLINE _Wrapped' #-}++instance (Metric v, OrderedField n, Metric u, OrderedField n')+  => Cons (Trail' Line v n) (Trail' Line u n') (Segment Closed v n) (Segment Closed u n') where+  _Cons = _Wrapped . _Cons . bimapping id _Unwrapped+  {-# INLINE _Cons #-}++instance (Metric v, OrderedField n, Metric u, OrderedField n')+  => Snoc (Trail' Line v n) (Trail' Line u n') (Segment Closed v n) (Segment Closed u n') where+  _Snoc = _Wrapped . _Snoc . bimapping _Unwrapped id+  {-# INLINE _Snoc #-}++-- | Compose two Located trails by adding a segment joining the endpoint+--   of the first to the starting point of the second.  Note, if you have+--   two located trails such that the end of the first coincides with the+--   start of the second, this will still add a trivial zero-length segment+--   between them; in that case you are probably better off with something+--   like @mapLoc (<> unLoc t2) t1@.+instance (Real n, Floating n, Metric v)+  => Semigroup (Located (Trail' Line v n)) where+    a@(Loc aLoc aLine) <> b@(Loc _ bLine) =+      Loc aLoc (aLine <> lineFromOffsets [atStart b .-. atEnd a] <> bLine)++--------------------------------------------------+-- Extracting segments++-- | A newtype wrapper around trails which exists solely for its+--   'Parametric', 'DomainBounds' and 'EndValues' instances.  The idea+--   is that if @tr@ is a trail, you can write, /e.g./+--+--   @+--   getSegment tr `atParam` 0.6+--   @+--+--   or+--+--   @+--   atStart (getSegment tr)+--   @+--+--   to get the segment at parameter 0.6 or the first segment in the+--   trail, respectively.+--+--   The codomain for 'GetSegment', /i.e./ the result you get from+--   calling 'atParam', 'atStart', or 'atEnd', is+--   'GetSegmentCodomain', which is a newtype wrapper around @Maybe+--   (v, Segment Closed v, AnIso' n n)@.  @Nothing@ results if the+--   trail is empty; otherwise, you get:+--+--   * the offset from the start of the trail to the beginning of the+--     segment,+--+--   * the segment itself, and+--+--   * a reparameterization isomorphism: in the forward direction, it+--     translates from parameters on the whole trail to a parameters+--     on the segment.  Note that for technical reasons you have to+--     call 'cloneIso' on the @AnIso'@ value to get a real isomorphism+--     you can use.+newtype GetSegment t = GetSegment t++newtype GetSegmentCodomain v n =+  GetSegmentCodomain+    (Maybe ( v n                -- offset from trail start to segment start+           , Segment Closed v n -- the segment+           , AnIso' n n         -- reparameterization, trail <-> segment+           ))++-- | Create a 'GetSegment' wrapper around a trail, after which you can+--   call 'atParam', 'atStart', or 'atEnd' to extract a segment.+getSegment :: t -> GetSegment t+getSegment = GetSegment++type instance V (GetSegment t) = V t+type instance N (GetSegment t) = N t++type instance Codomain (GetSegment t) = GetSegmentCodomain (V t)++-- | Parameters less than 0 yield the first segment; parameters+--   greater than 1 yield the last.  A parameter exactly at the+--   junction of two segments yields the second segment (/i.e./ the+--   one with higher parameter values).+instance (Metric v, OrderedField n) => Parametric (GetSegment (Trail' Line v n)) where+  atParam (GetSegment (Line (SegTree ft))) p+    | p <= 0 = case FT.viewl ft of+        EmptyL   -> GetSegmentCodomain Nothing+        seg FT.:< _ -> GetSegmentCodomain $ Just (zero, seg, reparam 0)++    | p >= 1 = case FT.viewr ft of+        EmptyR     -> GetSegmentCodomain Nothing+        ft' FT.:> seg -> GetSegmentCodomain $ Just (offset ft', seg, reparam (n-1))++    | otherwise+    = let (before, after) = FT.split ((p*n <) . numSegs) ft+      in  case FT.viewl after of+            EmptyL   -> GetSegmentCodomain Nothing+            seg FT.:< _ -> GetSegmentCodomain $ Just (offset before, seg, reparam (numSegs before))+    where+      n = numSegs ft+      reparam k = iso (subtract k . (*n))+                      ((/n) . (+ k))++-- | The parameterization for loops wraps around, /i.e./ parameters+--   are first reduced \"mod 1\".+instance (Metric v, OrderedField n, Real n) => Parametric (GetSegment (Trail' Loop v n)) where+  atParam (GetSegment l) p = atParam (GetSegment (cutLoop l)) (mod1 p)++instance (Metric v, OrderedField n, Real n)+    => Parametric (GetSegment (Trail v n)) where+  atParam (GetSegment t) p+    = withTrail+      ((`atParam` p) . GetSegment)+      ((`atParam` p) . GetSegment)+      t++instance DomainBounds t => DomainBounds (GetSegment t) where+  domainLower (GetSegment t) = domainLower t+  domainUpper (GetSegment t) = domainUpper t++instance (Metric v, OrderedField n)+    => EndValues (GetSegment (Trail' Line v n)) where+  atStart (GetSegment (Line (SegTree ft)))+    = case FT.viewl ft of+        EmptyL   -> GetSegmentCodomain Nothing+        seg FT.:< _ ->+          let n = numSegs ft+          in  GetSegmentCodomain $ Just (zero, seg, iso (*n) (/n))++  atEnd (GetSegment (Line (SegTree ft)))+    = case FT.viewr ft of+        EmptyR     -> GetSegmentCodomain Nothing+        ft' FT.:> seg ->+          let n = numSegs ft+          in  GetSegmentCodomain $+                Just (offset ft', seg, iso (subtract (n-1) . (*n))+                                         ((/n) . (+ (n-1)))+                     )++instance (Metric v, OrderedField n, Real n)+    => EndValues (GetSegment (Trail' Loop v n)) where+  atStart (GetSegment l) = atStart (GetSegment (cutLoop l))+  atEnd   (GetSegment l) = atEnd   (GetSegment (cutLoop l))++instance (Metric v, OrderedField n, Real n)+    => EndValues (GetSegment (Trail v n)) where+  atStart (GetSegment t)+    = withTrail+      (atStart . GetSegment)+      (atStart . GetSegment)+      t+  atEnd (GetSegment t)+    = withTrail+      (atEnd . GetSegment)+      (atEnd . GetSegment)+      t++--------------------------------------------------+-- The Trail type++-- | @Trail@ is a wrapper around @Trail'@, hiding whether the+--   underlying @Trail'@ is a line or loop (though which it is can be+--   recovered; see /e.g./ 'withTrail').+data Trail v n where+  Trail :: Trail' l v n -> Trail v n++deriving instance Show (v n) => Show (Trail v n)++instance Eq (v n) => Eq (Trail v n) where+  t1 == t2 =+    withTrail+      (\ln1 -> withTrail (\ln2 -> ln1 == ln2) (const False) t2)+      (\lp1 -> withTrail (const False) (\lp2 -> lp1 == lp2) t2)+      t1++instance Ord (v n) => Ord (Trail v n) where+  compare t1 t2 =+    withTrail+      (\ln1 -> withTrail (compare ln1) (const LT) t2)+      (\lp1 -> withTrail (const GT) (compare lp1) t2)+      t1++-- | Two @Trail@s are combined by first ensuring they are both lines+--   (using 'cutTrail' on loops) and then concatenating them.  The+--   result, in general, is a line.  However, there is a special case+--   for the empty line, which acts as the identity (so combining the+--   empty line with a loop results in a loop).+instance (OrderedField n, Metric v) => Semigroup (Trail v n) where+  (Trail (Line (SegTree ft))) <> t2 | FT.null ft = t2+  t1 <> (Trail (Line (SegTree ft))) | FT.null ft = t1+  t1 <> t2 = flip withLine t1 $ \l1 ->+             flip withLine t2 $ \l2 ->+             wrapLine (l1 <> l2)++-- | @Trail@s are combined as described in the 'Semigroup' instance;+--   the empty line is the identity element, with special cases so+--   that combining the empty line with a loop results in the+--   unchanged loop (in all other cases loops will be cut).  Note that+--   this does, in fact, satisfy the monoid laws, though it is a bit+--   strange.  Mostly it is provided for convenience, so one can work+--   directly with @Trail@s instead of working with @Trail' Line@s and+--   then wrapping.+instance (Metric v, OrderedField n) => Monoid (Trail v n) where+  mempty  = wrapLine emptyLine+  mappend = (<>)++instance (Metric v, OrderedField n) => AsEmpty (Trail v n) where+  _Empty = nearly emptyTrail isTrailEmpty++type instance V (Trail v n) = v+type instance N (Trail v n) = n++type instance Codomain (Trail v n) = v++instance (HasLinearMap v, Metric v, OrderedField n)+    => Transformable (Trail v n) where+  transform t = onTrail (transform t) (transform t)++instance (Metric v, OrderedField n) => Enveloped (Trail v n) where+  getEnvelope = withTrail getEnvelope getEnvelope++instance (Metric v, OrderedField n, Real n)+    => Parametric (Trail v n) where+  atParam t p = withTrail (`atParam` p) (`atParam` p) t++instance Num n => DomainBounds (Trail v n)++instance (Metric v, OrderedField n, Real n) => EndValues (Trail v n)++-- | Note that there is no @Sectionable@ instance for @Trail' Loop@,+--   because it does not make sense (splitting a loop at a parameter+--   results in a single line, not two loops).  However, it's+--   convenient to have a @Sectionable@ instance for @Trail@; if the+--   @Trail@ contains a loop the loop will first be cut and then+--   @splitAtParam@ called on the resulting line.  This is+--   semantically a bit silly, so please don't rely on it. (*E.g.* if+--   this is really the behavior you want, consider first calling+--   'cutLoop' yourself.)+instance (Metric v, OrderedField n, Real n) => Sectionable (Trail v n) where+  splitAtParam t p = withLine ((wrapLine *** wrapLine) . (`splitAtParam` p)) t++  section t p1 p2 = withLine (wrapLine . (\l -> section l p1 p2)) t++  reverseDomain = reverseTrail++instance (Metric v, OrderedField n, Real n)+    => HasArcLength (Trail v n) where+  arcLengthBounded = withLine . arcLengthBounded+  arcLengthToParam eps tr al = withLine (\ln -> arcLengthToParam eps ln al) tr++-- lens instrances -----------------------------------------------------++-- | Prism onto a 'Line'.+_Line :: Prism' (Trail v n) (Trail' Line v n)+_Line = _Wrapped' . _Left++-- | Prism onto a 'Loop'.+_Loop :: Prism' (Trail v n) (Trail' Loop v n)+_Loop = _Wrapped' . _Right++-- | Prism onto a 'Located' 'Line'.+_LocLine :: Prism' (Located (Trail v n)) (Located (Trail' Line v n))+_LocLine = prism' (mapLoc Trail) $ located (preview _Line)++-- | Prism onto a 'Located' 'Loop'.+_LocLoop :: Prism' (Located (Trail v n)) (Located (Trail' Loop v n))+_LocLoop = prism' (mapLoc Trail) $ located (preview _Loop)++instance Rewrapped (Trail v n) (Trail v' n')+instance Wrapped (Trail v n) where+  type Unwrapped (Trail v n) = Either (Trail' Line v n) (Trail' Loop v n)+  _Wrapped' = iso getTrail (either Trail Trail)+    where+      getTrail :: Trail v n -> Either (Trail' Line v n) (Trail' Loop v n)+      getTrail (Trail t@(Line {})) = Left t+      getTrail (Trail t@(Loop {})) = Right t++--------------------------------------------------+-- Constructors and eliminators for Trail++-- | A generic eliminator for 'Trail', taking functions specifying+--   what to do in the case of a line or a loop.+withTrail :: (Trail' Line v n -> r) -> (Trail' Loop v n -> r) -> Trail v n -> r+withTrail line loop (Trail t) = withTrail' line loop t++-- | Modify a @Trail@, specifying two separate transformations for the+--   cases of a line or a loop.+onTrail :: (Trail' Line v n -> Trail' l1 v n) -> (Trail' Loop v n -> Trail' l2 v n)+        -> Trail v n -> Trail v n+onTrail o c = withTrail (wrapTrail . o) (wrapTrail . c)++-- | An eliminator for @Trail@ based on eliminating lines: if the+--   trail is a line, the given function is applied; if it is a loop, it+--   is first converted to a line with 'cutLoop'.  That is,+--+-- @+-- withLine f === 'withTrail' f (f . 'cutLoop')+-- @+withLine :: (Metric v, OrderedField n)+              => (Trail' Line v n -> r) -> Trail v n -> r+withLine f = withTrail f (f . cutLoop)++-- | Modify a @Trail@ by specifying a transformation on lines.  If the+--   trail is a line, the transformation will be applied directly.  If+--   it is a loop, it will first be cut using 'cutLoop', the+--   transformation applied, and then glued back into a loop with+--   'glueLine'.  That is,+--+--   @+--   onLine f === onTrail f (glueLine . f . cutLoop)+--   @+--+--   Note that there is no corresponding @onLoop@ function, because+--   there is no nice way in general to convert a line into a loop,+--   operate on it, and then convert back.+onLine :: (Metric v, OrderedField n)+       => (Trail' Line v n -> Trail' Line v n) -> Trail v n -> Trail v n+onLine f = onTrail f (glueLine . f . cutLoop)++-- | Convert a 'Trail'' into a 'Trail', hiding the type-level+--   distinction between lines and loops.+wrapTrail :: Trail' l v n -> Trail v n+wrapTrail = Trail++-- | Convert a line into a 'Trail'.  This is the same as 'wrapTrail',+--   but with a more specific type, which can occasionally be+--   convenient for fixing the type of a polymorphic expression.+wrapLine :: Trail' Line v n -> Trail v n+wrapLine = wrapTrail++-- | Convert a loop into a 'Trail'.  This is the same as 'wrapTrail',+--   but with a more specific type, which can occasionally be+--   convenient for fixing the type of a polymorphic expression.+wrapLoop :: Trail' Loop v n -> Trail v n+wrapLoop = wrapTrail++------------------------------------------------------------+--  Constructing trails  -----------------------------------+------------------------------------------------------------++-- | The empty line, which is the identity for concatenation of lines.+emptyLine :: (Metric v, OrderedField n) => Trail' Line v n+emptyLine = Line mempty++-- | A wrapped variant of 'emptyLine'.+emptyTrail :: (Metric v, OrderedField n) => Trail v n+emptyTrail = wrapLine emptyLine++-- | Construct a line from a list of closed segments.+lineFromSegments :: (Metric v, OrderedField n)+                   => [Segment Closed v n] -> Trail' Line v n+lineFromSegments = Line . SegTree . FT.fromList++-- | Construct a loop from a list of closed segments and an open segment+--   that completes the loop.+loopFromSegments :: (Metric v, OrderedField n)+                  => [Segment Closed v n] -> Segment Open v n -> Trail' Loop v n+loopFromSegments segs = Loop (SegTree (FT.fromList segs))++-- | @trailFromSegments === 'wrapTrail' . 'lineFromSegments'@, for+--   conveniently constructing a @Trail@ instead of a @Trail'@.+trailFromSegments :: (Metric v, OrderedField n)+                  => [Segment Closed v n] -> Trail v n+trailFromSegments = wrapTrail . lineFromSegments++-- | Construct a line containing only linear segments from a list of+--   vectors, where each vector represents the offset from one vertex+--   to the next.  See also 'fromOffsets'.+--+--   <<diagrams/src_Diagrams_Trail_lineFromOffsetsEx.svg#diagram=lineFromOffsetsEx&width=300>>+--+--   > import Diagrams.Coordinates+--   > lineFromOffsetsEx = strokeLine $ lineFromOffsets [ 2 ^& 1, 2 ^& (-1), 2 ^& 0.5 ]+lineFromOffsets :: (Metric v, OrderedField n) => [v n] -> Trail' Line v n+lineFromOffsets = lineFromSegments . map straight++-- | @trailFromOffsets === 'wrapTrail' . 'lineFromOffsets'@, for+--   conveniently constructing a @Trail@ instead of a @Trail' Line@.+trailFromOffsets :: (Metric v, OrderedField n) => [v n] -> Trail v n+trailFromOffsets = wrapTrail . lineFromOffsets++-- | Construct a line containing only linear segments from a list of+--   vertices.  Note that only the relative offsets between the+--   vertices matters; the information about their absolute position+--   will be discarded.  That is, for all vectors @v@,+--+-- @+-- lineFromVertices === lineFromVertices . 'translate' v+-- @+--+--   If you want to retain the position information, you should+--   instead use the more general 'fromVertices' function to+--   construct, say, a @'Located' ('Trail'' 'Line' v)@ or a @'Located'+--   ('Trail' v)@.+--+--   <<diagrams/src_Diagrams_Trail_lineFromVerticesEx.svg#diagram=lineFromVerticesEx&width=300>>+--+--   > import Diagrams.Coordinates+--   > lineFromVerticesEx = pad 1.1 . centerXY . strokeLine+--   >   $ lineFromVertices [origin, 0 ^& 1, 1 ^& 2, 5 ^& 1]+lineFromVertices :: (Metric v, OrderedField n)+                   => [Point v n] -> Trail' Line v n+lineFromVertices []  = emptyLine+lineFromVertices [_] = emptyLine+lineFromVertices ps  = lineFromSegments . map straight $ zipWith (.-.) (tail ps) ps+++-- | @trailFromVertices === 'wrapTrail' . 'lineFromVertices'@, for+--   conveniently constructing a @Trail@ instead of a @Trail' Line@.+trailFromVertices :: (Metric v, OrderedField n)+                  => [Point v n] -> Trail v n+trailFromVertices = wrapTrail . lineFromVertices++------------------------------------------------------------+--  Converting between lines and loops  --------------------+------------------------------------------------------------++-- | Make a line into a loop by \"gluing\" the endpoint to the+--   starting point.  In particular, the offset of the final segment+--   is modified so that it ends at the starting point of the entire+--   trail.  Typically, you would first construct a line which you+--   know happens to end where it starts, and then call 'glueLine' to+--   turn it into a loop.+--+--   <<diagrams/src_Diagrams_Trail_glueLineEx.svg#diagram=glueLineEx&width=500>>+--+--   > glueLineEx = pad 1.1 . hsep 1+--   >   $ [almostClosed # strokeLine, almostClosed # glueLine # strokeLoop]+--   >+--   > almostClosed :: Trail' Line V2 Double+--   > almostClosed = fromOffsets $ map r2 [(2, -1), (-3, -0.5), (-2, 1), (1, 0.5)]+--+--   @glueLine@ is left inverse to 'cutLoop', that is,+--+--   @+--   glueLine . cutLoop === id+--   @+glueLine :: (Metric v, OrderedField n) => Trail' Line v n -> Trail' Loop v n+glueLine (Line (SegTree t)) =+  case FT.viewr t of+    FT.EmptyR           -> Loop mempty (Linear OffsetOpen)+    t' FT.:> Linear _      -> Loop (SegTree t') (Linear OffsetOpen)+    t' FT.:> Cubic c1 c2 _ -> Loop (SegTree t') (Cubic c1 c2 OffsetOpen)++-- | @glueTrail@ is a variant of 'glueLine' which works on 'Trail's.+--   It performs 'glueLine' on lines and is the identity on loops.+glueTrail :: (Metric v, OrderedField n) => Trail v n -> Trail v n+glueTrail = onTrail glueLine id++-- | Make a line into a loop by adding a new linear segment from the+--   line's end to its start.+--+--   @closeLine@ does not have any particularly nice theoretical+--   properties, but can be useful /e.g./ when you want to make a+--   closed polygon out of a list of points where the initial point is+--   not repeated at the end.  To use 'glueLine', one would first have+--   to duplicate the initial vertex, like+--+-- @+-- 'glueLine' . 'lineFromVertices' $ ps ++ [head ps]+-- @+--+--   Using @closeLine@, however, one can simply+--+-- @+-- closeLine . lineFromVertices $ ps+-- @+--+--   <<diagrams/src_Diagrams_Trail_closeLineEx.svg#diagram=closeLineEx&width=500>>+--+--   > closeLineEx = pad 1.1 . centerXY . hcat' (with & sep .~ 1)+--   >   $ [almostClosed # strokeLine, almostClosed # closeLine # strokeLoop]+closeLine :: Trail' Line v n -> Trail' Loop v n+closeLine (Line t) = Loop t (Linear OffsetOpen)++-- | @closeTrail@ is a variant of 'closeLine' for 'Trail', which+--   performs 'closeLine' on lines and is the identity on loops.+closeTrail :: Trail v n -> Trail v n+closeTrail = onTrail closeLine id++-- | Turn a loop into a line by \"cutting\" it at the common start/end+--   point, resulting in a line which just happens to start and end at+--   the same place.+--+--   @cutLoop@ is right inverse to 'glueLine', that is,+--+--   @+--   glueLine . cutLoop === id+--   @+cutLoop :: forall v n. (Metric v, OrderedField n)+         => Trail' Loop v n -> Trail' Line v n+cutLoop (Loop (SegTree t) c) =+  case (FT.null t, c) of+    (True, Linear OffsetOpen)      -> emptyLine+    (_   , Linear OffsetOpen)      -> Line (SegTree (t |> Linear off))+    (_   , Cubic c1 c2 OffsetOpen) -> Line (SegTree (t |> Cubic c1 c2 off))+  where+    offV :: v n+    offV = negated . trailMeasure zero (op TotalOffset .view oeOffset) $ t+    off = OffsetClosed offV++-- | @cutTrail@ is a variant of 'cutLoop' for 'Trail'; it is the is+--   the identity on lines and performs 'cutLoop' on loops.+cutTrail :: (Metric v, OrderedField n)+         => Trail v n -> Trail v n+cutTrail = onTrail id cutLoop++------------------------------------------------------------+--  Eliminating trails  ------------------------------------+------------------------------------------------------------++-- | Test whether a line is empty.+isLineEmpty :: (Metric v, OrderedField n) => Trail' Line v n -> Bool+isLineEmpty (Line (SegTree t)) = FT.null t++-- | Test whether a trail is empty.  Note that loops are never empty.+isTrailEmpty :: (Metric v, OrderedField n) => Trail v n -> Bool+isTrailEmpty = withTrail isLineEmpty (const False)++-- | Determine whether a trail is a line.+isLine :: Trail v n -> Bool+isLine = not . isLoop++-- | Determine whether a trail is a loop.+isLoop :: Trail v n -> Bool+isLoop = withTrail (const False) (const True)++-- | Extract the segments comprising a line.+lineSegments :: Trail' Line v n -> [Segment Closed v n]+lineSegments (Line (SegTree t)) = F.toList t++-- | Modify a line by applying a function to its list of segments.+onLineSegments+  :: (Metric v, OrderedField n)+  => ([Segment Closed v n] -> [Segment Closed v n])+  -> Trail' Line v n -> Trail' Line v n+onLineSegments f = lineFromSegments . f . lineSegments++-- | Extract the segments comprising a loop: a list of closed+--   segments, and one final open segment.+loopSegments :: Trail' Loop v n -> ([Segment Closed v n], Segment Open v n)+loopSegments (Loop (SegTree t) c) = (F.toList t, c)++-- | Extract the segments of a trail.  If the trail is a loop it will+--   first have 'cutLoop' applied.+trailSegments :: (Metric v, OrderedField n)+              => Trail v n -> [Segment Closed v n]+trailSegments = withLine lineSegments++-- | Extract the offsets of the segments of a trail.+trailOffsets :: (Metric v, OrderedField n) => Trail v n -> [v n]+trailOffsets = withLine lineOffsets++-- | Compute the offset from the start of a trail to the end.  Satisfies+--+--   @+--   trailOffset === sumV . trailOffsets+--   @+--+--   but is more efficient.+--+--   <<diagrams/src_Diagrams_Trail_trailOffsetEx.svg#diagram=trailOffsetEx&width=300>>+--+--   > trailOffsetEx = (strokeLine almostClosed <> showOffset) # centerXY # pad 1.1+--   >   where showOffset = fromOffsets [trailOffset (wrapLine almostClosed)]+--   >                    # strokeP # lc red+trailOffset :: (Metric v, OrderedField n) => Trail v n -> v n+trailOffset = withLine lineOffset++-- | Extract the offsets of the segments of a line.+lineOffsets :: Trail' Line v n -> [v n]+lineOffsets = map segOffset . lineSegments++-- | Extract the offsets of the segments of a loop.+loopOffsets :: (Metric v, OrderedField n) => Trail' Loop v n -> [v n]+loopOffsets = lineOffsets . cutLoop++-- | Compute the offset from the start of a line to the end.  (Note,+--   there is no corresponding @loopOffset@ function because by+--   definition it would be constantly zero.)+lineOffset :: (Metric v, OrderedField n) => Trail' Line v n -> v n+lineOffset (Line t) = trailMeasure zero (op TotalOffset . view oeOffset) t++-- | Extract the points of a concretely located trail, /i.e./ the points+--   where one segment ends and the next begins. Note that for loops,+--   the starting point will /not/ be repeated at the end.  If you+--   want this behavior, you can use 'cutTrail' to make the loop into+--   a line first, which happens to repeat the same point at the start+--   and end, /e.g./ with @trailPoints . mapLoc cutTrail@.+--+--   Note that it does not make sense to ask for the points of a+--   'Trail' by itself; if you want the points of a trail+--   with the first point at, say, the origin, you can use+--   @trailPoints . (\`at\` origin)@.+--+--   This function allows you "observe" the fact that trails are+--   implemented as lists of segments, which may be problematic if we+--   want to think of trails as parametric vector functions. This also+--   means that the behavior of this function may not be stable under+--   future changes to the implementation of trails.  For an+--   unproblematic version which only yields vertices at which there+--   is a sharp corner, excluding points where the trail is+--   differentiable, see 'trailVertices'.+--+--   This function is not re-exported from "Diagrams.Prelude"; to use+--   it, import "Diagrams.Trail".+trailPoints :: (Metric v, OrderedField n)+              => Located (Trail v n) -> [Point v n]+trailPoints (viewLoc -> (p,t))+  = withTrail (linePoints . (`at` p)) (loopPoints . (`at` p)) t++-- | Extract the segment join points of a concretely located line.  See+--   'trailPoints' for more information.+--+--   This function allows you "observe" the fact that lines are+--   implemented as lists of segments, which may be problematic if we+--   want to think of lines as parametric vector functions. This also+--   means that the behavior of this function may not be stable under+--   future changes to the implementation of trails.  For an+--   unproblematic version which only yields vertices at which there+--   is a sharp corner, excluding points where the trail is+--   differentiable, see 'lineVertices'.+--+--   This function is not re-exported from "Diagrams.Prelude"; to use+--   it, import "Diagrams.Trail".+linePoints :: (Metric v, OrderedField n)+             => Located (Trail' Line v n) -> [Point v n]+linePoints (viewLoc -> (p,t))+  = segmentPoints p . lineSegments $ t++-- | Extract the segment join points of a concretely located loop.  Note that the+--   initial vertex is not repeated at the end.  See 'trailPoints' for+--   more information.+--+--   This function allows you "observe" the fact that lines are+--   implemented as lists of segments, which may be problematic if we+--   want to think of lines as parametric vector functions. This also+--   means that the behavior of this function may not be stable under+--   future changes to the implementation of trails.  For an+--   unproblematic version which only yields vertices at which there+--   is a sharp corner, excluding points where the trail is+--   differentiable, see 'lineVertices'.+--+--   This function is not re-exported from "Diagrams.Prelude"; to use+--   it, import "Diagrams.Trail".+loopPoints :: (Metric v, OrderedField n)+             => Located (Trail' Loop v n) -> [Point v n]+loopPoints (viewLoc -> (p,t))+  = segmentPoints p . fst . loopSegments $ t++segmentPoints :: (Additive v, Num n) => Point v n -> [Segment Closed v n] -> [Point v n]+segmentPoints p = scanl (.+^) p . map segOffset++tolerance :: OrderedField a => a+tolerance = 10e-16++-- | Extract the vertices of a concretely located trail.  Here a /vertex/+--   is defined as a non-differentiable point on the trail, /i.e./ a+--   sharp corner.  (Vertices are thus a subset of the places where+--   segments join; if you want all joins between segments, see+--   'trailPoints'.)  The tolerance determines how close the tangents+--   of two segments must be at their endpoints to consider the+--   transition point to be differentiable.+--+--   Note that for loops, the starting vertex will /not/ be repeated+--   at the end.  If you want this behavior, you can use 'cutTrail' to+--   make the loop into a line first, which happens to repeat the same+--   vertex at the start and end, /e.g./ with @trailVertices . mapLoc+--   cutTrail@.+--+--   It does not make sense to ask for the vertices of a 'Trail' by+--   itself; if you want the vertices of a trail with the first vertex+--   at, say, the origin, you can use @trailVertices . (\`at\`+--   origin)@.+trailVertices' :: (Metric v, OrderedField n)+              => n ->  Located (Trail v n) -> [Point v n]+trailVertices' toler (viewLoc -> (p,t))+  = withTrail (lineVertices' toler . (`at` p)) (loopVertices' toler . (`at` p)) t++-- | Like 'trailVertices'', with a default tolerance.+trailVertices :: (Metric v, OrderedField n)+              => Located (Trail v n) -> [Point v n]+trailVertices = trailVertices' tolerance++-- | Extract the vertices of a concretely located line.  See+--   'trailVertices' for more information.+lineVertices' :: (Metric v, OrderedField n)+             => n -> Located (Trail' Line v n) -> [Point v n]+lineVertices' toler (viewLoc -> (p,t))+  = segmentVertices' toler p . lineSegments $ t++-- | Like 'lineVertices'', with a default tolerance.+lineVertices :: (Metric v, OrderedField n)+             => Located (Trail' Line v n) -> [Point v n]+lineVertices = lineVertices' tolerance++-- | Extract the vertices of a concretely located loop.  Note that the+--   initial vertex is not repeated at the end.  See 'trailVertices' for+--   more information.+loopVertices' :: (Metric v, OrderedField n)+             => n -> Located (Trail' Loop v n) -> [Point v n]+loopVertices' toler (viewLoc -> (p,t))+  | length segs > 1 = if far > toler  then init ps else init . drop 1 $ ps+  | otherwise       = ps+  where+    far = quadrance ((signorm . tangentAtStart . head $ segs) ^-^+                       (signorm . tangentAtEnd   . last $ segs))+    segs = lineSegments . cutLoop $ t+    ps = segmentVertices' toler p segs++-- | Same as 'loopVertices'', with a default tolerance.+loopVertices :: (Metric v, OrderedField n)+             => Located (Trail' Loop v n) -> [Point v n]+loopVertices = loopVertices' tolerance++-- | The vertices of a list of segments laid end to end.+--   The start and end points are always included in the list of+--   vertices.  The other points connecting segments are included if+--   the slope at the end of a segment is not equal to the slope at+--   the beginning of the next.  The 'toler' parameter is used to+--   control how close the slopes need to be in order to declare them+--   equal.+segmentVertices' :: (Metric v, OrderedField n)+             => n -> Point v n -> [Segment Closed v n] -> [Point v n]+segmentVertices' toler p ts  =+  case ps of+    (x:_:_) -> x : select (drop 1 ps) ds ++ [last ps]+    _       -> ps+    where+      ds = zipWith far tans (drop 1 tans)+      tans = [(signorm . tangentAtStart $ s+              ,signorm . tangentAtEnd   $ s) | s <- ts]+      ps = scanl (.+^) p . map segOffset $ ts+      far p2 q2 = quadrance (snd p2 ^-^ fst q2) > toler++select :: [a] -> [Bool] -> [a]+select xs bs = map fst $ filter snd (zip xs bs)++-- | Convert a concretely located trail into a list of fixed segments.+--   'unfixTrail' is almost its left inverse.+fixTrail :: (Metric v, OrderedField n)+         => Located (Trail v n) -> [FixedSegment v n]+fixTrail t = map mkFixedSeg (trailLocSegments t)++-- | Convert a list of fixed segments into a located trail.  Note that+--   this may lose information: it throws away the locations of all+--   but the first @FixedSegment@.  This does not matter precisely+--   when each @FixedSegment@ begins where the previous one ends.+--+--   This is almost left inverse to 'fixTrail', that is, @unfixTrail+--   . fixTrail == id@, except for the fact that @unfixTrail@ will+--   never yield a @Loop@.  In the case of a loop, we instead have+--   @glueTrail . unfixTrail . fixTrail == id@.  On the other hand, it+--   is not the case that @fixTrail . unfixTrail == id@ since+--   @unfixTrail@ may lose information.+unfixTrail+  :: (Metric v, Ord n, Floating n)+  => [FixedSegment v n] -> Located (Trail v n)+unfixTrail = mapLoc trailFromSegments . takeLoc . map fromFixedSeg+  where+    takeLoc []       = [] `at` origin+    takeLoc xs@(x:_) = map unLoc xs `at` loc x++-- | Convert a concretely located trail into a list of located segments.+trailLocSegments :: (Metric v, OrderedField n)+                  => Located (Trail v n) -> [Located (Segment Closed v n)]+trailLocSegments t = zipWith at (trailSegments (unLoc t)) (trailPoints t)++------------------------------------------------------------+--  Modifying trails  --------------------------------------+------------------------------------------------------------++-- | Reverse a trail.  Semantically, if a trail given by a function t+--   from [0,1] to vectors, then the reverse of t is given by t'(s) =+--   t(1-s).  @reverseTrail@ is an involution, that is,+--+--   @+--   reverseTrail . reverseTrail === id+--   @+reverseTrail :: (Metric v, OrderedField n) => Trail v n -> Trail v n+reverseTrail = onTrail reverseLine reverseLoop++-- | Reverse a concretely located trail.  The endpoint of the original+--   trail becomes the starting point of the reversed trail, so the+--   original and reversed trails comprise exactly the same set of+--   points.  @reverseLocTrail@ is an involution, /i.e./+--+--   @+--   reverseLocTrail . reverseLocTrail === id+--   @+reverseLocTrail :: (Metric v, OrderedField n)+                => Located (Trail v n) -> Located (Trail v n)+reverseLocTrail (viewLoc -> (p, t)) = reverseTrail t `at` (p .+^ trailOffset t)++-- | Reverse a line.  See 'reverseTrail'.+reverseLine :: (Metric v, OrderedField n)+            => Trail' Line v n -> Trail' Line v n+reverseLine = onLineSegments (reverse . map reverseSegment)++-- | Reverse a concretely located line.  See 'reverseLocTrail'.+reverseLocLine :: (Metric v, OrderedField n)+               => Located (Trail' Line v n) -> Located (Trail' Line v n)+reverseLocLine (viewLoc -> (p,l)) = reverseLine l `at` (p .+^ lineOffset l)++-- | Reverse a loop.  See 'reverseTrail'.+reverseLoop :: (Metric v, OrderedField n)+            => Trail' Loop v n -> Trail' Loop v n+reverseLoop = glueLine . reverseLine . cutLoop++-- | Reverse a concretely located loop.  See 'reverseLocTrail'.  Note+--   that this is guaranteed to preserve the location.+reverseLocLoop :: (Metric v, OrderedField n)+               => Located (Trail' Loop v n) -> Located (Trail' Loop v n)+reverseLocLoop = mapLoc reverseLoop++-- | Same as 'reverseLine' or 'reverseLoop'.+instance (Metric v, OrderedField n) => Reversing (Trail' l v n) where+  reversing t@(Line _)   = onLineSegments (reverse . map reversing) t+  reversing t@(Loop _ _) = glueLine . reversing . cutLoop $ t++-- | Same as 'reverseTrail'.+instance (Metric v, OrderedField n) => Reversing (Trail v n) where+  reversing (Trail t) = Trail (reversing t)++-- | Same as 'reverseLocLine' or 'reverseLocLoop'.+instance (Metric v, OrderedField n) => Reversing (Located (Trail' l v n)) where+  reversing l@(Loc _ Line {}) = reverseLocLine l+  reversing l@(Loc _ Loop {}) = reverseLocLoop l++-- | Same as 'reverseLocTrail'.+instance (Metric v, OrderedField n) => Reversing (Located (Trail v n)) where+  reversing = reverseLocTrail++------------------------------------------------------------+--  Serialize instances+------------------------------------------------------------++instance (Serialize (v n), OrderedField n, Metric v) => Serialize (Trail v n) where+  {-# INLINE get #-}+  get = do+    isLine <- Serialize.get+    case isLine of+      True  -> do+        segTree <- Serialize.get+        return (Trail (Line segTree))+      False -> do+        segTree <- Serialize.get+        segment <- Serialize.get+        return (Trail (Loop segTree segment))++  {-# INLINE put #-}+  put (Trail (Line segTree)) = do+    Serialize.put True+    Serialize.put segTree++  put (Trail (Loop segTree segment)) = do+    Serialize.put False+    Serialize.put segTree+    Serialize.put segment++instance (OrderedField n, Metric v, Serialize (v n)) => Serialize (SegTree v n) where+  {-# INLINE put #-}+  put (SegTree fingerTree) = Serialize.put (F.toList fingerTree)++  {-# INLINE get #-}+  get = do+    fingerTree <- Serialize.get+    return (SegTree (FT.fromList fingerTree))

src/Diagrams/TrailLike.hs view

@@ -1,6 +1,8 @@+{-# LANGUAGE ConstraintKinds      #-} {-# LANGUAGE FlexibleContexts     #-} {-# LANGUAGE FlexibleInstances    #-} {-# LANGUAGE TypeFamilies         #-}+{-# LANGUAGE TypeOperators        #-} {-# LANGUAGE UndecidableInstances #-} ----------------------------------------------------------------------------- -- |@@ -28,14 +30,17 @@         ) where -import           Data.AffineSpace ((.-.))-import           Data.VectorSpace+import           Control.Lens     (view, _Unwrapped')  import           Diagrams.Core import           Diagrams.Located import           Diagrams.Segment import           Diagrams.Trail +import           Linear.Affine+import           Linear.Metric+import           Linear.Vector+ ------------------------------------------------------------ --  TrailLike class ------------------------------------------------------------@@ -60,42 +65,42 @@ --   course call 'trailLike' directly; more typically, one would use --   one of the provided functions like 'fromOffsets', 'fromVertices', --   'fromSegments', or '~~'.-class (InnerSpace (V t), OrderedField (Scalar (V t))) => TrailLike t where+class (Metric (V t), OrderedField (N t)) => TrailLike t where    trailLike-    :: Located (Trail (V t))  -- ^ The concretely located trail.  Note-                              --   that some trail-like things-                              --   (e.g. 'Trail's) may ignore the-                              --   location.+    :: Located (Trail (V t) (N t)) -- ^ The concretely located trail.  Note+                                   --   that some trail-like things+                                   --   (e.g. 'Trail's) may ignore the+                                   --   location.     -> t  ------------------------------------------------------------ --  Instances  ---------------------------------------------  -- | A list of points is trail-like; this instance simply---   computes the vertices of the trail, using 'trailVertices'.-instance (InnerSpace v, OrderedField (Scalar v)) => TrailLike [Point v] where-  trailLike = trailVertices+--   computes the vertices of the trail, using 'trailPoints'.+instance (Metric v, OrderedField n) => TrailLike [Point v n] where+  trailLike = trailPoints  -- | Lines are trail-like.  If given a 'Trail' which contains a loop, --   the loop will be cut with 'cutLoop'.  The location is ignored.-instance (InnerSpace v, OrderedField (Scalar v)) => TrailLike (Trail' Line v) where+instance (Metric v, OrderedField n) => TrailLike (Trail' Line v n) where   trailLike = withTrail id cutLoop . unLoc  -- | Loops are trail-like.  If given a 'Trail' containing a line, the --   line will be turned into a loop using 'glueLine'.  The location --   is ignored.-instance (InnerSpace v, OrderedField (Scalar v)) => TrailLike (Trail' Loop v) where+instance (Metric v, OrderedField n) => TrailLike (Trail' Loop v n) where   trailLike = withTrail glueLine id . unLoc  -- | 'Trail's are trail-like; the location is simply ignored.-instance (InnerSpace v, OrderedField (Scalar v)) => TrailLike (Trail v) where+instance (Metric v, OrderedField n) => TrailLike (Trail v n) where   trailLike = unLoc  -- | Translationally invariant things are trail-like as long as the --   underlying type is. instance TrailLike t => TrailLike (TransInv t) where-  trailLike = TransInv . trailLike+  trailLike = view _Unwrapped' . trailLike  -- | 'Located' things are trail-like as long as the underlying type --   is.  The location is taken to be the location of the input@@ -110,24 +115,39 @@ -- | Construct a trail-like thing from a list of segments, with the --   origin as the location. -----   XXX example/picture-fromSegments :: TrailLike t => [Segment Closed (V t)] -> t+--   <<diagrams/src_Diagrams_TrailLike_fromSegmentsEx.svg#diagram=fromSegmentsEx&height=200>>+--+--   > fromSegmentsEx = fromSegments+--   >   [ straight (r2 (1,1))+--   >   , bézier3  (r2 (1,1)) unitX unit_Y+--   >   , straight unit_X+--   >   ]+--   >   # centerXY # pad 1.1+fromSegments :: TrailLike t => [Segment Closed (V t) (N t)] -> t fromSegments = fromLocSegments . (`at` origin)  -- | Construct a trail-like thing from a located list of segments.-fromLocSegments :: TrailLike t => Located [Segment Closed (V t)] -> t+fromLocSegments :: TrailLike t => Located [Segment Closed (V t) (N t)] -> t fromLocSegments = trailLike . mapLoc trailFromSegments  -- | Construct a trail-like thing of linear segments from a list --   of offsets, with the origin as the location. -----   XXX example/picture-fromOffsets :: TrailLike t => [V t] -> t+--   <<diagrams/src_Diagrams_TrailLike_fromOffsetsEx.svg#diagram=fromOffsetsEx&width=300>>+--+--   > fromOffsetsEx = fromOffsets+--   >   [ unitX+--   >   , unitX # rotateBy (1/6)+--   >   , unitX # rotateBy (-1/6)+--   >   , unitX+--   >   ]+--   >   # centerXY # pad 1.1+fromOffsets :: TrailLike t => [Vn t] -> t fromOffsets = trailLike . (`at` origin) . trailFromOffsets  -- | Construct a trail-like thing of linear segments from a located --   list of offsets.-fromLocOffsets :: (V (V t) ~ V t, TrailLike t) => Located [V t] -> t+fromLocOffsets :: (V t ~ v, N t ~ n, V (v n) ~ v, N (v n) ~ n, TrailLike t) => Located [v n] -> t fromLocOffsets = trailLike . mapLoc trailFromOffsets  -- | Construct a trail-like thing connecting the given vertices with@@ -135,23 +155,51 @@ --   vertices are given, the empty trail is used with the origin as --   the location. -----   XXX example/picture-fromVertices :: TrailLike t => [Point (V t)] -> t+--   <<diagrams/src_Diagrams_TrailLike_fromVerticesEx.svg#diagram=fromVerticesEx&width=300>>+--+--   > import Data.List (transpose)+--   >+--   > fromVerticesEx =+--   >   ( [ pentagon 1+--   >     , pentagon 1.3 # rotateBy (1/15)+--   >     , pentagon 1.5 # rotateBy (2/15)+--   >     ]+--   >     # transpose+--   >     # concat+--   >   )+--   >   # fromVertices+--   >   # closeTrail # strokeTrail+--   >   # centerXY # pad 1.1+fromVertices :: TrailLike t => [Point (V t) (N t)] -> t fromVertices []       = trailLike (emptyTrail `at` origin) fromVertices ps@(p:_) = trailLike (trailFromSegments (segmentsFromVertices ps) `at` p) -segmentsFromVertices :: AdditiveGroup v => [Point v] -> [Segment Closed v]+segmentsFromVertices :: (Additive v, Num n) => [Point v n] -> [Segment Closed v n] segmentsFromVertices []         = [] segmentsFromVertices vvs@(_:vs) = map straight (zipWith (flip (.-.)) vvs vs)  -- | Create a linear trail between two given points.-(~~) :: TrailLike t => Point (V t) -> Point (V t) -> t+--+--   <<diagrams/src_Diagrams_TrailLike_twiddleEx.svg#diagram=twiddleEx&width=300>>+--+--   > twiddleEx+--   >   = mconcat ((~~) <$> hexagon 1 <*> hexagon 1)+--   >   # centerXY # pad 1.1+(~~) :: (V t ~ v, N t ~ n, TrailLike t) => Point v n -> Point v n -> t p1 ~~ p2 = fromVertices [p1, p2]  -- | Given a concretely located trail, \"explode\" it by turning each --   segment into its own separate trail.  Useful for (say) applying a --   different style to each segment.-explodeTrail :: (VectorSpace (V t), TrailLike t) => Located (Trail (V t)) -> [t]+--+--   <<diagrams/src_Diagrams_TrailLike_explodeTrailEx.svg#diagram=explodeTrailEx&width=300>>+--+--   > explodeTrailEx+--   >   = pentagon 1+--   >   # explodeTrail  -- generate a list of diagrams+--   >   # zipWith lc [orange, green, yellow, red, blue]+--   >   # mconcat # centerXY # pad 1.1+explodeTrail :: (V t ~ v, N t ~ n, TrailLike t) => Located (Trail v n) -> [t] explodeTrail = map (mkTrail . fromFixedSeg) . fixTrail   where     mkTrail = trailLike . mapLoc (trailFromSegments . (:[]))

src/Diagrams/Transform.hs view

@@ -1,7 +1,15 @@+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes            #-}+{-# LANGUAGE TypeFamilies          #-}++{-# OPTIONS_GHC -fno-warn-unused-imports #-}+  -- for Data.Semigroup+ ----------------------------------------------------------------------------- -- | -- Module      :  Diagrams.Transform--- Copyright   :  (c) 2011-13 diagrams-lib team (see LICENSE)+-- Copyright   :  (c) 2011-15 diagrams-lib team (see LICENSE) -- License     :  BSD-style (see LICENSE) -- Maintainer  :  diagrams-discuss@googlegroups.com --@@ -11,6 +19,7 @@ -- ----------------------------------------------------------------------------- + module Diagrams.Transform     ( -- * Transformations       Transformation, inv, transl, apply, papply@@ -22,7 +31,7 @@     , translation, translate, moveTo, place, scaling, scale        -- * Miscellaneous transformation-related utilities-    , conjugate, under+    , conjugate, underT, transformed, translated, movedTo, movedFrom        -- * The HasOrigin class @@ -30,27 +39,90 @@      ) where +import           Control.Lens   hiding (transform) import           Data.Semigroup import           Diagrams.Core +import           Linear.Vector+ -- | Conjugate one transformation by another. @conjugate t1 t2@ is the --   transformation which performs first @t1@, then @t2@, then the --   inverse of @t1@.-conjugate :: HasLinearMap v => Transformation v -> Transformation v -> Transformation v-conjugate t1 t2  = inv t1 <> t2 <> t1+conjugate :: (Additive v, Num n)+          => Transformation v n -> Transformation v n -> Transformation v n+conjugate t1 t2 = inv t1 <> t2 <> t1 --- | Carry out some transformation \"under\" another one: @f ``under``+-- | Carry out some transformation \"under\" another one: @f ``underT`` --   t@ first applies @t@, then @f@, then the inverse of @t@.  For---   example, @'scaleX' 2 ``under`` 'rotationBy' (-1/8 :: Turn)@+--   example, @'scaleX' 2 ``underT`` 'rotation' (-1/8 \@\@ Turn)@ --   is the transformation which scales by a factor of 2 along the --   diagonal line y = x. -- --   Note that -----   @---   (transform t2) `under` t1 == transform (conjugate t1 t2)---   @+-- @+-- (transform t2) `underT` t1 == transform (conjugate t1 t2)+-- @ -- --   for all transformations @t1@ and @t2@.-under :: Transformable a => (a -> a) -> Transformation (V a) -> a -> a-f `under` t = transform (inv t) . f . transform t+--+--   See also the isomorphisms like 'transformed', 'movedTo',+--   'movedFrom', and 'translated'.+underT :: (InSpace v n a, SameSpace a b, Transformable a, Transformable b)+      => (a -> b) -> Transformation v n -> a -> b+f `underT` t = transform (inv t) . f . transform t++-- | Use a 'Transformation' to make an 'Iso' between an object+--   transformed and untransformed. This is useful for carrying out+--   functions 'under' another transform:+--+-- @+-- under (transformed t) f               == transform (inv t) . f . transform t+-- under (transformed t1) (transform t2) == transform (conjugate t1 t2)+-- transformed t ## a                    == transform t a+-- a ^. transformed t                    == transform (inv t) a+-- @+transformed :: (InSpace v n a, SameSpace a b, Transformable a, Transformable b)+            => Transformation v n -> Iso a b a b+transformed t = iso (transform $ inv t) (transform t)++-- | Use a 'Point' to make an 'Iso' between an object+--   moved to and from that point:+--+-- @+-- under (movedTo p) f == moveTo (-p) . f . moveTo p+-- over (movedTo p) f  == moveTo p . f . moveTo (-p)+-- movedTo p           == from (movedFrom p)+-- movedTo p ## a      == moveTo p a+-- a ^. movedTo p      == moveOriginTo p a+-- @+movedTo :: (InSpace v n a, SameSpace a b, HasOrigin a, HasOrigin b)+        => Point v n -> Iso a b a b+movedTo p = iso (moveTo (negated p)) (moveTo p)++-- | Use a 'Transformation' to make an 'Iso' between an object+--   transformed and untransformed. We have+--+-- @+-- under (movedFrom p) f == moveTo p . f . moveTo (-p)+-- movedFrom p           == from (movedTo p)+-- movedFrom p ## a      == moveOriginTo p a+-- a ^. movedFrom p      == moveTo p a+-- over (movedFrom p) f  == moveTo (-p) . f . moveTo p+-- @+movedFrom :: (InSpace v n a, SameSpace a b, HasOrigin a, HasOrigin b)+          => Point v n -> Iso a b a b+movedFrom p = iso (moveOriginTo (negated p)) (moveOriginTo p)++-- | Use a vector to make an 'Iso' between an object translated and+--   untranslated.+--+-- @+-- under (translated v) f == translate (-v) . f . translate v+-- translated v ## a      == translate v a+-- a ^. translated v      == translate (-v) a+-- over (translated v) f  == translate v . f . translate (-v)+-- @+translated :: (InSpace v n a, SameSpace a b, Transformable a, Transformable b)+           => v n -> Iso a b a b+translated v = transformed $ translation v

+ src/Diagrams/Transform/Matrix.hs view

@@ -0,0 +1,73 @@+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE MonoLocalBinds  #-}+{-# LANGUAGE TypeFamilies    #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Diagrams.Transform.Matrix+-- Copyright   :  (c) 2014 diagrams team (see LICENSE)+-- License     :  BSD-style (see LICENSE)+-- Maintainer  :  diagrams-discuss@googlegroups.com+--+-- Functions for converting between 'Transformation's and matricies.+--+-----------------------------------------------------------------------------++module Diagrams.Transform.Matrix where++import           Control.Arrow           ((&&&))+import           Control.Lens+import           Data.Distributive+import qualified Data.Foldable           as F+import           Data.Functor.Rep++import           Diagrams.Core.Transform as D+import           Diagrams.ThreeD.Types+import           Diagrams.TwoD.Types++import           Linear.Matrix+import           Linear.Vector++-- | Build a matrix from a 'Transformation', ignoring the translation.+mkMat :: (HasBasis v, Num n) => Transformation v n -> v (v n)+mkMat t = distribute . tabulate $ apply t . unit . (\x -> el x)++-- | Build a 3D transformation matrix in homogeneous coordinates from+--   a 'Transformation V3'.+mkMatHomo :: Num n => Transformation V3 n -> M44 n+mkMatHomo t = mkTransformationMat (mkMat t) (transl t)++-- | Make a 2D transformation from a 2x2 transform matrix and a+--   translation vector. Does not check if the matrix is not invertible+--   (in which case the 'T2' will be invalid).+fromMat22 :: Floating n => M22 n -> V2 n -> T2 n+fromMat22 m v = fromMatWithInv m (inv22 m) v++-- | Make a 3D transformation from a 3x3 transform matrix and a+--   translation vector. Does not check if the matrix is not invertible+--   (in which case the 'T3' will be invalid).+fromMat33 :: Floating n => M33 n -> V3 n -> T3 n+fromMat33 m v = fromMatWithInv m (inv33 m) v++-- | Build a transform with a maxtrix along with its inverse.+fromMatWithInv :: (Additive v, Distributive v, F.Foldable v, Num n)+  => v (v n) -- ^ matrix+  -> v (v n) -- ^ inverse+  -> v n     -- ^ translation+  -> Transformation v n+fromMatWithInv m m_ v =+  Transformation ((m !*)            <-> (m_ !*))+                 ((distribute m !*) <-> (distribute m_ !*))+                 v++-- | Prism onto a 2D transformation from a 2x2 transform matrix and+--   translation vector. Does not check if the matrix is invertible (in+--   which case the 'T2' will be invalid).+mat22 :: Floating n => Iso' (M22 n, V2 n) (T2 n)+mat22 = iso (uncurry fromMat22) (mkMat &&& transl)++-- | Prism onto a 3D transformation from a 3x3 transform matrix and+--   translation vector. Does not check if the matrix is invertible+--   (in which case the 'T3' will be invalid).+mat33 :: Floating n => Iso' (M33 n, V3 n) (T3 n)+mat33 = iso (uncurry fromMat33) (mkMat &&& transl)

+ src/Diagrams/Transform/ScaleInv.hs view

@@ -0,0 +1,185 @@+{-# LANGUAGE ConstraintKinds       #-}+{-# LANGUAGE DeriveDataTypeable    #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE StandaloneDeriving    #-}+{-# LANGUAGE TemplateHaskell       #-}+{-# LANGUAGE TypeFamilies          #-}+{-# LANGUAGE TypeOperators         #-}+{-# LANGUAGE UndecidableInstances  #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Diagrams.TwoD.Transform.ScaleInv+-- Copyright   :  (c) 2012-2013 diagrams-lib team (see LICENSE)+-- License     :  BSD-style (see LICENSE)+-- Maintainer  :  diagrams-discuss@googlegroups.com+--+-- Wrapper for creating scale-invariant objects in two dimensions.+--+-----------------------------------------------------------------------------++module Diagrams.Transform.ScaleInv+    ( ScaleInv(..)+    , scaleInvObj, scaleInvDir, scaleInvLoc+    , scaleInv, scaleInvPrim)+    where++import           Control.Lens            (makeLenses, view, (^.))+import           Data.Typeable++import           Diagrams.Angle+import           Diagrams.Core+import           Diagrams.TwoD.Transform+import           Diagrams.TwoD.Types++import           Linear.Affine+import           Linear.Vector++-- | 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+  { _scaleInvObj :: t+  , _scaleInvDir :: Vn t+  , _scaleInvLoc :: Point (V t) (N t)+  }+  deriving Typeable++deriving instance (Show t, Show (Vn t)) => Show (ScaleInv t)++makeLenses ''ScaleInv++-- | Create a scale-invariant object pointing in the given direction,+--   located at the origin.+scaleInv :: (V t ~ v, N t ~ n, Additive v, Num n) => t -> v n -> ScaleInv t+scaleInv t d = ScaleInv t d origin++type instance V (ScaleInv t) = V t+type instance N (ScaleInv t) = N t++instance (V t ~ v, N t ~ n, Additive v, Num n, HasOrigin t) => HasOrigin (ScaleInv t) where+  moveOriginTo p (ScaleInv t v l) = ScaleInv (moveOriginTo p t) v (moveOriginTo p l)++instance (V t ~ V2, N t ~ n, RealFloat n, Transformable t) => Transformable (ScaleInv t) where+  transform tr (ScaleInv t v l) = ScaleInv (trans . rot $ t) (rot v) l'+    where+      angle = transform tr v ^. _theta++      rot :: (V k ~ V t, N k ~ N t, Transformable k) => k -> k+      rot = rotateAround l angle++      l'  = transform tr l++      trans = translate (l' .-. l)++{- Proof that the above satisfies the monoid action laws.++   1. transform mempty (ScaleInv t v l)+      = ScaleInv (trans . rot $ t) (rot v) l'+        { l'    = transform mempty l = l }+        { trans = translate (l' .-. l)+                = translate (l .-. l)+                = translate zeroV+                = id+        }+        { rot   = rotateAround l angle+                = rotateAround l (direction (transform mempty v) - direction v)+                = rotateAround l (direction v - direction v)+                = rotateAround l 0+                = id+        }+      = ScaleInv t v l++  2. transform t1 (transform t2 (ScaleInv t v l))+     = let angle = direction (transform t2 v) - direction v+           rot   = rotateAround l angle+           l'    = transform t2 l+           trans = translate (l' .-. l)+       in+           transform t1 (ScaleInv (trans . rot $ t) (rot v) l')++     = let angle  = direction (transform t2 v) - direction v+           rot    = rotateAround l angle+           l'     = transform t2 l+           trans  = translate (l' .-. l)+           angle2 = direction (transform t1 (rot v)) - direction (rot v)+           rot2   = rotateAround l' angle2+           l'2    = transform t1 l'+           trans2 = translate (l'2 .-. l')+       in+           ScaleInv (trans2 . rot2 . trans . rot $ t) (rot2 . rot $ v) l'2++       { l'2 = transform t1 l'+             = transform t1 (transform t2 l)+             = transform (t1 <> t2) l+       }+       { trans2 = translate (l'2 .-. l')+                = translate (transform (t1 <> t2) l .-. transform t2 l)+                = translate (transform t1 l .-. l)+       }+       { rot v  = rotateAround l angle v+                = rotate angle `under` translation (origin .-. l) $ v+                = rotate angle v+       }+       { angle2 = direction (transform t1 (rot v)) - direction (rot v)+                = direction (transform t1 (rotate angle v)) - direction (rotate angle v)+                = direction (transform t1 (rotate angle v)) - direction v - angle+       }+       { rot2   = rotateAround l' angle2+                = ???+       }++-}++instance (V t ~ V2, N t ~ n, RealFloat n, Renderable t b) => Renderable (ScaleInv t) b where+  render b = render b . view scaleInvObj++-- | Create a diagram from a single scale-invariant primitive.  The+--   vector argument specifies the direction in which the primitive is+--   \"pointing\" (for the purpose of keeping it rotated correctly+--   under non-uniform scaling).  The primitive is assumed to be+--   \"located\" at the origin (for the purpose of translating it+--   correctly under scaling).+--+--   Note that the resulting diagram will have an /empty/ envelope,+--   trace, and query.  The reason is that the envelope, trace, and+--   query cannot be cached---applying a transformation would cause+--   the cached envelope, etc. to get \"out of sync\" with the+--   scale-invariant object.  The intention, at any rate, is that+--   scale-invariant things will be used only as \"decorations\" (/e.g./+--   arrowheads) which should not affect the envelope, trace, and+--   query.+scaleInvPrim :: (V t ~ V2, N t ~ n, RealFloat n, Typeable t, Renderable t b, Monoid m)+             => t -> V2 n -> QDiagram b (V t) (N t) m+scaleInvPrim t d = mkQD (Prim $ scaleInv t d) mempty mempty mempty mempty

src/Diagrams/TwoD.hs view

@@ -4,7 +4,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  Diagrams.TwoD--- Copyright   :  (c) 2011 diagrams-lib team (see LICENSE)+-- Copyright   :  (c) 2011-2015 diagrams-lib team (see LICENSE) -- License     :  BSD-style (see LICENSE) -- Maintainer  :  diagrams-discuss@googlegroups.com --@@ -25,10 +25,17 @@ --     specialized to two dimensions (see also "Diagrams.Combinators" --     for more general combining). --+--   * "Diagrams.TwoD.Attributes" defines attributes specific to two+--     dimensions, *e.g.* fill color, line color, and gradients.+-- --   * "Diagrams.TwoD.Transform" defines R^2-specific transformations --     such as rotation by an angle, and scaling, translation, and --     reflection in the X and Y directions. --+--   * "Diagrams.TwoD.Deform" defines some non-affine transformations+--     specific to two dimensions, *e.g.* parallel and perspective+--     projections.+-- --   * "Diagrams.TwoD.Ellipse" defines circles and ellipses. -- --   * "Diagrams.TwoD.Arc" defines circular arcs.@@ -42,6 +49,10 @@ --   * "Diagrams.TwoD.Shapes" defines other two-dimensional shapes, --     e.g. various polygons. --+--   * "Diagrams.TwoD.Arrow" contains tools for drawing arrows between+--     things, and "Diagrams.TwoD.Arrowheads" defines a collection of+--     arrowheads.+-- --   * "Diagrams.TwoD.Text" defines primitive text diagrams. -- --   * "Diagrams.TwoD.Image" allows importing external images into diagrams.@@ -58,27 +69,38 @@ ----------------------------------------------------------------------------- module Diagrams.TwoD        ( -- * R^2-         R2, r2, unr2-       , P2, p2, unp2-       , T2+         V2 (..), R1 (..), R2 (..)+       , P2, T2+       , r2, unr2, mkR2+       , p2, unp2, mkP2        , unitX, unitY, unit_X, unit_Y-       , direction, fromDirection, e+       , perp, leftTurn+       , xDir, yDir           -- * Angles        , tau-       , Angle(..)-       , Turn(..), CircleFrac, Rad(..), Deg(..)-       , fullCircle, convertAngle+       , angleV+       , angleDir+       , signedAngleBetween , signedAngleBetweenDirs +       -- * Polar Coördinates+       , HasR(..), r2PolarIso+          -- * Paths          -- ** Stroking-       , stroke, stroke', strokeT, strokeT', strokeLine, strokeLoop-       , strokeLocT, strokeLocLine, strokeLocLoop-       , FillRule(..), fillRule-       , StrokeOpts(..)+       , stroke, stroke'+       , strokePath, strokeP, strokePath', strokeP'+       , strokeTrail, strokeT, strokeTrail', strokeT'+       , strokeLine, strokeLoop+       , strokeLocTrail, strokeLocT, strokeLocLine, strokeLocLoop+       , FillRule(..), fillRule, _fillRule+       , StrokeOpts(..), vertexNames, queryFillRule+       , intersectPoints, intersectPoints'+       , intersectPointsP, intersectPointsP'+       , intersectPointsT, intersectPointsT'           -- ** Clipping-       , clipBy+       , clipBy, clipTo, clipped, _Clip, _clip           -- * Shapes          -- ** Rules@@ -92,11 +114,15 @@        , arc        , arc'        , arcCW+       , arcCCW        , wedge+       , arcBetween+       , annularWedge           -- ** General polygons        , polygon, polyTrail-       , PolygonOpts(..), PolyType(..), PolyOrientation(..)+       , PolygonOpts(..), polyType, polyOrient, polyCenter+       , PolyType(..), PolyOrientation(..)           -- ** Star polygons        , StarOpts(..), star@@ -108,6 +134,7 @@        , square        , pentagon        , hexagon+       , heptagon        , septagon        , octagon        , nonagon@@ -121,19 +148,60 @@           -- ** Other shapes        , roundedRect, roundedRect'-       , RoundedRectOpts(..)+       , RoundedRectOpts(..), radiusTL, radiusTR, radiusBL, radiusBR +         -- ** Arrows+       , arrowV, arrowV'+       , arrowAt, arrowAt'+       , arrowBetween, arrowBetween'+       , connect, connect'+       , connectPerim, connectPerim'+       , connectOutside, connectOutside'+       , arrow, arrow'+       , straightShaft+       , module Diagrams.TwoD.Arrowheads++       , ArrowOpts(..)++       , arrowHead+       , arrowTail+       , arrowShaft+       , headGap+       , tailGap+       , gaps, gap+       , headTexture+       , headStyle+       , tailTexture+       , tailStyle+       , shaftTexture+       , shaftStyle+       , headLength+       , tailLength+       , lengths+          -- * Text        , text, topLeftText, alignedText, baselineText-       , font, fontSize, italic, oblique, bold+       , font, italic, oblique, fontSize+       , bold, bolder, lighter, thinWeight+       , ultraLight, light, mediumWeight, heavy, semiBold, ultraBold+       , _font, _fontSizeR, _fontSize+       , fontSizeO, fontSizeL, fontSizeN, fontSizeG           -- * Images+       , DImage(..), ImageData(..)+       , Embedded, External, Native        , image+       , loadImageEmb+       , loadImageExt+       , uncheckedImageRef+       , raster+       , rasterDia           -- * Transformations          -- ** Rotation-       , rotation, rotate, rotateBy-       , rotationAbout, rotateAbout+       , rotation, rotate, rotateBy, rotated+       , rotationAround, rotateAround+       , rotationTo, rotateTo          -- ** Scaling        , scalingX, scaleX        , scalingY, scaleY@@ -144,60 +212,100 @@        , translationX, translateX        , translationY, translateY        , translation, translate+         -- ** Conformal affine maps+       , scalingRotationTo, scaleRotateTo          -- ** Reflection        , reflectionX, reflectX        , reflectionY, reflectY+       , reflectionXY, reflectXY        , reflectionAbout, reflectAbout          -- ** Shears        , shearingX, shearX        , shearingY, shearY +         -- * Deformations - non-affine transforms+       , parallelX0, perspectiveX1, parallelY0, perspectiveY1+       , facingX, facingY+          -- * Combinators          -- ** Combining multiple diagrams-       , (===), (|||), atAngle-       , hcat, hcat'-       , vcat, vcat' +       , (===), (|||)+       , hcat, hcat', hsep+       , vcat, vcat', vsep+          -- ** Spacing and envelopes        , strutX, strutY        , padX, padY         , extrudeLeft, extrudeRight, extrudeBottom, extrudeTop -       , view+       , rectEnvelope, crop           -- ** Background -       , boundingRect, bg+       , boundingRect, bg, bgFrame           -- * Alignment        , alignL, alignR, alignT, alignB, alignTL, alignTR, alignBL, alignBR        , alignX, alignY        , centerX, centerY, centerXY +         -- * Snugging+       , snugL, snugR, snugT, snugB+       , snugX, snugY+       , snugCenterX, snugCenterY, snugCenterXY+          -- * Size          -- ** Computing size-       , width, height, size2D, sizeSpec2D-       , extentX, extentY, center2D+       , width, height+       , extentX, extentY           -- ** Specifying size-       , SizeSpec2D(..)-       , mkSizeSpec+       , mkSizeSpec2D+       , mkWidth+       , mkHeight+       , dims2D -         -- ** Adjusting size-       , sized, sizedAs+         -- * Textures+       , Texture(..), solid+       , SpreadMethod(..), GradientStop(..)+       , _FillTexture, fillTexture, _fillTexture, getFillTexture+       , _LineTexture, lineTexture, _lineTexture, lineTextureA, getLineTexture+       , stopFraction, stopColor, mkStops +       , LGradient(..), _LG, lGradStops, lGradTrans, lGradStart, lGradEnd+       , lGradSpreadMethod, defaultLG, mkLinearGradient++       , RGradient(..)+       , rGradStops, rGradCenter0, rGradRadius0, rGradCenter1, rGradRadius1+       , rGradTrans, rGradSpreadMethod, defaultRG, _RG, mkRadialGradient++         -- ** Colors+       , fillColor, _SC, _AC, fc, fcA, recommendFillColor+       , lineColor, lc, lcA+          -- * Visual aids for understanding the internal model        , showOrigin        , showOrigin'-       , OriginOpts(..)+       , OriginOpts(..), oColor, oScale, oMinSize+       , showEnvelope+       , showEnvelope'+       , EnvelopeOpts(..), eColor, eLineWidth, ePoints+       , showTrace+       , showTrace'+       , TraceOpts(..), tColor, tScale, tMinSize, tPoints        , showLabels         ) where  import           Diagrams.TwoD.Align import           Diagrams.TwoD.Arc+import           Diagrams.TwoD.Arrow+import           Diagrams.TwoD.Arrowheads+import           Diagrams.TwoD.Attributes import           Diagrams.TwoD.Combinators+import           Diagrams.TwoD.Deform import           Diagrams.TwoD.Ellipse import           Diagrams.TwoD.Image import           Diagrams.TwoD.Model

src/Diagrams/TwoD/Adjust.hs view

@@ -1,6 +1,11 @@-{-# LANGUAGE ViewPatterns-  #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE Rank2Types       #-}+{-# LANGUAGE TypeFamilies     #-} +{-# OPTIONS_GHC -fno-warn-unused-imports #-}+  -- for Data.Semigroup+ ----------------------------------------------------------------------------- -- | -- Module      :  Diagrams.TwoD.Adjust@@ -14,105 +19,85 @@ -----------------------------------------------------------------------------  module Diagrams.TwoD.Adjust-    (-      setDefault2DAttributes-    , adjustDiaSize2D+    ( setDefault2DAttributes+    , adjustSize2D     , adjustDia2D-    , adjustSize     -- for backwards compatibility-    , requiredScale  -- re-exported for backwards compatibility     ) where -import Diagrams.Core+import           Diagrams.Attributes+import           Diagrams.BoundingBox+import           Diagrams.Core+import           Diagrams.Size+import           Diagrams.TwoD.Attributes (lineTextureA)+import           Diagrams.TwoD.Types+import           Diagrams.Util            (( # )) -import Diagrams.Attributes  (lineWidthA, lineColorA, lineCap-                            , lineJoin, lineMiterLimitA-                            )-import Diagrams.Util        ((#))+import           Control.Lens             (Lens', set, (^.))+import           Data.Default+import           Data.Semigroup -import Diagrams.TwoD.Types  (R2, p2)-import Diagrams.TwoD.Size   ( size2D, center2D, SizeSpec2D(..)-                            , requiredScaleT, requiredScale-                            )-import Diagrams.TwoD.Text   (fontSizeA) -import Data.AffineSpace     ((.-.))-import Data.Semigroup--import Data.Default.Class--import Data.Colour.Names    (black)- -- | Set default attributes of a 2D diagram (in case they have not --   been set): -----       * Line width 0.01------       * Line color black+--       * 'LineWidth':  0.01 -----       * Font size 1+--       * 'LineTexture': solid black -----       * Line cap LineCapButt+--       * 'LineCap': LineCapButt -----       * line join miter+--       * 'LineJoin': miter -----       * Miter limit 10-setDefault2DAttributes :: Semigroup m => QDiagram b R2 m -> QDiagram b R2 m-setDefault2DAttributes d = d # lineWidthA def # lineColorA def # fontSizeA def-                             # lineCap def # lineJoin def # lineMiterLimitA def+--       * 'MiterLimit': 10+setDefault2DAttributes :: (TypeableFloat n, Semigroup m)+  => QDiagram b V2 n m -> QDiagram b V2 n m+setDefault2DAttributes d+  = d # lineWidthM def+      # lineTextureA def+      # lineCap def+      # lineJoin def+      # lineMiterLimitA def  -- | 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 # scale s-      # translate tr-  )-  where spec = getSize opts-        size = size2D d-        s    = requiredScale spec size-        finalSz = case spec of-                    Dims w h -> (w,h)-                    _        -> scale s size-        tr = (0.5 *. p2 finalSz) .-. (s *. center2D d)+--   requested size. The first argument is a lens into the output+--   size contained in the rendering options.  Returns an updated+--   options record, any transformation applied to the diagram (the+--   inverse of which can be used, say, to translate output/device+--   coordinates back into local diagram coordinates), and the+--   modified diagram itself.+adjustSize2D+  :: (TypeableFloat n, Monoid' m)+  => Lens' (Options b V2 n) (SizeSpec V2 n)+  -> b+  -> Options b V2 n+  -> QDiagram b V2 n m+  -> (Options b V2 n, Transformation V2 n, QDiagram b V2 n m)+adjustSize2D szL _ opts d = (set szL spec opts, t, d # transform t)+  where+    spec    = dims sz+    (sz, t) = sizeAdjustment (opts ^. szL) (boundingBox d)  -- | @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.+--   As its first argument it requires a lens into the output size+--   contained in the rendering options. -- --   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)+--   It returns an updated options record, any transformation applied+--   to the diagram (the inverse of which can be used, say, to+--   translate output/device coordinates back into local diagram+--   coordinates), and the modified diagram itself.+adjustDia2D :: (TypeableFloat n, Monoid' m)+            => Lens' (Options b V2 n) (SizeSpec V2 n)+            -> b -> Options b V2 n -> QDiagram b V2 n m+            -> (Options b V2 n, Transformation V2 n, QDiagram b V2 n m)+adjustDia2D szL b opts d+  = adjustSize2D szL b opts (d # setDefault2DAttributes) -{-# 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

src/Diagrams/TwoD/Align.hs view

@@ -1,6 +1,7 @@-{-# LANGUAGE FlexibleContexts-           , TypeFamilies-  #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies     #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  Diagrams.TwoD.Align@@ -12,86 +13,122 @@ -- "Diagrams.Align" for more general alignment combinators. -- -- The basic idea is that alignment is achieved by moving diagrams'--- local origins relative to their envelopes.  For example, to align--- several diagrams along their tops, we first move their local--- origins to the upper edge of their envelopes (using e.g. @map--- 'alignTop'@), and then put them together with their local origins--- along a horizontal line (using e.g. 'hcat' from--- "Diagrams.TwoD.Combinators").+-- local origins relative to their envelopes or traces (or some other+-- sort of boundary).  For example, to align several diagrams along+-- their tops, we first move their local origins to the upper edge of+-- their boundary (using e.g. @map 'alignTop'@), and then put them+-- together with their local origins along a horizontal line (using+-- e.g. 'hcat' from "Diagrams.TwoD.Combinators"). -- -----------------------------------------------------------------------------  module Diagrams.TwoD.Align     ( -- * Absolute alignment+      -- ** Align by envelope       alignL, alignR, alignT, alignB     , alignTL, alignTR, alignBL, alignBR +      -- ** Align by trace+    , snugL, snugR, snugT, snugB+       -- * Relative alignment-    , alignX, alignY+    , alignX, snugX, alignY, snugY        -- * Centering     , centerX, centerY, centerXY+    , snugCenterX, snugCenterY, snugCenterXY      ) where -import Diagrams.Core--import Diagrams.TwoD.Types-import Diagrams.TwoD.Vector-import Diagrams.Align+import           Diagrams.Core -import Data.VectorSpace+import           Diagrams.Align+import           Diagrams.TwoD.Types+import           Diagrams.TwoD.Vector  -- | Align along the left edge, i.e. translate the diagram in a --   horizontal direction so that the local origin is on the left edge --   of the envelope.-alignL :: (Alignable a, V a ~ R2) => a -> a-alignL = align (negateV unitX)+alignL :: (InSpace V2 n a, Fractional n, Alignable a, HasOrigin a) => a -> a+alignL = align unit_X +snugL :: (InSpace V2 n a, Fractional n, Alignable a, Traced a, HasOrigin a) => a -> a+snugL = snug unit_X+ -- | Align along the right edge.-alignR :: (Alignable a, V a ~ R2) => a -> a+alignR :: (InSpace V2 n a, Fractional n, Alignable a, HasOrigin a) => a -> a alignR = align unitX +snugR :: (InSpace V2 n a, Fractional n, Alignable a, Traced a, HasOrigin a) => a -> a+snugR = snug unitX++ -- | Align along the top edge.-alignT :: (Alignable a, V a ~ R2) => a -> a+alignT :: (InSpace V2 n a, Fractional n, Alignable a, HasOrigin a) => a -> a alignT = align unitY +snugT:: (InSpace V2 n a, Fractional n, Alignable a, Traced a, HasOrigin a) => a -> a+snugT = snug unitY+ -- | Align along the bottom edge.-alignB :: (Alignable a, V a ~ R2) => a -> a-alignB = align (negateV unitY)+alignB :: (InSpace V2 n a, Fractional n, Alignable a, HasOrigin a) => a -> a+alignB = align unit_Y -alignTL, alignTR, alignBL, alignBR :: (Alignable a, V a ~ R2) => a -> a+snugB :: (InSpace V2 n a, Fractional n, Alignable a, Traced a, HasOrigin a) => a -> a+snugB = snug unit_Y++alignTL, alignTR, alignBL, alignBR :: (InSpace V2 n a, Fractional n, Alignable a, HasOrigin a) => a -> a alignTL = alignT . alignL alignTR = alignT . alignR alignBL = alignB . alignL alignBR = alignB . alignR --- | @alignX@ moves the local origin horizontally as follows:+-- | @alignX@ and @snugX@ move the local origin horizontally as follows: -----   * @alignX (-1)@ moves the local origin to the left edge of the envelope;+--   * @alignX (-1)@ moves the local origin to the left edge of the boundary; -- --   * @align 1@ moves the local origin to the right edge; -- --   * any other argument interpolates linearly between these.  For --     example, @alignX 0@ centers, @alignX 2@ moves the origin one --     \"radius\" to the right of the right edge, and so on.-alignX :: (Alignable a, V a ~ R2) => Double -> a -> a+--+--   * @snugX@ works the same way.++alignX :: (InSpace v n a, R1 v, Fractional n, Alignable a, HasOrigin a) => n -> a -> a alignX = alignBy unitX +-- | See the documentation for 'alignX'.+snugX :: (InSpace v n a, R1 v, Fractional n, Alignable a, Traced a, HasOrigin a) => n -> a -> a+snugX = snugBy unitX+ -- | Like 'alignX', but moving the local origin vertically, with an --   argument of @1@ corresponding to the top edge and @(-1)@ corresponding --   to the bottom edge.-alignY :: (Alignable a, V a ~ R2) => Double -> a -> a+alignY :: (InSpace v n a, R2 v, Fractional n, Alignable a, HasOrigin a) => n -> a -> a alignY = alignBy unitY +-- | See the documentation for 'alignY'.+snugY :: (InSpace v n a, R2 v, Fractional n, Alignable a, Traced a, HasOrigin a) => n -> a -> a+snugY = snugBy unitY+ -- | Center the local origin along the X-axis.-centerX  :: (Alignable a, V a ~ R2) => a -> a-centerX  = alignBy unitX 0+centerX :: (InSpace v n a, R1 v, Fractional n, Alignable a, HasOrigin a) => a -> a+centerX = alignBy unitX 0 +snugCenterX :: (InSpace v n a, R1 v, Fractional n, Alignable a, Traced a, HasOrigin a) => a -> a+snugCenterX = snugBy unitX 0+ -- | Center the local origin along the Y-axis.-centerY  :: (Alignable a, V a ~ R2) => a -> a-centerY  = alignBy unitY 0+centerY :: (InSpace v n a, R2 v, Fractional n, Alignable a, HasOrigin a) => a -> a+centerY = alignBy unitY 0 +snugCenterY :: (InSpace v n a, R2 v, Fractional n, Alignable a, Traced a, HasOrigin a) => a -> a+snugCenterY = snugBy unitY 0+ -- | Center along both the X- and Y-axes.-centerXY :: (Alignable a, V a ~ R2) => a -> a+centerXY :: (InSpace v n a, R2 v, Fractional n, Alignable a, HasOrigin a) => a -> a centerXY = centerX . centerY++snugCenterXY :: (InSpace v n a, R2 v, Fractional n, Alignable a, Traced a, HasOrigin a) => a -> a+snugCenterXY = snugCenterX . snugCenterY

src/Diagrams/TwoD/Arc.hs view

@@ -1,5 +1,12 @@-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE ConstraintKinds  #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies     #-}+{-# LANGUAGE TypeOperators    #-}+{-# LANGUAGE ViewPatterns     #-}++{-# OPTIONS_GHC -fno-warn-unused-imports #-}+  -- for Data.Semigroup+ ----------------------------------------------------------------------------- -- | -- Module      :  Diagrams.TwoD.Arc@@ -14,56 +21,63 @@ module Diagrams.TwoD.Arc     ( arc     , arc'-    , arcCW     , arcT++    , arcCCW+    , arcCW+     , bezierFromSweep      , wedge+    , arcBetween+    , annularWedge     ) where -import           Diagrams.Coordinates+import           Diagrams.Angle import           Diagrams.Core+import           Diagrams.Direction import           Diagrams.Located        (at)-import           Diagrams.Path import           Diagrams.Segment import           Diagrams.Trail import           Diagrams.TrailLike import           Diagrams.TwoD.Transform import           Diagrams.TwoD.Types-import           Diagrams.TwoD.Vector    (e, unitX)-import           Diagrams.Util           (tau, ( # ))+import           Diagrams.TwoD.Vector    (e, unitX, unitY, unit_Y)+import           Diagrams.Util           (( # )) -import           Data.Semigroup          ((<>))-import           Data.VectorSpace        (negateV, (*^), (^-^))+import           Control.Lens            ((&), (<>~), (^.))+import           Data.Semigroup +import           Linear.Affine+import           Linear.Metric+import           Linear.Vector+ -- For details of this approximation see: --   http://www.tinaja.com/glib/bezcirc2.pdf  -- | @bezierFromSweepQ1 s@ constructs a 'Cubic' segment that starts in---   the positive y direction and sweeps counterclockwise through @s@---   radians.  The approximation is only valid for angles in the first---   quadrant.-bezierFromSweepQ1 :: Rad -> Segment Closed R2-bezierFromSweepQ1 s = fmap (^-^ v) . rotate (s/2) $ bezier3 c2 c1 p0-  where p0@(coords -> x :& y) = rotate (s/2) v-        c1                    = ((4-x)/3)  &  ((1-x)*(3-x)/(3*y))-        c2                    = reflectY c1-        v                     = unitX+--  the positive y direction and sweeps counterclockwise through an+--  angle @s@.  The approximation is only valid for angles in the+--  first quadrant.+bezierFromSweepQ1 :: Floating n => Angle n -> Segment Closed V2 n+bezierFromSweepQ1 s = mapSegmentVectors (^-^ unitX) . rotate (s ^/ 2) $ bezier3 c2 c1 p0+  where p0@(V2 x y) = e (s ^/ 2)+        c1          = V2 ((4-x)/3) ((1-x)*(3-x)/(3*y))+        c2          = reflectY c1  -- | @bezierFromSweep s@ constructs a series of 'Cubic' segments that --   start in the positive y direction and sweep counter clockwise---   through @s@ radians.  If @s@ is negative, it will start in the+--   through the angle @s@.  If @s@ is negative, it will start in the --   negative y direction and sweep clockwise.  When @s@ is less than---   0.0001 the empty list results.  If the sweep is greater than tau---   then it is truncated to tau.-bezierFromSweep :: Rad -> [Segment Closed R2]+--   0.0001 the empty list results.  If the sweep is greater than @fullTurn@+--   later segments will overlap earlier segments.+bezierFromSweep :: OrderedField n => Angle n -> [Segment Closed V2 n] bezierFromSweep s-  | s > tau    = bezierFromSweep tau-  | s < 0      = fmap reflectY . bezierFromSweep $ (-s)-  | s < 0.0001 = []-  | s < tau/4  = [bezierFromSweepQ1 s]-  | otherwise  = bezierFromSweepQ1 (tau/4)-          : map (rotateBy (1/4)) (bezierFromSweep (max (s - tau/4) 0))+  | s < zero          = fmap reflectY . bezierFromSweep $ negated s+  | s < 0.0001 @@ rad = []+  | s < fullTurn^/4   = [bezierFromSweepQ1 s]+  | otherwise         = bezierFromSweepQ1 (fullTurn^/4)+          : map (rotateBy (1/4)) (bezierFromSweep (max (s ^-^ fullTurn^/4) zero))  {- ~~~~ Note [segment spacing]@@ -85,54 +99,124 @@ 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-    | e < s     = arcT s (e + fromIntegral d)-    | otherwise = (if sweep >= tau then glueTrail else id)-                $ trailFromSegments bs-  where sweep = convertAngle $ end - start-        bs    = map (rotate start) . bezierFromSweep $ sweep+-- | Given a start direction @d@ and a sweep angle @s@, @'arcT' d s@+--   is the 'Trail' of a radius one arc starting at @d@ and sweeping out+--   the angle @s@ counterclockwise (for positive s).  The resulting+--   @Trail@ is allowed to wrap around and overlap itself.+arcT :: OrderedField n => Direction V2 n -> Angle n -> Trail V2 n+arcT start sweep = trailFromSegments bs+  where+    bs = map (rotateTo 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 :: Turn-        e = convertAngle end-        d = ceiling (s - e) :: Integer+-- | Given a start direction @d@ and a sweep angle @s@, @'arc' d s@ is the+--   path of a radius one arc starting at @d@ and sweeping out the angle+--   @s@ counterclockwise (for positive s).  The resulting+--   @Trail@ is allowed to wrap around and overlap itself.+arc :: (InSpace V2 n t, OrderedField n, TrailLike t) => Direction V2 n -> Angle n -> t+arc start sweep = trailLike $ arcT start sweep `at` P (fromDirection start) --- | 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.+-- | Given a radus @r@, a start direction @d@ and an angle @s@,+--   @'arc'' r d s@ is the path of a radius @(abs r)@ arc starting at+--   @d@ and sweeping out the angle @s@ counterclockwise (for positive+--   s).  The origin of the arc is its center.+--+--   <<diagrams/src_Diagrams_TwoD_Arc_arc'Ex.svg#diagram=arc'Ex&width=300>>+--+--   > arc'Ex = mconcat [ arc' r xDir (1/4 @@ turn) | r <- [0.5,-1,1.5] ]+--   >        # centerXY # pad 1.1+arc' :: (InSpace V2 n t, OrderedField n, TrailLike t) => n -> Direction V2 n -> Angle n -> t+arc' (abs -> r) start sweep = trailLike $ scale r ts `at` P (r *^ fromDirection start)+  where ts = arcT start sweep++arcCCWT :: RealFloat n => Direction V2 n -> Direction V2 n -> Trail V2 n+arcCCWT start end = trailFromSegments bs+  where+    bs    = map (rotateTo start) . bezierFromSweep $ sweep+    sweep = normalizeAngle $ end ^. _theta ^-^ start ^. _theta++-- | Given a start direction @s@ and end direction @e@, @arcCCW s e@ is the+--   path of a radius one arc counterclockwise between the two directions. --   The origin of the arc is its center.-arc :: (Angle a, TrailLike t, V t ~ R2) => a -> a -> t-arc start end = trailLike $ arcT start end `at` (rotate start $ p2 (1,0))+arcCCW :: (InSpace V2 n t, RealFloat n, TrailLike t) => Direction V2 n -> Direction V2 n -> t+arcCCW start end = trailLike $ arcCCWT start end `at` P (fromDirection start) --- | Like 'arc' but clockwise.-arcCW :: (Angle a, TrailLike t, V t ~ R2) => a -> a -> t+-- | Like 'arcAngleCCW' but clockwise.+arcCW :: (InSpace V2 n t, RealFloat n, TrailLike t) => Direction V2 n -> Direction V2 n -> t arcCW start end = trailLike $-                            -- flipped arguments to get the path we want-                            -- then reverse the trail to get the cw direction.-                            (reverseTrail $ arcT end start)-                            `at`-                            (rotate start $ p2 (1,0))-                   -- We could just have `arcCW = reversePath . flip arc`-                   -- but that wouldn't be `TrailLike`.---- | 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, TrailLike p, V p ~ R2) => Double -> a -> a -> p-arc' r start end = trailLike $ scale (abs r) ts `at` (rotate start $ p2 (abs r,0))-  where ts | r < 0     = reverseTrail $ arcT end start-           | otherwise = arcT start end+  -- flipped arguments to get the path we want+  -- then reverse the trail to get the cw direction.+  reverseTrail (arcCCWT end start) `at` P (fromDirection start)  -- | Create a circular wedge of the given radius, beginning at the---   first angle and extending counterclockwise to the second.-wedge :: (Angle a, TrailLike p, V p ~ R2) => Double -> a -> a -> p-wedge r a1 a2 = trailLike . (`at` origin) . wrapLine-              $ fromOffsets [r *^ e a1]-                <> arc a1 a2 # scale r-                <> fromOffsets [r *^ negateV (e a2)]+--   given direction and extending through the given angle.+--+--   <<diagrams/src_Diagrams_TwoD_Arc_wedgeEx.svg#diagram=wedgeEx&width=400>>+--+--   > wedgeEx = hcat' (with & sep .~ 0.5)+--   >   [ wedge 1 xDir (1/4 @@ turn)+--   >   , wedge 1 (rotate (7/30 @@ turn) xDir) (4/30 @@ turn)+--   >   , wedge 1 (rotate (1/8 @@ turn) xDir) (3/4 @@ turn)+--   >   ]+--   >   # fc blue+--   >   # centerXY # pad 1.1+wedge :: (InSpace V2 n t, OrderedField n, TrailLike t) => n -> Direction V2 n -> Angle n -> t+wedge r d s = trailLike . (`at` origin) . glueTrail . wrapLine+              $ fromOffsets [r *^ fromDirection d]+                <> arc d s # scale r+                <> fromOffsets [r *^ negated (rotate s $ fromDirection d)]++-- | @arcBetween p q height@ creates an arc beginning at @p@ and+--   ending at @q@, with its midpoint at a distance of @abs height@+--   away from the straight line from @p@ to @q@.  A positive value of+--   @height@ results in an arc to the left of the line from @p@ to+--   @q@; a negative value yields one to the right.+--+--   <<diagrams/src_Diagrams_TwoD_Arc_arcBetweenEx.svg#diagram=arcBetweenEx&width=300>>+--+--   > arcBetweenEx = mconcat+--   >   [ arcBetween origin (p2 (2,1)) ht | ht <- [-0.2, -0.1 .. 0.2] ]+--   >   # centerXY # pad 1.1+arcBetween :: (TrailLike t, V t ~ V2, N t ~ n, RealFloat n) => Point V2 n -> Point V2 n -> n -> t+arcBetween p q ht = trailLike (a # rotate (v^._theta) # moveTo p)+  where+    h = abs ht+    isStraight = h < 0.00001+    v = q .-. p+    d = norm (q .-. p)+    th  = acosA ((d*d - 4*h*h)/(d*d + 4*h*h))+    r = d/(2*sinA th)+    mid | ht >= 0    = direction unitY+        | otherwise  = direction unit_Y+    st  = mid & _theta <>~ negated th+    a | isStraight+      = fromOffsets [d *^ unitX]+      | otherwise+      = arc st (2 *^ th)+        # scale r+        # translateY ((if ht > 0 then negate else id) (r - h))+        # translateX (d/2)+        # (if ht > 0 then reverseLocTrail else id)++-- | Create an annular wedge of the given radii, beginning at the+--   first direction and extending through the given sweep angle.+--   The radius of the outer circle is given first.+--+--   <<diagrams/src_Diagrams_TwoD_Arc_annularWedgeEx.svg#diagram=annularWedgeEx&width=400>>+--+--   > annularWedgeEx = hsep 0.50+--   >   [ annularWedge 1 0.5 xDir (1/4 @@ turn)+--   >   , annularWedge 1 0.3 (rotate (7/30 @@ turn) xDir) (4/30 @@ turn)+--   >   , annularWedge 1 0.7 (rotate (1/8 @@ turn) xDir) (3/4 @@ turn)+--   >   ]+--   >   # fc blue+--   >   # centerXY # pad 1.1+annularWedge :: (TrailLike t, V t ~ V2, N t ~ n, RealFloat n) =>+                n -> n -> Direction V2 n -> Angle n -> t+annularWedge r1' r2' d1 s = trailLike . (`at` o) . glueTrail . wrapLine+              $ fromOffsets [(r1' - r2') *^ fromDirection d1]+                <> arc d1 s # scale r1'+                <> fromOffsets [(r1' - r2') *^ negated (fromDirection d2)]+                <> arc d2 (negated s) # scale r2'+  where o = origin # translate (r2' *^ fromDirection d1)+        d2 = d1 & _theta <>~ s+

+ src/Diagrams/TwoD/Arrow.hs view

@@ -0,0 +1,588 @@+{-# LANGUAGE ConstraintKinds            #-}+{-# LANGUAGE DeriveDataTypeable         #-}+{-# LANGUAGE FlexibleContexts           #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses      #-}+{-# LANGUAGE RankNTypes                 #-}+{-# LANGUAGE ScopedTypeVariables        #-}+{-# LANGUAGE TemplateHaskell            #-}+{-# LANGUAGE TypeFamilies               #-}+{-# LANGUAGE TypeOperators              #-}+{-# LANGUAGE UndecidableInstances       #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Diagrams.TwoD.Arrow+-- Copyright   :  (c) 2013-2015 diagrams-lib team (see LICENSE)+-- License     :  BSD-style (see LICENSE)+-- Maintainer  :  diagrams-discuss@googlegroups.com+--+-- Drawing arrows in two dimensions.  For a tutorial on drawing arrows+-- using this module, see the diagrams website:+-- <https://diagrams.github.io/doc/arrow.html>.+--+-----------------------------------------------------------------------------+++module Diagrams.TwoD.Arrow+       ( -- * Examples+         -- ** Example 1+-- | <<diagrams/src_Diagrams_TwoD_Arrow_example1.svg#diagram=example1&width=500>>+--+--   > -- Connecting two diagrams at their origins.+--   >+--   > sq = square 2 # showOrigin # lc darkgray # lw ultraThick+--   > ds = (sq # named "left") ||| strutX 3 ||| (sq # named "right")+--   >+--   > shaft  = cubicSpline False ( map p2 [(0, 0), (1, 0), (1, 0.2), (2, 0.2)])+--   >+--   > example1 = ds # connect' (with & arrowHead .~ dart & arrowTail .~ quill+--   >                                & arrowShaft .~ shaft+--   >                                & headLength .~ huge & tailLength .~ veryLarge)+--   >                                "left" "right" # pad 1.1++         -- ** Example 2++-- | <<diagrams/src_Diagrams_TwoD_Arrow_example2.svg#diagram=example2&width=500>>+--+--   > -- Comparing connect, connectPerim, and arrowAt.+--   >+--   > oct  = octagon 1 # lc darkgray # lw ultraThick # showOrigin+--   > dias = oct # named "first" ||| strut 3 ||| oct # named "second"+--   >+--   > -- Connect two diagrams and two points on their trails.+--   > ex12 = dias # connect' (with & lengths .~ veryLarge) "first" "second"+--   >             # connectPerim' (with & lengths .~ veryLarge)+--   >        "first" "second" (15/16 @@ turn) (9/16 @@ turn)+--   >+--   > -- Place an arrow at (0,0) the size and direction of (0,1).+--   > ex3 = arrowAt origin unit_Y+--   >+--   > example2 = (ex12 <> ex3) # centerXY # pad 1.1++         -- * Creating arrows+         arrowV+       , arrowV'+       , arrowAt+       , arrowAt'+       , arrowBetween+       , arrowBetween'+       , connect+       , connect'+       , connectPerim+       , connectPerim'+       , connectOutside+       , connectOutside'++       , arrow+       , arrow'++       , arrowFromLocatedTrail+       , arrowFromLocatedTrail'++         -- * Options+       , ArrowOpts(..)++       , arrowHead+       , arrowTail+       , arrowShaft+       , headGap+       , tailGap+       , gaps, gap+       , headTexture+       , headStyle+       , headLength+       , tailTexture+       , tailStyle+       , tailLength+       , lengths+       , shaftTexture+       , shaftStyle+       , straightShaft++         -- | See "Diagrams.TwoD.Arrowheads" for a list of standard+         --   arrowheads and help creating your own.+       , module Diagrams.TwoD.Arrowheads+       ) where++import           Control.Lens              (Lens', Traversal',+                                            generateSignatures, lensRules,+                                            makeLensesWith, view, (%~), (&),+                                            (.~), (^.))+import           Data.Default+import           Data.Maybe                (fromMaybe)+import           Data.Monoid.Coproduct     (untangle)+import           Data.Semigroup+import           Data.Typeable++import           Data.Colour               hiding (atop)+import           Diagrams.Core+import           Diagrams.Core.Style       (unmeasureAttrs)+import           Diagrams.Core.Types       (QDiaLeaf (..), mkQD')++import           Diagrams.Angle+import           Diagrams.Attributes+import           Diagrams.Direction        hiding (dir)+import           Diagrams.Located          (Located (..), unLoc)+import           Diagrams.Parametric+import           Diagrams.Path+import           Diagrams.Solve.Polynomial (quadForm)+import           Diagrams.Tangent          (tangentAtEnd, tangentAtStart)+import           Diagrams.Trail+import           Diagrams.TwoD.Arrowheads+import           Diagrams.TwoD.Attributes+import           Diagrams.TwoD.Path        (stroke, strokeT)+import           Diagrams.TwoD.Transform   (reflectY, translateX)+import           Diagrams.TwoD.Types+import           Diagrams.TwoD.Vector      (unitX, unit_X)+import           Diagrams.Util             (( # ))++import           Linear.Affine+import           Linear.Metric+import           Linear.Vector+++data ArrowOpts n+  = ArrowOpts+    { _arrowHead  :: ArrowHT n+    , _arrowTail  :: ArrowHT n+    , _arrowShaft :: Trail V2 n+    , _headGap    :: Measure n+    , _tailGap    :: Measure n+    , _headStyle  :: Style V2 n+    , _headLength :: Measure n+    , _tailStyle  :: Style V2 n+    , _tailLength :: Measure n+    , _shaftStyle :: Style V2 n+    }++-- | Straight line arrow shaft.+straightShaft :: OrderedField n => Trail V2 n+straightShaft = trailFromOffsets [unitX]++instance TypeableFloat n => Default (ArrowOpts n) where+  def = ArrowOpts+        { _arrowHead    = dart+        , _arrowTail    = noTail+        , _arrowShaft   = straightShaft+        , _headGap      = none+        , _tailGap      = none++        -- See note [Default arrow style attributes]+        , _headStyle    = mempty+        , _headLength   = normal+        , _tailStyle    = mempty+        , _tailLength   = normal+        , _shaftStyle   = mempty+        }++makeLensesWith (lensRules & generateSignatures .~ False) ''ArrowOpts++-- | A shape to place at the head of the arrow.+arrowHead :: Lens' (ArrowOpts n) (ArrowHT n)++-- | A shape to place at the tail of the arrow.+arrowTail :: Lens' (ArrowOpts n) (ArrowHT n)++-- | The trail to use for the arrow shaft.+arrowShaft :: Lens' (ArrowOpts n) (Trail V2 n)++-- | Distance to leave between the head and the target point.+headGap :: Lens' (ArrowOpts n) (Measure n)++-- | Distance to leave between the starting point and the tail.+tailGap :: Lens' (ArrowOpts n) (Measure n)++-- | Set both the @headGap@ and @tailGap@ simultaneously.+gaps :: Traversal' (ArrowOpts n) (Measure n)+gaps f opts = (\h t -> opts & headGap .~ h & tailGap .~ t)+        <$> f (opts ^. headGap)+        <*> f (opts ^. tailGap)++-- | Same as gaps, provided for backward compatiiblity.+gap :: Traversal' (ArrowOpts n) (Measure n)+gap = gaps++-- | Style to apply to the head. @headStyle@ is modified by using the lens+--   combinator @%~@ to change the current style. For example, to change+--   an opaque black arrowhead to translucent orange:+--   @(with & headStyle %~ fc orange .  opacity 0.75)@.+headStyle :: Lens' (ArrowOpts n) (Style V2 n)++-- | Style to apply to the tail. See `headStyle`.+tailStyle :: Lens' (ArrowOpts n) (Style V2 n)++-- | Style to apply to the shaft. See `headStyle`.+shaftStyle :: Lens' (ArrowOpts n) (Style V2 n)++-- | The length from the start of the joint to the tip of the head.+headLength :: Lens' (ArrowOpts n) (Measure n)++-- | The length of the tail plus its joint.+tailLength :: Lens' (ArrowOpts n) (Measure n)++-- | Set both the @headLength@ and @tailLength@ simultaneously.+lengths :: Traversal' (ArrowOpts n) (Measure n)+lengths f opts =+  (\h t -> opts & headLength .~ h & tailLength .~ t)+    <$> f (opts ^. headLength)+    <*> f (opts ^. tailLength)++-- | A lens for setting or modifying the texture of an arrowhead. For+--   example, one may write @... (with & headTexture .~ grad)@ to get an+--   arrow with a head filled with a gradient, assuming grad has been+--   defined. Or @... (with & headTexture .~ solid blue@ to set the head+--   color to blue. For more general control over the style of arrowheads,+--   see 'headStyle'.+headTexture :: TypeableFloat n => Lens' (ArrowOpts n) (Texture n)+headTexture = headStyle . _fillTexture++-- | A lens for setting or modifying the texture of an arrow+--   tail. This is *not* a valid lens (see 'committed').+tailTexture :: TypeableFloat n => Lens' (ArrowOpts n) (Texture n)+tailTexture = tailStyle . _fillTexture++-- | A lens for setting or modifying the texture of an arrow+--   shaft.+shaftTexture :: TypeableFloat n => Lens' (ArrowOpts n) (Texture n)+shaftTexture = shaftStyle . _lineTexture++-- Set the default shaft style of an `ArrowOpts` record by applying the+-- default style after all other styles have been applied.+-- The semigroup stucture of the lw attribute will insure that the default+-- is only used if it has not been set in @opts@.+shaftSty :: ArrowOpts n -> Style V2 n+shaftSty opts = opts^.shaftStyle++-- Set the default head style. See `shaftSty`.+headSty :: TypeableFloat n => ArrowOpts n -> Style V2 n+headSty opts = fc black (opts^.headStyle)++-- Set the default tail style. See `shaftSty`.+tailSty :: TypeableFloat n => ArrowOpts n -> Style V2 n+tailSty opts = fc black (opts^.tailStyle)++-- | Calculate the length of the portion of the horizontal line that passes+--   through the origin and is inside of p.+xWidth :: Floating n => (Traced t, V t ~ V2, N t ~ n) => t -> n+xWidth p = a + b+  where+    a = fromMaybe 0 (norm <$> traceV origin unitX p)+    b = fromMaybe 0 (norm <$> traceV origin unit_X p)++-- | Get the line color from the shaft to use as the fill color for the joint.+--   And set the opacity of the shaft to the current opacity.+colorJoint :: TypeableFloat n => Style V2 n -> Style V2 n+colorJoint sStyle =+  let c = fmap getLineTexture . getAttr $ sStyle+      o = fmap getOpacity . getAttr $ sStyle+  in+  case (c, o) of+      (Nothing, Nothing) -> fillColor black mempty+      (Just t, Nothing)  -> fillTexture t mempty+      (Nothing, Just o') -> opacity o' . fillColor black $ mempty+      (Just t, Just o')  -> opacity o' . fillTexture t $ mempty++-- | Get line width from a style.+widthOfJoint :: forall n. TypeableFloat n => Style V2 n -> n -> n -> n+widthOfJoint sStyle gToO nToO =+  fromMaybe+    (fromMeasured gToO nToO medium) -- should be same as default line width+    (fmap getLineWidth . getAttr . unmeasureAttrs gToO nToO $ sStyle)++-- | Combine the head and its joint into a single scale invariant diagram+--   and move the origin to the attachment point. Return the diagram+--   and its width.+mkHead :: (TypeableFloat n, Renderable (Path V2 n) b) =>+          n -> ArrowOpts n -> n -> n -> Bool -> (QDiagram b V2 n Any, n)+mkHead = mkHT unit_X arrowHead headSty++mkTail :: (TypeableFloat n, Renderable (Path V2 n) b) =>+          n -> ArrowOpts n -> n -> n -> Bool -> (QDiagram b V2 n Any, n)+mkTail = mkHT unitX arrowTail tailSty++mkHT+  :: (TypeableFloat n, Renderable (Path V2 n) b)+  => V2 n -> Lens' (ArrowOpts n) (ArrowHT n) -> (ArrowOpts n -> Style V2 n)+  -> n -> ArrowOpts n -> n -> n -> Bool -> (QDiagram b V2 n Any, n)+mkHT xDir htProj styProj sz opts gToO nToO reflect+    = ( (j <> ht)+        # (if reflect then reflectY else id)+        # moveOriginBy (jWidth *^ xDir) # lwO 0+      , htWidth + jWidth+      )+  where+    (ht', j') = (opts^.htProj) sz+                (widthOfJoint (shaftSty opts) gToO nToO)+    htWidth = xWidth ht'+    jWidth  = xWidth j'+    ht = stroke ht' # applyStyle (styProj opts)+    j  = stroke j'  # applyStyle (colorJoint (opts^.shaftStyle))++-- | @spine tr tw hw sz@ makes a trail with the same angles and offset+--   as an arrow with tail width @t@w, head width @hw@ and shaft @tr@,+--   such that the magnitude of the shaft offset is @sz@. Used for+--   calculating the offset of an arrow.+spine :: TypeableFloat n => Trail V2 n -> n -> n -> n -> Trail V2 n+spine tr tw hw sz = tS <> tr # scale sz <> hS+  where+    tSpine = trailFromOffsets [signorm . tangentAtStart $ tr] # scale tw+    hSpine = trailFromOffsets [signorm . tangentAtEnd $ tr] # scale hw+    hS = if hw > 0 then hSpine else mempty+    tS = if tw > 0 then tSpine else mempty++-- | @scaleFactor tr tw hw t@ calculates the amount required to scale+--   a shaft trail @tr@ so that an arrow with head width @hw@ and tail+--   width @tw@ has offset @t@.+scaleFactor :: TypeableFloat n => Trail V2 n -> n -> n -> n -> n+scaleFactor tr tw hw t++  -- Let tv be a vector representing the tail width, i.e. a vector+  -- of length tw tangent to the trail's start; similarly for hv.+  -- Let v be the vector offset of the trail.+  --+  -- Then we want to find k such that+  --+  --   || tv + k*v + hv || = t.+  --+  -- We can solve by squaring both sides and expanding the LHS as a+  -- dot product, resulting in a quadratic in k.++  = case quadForm+             (quadrance v)+             (2* (v `dot` (tv ^+^ hv)))+             (quadrance (tv ^+^ hv) - t*t)+    of+      []  -> 1   -- no scale works, just return 1+      [s] -> s   -- single solution+      ss  -> maximum ss+        -- we will usually get both a positive and a negative solution;+        -- return the maximum (i.e. positive) solution+  where+    tv = tw *^ (tangentAtStart tr # signorm)+    hv = hw *^ (tangentAtEnd   tr # signorm)+    v  = trailOffset tr++-- Calculate the approximate envelope of a horizontal arrow+-- as if the arrow were made only of a shaft.+arrowEnv :: TypeableFloat n => ArrowOpts n -> n -> Envelope V2 n+arrowEnv opts len = getEnvelope horizShaft+  where+    horizShaft = shaft # rotate (negated (v ^. _theta)) # scale (len / m)+    m = norm v+    v = trailOffset shaft+    shaft = opts ^. arrowShaft++-- | @arrow len@ creates an arrow of length @len@ with default+--   parameters, starting at the origin and ending at the point+--   @(len,0)@.+arrow :: (TypeableFloat n, Renderable (Path V2 n) b) => n -> QDiagram b V2 n Any+arrow = arrow' def++-- | @arrow' opts len@ creates an arrow of length @len@ using the+--   given options, starting at the origin and ending at the point+--   @(len,0)@.  In particular, it scales the given 'arrowShaft' so+--   that the entire arrow has length @len@.+arrow' :: (TypeableFloat n, Renderable (Path V2 n) b) => ArrowOpts n -> n -> QDiagram b V2 n Any+arrow' opts len = mkQD' (DelayedLeaf delayedArrow)++      -- Currently we approximate the envelope of an arrow by using the+      -- envelope of its shaft (see 'arrowEnv'). The trace of an arrow is empty.+      (arrowEnv opts len) mempty mempty mempty++  where++    -- Once we learn the global transformation context (da) and the two scale+    -- factors, normal to output (n) and global to output (g), this arrow is+    -- drawn in, we can apply it to the origin and (len,0) to find out+    -- the actual final points between which this arrow should be+    -- drawn.  We need to know this to draw it correctly, since the+    -- head and tail are scale invariant, and hence the precise points+    -- between which we need to draw the shaft do not transform+    -- uniformly as the transformation applied to the entire arrow.+    -- See https://github.com/diagrams/diagrams-lib/issues/112.+    delayedArrow da g n =+      let (trans, globalSty) = maybe mempty untangle . fst $ da+      in  dArrow globalSty trans len g n++    -- Build an arrow and set its endpoints to the image under tr of origin and (len,0).+    dArrow sty tr ln gToO nToO = (h' <> t' <> shaft)+               # moveOriginBy (tWidth *^ (unit_X # rotate tAngle))+               # rotate (((q .-. p)^._theta) ^-^ (dir^._theta))+               # moveTo p+      where++        p = origin # transform tr+        q = origin # translateX ln # transform tr++        -- Use the existing line color for head, tail, and shaft by+        -- default (can be overridden by explicitly setting headStyle,+        -- tailStyle, or shaftStyle).  Also use existing global line width+        -- for shaft if not explicitly set in shaftStyle.+        globalLC = getLineTexture <$> getAttr sty+        opts' = opts+          & headStyle  %~ maybe id fillTexture globalLC+          & tailStyle  %~ maybe id fillTexture globalLC+          & shaftStyle %~ applyStyle sty . transform tr++        -- The head size, tail size, head gap, and tail gap are obtained+        -- from the style and converted to output units.+        scaleFromMeasure = fromMeasured gToO nToO . scaleLocal (avgScale tr)+        hSize = scaleFromMeasure $ opts ^. headLength+        tSize = scaleFromMeasure $ opts ^. tailLength+        hGap  = scaleFromMeasure $ opts ^. headGap+        tGap  = scaleFromMeasure $ opts ^. tailGap++        -- Make the head and tail and save their widths.+        (h, hWidth') = mkHead hSize opts' gToO nToO (isReflection tr)+        (t, tWidth') = mkTail tSize opts' gToO nToO (isReflection tr)++        rawShaftTrail = opts^.arrowShaft+        shaftTrail+          = rawShaftTrail+            -- rotate it so it is pointing in the positive X direction+          # rotate (negated . view _theta . trailOffset $ rawShaftTrail)+            -- apply the context transformation -- in case it includes+            -- things like flips and shears (the possibility of shears+            -- is why we must rotate it to a neutral position first)+          # transform tr++        -- Adjust the head width and tail width to take gaps into account+        tWidth = tWidth' + tGap+        hWidth = hWidth' + hGap++        -- Calculate the angles that the head and tail should point.+        tAngle = tangentAtStart shaftTrail ^. _theta+        hAngle = tangentAtEnd shaftTrail ^. _theta++        -- Calculte the scaling factor to apply to the shaft shaftTrail so that the entire+        -- arrow will be of length len. Then apply it to the shaft and make the+        -- shaft into a Diagram with using its style.+        sf = scaleFactor shaftTrail tWidth hWidth (norm (q .-. p))+        shaftTrail' = shaftTrail # scale sf+        shaft = strokeT shaftTrail' # applyStyle (shaftSty opts')++        -- Adjust the head and tail to point in the directions of the shaft ends.+        h' = h # rotate hAngle+               # moveTo (origin .+^ shaftTrail' `atParam` domainUpper shaftTrail')+        t' = t # rotate tAngle++        -- Find out what direction the arrow is pointing so we can set it back+        -- to point in the direction unitX when we are done.+        dir = direction (trailOffset $ spine shaftTrail tWidth hWidth sf)++-- | @arrowBetween s e@ creates an arrow pointing from @s@ to @e@+--   with default parameters.+arrowBetween :: (TypeableFloat n, Renderable (Path V2 n) b) => Point V2 n -> Point V2 n -> QDiagram b V2 n Any+arrowBetween = arrowBetween' def++-- | @arrowBetween' opts s e@ creates an arrow pointing from @s@ to+--   @e@ using the given options.  In particular, it scales and+--   rotates @arrowShaft@ to go between @s@ and @e@, taking head,+--   tail, and gaps into account.+arrowBetween'+  :: (TypeableFloat n, Renderable (Path V2 n) b) =>+     ArrowOpts n -> Point V2 n -> Point V2 n -> QDiagram b V2 n Any+arrowBetween' opts s e = arrowAt' opts s (e .-. s)++-- | Create an arrow starting at s with length and direction determined by+--   the vector v.+arrowAt :: (TypeableFloat n, Renderable (Path V2 n) b) => Point V2 n -> V2 n -> QDiagram b V2 n Any+arrowAt = arrowAt' def++arrowAt'+  :: (TypeableFloat n, Renderable (Path V2 n) b) =>+     ArrowOpts n -> Point V2 n -> V2 n -> QDiagram b V2 n Any+arrowAt' opts s v = arrow' opts len+                  # rotate dir # moveTo s+  where+    len = norm v+    dir = v ^. _theta++-- | @arrowV v@ creates an arrow with the direction and norm of+--   the vector @v@ (with its tail at the origin), using default+--   parameters.+arrowV :: (TypeableFloat n, Renderable (Path V2 n) b) => V2 n -> QDiagram b V2 n Any+arrowV = arrowV' def++-- | @arrowV' v@ creates an arrow with the direction and norm of+--   the vector @v@ (with its tail at the origin).+arrowV'+  :: (TypeableFloat n, Renderable (Path V2 n) b)+  => ArrowOpts n -> V2 n -> QDiagram b V2 n Any+arrowV' opts = arrowAt' opts origin++-- | Turn a located trail into a default arrow by putting an+--   arrowhead at the end of the trail.+arrowFromLocatedTrail+  :: (Renderable (Path V2 n) b, RealFloat n, Typeable n)+  => Located (Trail V2 n) -> QDiagram b V2 n Any+arrowFromLocatedTrail = arrowFromLocatedTrail' def++-- | Turn a located trail into an arrow using the given options.+arrowFromLocatedTrail'+  :: (Renderable (Path V2 n) b, RealFloat n, Typeable n)+  => ArrowOpts n -> Located (Trail V2 n) -> QDiagram b V2 n Any+arrowFromLocatedTrail' opts trail = arrowBetween' opts' start end+  where+    opts' = opts & arrowShaft .~ unLoc trail+    start = atStart trail+    end   = atEnd trail++-- | Connect two diagrams with a straight arrow.+connect+  :: (TypeableFloat n, Renderable (Path V2 n) b, IsName n1, IsName n2)+  => n1 -> n2 -> QDiagram b V2 n Any -> QDiagram b V2 n Any+connect = connect' def++-- | Connect two diagrams with an arbitrary arrow.+connect'+  :: (TypeableFloat n, Renderable (Path V2 n) b, IsName n1, IsName n2)+  => ArrowOpts n -> n1 -> n2 -> QDiagram b V2 n Any -> QDiagram b V2 n Any+connect' opts n1 n2 =+  withName n1 $ \sub1 ->+  withName n2 $ \sub2 ->+    let [s,e] = map location [sub1, sub2]+    in  atop (arrowBetween' opts s e)++-- | Connect two diagrams at point on the perimeter of the diagrams, choosen+--   by angle.+connectPerim+  :: (TypeableFloat n, Renderable (Path V2 n) b, IsName n1, IsName n2)+ => n1 -> n2 -> Angle n -> Angle n+  -> QDiagram b V2 n Any -> QDiagram b V2 n Any+connectPerim = connectPerim' def++connectPerim'+  :: (TypeableFloat n, Renderable (Path V2 n) b, IsName n1, IsName n2)+  => ArrowOpts n -> n1 -> n2 -> Angle n -> Angle n+  -> QDiagram b V2 n Any -> QDiagram b V2 n Any+connectPerim' opts n1 n2 a1 a2 =+  withName n1 $ \sub1 ->+  withName n2 $ \sub2 ->+    let [os, oe] = map location [sub1, sub2]+        s = fromMaybe os (maxTraceP os (unitX # rotate a1) sub1)+        e = fromMaybe oe (maxTraceP oe (unitX # rotate a2) sub2)+    in  atop (arrowBetween' opts s e)++-- | Draw an arrow from diagram named "n1" to diagram named "n2".  The+--   arrow lies on the line between the centres of the diagrams, but is+--   drawn so that it stops at the boundaries of the diagrams, using traces+--   to find the intersection points.+connectOutside+  :: (TypeableFloat n, Renderable (Path V2 n) b, IsName n1, IsName n2)+  => n1 -> n2 -> QDiagram b V2 n Any -> QDiagram b V2 n Any+connectOutside = connectOutside' def++connectOutside'+  :: (TypeableFloat n, Renderable (Path V2 n) b, IsName n1, IsName n2)+  => ArrowOpts n -> n1 -> n2 -> QDiagram b V2 n Any -> QDiagram b V2 n Any+connectOutside' opts n1 n2 =+  withName n1 $ \b1 ->+  withName n2 $ \b2 ->+    let v = location b2 .-. location b1+        midpoint = location b1 .+^ (v ^/ 2)+        s' = fromMaybe (location b1) $ traceP midpoint (negated v) b1+        e' = fromMaybe (location b2) $ traceP midpoint v b2+    in+      atop (arrowBetween' opts s' e')

+ src/Diagrams/TwoD/Arrowheads.hs view

@@ -0,0 +1,346 @@+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE FlexibleContexts          #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE ScopedTypeVariables       #-}+{-# LANGUAGE TypeFamilies              #-}+{-# OPTIONS_GHC -fno-warn-unused-imports       #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Diagrams.TwoD.Arrowheads+-- Copyright   :  (c) 2013 diagrams-lib team (see LICENSE)+-- License     :  BSD-style (see LICENSE)+-- Maintainer  :  diagrams-discuss@googlegroups.com+--+-- Standard arrowheads and tails. Each arrowhead or tail is designed+-- to be drawn filled, with a line width of 0, and is normalized to+-- fit inside a circle of diameter 1.+--+-----------------------------------------------------------------------------++module Diagrams.TwoD.Arrowheads+       (+       -- * Arrowheads+       -- ** Standard arrowheads+         tri+       , dart+       , halfDart+       , spike+       , thorn+       , lineHead+       , noHead++       -- ** Configurable arrowheads+       -- | Creates arrowheads of the same shape as the standard heads but+       --   where the angle parameter is used to specify the angle to the top+       --   left point of the arrowhead.+       , arrowheadTriangle+       , arrowheadDart+       , arrowheadHalfDart+       , arrowheadSpike+       , arrowheadThorn++       -- * Arrow tails+       -- ** Standard arrow tails+       , tri'+       , dart'+       , halfDart'+       , spike'+       , thorn'+       , lineTail+       , noTail+       , quill+       , block++       -- ** Configurable arrow tails++       , arrowtailQuill+       , arrowtailBlock++       -- * Internals+       , ArrowHT+       ) where++import           Control.Lens            ((&), (.~), (<>~), (^.))+import           Data.Default+import           Data.Monoid             (mempty, (<>))++import           Diagrams.Angle+import           Diagrams.Core++import           Diagrams.Path+import           Diagrams.Segment+import           Diagrams.Trail+import           Diagrams.TrailLike      (fromOffsets)+import           Diagrams.TwoD.Align+import           Diagrams.TwoD.Arc       (arc')+import           Diagrams.TwoD.Path      ()+import           Diagrams.TwoD.Polygons+import           Diagrams.TwoD.Shapes+import           Diagrams.TwoD.Transform+import           Diagrams.TwoD.Types+import           Diagrams.TwoD.Vector    (unitX, unit_X, xDir)+import           Diagrams.Util           (( # ))++import           Linear.Affine+import           Linear.Metric+import           Linear.Vector++-----------------------------------------------------------------------------++type ArrowHT n = n -> n -> (Path V2 n, Path V2 n)++closedPath :: OrderedField n => Trail V2 n -> Path V2 n+closedPath = pathFromTrail . closeTrail++-- Heads ------------------------------------------------------------------+--   > drawHead h = arrowAt' (with & arrowHead .~ h & shaftStyle %~ lw none+--   >                             & headLength .~ local 0.5)+--   >         origin (r2 (1, 0))+--   >      <> square 0.5 # alignL # lw none # frame 0.1++-- | Isoceles triangle style. The above example specifies an angle of `2/5 Turn`.++-- | <<diagrams/src_Diagrams_TwoD_Arrowheads_tri25Ex.svg#diagram=tri25Ex&width=120>>++--   > tri25Ex = arrowAt' (with & arrowHead .~ arrowheadTriangle (2/5 @@ turn)+--   >                          & shaftStyle %~ lw none & headLength .~ local 0.5)+--   >           origin (r2 (0.5, 0))+--   >        <> square 0.6 # alignL # lw none # frame 0.1+arrowheadTriangle :: RealFloat n => Angle n -> ArrowHT n+arrowheadTriangle theta = aHead+  where+    aHead len _ = (p, mempty)+      where+        psi = pi - (theta ^. rad)+        r = len / (1 + cos psi)+        p = polygon (def & polyType .~ PolyPolar [theta, (-2) *^ theta]+            (repeat r) & polyOrient .~ NoOrient)  # alignL+++-- | Isoceles triangle with linear concave base. Inkscape type 1 - dart like.+arrowheadDart :: RealFloat n => Angle n -> ArrowHT n+arrowheadDart theta len shaftWidth = (hd # scale sz, jt)+  where+    hd = snugL . pathFromTrail . glueTrail $ fromOffsets [t1, t2, b2, b1]+    jt = pathFromTrail . glueTrail $ j <> reflectY j+    j = closeTrail $ fromOffsets [V2 (-jLength) 0, V2 0 (shaftWidth / 2)]+    v = rotate theta unitX+    (t1, t2) = (unit_X ^+^ v, V2 (-0.5) 0 ^-^ v)+    [b1, b2] = map (reflectY . negated) [t1, t2]+    psi = pi - negated t2 ^. _theta . rad+    jLength = shaftWidth / (2 * tan psi)++    -- If the shaft is too wide, set the size to a default value of 1.+    sz = max 1 ((len - jLength) / 1.5)++-- | Top half of an 'arrowheadDart'.+arrowheadHalfDart :: RealFloat n => Angle n -> ArrowHT n+arrowheadHalfDart theta len shaftWidth = (hd, jt)+  where+    hd = fromOffsets [t1, t2]+       # closeTrail # pathFromTrail+       # translateX 1.5 # scale sz+       # translateY (-shaftWidth/2)+       # snugL+    jt = snugR . translateY (-shaftWidth/2) . pathFromTrail . closeTrail $ fromOffsets [V2 (-jLength) 0, V2 0 shaftWidth]+    v = rotate theta unitX+    (t1, t2) = (unit_X ^+^ v, (0.5 *^ unit_X) ^-^ v)+    psi = pi - negated t2 ^. _theta . rad+    jLength = shaftWidth / tan psi++    -- If the shaft is too wide, set the size to a default value of 1.+    sz = max 1 ((len - jLength) / 1.5)++-- | Isoceles triangle with curved concave base. Inkscape type 2.+arrowheadSpike :: RealFloat n => Angle n -> ArrowHT n+arrowheadSpike theta len shaftWidth  = (hd # scale r, jt # scale r)+  where+    hd = snugL . closedPath $ l1 <> c <> l2+    jt = alignR . centerY . pathFromTrail+                . closeTrail $ arc' 1 (xDir & _theta <>~ negated phi) (2 *^ phi)+    l1 = trailFromSegments [straight $ unit_X ^+^ v]+    l2 = trailFromSegments [reverseSegment . straight $ (unit_X ^+^ reflectY v)]+    c = arc' 1 (rotate α xDir) ((-2) *^ α)+    α = (1/2 @@ turn) ^-^ theta+    v = rotate theta unitX++    -- The length of the head without its joint is, -2r cos theta and+    -- the length of the joint is r - sqrt (r^2 - y^2). So the total+    -- length of the arrow head is given by r(1 - 2 cos theta)-sqrt (r^2-y^2).+    -- Solving the quadratic gives two roots, we want the larger one.++    -- 1/4 turn < theta < 2/3 turn.+    a = 1 - 2 * cos (theta ^. rad)+    y = shaftWidth / 2++    -- If the shaft is too wide for the head, we default the radius r to+    -- 2/3 * len by setting d=1 and phi=pi/2.+    d = max 1 (len**2 + (1 - a**2) * y**2)+    r = (a * len + sqrt d) / (a**2 -1)+    phi = asinA (min 1 (y/r))++-- | Curved sides, linear concave base. Illustrator CS5 #3+arrowheadThorn :: RealFloat n => Angle n -> ArrowHT n+arrowheadThorn theta len shaftWidth = (hd # scale sz, jt)+  where+    hd = snugL . pathFromTrail . glueTrail $ hTop <> reflectY hTop+    hTop = closeTrail . trailFromSegments $ [c, l]+    jt = pathFromTrail . glueTrail $ j <> reflectY j+    j = closeTrail $ fromOffsets [V2 (-jLength) 0, V2 0 (shaftWidth / 2)]+    c = curvedSide theta+    v = rotate theta unitX+    l = reverseSegment . straight $ t+    t = v ^-^ V2 (-0.5) 0+    psi = fullTurn ^/ 2 ^-^ (negated t ^. _theta)+    jLength = shaftWidth / (2 * tanA psi)++    -- If the shaft if too wide, set the size to a default value of 1.+    sz = max 1 ((len - jLength) / 1.5)++-- | Make a side for the thorn head.+curvedSide :: Floating n => Angle n -> Segment Closed V2 n+curvedSide theta = bezier3 ctrl1 ctrl2 end+  where+    v0    = unit_X+    v1    = rotate theta unitX+    ctrl1 = v0+    ctrl2 = v0 ^+^ v1+    end   = v0 ^+^ v1++-- Standard heads ---------------------------------------------------------+-- | A line the same width as the shaft.+lineHead :: RealFloat n => ArrowHT n+lineHead s w = (square 1 # scaleX s # scaleY w # alignL, mempty)++noHead :: ArrowHT n+noHead _ _ = (mempty, mempty)++-- | <<diagrams/src_Diagrams_TwoD_Arrowheads_triEx.svg#diagram=triEx&width=100>>++--   > triEx = drawHead tri+tri :: RealFloat n => ArrowHT n+tri = arrowheadTriangle (1/3 @@ turn)++-- | <<diagrams/src_Diagrams_TwoD_Arrowheads_spikeEx.svg#diagram=spikeEx&width=100>>++--   > spikeEx = drawHead spike+spike :: RealFloat n => ArrowHT n+spike = arrowheadSpike (3/8 @@ turn)++-- | <<diagrams/src_Diagrams_TwoD_Arrowheads_thornEx.svg#diagram=thornEx&width=100>>++--   > thornEx = drawHead thorn+thorn :: RealFloat n => ArrowHT n+thorn = arrowheadThorn (3/8 @@ turn)++-- | <<diagrams/src_Diagrams_TwoD_Arrowheads_dartEx.svg#diagram=dartEx&width=100>>++--   > dartEx = drawHead dart+dart :: RealFloat n => ArrowHT n+dart = arrowheadDart (2/5 @@ turn)++-- | <<diagrams/src_Diagrams_TwoD_Arrowheads_halfDartEx.svg#diagram=halfDartEx&width=100>>++--   > halfDartEx = drawHead halfDart+halfDart :: RealFloat n => ArrowHT n+halfDart = arrowheadHalfDart (2/5 @@ turn)++-- Tails ------------------------------------------------------------------+--   > drawTail t = arrowAt' (with  & arrowTail .~ t & shaftStyle %~ lw none+--   >                              & arrowHead .~ noHead & tailLength .~ local 0.5)+--   >         origin (r2 (1, 0))+--   >      <> square 0.5 # alignL # lw none # frame 0.1++-- | Utility function to convert any arrowhead to an arrowtail, i.e.+--   attached at the start of the trail.+headToTail :: OrderedField n => ArrowHT n -> ArrowHT n+headToTail hd = tl+  where+    tl sz shaftWidth = (t, j)+      where+        (t', j') = hd sz shaftWidth+        t = reflectX t'+        j = reflectX j'++arrowtailBlock :: forall n. (RealFloat n) => Angle n -> ArrowHT n+arrowtailBlock theta = aTail+  where+   aTail len _ = (t, mempty)+      where+        t  = rect len (len * x) # alignR+        a' :: V2 n+        a' = rotate theta unitX+        a  = a' ^-^ reflectY a'+        x  = norm a++-- | The angle is where the top left corner intersects the circle.+arrowtailQuill :: OrderedField n => Angle n -> ArrowHT n+arrowtailQuill theta = aTail+  where+   aTail len shaftWidth = (t, j)+      where+        t = closedPath (trailFromVertices [v0, v1, v2, v3, v4, v5, v0])+              # scale sz # alignR+        sz = len / 0.6+        v0 = p2 (0.5, 0)+        v2 = origin .+^ (rotate theta unitX # scale 0.5)+        v1 = v2 # translateX (5/8)+        v3 = p2 (-0.1, 0)+        v4 = v2 # reflectY+        v5 = v4 # translateX (5/8)+        s = 1 - shaftWidth / norm (v1 .-. v5)+        n1 = v0 # translateY (0.5 * shaftWidth)+        n2 = v1 .-^ ((v1 .-. v0) # scale s)+        n3 = v5 .-^ ((v5 .-. v0) # scale s)+        n4 = n1 # reflectY+        j  = closedPath $ trailFromVertices [v0, n1, n2, v0, n3, n4, v0]++-- Standard tails ---------------------------------------------------------+-- | A line the same width as the shaft.+lineTail :: RealFloat n => ArrowHT n+lineTail s w = (square 1 # scaleY w # scaleX s # alignR, mempty)++noTail :: ArrowHT n+noTail _ _ = (mempty, mempty)++-- | <<diagrams/src_Diagrams_TwoD_Arrowheads_tri'Ex.svg#diagram=tri'Ex&width=100>>++--   > tri'Ex = drawTail tri'+tri' :: RealFloat n => ArrowHT n+tri' = headToTail tri++-- | <<diagrams/src_Diagrams_TwoD_Arrowheads_spike'Ex.svg#diagram=spike'Ex&width=100>>++--   > spike'Ex = drawTail spike'+spike' :: RealFloat n => ArrowHT n+spike' = headToTail spike++-- | <<diagrams/src_Diagrams_TwoD_Arrowheads_thorn'Ex.svg#diagram=thorn'Ex&width=100>>++--   > thorn'Ex = drawTail thorn'+thorn' :: RealFloat n => ArrowHT n+thorn' = headToTail thorn++-- | <<diagrams/src_Diagrams_TwoD_Arrowheads_dart'Ex.svg#diagram=dart'Ex&width=100>>++--   > dart'Ex = drawTail dart'+dart' :: RealFloat n => ArrowHT n+dart' = headToTail dart++-- | <<diagrams/src_Diagrams_TwoD_Arrowheads_halfDart'Ex.svg#diagram=halfDart'Ex&width=100>>++--   > halfDart'Ex = drawTail halfDart'+halfDart' :: RealFloat n => ArrowHT n+halfDart' = headToTail halfDart++-- | <<diagrams/src_Diagrams_TwoD_Arrowheads_quillEx.svg#diagram=quillEx&width=100>>++--   > quillEx = drawTail quill+quill :: (Floating n, Ord n) => ArrowHT n+quill = arrowtailQuill (2/5 @@ turn)++-- | <<diagrams/src_Diagrams_TwoD_Arrowheads_blockEx.svg#diagram=blockEx&width=100>>++--   > blockEx = drawTail block+block :: RealFloat n => ArrowHT n+block = arrowtailBlock (7/16 @@ turn)

+ src/Diagrams/TwoD/Attributes.hs view

@@ -0,0 +1,423 @@+{-# LANGUAGE ConstraintKinds            #-}+{-# LANGUAGE DeriveDataTypeable         #-}+{-# LANGUAGE DeriveFunctor              #-}+{-# LANGUAGE FlexibleContexts           #-}+{-# LANGUAGE FlexibleInstances          #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses      #-}+{-# LANGUAGE ScopedTypeVariables        #-}+{-# LANGUAGE StandaloneDeriving         #-}+{-# LANGUAGE TemplateHaskell            #-}+{-# LANGUAGE TypeFamilies               #-}+{-# LANGUAGE UndecidableInstances       #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Diagrams.TwoD.Attributes+-- Copyright   :  (c) 2013-2015 diagrams-lib team (see LICENSE)+-- License     :  BSD-style (see LICENSE)+-- Maintainer  :  diagrams-discuss@googlegroups.com+--+-- Diagrams may have /attributes/ which affect the way they are+-- rendered. This module defines /Textures/ (Gradients and Colors) in two+-- dimensions. Like the attributes defined in the Diagrams.Attributes module,+-- all attributes defined here use the 'Last' or 'Recommend' /semigroup/ structure.+-- 'FillColor' and 'LineColor' attributes are provided so that backends that+-- don't support gradients need not be concerned with using textures. Backends+-- should only implement color attributes or textures attributes, not both.+--+-----------------------------------------------------------------------------++module Diagrams.TwoD.Attributes (+  -- * Textures+    Texture(..), solid, _SC, _AC, _LG, _RG, defaultLG, defaultRG+  , GradientStop(..), stopColor, stopFraction, mkStops+  , SpreadMethod(..), lineLGradient, lineRGradient++  -- ** Linear Gradients+  , LGradient(..), lGradStops, lGradTrans, lGradStart, lGradEnd+  , lGradSpreadMethod, mkLinearGradient++  -- ** Radial Gradients+  , RGradient(..), rGradStops, rGradTrans+  , rGradCenter0, rGradRadius0, rGradCenter1, rGradRadius1+  , rGradSpreadMethod, mkRadialGradient++  -- ** Line texture+  , LineTexture(..), _LineTexture, getLineTexture, lineTexture, lineTextureA+  , mkLineTexture, _lineTexture++  -- ** Line color+  , lineColor, lc, lcA++  -- ** Fill texture+  , FillTexture(..), _FillTexture, getFillTexture, fillTexture+  , mkFillTexture, _fillTexture, _fillTextureR++  -- ** Fill color+  , fillColor, fc, fcA, recommendFillColor++  -- * Compilation utilities+  , splitTextureFills++  ) where++import           Control.Lens                hiding (transform)+import           Data.Colour                 hiding (AffineSpace, over)+import           Data.Data+import           Data.Default+import           Data.Monoid.Recommend+import           Data.Semigroup++import           Diagrams.Attributes+import           Diagrams.Attributes.Compile+import           Diagrams.Core+import           Diagrams.Core.Types         (RTree)+import           Diagrams.Located            (unLoc)+import           Diagrams.Path               (Path, pathTrails)+import           Diagrams.Trail              (isLoop)+import           Diagrams.TwoD.Types+import           Diagrams.Util+++-----------------------------------------------------------------+--  Gradients  --------------------------------------------------+-----------------------------------------------------------------++-- | A gradient stop contains a color and fraction (usually between 0 and 1)+data GradientStop d = GradientStop+  { _stopColor    :: SomeColor+  , _stopFraction :: d+  }++makeLensesWith (lensRules & generateSignatures .~ False) ''GradientStop++-- | A color for the stop.+stopColor :: Lens' (GradientStop n) SomeColor++-- | The fraction for stop.+stopFraction :: Lens' (GradientStop n) n++-- | The 'SpreadMethod' determines what happens before 'lGradStart' and after+--   'lGradEnd'. 'GradPad' fills the space before the start of the gradient+--   with the color of the first stop and the color after end of the gradient+--   with the color of the last stop. 'GradRepeat' restarts the gradient and+--   'GradReflect' restarts the gradient with the stops in reverse order.+data SpreadMethod = GradPad | GradReflect | GradRepeat++-- | Linear Gradient+data LGradient n = LGradient+  { _lGradStops        :: [GradientStop n]+  , _lGradStart        :: Point V2 n+  , _lGradEnd          :: Point V2 n+  , _lGradTrans        :: Transformation V2 n+  , _lGradSpreadMethod :: SpreadMethod }++type instance V (LGradient n) = V2+type instance N (LGradient n) = n++makeLensesWith (lensRules & generateSignatures .~ False) ''LGradient++instance Fractional n => Transformable (LGradient n) where+  transform = over lGradTrans . transform++-- | A list of stops (colors and fractions).+lGradStops :: Lens' (LGradient n) [GradientStop n]++-- | A transformation to be applied to the gradient. Usually this field will+--   start as the identity transform and capture the transforms that are applied+--   to the gradient.+lGradTrans :: Lens' (LGradient n) (Transformation V2 n)++-- | The starting point for the first gradient stop. The coordinates are in+--   'local' units and the default is (-0.5, 0).+lGradStart :: Lens' (LGradient n) (Point V2 n)++-- | The ending point for the last gradient stop.The coordinates are in+--   'local' units and the default is (0.5, 0).+lGradEnd :: Lens' (LGradient n) (Point V2 n)++-- | For setting the spread method.+lGradSpreadMethod :: Lens' (LGradient n) SpreadMethod++-- | Radial Gradient+data RGradient n = RGradient+  { _rGradStops        :: [GradientStop n]+  , _rGradCenter0      :: Point V2 n+  , _rGradRadius0      :: n+  , _rGradCenter1      :: Point V2 n+  , _rGradRadius1      :: n+  , _rGradTrans        :: Transformation V2 n+  , _rGradSpreadMethod :: SpreadMethod }++makeLensesWith (lensRules & generateSignatures .~ False) ''RGradient++type instance V (RGradient n) = V2+type instance N (RGradient n) = n++instance Fractional n => Transformable (RGradient n) where+  transform = over rGradTrans . transform++-- | A list of stops (colors and fractions).+rGradStops :: Lens' (RGradient n) [GradientStop n]++-- | The center point of the inner circle.+rGradCenter0 :: Lens' (RGradient n) (Point V2 n)++-- | The radius of the inner cirlce in 'local' coordinates.+rGradRadius0 :: Lens' (RGradient n) n++-- | The center of the outer circle.+rGradCenter1  :: Lens' (RGradient n) (Point V2 n)++-- | The radius of the outer circle in 'local' coordinates.+rGradRadius1 :: Lens' (RGradient n) n++-- | A transformation to be applied to the gradient. Usually this field will+--   start as the identity transform and capture the transforms that are applied+--   to the gradient.+rGradTrans :: Lens' (RGradient n) (Transformation V2 n)++-- | For setting the spread method.+rGradSpreadMethod :: Lens' (RGradient n) SpreadMethod++-----------------------------------------------------------------+--  Textures  ---------------------------------------------------+-----------------------------------------------------------------++-- | A Texture is either a color 'SC', linear gradient 'LG', or radial gradient 'RG'.+--   An object can have only one texture which is determined by the 'Last'+--   semigroup structure.+data Texture n = SC SomeColor | LG (LGradient n) | RG (RGradient n)+  deriving Typeable++type instance V (Texture n) = V2+type instance N (Texture n) = n++makePrisms ''Texture++-- | Prism onto an 'AlphaColour' 'Double' of a 'SC' texture.+_AC :: Prism' (Texture n) (AlphaColour Double)+_AC = _SC . _SomeColor++instance Floating n => Transformable (Texture n) where+  transform t (LG lg) = LG $ transform t lg+  transform t (RG rg) = RG $ transform t rg+  transform _ sc      = sc++-- | Convert a solid colour into a texture.+solid :: Color a => a -> Texture n+solid = SC . SomeColor++-- | A default is provided so that linear gradients can easily be created using+--   lenses. For example, @lg = defaultLG & lGradStart .~ (0.25 ^& 0.33)@. Note that+--   no default value is provided for @lGradStops@, this must be set before+--   the gradient value is used, otherwise the object will appear transparent.+defaultLG :: Fractional n => Texture n+defaultLG = LG LGradient+  { _lGradStops        = []+  , _lGradStart        = mkP2 (-0.5) 0+  , _lGradEnd          = mkP2 0.5 0+  , _lGradTrans        = mempty+  , _lGradSpreadMethod = GradPad+  }++-- | A default is provided so that radial gradients can easily be created using+--   lenses. For example, @rg = defaultRG & rGradRadius1 .~ 0.25@. Note that+--   no default value is provided for @rGradStops@, this must be set before+--   the gradient value is used, otherwise the object will appear transparent.+defaultRG :: Fractional n => Texture n+defaultRG = RG RGradient+  { _rGradStops        = []+  , _rGradCenter0      = mkP2 0 0+  , _rGradRadius0      = 0.0+  , _rGradCenter1      = mkP2 0 0+  , _rGradRadius1      = 0.5+  , _rGradTrans        = mempty+  , _rGradSpreadMethod = GradPad+  }++-- | A convenient function for making gradient stops from a list of triples.+--   (An opaque color, a stop fraction, an opacity).+mkStops :: [(Colour Double, d, Double)] -> [GradientStop d]+mkStops = map (\(x, y, z) -> GradientStop (SomeColor (withOpacity x z)) y)++-- | Make a linear gradient texture from a stop list, start point, end point,+--   and 'SpreadMethod'. The 'lGradTrans' field is set to the identity+--   transfrom, to change it use the 'lGradTrans' lens.+mkLinearGradient :: Num n => [GradientStop n] -> Point V2 n -> Point V2 n -> SpreadMethod -> Texture n+mkLinearGradient stops  start end spreadMethod+  = LG (LGradient stops start end mempty spreadMethod)++-- | Make a radial gradient texture from a stop list, radius, start point,+--   end point, and 'SpreadMethod'. The 'rGradTrans' field is set to the identity+--   transfrom, to change it use the 'rGradTrans' lens.+mkRadialGradient :: Num n => [GradientStop n] -> Point V2 n -> n+                  -> Point V2 n -> n -> SpreadMethod -> Texture n+mkRadialGradient stops c0 r0 c1 r1 spreadMethod+  = RG (RGradient stops c0 r0 c1 r1 mempty spreadMethod)++-- Line Texture --------------------------------------------------------++-- | The texture with which lines are drawn.  Note that child+--   textures always override parent textures.+--   More precisely, the semigroup structure on line texture attributes+--   is that of 'Last'.+newtype LineTexture n = LineTexture (Last (Texture n))+  deriving (Typeable, Semigroup)+instance (Typeable n) => AttributeClass (LineTexture n)++type instance V (LineTexture n) = V2+type instance N (LineTexture n) = n++_LineTexture :: Iso (LineTexture n) (LineTexture n')+                    (Texture n)     (Texture n')+_LineTexture = iso getLineTexture (LineTexture . Last)++-- Only gradients get transformed. The transform is applied to the gradients+-- transform field. Colors are left unchanged.+instance Floating n => Transformable (LineTexture n) where+  transform t (LineTexture (Last tx)) = LineTexture (Last $ transform t tx)++instance Default (LineTexture n) where+  def = _LineTexture . _SC ## SomeColor black++mkLineTexture :: Texture n -> LineTexture n+mkLineTexture = LineTexture . Last++getLineTexture :: LineTexture n -> Texture n+getLineTexture (LineTexture (Last t)) = t++lineTexture :: (InSpace V2 n a, Typeable n, Floating n, HasStyle a) => Texture n -> a -> a+lineTexture = applyTAttr . LineTexture . Last++lineTextureA :: (InSpace V2 n a, Typeable n, Floating n, HasStyle a) => LineTexture n -> a -> a+lineTextureA = applyTAttr++_lineTexture :: (Floating n, Typeable n) => Lens' (Style V2 n) (Texture n)+_lineTexture = atTAttr . anon def isDef . _LineTexture+  where+    isDef = anyOf (_LineTexture . _AC) (== opaque black)++-- | Set the line (stroke) color.  This function is polymorphic in the+--   color type (so it can be used with either 'Colour' or+--   'AlphaColour'), but this can sometimes create problems for type+--   inference, so the 'lc' and 'lcA' variants are provided with more+--   concrete types.+lineColor :: (InSpace V2 n a, Color c, Typeable n, Floating n, HasStyle a) => c -> a -> a+lineColor = lineTexture . SC . SomeColor++-- | A synonym for 'lineColor', specialized to @'Colour' Double@+--   (i.e. opaque colors).  See comment in 'lineColor' about backends.+lc :: (InSpace V2 n a, Typeable n, Floating n, HasStyle a) => Colour Double -> a -> a+lc = lineColor++-- | A synonym for 'lineColor', specialized to @'AlphaColour' Double@+--   (i.e. colors with transparency).  See comment in 'lineColor'+--   about backends.+lcA :: (InSpace V2 n a, Typeable n, Floating n, HasStyle a) => AlphaColour Double -> a -> a+lcA = lineColor++-- | Apply a linear gradient.+lineLGradient :: (InSpace V2 n a, Typeable n, Floating n, HasStyle a) => LGradient n -> a -> a+lineLGradient g = lineTexture (LG g)++-- | Apply a radial gradient.+lineRGradient :: (InSpace V2 n a, Typeable n, Floating n, HasStyle a) => RGradient n -> a -> a+lineRGradient g = lineTexture (RG g)++-- Fill Texture --------------------------------------------------------++-- | The texture with which objects are filled.+--   The semigroup structure on fill texture attributes+--   is that of 'Recommed . Last'.+newtype FillTexture n = FillTexture (Recommend (Last (Texture n)))+  deriving (Typeable, Semigroup)++instance Typeable n => AttributeClass (FillTexture n)++_FillTexture :: Iso' (FillTexture n) (Recommend (Texture n))+_FillTexture = iso getter setter+  where+    getter (FillTexture (Recommend (Last t))) = Recommend t+    getter (FillTexture (Commit    (Last t))) = Commit t+    setter (Recommend t) = FillTexture (Recommend (Last t))+    setter (Commit t)    = FillTexture (Commit (Last t))+  -- = iso (\(FillTexture a) -> a) FillTexture . mapping _Wrapped+  -- -- once we depend on monoid-extras-0.4++type instance V (FillTexture n) = V2+type instance N (FillTexture n) = n++-- Only gradients get transformed. The transform is applied to the gradients+-- transform field. Colors are left unchanged.+instance Floating n => Transformable (FillTexture n) where+  transform = over (_FillTexture . _recommend) . transform++instance Default (FillTexture n) where+  def = mkFillTexture $ _AC ## transparent++getFillTexture :: FillTexture n -> Texture n+getFillTexture (FillTexture tx) = getLast . getRecommend $ tx++fillTexture :: (InSpace V2 n a, Typeable n, Floating n, HasStyle a) => Texture n -> a -> a+fillTexture = applyTAttr . mkFillTexture++mkFillTexture :: Texture n -> FillTexture n+mkFillTexture = FillTexture . Commit . Last++-- | Lens onto the 'Recommend' of a fill texture in a style.+_fillTextureR :: (Typeable n, Floating n) => Lens' (Style V2 n) (Recommend (Texture n))+_fillTextureR = atTAttr . anon def isDef . _FillTexture+  where+    isDef = anyOf (_FillTexture . _Recommend . _AC) (== transparent)++-- | Commit a fill texture in a style. This is /not/ a valid setter+--   because it doesn't abide the functor law (see 'committed').+_fillTexture :: (Typeable n, Floating n) => Lens' (Style V2 n) (Texture n)+_fillTexture = _fillTextureR . committed++-- | Set the fill color.  This function is polymorphic in the color+--   type (so it can be used with either 'Colour' or 'AlphaColour'),+--   but this can sometimes create problems for type inference, so the+--   'fc' and 'fcA' variants are provided with more concrete types.+fillColor :: (InSpace V2 n a, Color c, Typeable n, Floating n, HasStyle a) => c -> a -> a+fillColor = fillTexture . SC . SomeColor++-- | Set a \"recommended\" fill color, to be used only if no explicit+--   calls to 'fillColor' (or 'fc', or 'fcA') are used.+--   See comment after 'fillColor' about backends.+recommendFillColor :: (InSpace V2 n a, Color c, Typeable n, Floating n, HasStyle a) => c -> a -> a+recommendFillColor =+  applyTAttr . FillTexture . Recommend . Last . SC . SomeColor++-- | A synonym for 'fillColor', specialized to @'Colour' Double@+--   (i.e. opaque colors). See comment after 'fillColor' about backends.+fc :: (InSpace V2 n a, Floating n, Typeable n, HasStyle a) => Colour Double -> a -> a+fc = fillColor++-- | A synonym for 'fillColor', specialized to @'AlphaColour' Double@+--   (i.e. colors with transparency). See comment after 'fillColor' about backends.+fcA :: (InSpace V2 n a, Floating n, Typeable n, HasStyle a) => AlphaColour Double -> a -> a+fcA = fillColor++-- Split fills ---------------------------------------------------------++data FillTextureLoops n = FillTextureLoops++instance Typeable n => SplitAttribute (FillTextureLoops n) where+  type AttrType (FillTextureLoops n) = FillTexture n+  type PrimType (FillTextureLoops n) = Path V2 n++  primOK _ = all (isLoop . unLoc) . pathTrails++-- | Push fill attributes down until they are at the root of subtrees+--   containing only loops. This makes life much easier for backends,+--   which typically have a semantics where fill attributes are+--   applied to lines/non-closed paths as well as loops/closed paths,+--   whereas in the semantics of diagrams, fill attributes only apply+--   to loops.+splitTextureFills+  :: forall b v n a. (+                     Typeable n) => RTree b v n a -> RTree b v n a+splitTextureFills = splitAttr (FillTextureLoops :: FillTextureLoops n)

src/Diagrams/TwoD/Combinators.hs view

@@ -1,7 +1,12 @@+{-# LANGUAGE ConstraintKinds       #-} {-# LANGUAGE FlexibleContexts      #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables   #-} {-# LANGUAGE TypeFamilies          #-}-{-# LANGUAGE ViewPatterns          #-}++{-# OPTIONS_GHC -fno-warn-unused-imports #-}+  -- for Data.Semigroup+ ----------------------------------------------------------------------------- -- | -- Module      :  Diagrams.TwoD.Combinators@@ -18,11 +23,11 @@     (       -- * Binary combinators -      (===), (|||), atAngle+      (===), (|||)        -- * n-ary combinators-    , hcat, hcat'-    , vcat, vcat'+    , hcat, hcat', hsep+    , vcat, vcat', vsep        -- * Spacing/envelopes     , strutR2@@ -31,36 +36,38 @@      , extrudeLeft, extrudeRight, extrudeBottom, extrudeTop -    , view+    , rectEnvelope, crop -    , boundingRect, bg+    , boundingRect, bg, bgFrame      ) where -import           Data.AffineSpace+import           Control.Lens             ((&), (.~)) import           Data.Colour-import           Data.Default.Class+import           Data.Default import           Data.Semigroup-import           Data.VectorSpace  import           Diagrams.Core -import           Diagrams.Attributes     (fc, lw)+import           Diagrams.Attributes      (lwO) import           Diagrams.BoundingBox import           Diagrams.Combinators-import           Diagrams.Coordinates import           Diagrams.Path+import           Diagrams.Query           (value) import           Diagrams.Segment import           Diagrams.TrailLike import           Diagrams.TwoD.Align-import           Diagrams.TwoD.Path      ()-import           Diagrams.TwoD.Segment+import           Diagrams.TwoD.Attributes (fc)+import           Diagrams.TwoD.Path       () import           Diagrams.TwoD.Shapes-import           Diagrams.TwoD.Transform (scaleX, scaleY)+import           Diagrams.TwoD.Transform  (scaleX, scaleY) import           Diagrams.TwoD.Types-import           Diagrams.TwoD.Vector    (fromDirection, unitX, unitY)-import           Diagrams.Util           (( # ))+import           Diagrams.TwoD.Vector+import           Diagrams.Util            (( # )) +import           Linear.Affine+import           Linear.Metric+import           Linear.Vector  infixl 6 === infixl 6 |||@@ -79,26 +86,18 @@ --   combined diagram is the same as the local origin of the first. --   @(===)@ is associative and has 'mempty' as an identity.  See the --   documentation of 'beside' for more information.-(===) :: (Juxtaposable a, V a ~ R2, Semigroup a) => a -> a -> a-(===) = beside (negateV unitY)+(===) :: (InSpace V2 n a, Juxtaposable a, Semigroup a) => a -> a -> a+(===) = beside unit_Y  -- | Place two diagrams (or other juxtaposable objects) horizontally --   adjacent to one another, with the first diagram to the left of --   the second.  The local origin of the resulting combined diagram---   is the same as the local origin of the first.  @(===)@ is+--   is the same as the local origin of the first.  @(|||)@ is --   associative and has 'mempty' as an identity.  See the --   documentation of 'beside' for more information.-(|||) :: (Juxtaposable a, V a ~ R2, Semigroup a) => a -> a -> a+(|||) :: (InSpace V2 n a, Juxtaposable a, Semigroup a) => a -> a -> a (|||) = beside unitX --- | Place two diagrams (or other juxtaposable objects) adjacent to one---   another, with the second diagram placed along a line at angle---   'th' from the first.  The local origin of the resulting combined---   diagram is the same as the local origin of the first.---   See the documentation of 'beside' for more information.-atAngle :: (Juxtaposable a, V a ~ R2, Semigroup a, Angle b) => b -> a -> a -> a-atAngle th = beside (fromDirection th)- -- | Lay out a list of juxtaposable objects in a row from left to right, --   so that their local origins lie along a single horizontal line, --   with successive envelopes tangent to one another.@@ -110,17 +109,24 @@ --     "Diagrams.TwoD.Align" before applying 'hcat'. -- --   * For non-axis-aligned layout, see 'cat'.-hcat :: (Juxtaposable a, HasOrigin a, Monoid' a, V a ~ R2)+hcat :: (InSpace V2 n a, Floating n, Juxtaposable a, HasOrigin a, Monoid' a)      => [a] -> a hcat = hcat' def  -- | A variant of 'hcat' taking an extra 'CatOpts' record to control --   the spacing.  See the 'cat'' documentation for a description of---   the possibilities.-hcat' :: (Juxtaposable a, HasOrigin a, Monoid' a, V a ~ R2)-      => CatOpts R2 -> [a] -> a+--   the possibilities. For the common case of setting just a+--   separation amount, see 'hsep'.+hcat' :: (InSpace V2 n a, Floating n, Juxtaposable a, HasOrigin a, Monoid' a)+      => CatOpts n -> [a] -> a hcat' = cat' unitX +-- | A convenient synonym for horizontal concatenation with+--   separation: @hsep s === hcat' (with & sep .~ s)@.+hsep :: (InSpace V2 n a, Floating n, Juxtaposable a, HasOrigin a, Monoid' a)+     => n -> [a] -> a+hsep s = hcat' (def & sep .~ s)+ -- | Lay out a list of juxtaposable objects in a column from top to --   bottom, so that their local origins lie along a single vertical --   line, with successive envelopes tangent to one another.@@ -132,24 +138,31 @@ --     "Diagrams.TwoD.Align" before applying 'vcat'. -- --   * For non-axis-aligned layout, see 'cat'.-vcat :: (Juxtaposable a, HasOrigin a, Monoid' a, V a ~ R2)+vcat :: (InSpace V2 n a, Floating n, Juxtaposable a, HasOrigin a, Monoid' a)      => [a] -> a vcat = vcat' def  -- | A variant of 'vcat' taking an extra 'CatOpts' record to control---   the spacing.  See the 'cat'' documentation for a description of the---   possibilities.-vcat' :: (Juxtaposable a, HasOrigin a, Monoid' a, V a ~ R2)-      => CatOpts R2 -> [a] -> a-vcat' = cat' (negateV unitY)+--   the spacing.  See the 'cat'' documentation for a description of+--   the possibilities.  For the common case of setting just a+--   separation amount, see 'vsep'.+vcat' :: (InSpace V2 n a, Floating n, Juxtaposable a, HasOrigin a, Monoid' a)+      => CatOpts n -> [a] -> a+vcat' = cat' unit_Y +-- | A convenient synonym for vertical concatenation with+--   separation: @vsep s === vcat' (with & sep .~ s)@.+vsep :: (InSpace V2 n a, Floating n, Juxtaposable a, HasOrigin a, Monoid' a)+     => n -> [a] -> a+vsep s = vcat' (def & sep .~ s)+ -- | @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 :: (RealFloat n, Monoid' m) => V2 n -> QDiagram b V2 n m strutR2 v = phantom seg   where     seg = FLinear (origin .+^ 0.5 *^ v) (origin .+^ (-0.5) *^ v)@@ -157,14 +170,14 @@ -- | @strutX w@ is an empty diagram with width @w@, 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 (d & 0)+strutX :: (Metric v, R1 v, OrderedField n) => n -> QDiagram b v n m+strutX d = strut (zero & _x .~ d)  -- | @strutY h@ is an empty diagram with height @h@, width 0, and a --   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 (0 & d)+strutY :: (Metric v, R2 v, OrderedField n) => n -> QDiagram b v n m+strutY d = strut (zero & _y .~ d)  -- | @padX s@ \"pads\" a diagram in the x-direction, expanding its --   envelope horizontally by a factor of @s@ (factors between 0 and 1@@ -173,8 +186,8 @@ --   centered horizontally the padding may appear \"uneven\".  If this --   is not desired, the origin can be centered (using 'centerX') --   before applying @padX@.-padX :: ( Backend b R2, Monoid' m )-     => Double -> QDiagram b R2 m -> QDiagram b R2 m+padX :: (Metric v, R2 v, OrderedField n, Monoid' m)+     => n -> QDiagram b v n m -> QDiagram b v n m padX s d = withEnvelope (d # scaleX s) d  -- | @padY s@ \"pads\" a diagram in the y-direction, expanding its@@ -184,8 +197,8 @@ --   so if the origin is not centered vertically the padding may appear --   \"uneven\".  If this is not desired, the origin can be centered --   (using 'centerY') before applying @padY@.-padY :: ( Backend b R2, Monoid' m )-     => Double -> QDiagram b R2 m -> QDiagram b R2 m+padY :: (Metric v, R2 v, Monoid' m, OrderedField n)+     => n -> QDiagram b v n m -> QDiagram b v n m padY s d = withEnvelope (d # scaleY s) d  -- | @extrudeLeft s@ \"extrudes\" a diagram in the negative x-direction,@@ -193,6 +206,7 @@ --   the envelope is inset instead. -- --   See the documentation for 'extrudeEnvelope' for more information.+extrudeLeft :: (OrderedField n, Monoid' m) => n -> QDiagram b V2 n m -> QDiagram b V2 n m extrudeLeft s   | s >= 0    = extrudeEnvelope $ unitX ^* negate s   | otherwise = intrudeEnvelope $ unitX ^* negate s@@ -202,6 +216,7 @@ --   the envelope is inset instead. -- --   See the documentation for 'extrudeEnvelope' for more information.+extrudeRight :: (OrderedField n, Monoid' m) => n -> QDiagram b V2 n m -> QDiagram b V2 n m extrudeRight s   | s >= 0    = extrudeEnvelope $ unitX ^* s   | otherwise = intrudeEnvelope $ unitX ^* s@@ -211,6 +226,7 @@ --   the envelope is inset instead. -- --   See the documentation for 'extrudeEnvelope' for more information.+extrudeBottom :: (OrderedField n, Monoid' m) => n -> QDiagram b V2 n m -> QDiagram b V2 n m extrudeBottom s   | s >= 0    = extrudeEnvelope $ unitY ^* negate s   | otherwise = intrudeEnvelope $ unitY ^* negate s@@ -220,28 +236,44 @@ --   the envelope is inset instead. -- --   See the documentation for 'extrudeEnvelope' for more information.+extrudeTop :: (OrderedField n, Monoid' m) => n -> QDiagram b V2 n m -> QDiagram b V2 n m extrudeTop s   | s >= 0    = extrudeEnvelope $ unitY ^* s   | otherwise = intrudeEnvelope $ unitY ^* s --- | @view p v@ sets the envelope of a diagram to a rectangle whose+-- | @rectEnvelope 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 --   diagram which should actually be \"viewed\" in the final render, --   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 (coords -> w :& h) = withEnvelope (rect w h # alignBL # moveTo p :: D R2)+rectEnvelope :: forall b n m. (OrderedField n, Monoid' m)+     => Point V2 n -> V2 n -> QDiagram b V2 n m -> QDiagram b V2 n m+rectEnvelope p (V2 w h) = withEnvelope (rect w h # alignBL # moveTo p :: Path V2 n) +-- | A synonym for 'rectEnvelope'.+crop :: forall b n m. (OrderedField n, Monoid' m)+     => Point V2 n -> V2 n -> QDiagram b V2 n m -> QDiagram b V2 n m+crop = rectEnvelope+ -- | Construct a bounding rectangle for an enveloped object, that is, --   the smallest axis-aligned rectangle which encloses the object.-boundingRect :: ( Enveloped t, Transformable t, TrailLike t, Monoid t, V t ~ R2-                , Enveloped a, V a ~ R2-                )+boundingRect :: ( InSpace V2 n a, SameSpace a t+                , Enveloped t, Transformable t, TrailLike t, Monoid t+                , Enveloped a)              => a -> t 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+--   The background does not change the result of queries.+bg :: (TypeableFloat n, Renderable (Path V2 n) b, Monoid' q)+    => Colour Double -> QDiagram b V2 n q -> QDiagram b V2 n q+bg c d = d <> boundingRect d # lwO 0 # fc c # value mempty++-- | Similar to 'bg' but makes the colored background rectangle larger than+--   the diagram. The first parameter is used to set how far the background+--   extends beyond the diagram.+--   The background does not change the result of queries.+bgFrame :: (TypeableFloat n, Renderable (Path V2 n) b, Monoid' q)+    => n -> Colour Double -> QDiagram b V2 n q -> QDiagram b V2 n q+bgFrame f c d = d <> boundingRect (frame f d) # lwO 0 # fc c # value mempty

src/Diagrams/TwoD/Curvature.hs view

@@ -19,19 +19,16 @@     , squaredRadiusOfCurvature     ) where -import           Data.AffineSpace+import           Control.Lens        (over)+import           Control.Monad import           Data.Monoid.Inf-import           Data.VectorSpace -import           Control.Arrow        (first, second)-import           Control.Monad        (join)--import           Diagrams.Core- import           Diagrams.Segment+import           Diagrams.Tangent import           Diagrams.TwoD.Types-import           Diagrams.TwoD.Vector +import           Linear.Vector+ -- | Curvature measures how curved the segment is at a point.  One intuition -- for the concept is how much you would turn the wheel when driving a car -- along the curve.  When the wheel is held straight there is zero curvature.@@ -51,19 +48,19 @@ -- -- Lets consider the following curve: ----- <<diagrams/diagramA.svg#diagram=diagramA&height=200&width=400>>+-- <<diagrams/src_Diagrams_TwoD_Curvature_diagramA.svg#diagram=diagramA&height=200&width=400>> -- -- The curve starts with positive curvature, ----- <<diagrams/diagramPos.svg#diagram=diagramPos&height=200&width=400>>+-- <<diagrams/src_Diagrams_TwoD_Curvature_diagramPos.svg#diagram=diagramPos&height=200&width=400>> -- -- approaches zero curvature ----- <<diagrams/diagramZero.svg#diagram=diagramZero&height=200&width=400>>+-- <<diagrams/src_Diagrams_TwoD_Curvature_diagramZero.svg#diagram=diagramZero&height=200&width=400>> -- -- then has negative curvature ----- <<diagrams/diagramNeg.svg#diagram=diagramNeg&height=200&width=400>>+-- <<diagrams/src_Diagrams_TwoD_Curvature_diagramNeg.svg#diagram=diagramNeg&height=200&width=400>> -- -- > {-# LANGUAGE GADTs #-} -- >@@ -71,70 +68,72 @@ -- > import Data.Monoid.Inf -- > import Diagrams.Coordinates -- >--- > segmentA = Cubic (12 & 0) (8 & 10) (OffsetClosed (20 & 8))+-- > segmentA :: Segment Closed V2 Double+-- > segmentA = Cubic (12 ^& 0) (8 ^& 10) (OffsetClosed (20 ^& 8)) -- >--- > curveA = lw 0.1 . stroke . fromSegments $ [segmentA]+-- > curveA = lw thick . strokeP . fromSegments $ [segmentA] -- > -- > diagramA = pad 1.1 . centerXY $ curveA -- > -- > diagramPos = diagramWithRadius 0.2 -- >--- > diagramZero = diagramWithRadius 0.5+-- > diagramZero = diagramWithRadius 0.45 -- > -- > diagramNeg = diagramWithRadius 0.8 -- > -- > diagramWithRadius t = pad 1.1 . centerXY -- >          $ curveA -- >         <> showCurvature segmentA t--- >          # withEnvelope (curveA :: D R2)--- >          # lw 0.05 # lc red+-- >          # withEnvelope (curveA :: D V2 Double)+-- >          # lc red -- >+-- > showCurvature :: Segment Closed V2 Double -> Double -> Diagram SVG -- > showCurvature bez@(Cubic b c (OffsetClosed d)) t--- >   | v == 0    = mempty--- >   | otherwise = go (radiusOfCurvature bez t)+-- >   | v == (0,0) = mempty+-- >   | otherwise  = go (radiusOfCurvature bez t) -- >   where -- >     v@(x,y) = unr2 $ firstDerivative b c d t--- >     vp = (-y) & x+-- >     vp = (-y) ^& x -- > -- >     firstDerivative b c d t = let tt = t*t in (3*(3*tt-4*t+1))*^b + (3*(2-3*t)*t)*^c + (3*tt)*^d -- > -- >     go Infinity   = mempty -- >     go (Finite r) = (circle (abs r) # translate vpr--- >                  <> stroke (origin ~~ (origin .+^ vpr)))+-- >                  <> strokeP (origin ~~ (origin .+^ vpr))) -- >                   # moveTo (origin .+^ atParam bez t) -- >       where--- >         vpr = r2 (normalized vp ^* r)+-- >         vpr = signorm vp ^* r -- > ---curvature :: Segment Closed R2  -- ^ Segment to measure on.-          -> Double           -- ^ Parameter to measure at.-          -> PosInf Double    -- ^ Result is a @PosInf@ value where @PosInfty@ represents-                              -- infinite curvature or zero radius of curvature.-curvature s = toPosInf . second sqrt . curvaturePair (fmap unr2 s) -- TODO: Use the generalized unr2+curvature :: RealFloat n+          => Segment Closed V2 n  -- ^ Segment to measure on.+          -> n                    -- ^ Parameter to measure at.+          -> PosInf n             -- ^ Result is a @PosInf@ value where @PosInfty@ represents+                                  --   infinite curvature or zero radius of curvature.+curvature s = toPosInf . over _y sqrt . curvaturePair s  -- | With @squaredCurvature@ we can compute values in spaces that do not support -- 'sqrt' and it is just as useful for relative ordering of curvatures or looking -- for zeros.-squaredCurvature :: Segment Closed R2 -> Double -> PosInf Double-squaredCurvature s = toPosInf . first (join (*)) . curvaturePair (fmap unr2 s) -- TODO: Use the generalized unr2-+squaredCurvature :: RealFloat n => Segment Closed V2 n -> n -> PosInf n+squaredCurvature s = toPosInf . over _x (join (*)) . curvaturePair s  -- | Reciprocal of @curvature@.-radiusOfCurvature :: Segment Closed R2  -- ^ Segment to measure on.-                  -> Double           -- ^ Parameter to measure at.-                  -> PosInf Double    -- ^ Result is a @PosInf@ value where @PosInfty@ represents-                                      -- infinite radius of curvature or zero curvature.-radiusOfCurvature s = toPosInf . (\(p,q) -> (q,p)) . second sqrt . curvaturePair (fmap unr2 s)+radiusOfCurvature :: RealFloat n+                  => Segment Closed V2 n -- ^ Segment to measure on.+                  -> n                   -- ^ Parameter to measure at.+                  -> PosInf n            -- ^ Result is a @PosInf@ value where @PosInfty@ represents+                                         --   infinite radius of curvature or zero curvature.+radiusOfCurvature s = toPosInf . (\(V2 p q) -> V2 (sqrt q) p) . curvaturePair s  -- | Reciprocal of @squaredCurvature@-squaredRadiusOfCurvature :: Segment Closed R2 -> Double -> PosInf Double-squaredRadiusOfCurvature s = toPosInf . (\(p,q) -> (q,p)) . first (join (*)) . curvaturePair (fmap unr2 s)-+squaredRadiusOfCurvature :: RealFloat n => Segment Closed V2 n -> n -> PosInf n+squaredRadiusOfCurvature s = toPosInf . (\(V2 p q) -> (V2 q (p * p))) . curvaturePair s  -- Package up problematic values with the appropriate infinity.-toPosInf :: RealFloat a => (a,a) -> PosInf a-toPosInf (_,0) = Infinity-toPosInf (p,q)+toPosInf :: RealFloat a => V2 a -> PosInf a+toPosInf (V2 _ 0) = Infinity+toPosInf (V2 p q)   | isInfinite r || isNaN r = Infinity   | otherwise               = Finite r   where r = p / q@@ -142,22 +141,26 @@ -- Internal function that is not quite curvature or squaredCurvature but lets -- us get there by either taking the square root of the numerator or squaring -- the denominator respectively.-curvaturePair :: (Num t, Num (Scalar t), VectorSpace t)-    => Segment Closed (t, t) -> Scalar t -> (t, t)-curvaturePair (Linear _)    t = (0,1) -- Linear segments always have zero curvature (infinite radius).-curvaturePair (Cubic b c (OffsetClosed d)) t = ((x'*y'' - y'*x''), (x'*x' + y'*y')^(3 :: Integer))+curvaturePair :: Num n+    => Segment Closed V2 n -> n -> V2 n+curvaturePair (Linear _) _ = V2 0 1 -- Linear segments always have zero curvature (infinite radius).+curvaturePair seg@(Cubic b c (OffsetClosed d)) t+  = V2 (x'*y'' - y'*x'') ((x'*x' + y'*y')^(3 :: Int))   where-    (x' ,y' ) = firstDerivative  b c d t -- TODO: Use the generalized unr2-    (x'',y'') = secondDerivative b c d t--    firstDerivative b c d t = (3*(3*tt-4*t+1))*^b + (3*(2-3*t)*t)*^c + (3*tt)*^d-      where-        tt = t * t--    secondDerivative b c d t = (6*(3*t-2))*^b + (6-18*t)*^c + (6*t)*^d+    (V2 x'  y' )     = seg `tangentAtParam` t+    (V2 x'' y'')     = secondDerivative+    secondDerivative = (6*(3*t-2))*^b ^+^ (6-18*t)*^c ^+^ (6*t)*^d  -- TODO: We should be able to generalize this to higher dimensions.  See -- <http://en.wikipedia.org/wiki/Curvature> -- -- TODO: I'm not sure what the best way to generalize squaredCurvature to other spaces is. +-- curvaturePair :: (Num t, Num (Scalar t), VectorSpace t)+--     => Segment Closed (t, t) -> Scalar t -> (t, t)+-- curvaturePair (Linear _) _ = (0,1) -- Linear segments always have zero curvature (infinite radius).+-- curvaturePair seg@(Cubic b c (OffsetClosed d)) t = ((x'*y'' - y'*x''), (x'*x' + y'*y')^(3 :: Integer))+--   where+--     (x' ,y' ) = seg `tangentAtParam` t+--     (x'',y'') = secondDerivative+--     secondDerivative = (6*(3*t-2))*^b ^+^ (6-18*t)*^c ^+^ (6*t)*^d

+ src/Diagrams/TwoD/Deform.hs view

@@ -0,0 +1,41 @@+module Diagrams.TwoD.Deform where++import           Control.Lens++import           Diagrams.Deform++import           Linear.V2+import           Linear.Vector++-- | The parallel projection onto the plane x=0+parallelX0 :: (R1 v, Num n) => Deformation v v n+parallelX0 = Deformation (_x .~ 0)++-- | The perspective division onto the plane x=1 along lines going+-- through the origin.+perspectiveX1 :: (R1 v, Functor v, Fractional n) => Deformation v v n+perspectiveX1 = Deformation $ \p -> p ^/ (p ^. _x)++-- | The parallel projection onto the plane y=0+parallelY0 :: (R2 v, Num n) => Deformation v v n+parallelY0 = Deformation (_y .~ 0)++-- | The perspective division onto the plane y=1 along lines going+-- through the origin.+perspectiveY1 :: (R2 v, Functor v, Floating n) => Deformation v v n+perspectiveY1 = Deformation $ \p -> p ^/ (p ^. _y)++-- | The viewing transform for a viewer facing along the positive X+-- axis.  X coördinates stay fixed, while Y coördinates are compressed+-- with increasing distance.  @asDeformation (translation unitX) <>+-- parallelX0 <> frustrumX = perspectiveX1@+facingX :: (R1 v, Functor v, Fractional n) => Deformation v v n+facingX = Deformation $+  \p -> let x = p ^. _x+        in  p ^/ x & _x .~ x++facingY :: (R2 v, Functor v, Fractional n) => Deformation v v n+facingY = Deformation $+  \p -> let y = p ^. _y+        in  p ^/ y & _y .~ y+

src/Diagrams/TwoD/Ellipse.hs view

@@ -1,6 +1,7 @@ {-# LANGUAGE FlexibleContexts      #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeFamilies          #-}+{-# LANGUAGE TypeOperators         #-} {-# LANGUAGE TypeSynonymInstances  #-} ----------------------------------------------------------------------------- -- |@@ -24,27 +25,29 @@  import           Diagrams.Core +import           Diagrams.Angle import           Diagrams.Located        (at)-import           Diagrams.Path+import           Diagrams.Trail          (glueTrail) import           Diagrams.TrailLike import           Diagrams.TwoD.Arc import           Diagrams.TwoD.Transform import           Diagrams.TwoD.Types+import           Diagrams.TwoD.Vector    (xDir) import           Diagrams.Util  -- | A circle of radius 1, with center at the origin.-unitCircle :: (TrailLike t, V t ~ R2) => t-unitCircle = trailLike $ arcT 0 (tau::Rad) `at` (p2 (1,0))+unitCircle :: (TrailLike t, V t ~ V2, N t ~ n) => t+unitCircle = trailLike $ glueTrail (arcT xDir fullTurn) `at` p2 (1,0)  -- | A circle of the given radius, centered at the origin.  As a path, --   it begins at (r,0).-circle :: (TrailLike t, V t ~ R2, Transformable t) => Double -> t+circle :: (TrailLike t, V t ~ V2, N t ~ n, Transformable t) => n -> t circle d = unitCircle # scale d  -- | @ellipse e@ constructs an ellipse with eccentricity @e@ by --   scaling the unit circle in the X direction.  The eccentricity must --   be within the interval [0,1).-ellipse :: (TrailLike t, V t ~ R2, Transformable t) => Double -> t+ellipse :: (TrailLike t, V t ~ V2, N t ~ n, Transformable t) => n -> t ellipse e     | e >= 0 && e < 1  = scaleX (sqrt (1 - e*e)) unitCircle     | otherwise        = error "Eccentricity of ellipse must be >= 0 and < 1."@@ -52,5 +55,5 @@ -- | @ellipseXY x y@ creates an axis-aligned ellipse, centered at the --   origin, with radius @x@ along the x-axis and radius @y@ along the --   y-axis.-ellipseXY :: (TrailLike t, V t ~ R2, Transformable t) => Double -> Double -> t+ellipseXY :: (TrailLike t, V t ~ V2, N t ~ n, Transformable t) => n -> n -> t ellipseXY x y = unitCircle # scaleX x # scaleY y

src/Diagrams/TwoD/Image.hs view

@@ -1,7 +1,12 @@-{-# LANGUAGE TypeFamilies-           , FlexibleContexts-           , MultiParamTypeClasses-  #-}+{-# LANGUAGE ConstraintKinds       #-}+{-# LANGUAGE DeriveDataTypeable    #-}+{-# LANGUAGE EmptyDataDecls        #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE GADTs                 #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies          #-}+{-# LANGUAGE UndecidableInstances  #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  Diagrams.TwoD.Image@@ -9,73 +14,155 @@ -- License     :  BSD-style (see LICENSE) -- Maintainer  :  diagrams-discuss@googlegroups.com ----- Importing external images into diagrams.---+-- Importing external images into diagrams.  Usage example: To create+-- a diagram from an embedded image with width 1 and height set+-- according to the aspect ratio, use @image img # scaleUToX 1@, where+-- @img@ is a value of type @DImage n e@, created with a function like+-- 'loadImageEmb', 'loadImageExt', or 'raster'. -----------------------------------------------------------------------------  module Diagrams.TwoD.Image     (-      Image(..)+      DImage(..), ImageData(..)+    , Embedded, External, Native     , image+    , embeddedImage+    , loadImageEmb+    , loadImageEmbBS+    , loadImageExt+    , uncheckedImageRef+    , raster+    , rasterDia     ) where -import Diagrams.Core+import           Codec.Picture -import Diagrams.Path-import Diagrams.TwoD.Types-import Diagrams.TwoD.Path-import Diagrams.TwoD.Shapes-import Diagrams.TwoD.Size (SizeSpec2D(..))+import           Data.Colour          (AlphaColour)+import           Data.Kind            (Type)+import           Data.Semigroup+import           Data.Typeable        (Typeable) -import Data.AffineSpace ((.-.))+import           Diagrams.Core -import Data.Semigroup+import           Diagrams.Attributes  (colorToSRGBA)+import           Diagrams.Path        (Path)+import           Diagrams.Query+import           Diagrams.TwoD.Path   (isInsideEvenOdd)+import           Diagrams.TwoD.Shapes (rect)+import           Diagrams.TwoD.Types --- | An external image primitive, representing an image the backend---   should import from another file when rendering.-data Image = Image { imgFile   :: FilePath-                   , imgSize   :: SizeSpec2D-                   , imgTransf :: T2-                   }+import           Data.ByteString -type instance V Image = R2+import           Linear.Affine -instance Transformable Image where-  transform t1 (Image file sz t2) = Image file sz (t1 <> t2)+data Embedded deriving Typeable+data External deriving Typeable+data Native (t :: Type) deriving Typeable -instance IsPrim Image+-- | 'ImageData' is either a JuicyPixels @DynamicImage@ tagged as 'Embedded' or+--   a reference tagged as 'External'. Additionally 'Native' is provided for+--   external libraries to hook into.+data ImageData :: Type -> Type where+  ImageRaster :: DynamicImage -> ImageData Embedded+  ImageRef    :: FilePath -> ImageData External+  ImageNative :: t -> ImageData (Native t) -instance HasOrigin Image where+-------------------------------------------------------------------------------+-- | An image primitive, the two ints are width followed by height.+--   Will typically be created by @loadImageEmb@ or @loadImageExt@ which,+--   will handle setting the width and height to the actual width and height+--   of the image.+data DImage :: Type -> Type -> Type where+  DImage :: ImageData t -> Int -> Int -> Transformation V2 n -> DImage n t+  deriving Typeable++type instance V (DImage n a) = V2+type instance N (DImage n a) = n++instance RealFloat n => HasQuery (DImage n a) Any where+  getQuery (DImage _ w h _) = -- transform t $+    Query $ \p -> Any (isInsideEvenOdd r p)+    where+    r = rectPath (fromIntegral w) (fromIntegral h)++instance Fractional n => Transformable (DImage n a) where+  transform t1 (DImage iD w h t2) = DImage iD w h (t1 <> t2)++instance Fractional n => HasOrigin (DImage n a) where   moveOriginTo p = translate (origin .-. p) -instance Renderable Image NullBackend where-  render _ _ = mempty+-- | Make a 'DImage' into a 'Diagram'.+image :: (TypeableFloat n, Typeable a, Renderable (DImage n a) b)+      => DImage n a -> QDiagram b V2 n Any+image img+  = mkQD (Prim img)+         (getEnvelope r)+         (getTrace r)+         mempty+         (Query $ \p -> Any (isInsideEvenOdd r p))+  where+    r = rectPath (fromIntegral w) (fromIntegral h)+    -- should we use the transform here?+    DImage _ w h _ = img --- See Note [Image size specification]+rectPath :: RealFloat n => n -> n -> Path V2 n+rectPath = rect --- | Take an external image from the specified file and turn it into a---   diagram with the specified width and height, centered at the---   origin.  Note that the image's aspect ratio will be preserved; if---   the specified width and height have a different ratio than the---   image's aspect ratio, there will be extra space in one dimension.-image :: (Renderable Image b) => FilePath -> Double -> Double -> Diagram b R2-image file w h = mkQD (Prim (Image file (Dims w h) mempty))-                      (getEnvelope r)-                      (getTrace r)-                      mempty-                      (Query $ \p -> Any (isInsideEvenOdd p r))-  where r :: Path R2-        r = rect w h+-- | Read a JuicyPixels @DynamicImage@ and wrap it in a 'DImage'.+--   The width and height of the image are set to their actual values.+embeddedImage :: Num n => DynamicImage -> DImage n Embedded+embeddedImage img = DImage (ImageRaster img) w h mempty+  where+    w = dynamicMap imageWidth img+    h = dynamicMap imageHeight img -{- ~~~~ Note [Image size specification]+-- | Use JuicyPixels to read a file in any format and wrap it in a 'DImage'.+--   The width and height of the image are set to their actual values.+loadImageEmb :: Num n => FilePath -> IO (Either String (DImage n Embedded))+loadImageEmb path = fmap embeddedImage `fmap` readImage path -It's tempting to make 'image' take a SizeSpec2D instead of two-Doubles.  For example, if I know I want the image to be x units wide-but I don't know the original aspect ratio of the image, I'd like to-be able to just say "make it x units wide".  The problem is that-diagrams would then not know how tall the image is until rendering-time (at least, not without unsafePerformIO yuckiness).  A more-general solution will have to wait until we can specify constraints-and solve them later.+-- | A pure variant of 'loadImageEmb'+loadImageEmbBS :: Num n => ByteString -> Either String (DImage n Embedded)+loadImageEmbBS bs = embeddedImage `fmap` decodeImage bs --}+-- | Check that a file exists, and use JuicyPixels to figure out+--   the right size, but save a reference to the image instead+--   of the raster data+loadImageExt :: Num n => FilePath -> IO (Either String (DImage n External))+loadImageExt path = do+  dImg <- readImage path+  return $ case dImg of+    Left msg  -> Left msg+    Right img -> Right $ DImage (ImageRef path) w h mempty+      where+        w = dynamicMap imageWidth img+        h = dynamicMap imageHeight img++-- | Make an "unchecked" image reference; have to specify a+--   width and height. Unless the aspect ratio of the external+--   image is the w :: h, then the image will be distorted.+uncheckedImageRef :: Num n => FilePath -> Int -> Int -> DImage n External+uncheckedImageRef path w h = DImage (ImageRef path) w h mempty++-- | Crate a diagram from raw raster data.+rasterDia :: (TypeableFloat n, Renderable (DImage n Embedded) b)+          => (Int -> Int -> AlphaColour Double) -> Int -> Int -> QDiagram b V2 n Any+rasterDia f w h = image $ raster f w h++-- | Create an image "from scratch" by specifying the pixel data+raster :: Num n => (Int -> Int -> AlphaColour Double) -> Int -> Int -> DImage n Embedded+raster f w h = DImage (ImageRaster (ImageRGBA8 img)) w h mempty+  where+    img = generateImage g w h+    g x y = fromAlphaColour $ f x y++fromAlphaColour :: AlphaColour Double -> PixelRGBA8+fromAlphaColour c = PixelRGBA8 r g b a+  where+    (r, g, b, a) = (int r', int g', int b', int a')+    (r', g', b', a') = colorToSRGBA c+    int x = round (255 * x)++instance Fractional n => (Renderable (DImage n a) NullBackend) where+  render _ _ = mempty+

src/Diagrams/TwoD/Model.hs view

@@ -1,5 +1,8 @@+{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE FlexibleContexts      #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TemplateHaskell       #-}+{-# LANGUAGE TypeFamilies          #-} ----------------------------------------------------------------------------- -- | -- Module      :  Diagrams.TwoD.Model@@ -8,80 +11,163 @@ -- Maintainer  :  diagrams-discuss@googlegroups.com -- -- Tools for visualizing diagrams' internal model: local origins,--- envelopes, /etc./+-- envelopes, traces, /etc./ -- ----------------------------------------------------------------------------- module Diagrams.TwoD.Model        ( -- * Showing the local origin          showOrigin        , showOrigin'-       , OriginOpts(..)+       , OriginOpts(..), oColor, oScale, oMinSize++         -- * Showing an approximation of the envelope+       , showEnvelope+       , showEnvelope'+       , EnvelopeOpts(..), eColor, eLineWidth, ePoints++         -- * Showing an approximation of the trace+       , showTrace+       , showTrace'+       , TraceOpts(..), tColor, tScale, tMinSize, tPoints++         -- * Showing labels of all named subdiagrams        , showLabels        ) where +import           Control.Arrow            (second)+import           Control.Lens             (makeLenses, (^.))+import           Data.Colour              (Colour)+import           Data.Colour.Names+import           Data.Default+import           Data.List                (intercalate)+import qualified Data.Map                 as M+import           Data.Maybe               (catMaybes)+import           Data.Semigroup++import           Diagrams.Attributes+import           Diagrams.Combinators     (atPoints) import           Diagrams.Core import           Diagrams.Core.Names-+import           Diagrams.CubicSpline import           Diagrams.Path--import           Diagrams.Attributes+import           Diagrams.TwoD.Attributes import           Diagrams.TwoD.Ellipse import           Diagrams.TwoD.Path-import           Diagrams.TwoD.Size    (size2D) import           Diagrams.TwoD.Text+import           Diagrams.TwoD.Transform  (rotateBy) import           Diagrams.TwoD.Types+import           Diagrams.TwoD.Vector     (unitX) import           Diagrams.Util -import           Control.Arrow         (second)-import           Data.AffineSpace      ((.-.))-import           Data.Default.Class-import           Data.Semigroup-import           Data.VectorSpace      ((^*))--import qualified Data.Map              as M--import           Data.Colour           (Colour)-import           Data.Colour.Names+import           Linear.Affine+import           Linear.Vector  ------------------------------------------------------------ -- Marking the origin ------------------------------------------------------------ +data OriginOpts n = OriginOpts+  { _oColor   :: Colour Double+  , _oScale   :: n+  , _oMinSize :: n+  }++makeLenses ''OriginOpts++instance Fractional n => Default (OriginOpts n) where+  def = OriginOpts red (1/50) 0.001++data EnvelopeOpts n = EnvelopeOpts+  { _eColor     :: Colour Double+  , _eLineWidth :: Measure n+  , _ePoints    :: Int+  }++makeLenses ''EnvelopeOpts++instance OrderedField n => Default (EnvelopeOpts n) where+  def = EnvelopeOpts red medium 32++data TraceOpts n = TraceOpts+  { _tColor   :: Colour Double+  , _tScale   :: n+  , _tMinSize :: n+  , _tPoints  :: Int+  }++makeLenses ''TraceOpts++instance Floating n => Default (TraceOpts n) where+  def = TraceOpts red (1/100) 0.001 64+ -- | 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 :: (TypeableFloat n, Renderable (Path V2 n) b, Monoid' m)+           => QDiagram b V2 n m -> QDiagram b V2 n m showOrigin = showOrigin' def  -- | Mark the origin of a diagram, with control over colour and scale -- of marker dot.-showOrigin' :: (Renderable (Path R2) b, Backend b R2, Monoid' m)-           => OriginOpts -> QDiagram b R2 m -> QDiagram b R2 m+showOrigin' :: (TypeableFloat n, Renderable (Path V2 n) b, Monoid' m)+           => OriginOpts n -> QDiagram b V2 n m -> QDiagram b V2 n m showOrigin' oo d = o <> d-  where o     = stroke (circle sz)-                # fc (oColor oo)-                # lw 0-                # fmap (const mempty)-        (w,h) = size2D d ^* oScale oo-        sz = maximum [w, h, oMinSize oo]+  where o      = strokeP (circle sz)+                   # fc (oo^.oColor)+                   # lw none+                   # fmap (const mempty)+        V2 w h = oo^.oScale *^ size d+        sz     = maximum [w, h, oo^.oMinSize] -data OriginOpts = OriginOpts { oColor   :: Colour Double-                             , oScale   :: Double-                             , oMinSize :: Double-                             }+-- | Mark the envelope with an approximating cubic spline with control +--   over the color, line width and number of points.+showEnvelope' :: (Enum n, TypeableFloat n, Renderable (Path V2 n) b) +              => EnvelopeOpts n -> QDiagram b V2 n Any -> QDiagram b V2 n Any+showEnvelope' opts d = cubicSpline True pts # lc (opts^.eColor)+                                            # lw w <> d+  where+    pts = catMaybes [envelopePMay v d | v <- map (`rotateBy` unitX) [0,inc..top]]+    w   = opts ^. eLineWidth+    inc = 1 / fromIntegral (opts^.ePoints)+    top = 1 - inc -instance Default OriginOpts where-  def = OriginOpts red (1/50) 0.001 +-- | Mark the envelope with an approximating cubic spline+--   using 32 points, medium line width and red line color.+showEnvelope :: (Enum n, TypeableFloat n, Renderable (Path V2 n) b)+             => QDiagram b V2 n Any -> QDiagram b V2 n Any+showEnvelope = showEnvelope' def +-- | Mark the trace of a diagram, with control over colour and scale+-- of marker dot and the number of points on the trace.+showTrace' :: (Enum n, TypeableFloat n, Renderable (Path V2 n) b) +          => TraceOpts n -> QDiagram b V2 n Any -> QDiagram b V2 n Any+showTrace' opts d =  atPoints ps (repeat pt) <> d+  where+    ps = concatMap p ts+    ts = zip rs vs+    p (r, v) = [origin .+^ (s *^ v) | s <- r]+    vs = map (`rotateBy` unitX) [0, inc..top]+    rs = [getSortedList $ (appTrace . getTrace) d origin v | v <- vs]+    pt = circle sz # fc (opts^.tColor) # lw none+    V2 w h = opts^.tScale *^ size d+    sz     = maximum [w, h, opts^.tMinSize]+    inc = 1 / fromIntegral (opts^.tPoints)+    top = 1 - inc++-- | Mark the trace of a diagram by placing 64 red dots 1/100th its size+--   along the trace.+showTrace :: (Enum n, TypeableFloat n, Renderable (Path V2 n) b) +          => QDiagram b V2 n Any -> QDiagram b V2 n Any+showTrace = showTrace' def+ ------------------------------------------------------------ -- Labeling named points ------------------------------------------------------------ -showLabels :: (Renderable Text b, Backend b R2)-           => QDiagram b R2 m -> QDiagram b R2 Any+showLabels :: (TypeableFloat n, Renderable (Text n) b, Semigroup m)+           => QDiagram b V2 n m -> QDiagram b V2 n Any showLabels d =              ( mconcat-             . map (\(n,p) -> text (show n) # translate (p .-. origin))+             . map (\(n,p) -> text (simpleName n) # translate (p .-. origin))              . concatMap (\(n,ps) -> zip (repeat n) ps)              . (map . second . map) location              . M.assocs@@ -89,4 +175,6 @@              ) <>              fmap (const (Any False)) d   where-    SubMap m = subMap d+    SubMap m = d^.subMap+    simpleName (Name ns) = intercalate " .> " $ map simpleAName ns+    simpleAName (AName n) = show n

src/Diagrams/TwoD/Offset.hs view

@@ -1,43 +1,88 @@-{-# LANGUAGE GADTs #-}+{-# LANGUAGE ConstraintKinds      #-}+{-# LANGUAGE FlexibleContexts     #-}+{-# LANGUAGE GADTs                #-}+{-# LANGUAGE StandaloneDeriving   #-}+{-# LANGUAGE TemplateHaskell      #-}+{-# LANGUAGE TypeFamilies         #-}+{-# LANGUAGE TypeOperators        #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE ViewPatterns         #-}++{-# OPTIONS_GHC -fno-warn-unused-imports #-}+  -- for Data.Semigroup+ ----------------------------------------------------------------------------- -- | -- Module      :  Diagrams.TwoD.Offset--- Copyright   :  (c) 2012 diagrams-lib team (see LICENSE)+-- Copyright   :  (c) 2013 diagrams-lib team (see LICENSE) -- License     :  BSD-style (see LICENSE) -- Maintainer  :  diagrams-discuss@googlegroups.com ----- Compute offsets to segments in two dimensions.--- +-- Compute offsets to segments in two dimensions.  More details can be+-- found in the manual at+-- <https://diagrams.github.io/doc/manual.html#offsets-of-segments-trails-and-paths>.+-- ------------------------------------------------------------------------------module Diagrams.TwoD.Offset -    ( offsetSegment+module Diagrams.TwoD.Offset+    (+      -- * Offsets++      offsetSegment++    , OffsetOpts(..), offsetJoin, offsetMiterLimit, offsetEpsilon+    , offsetTrail+    , offsetTrail'+    , offsetPath+    , offsetPath'++      -- * Expansions++    , ExpandOpts(..), expandJoin, expandMiterLimit, expandCap, expandEpsilon+    , expandTrail+    , expandTrail'+    , expandPath+    , expandPath'+     ) where -import Data.AffineSpace-import Data.Monoid.Inf-import Data.VectorSpace+import           Control.Applicative+import           Control.Lens            hiding (at)+import           Prelude -import Diagrams.Core+import           Data.Maybe              (catMaybes)+import           Data.Monoid+import           Data.Monoid.Inf -import Diagrams.Parametric-import Diagrams.Path-import Diagrams.Segment-import Diagrams.Trail-import Diagrams.TwoD.Curvature-import Diagrams.TwoD.Transform-import Diagrams.TwoD.Types+import           Data.Default -perp :: R2 -> R2-perp v = rotateBy (-1/4) v+import           Diagrams.Core -unitPerp :: R2 -> R2-unitPerp = normalized . perp+import           Diagrams.Attributes+import           Diagrams.Direction+import           Diagrams.Located+import           Diagrams.Parametric+import           Diagrams.Path+import           Diagrams.Segment+import           Diagrams.Trail          hiding (isLoop, offset)+import           Diagrams.TrailLike+import           Diagrams.TwoD.Arc+import           Diagrams.TwoD.Curvature+import           Diagrams.TwoD.Path      ()+import           Diagrams.TwoD.Types+import           Diagrams.TwoD.Vector    hiding (e) -perpAtParam :: Segment Closed R2 -> Double -> R2-perpAtParam   (Linear (OffsetClosed a))  t = unitPerp a -perpAtParam s@(Cubic _ _ _)              t = unitPerp a+import           Linear.Affine+import           Linear.Metric+import           Linear.Vector++unitPerp :: OrderedField n => V2 n -> V2 n+unitPerp = signorm . perp++perpAtParam :: OrderedField n => Segment Closed V2 n -> n -> V2 n+perpAtParam (Linear (OffsetClosed a)) _ = negated $ unitPerp a+perpAtParam cubic t                     = negated $ unitPerp a   where-    (Cubic a _ _) = snd $ splitAtParam s t+    (Cubic a _ _) = snd $ splitAtParam cubic t  -- | Compute the offset of a segment.  Given a segment compute the offset --   curve that is a fixed distance from the original curve.  For linear@@ -46,7 +91,9 @@ --   length. -- --   Cubic segments require a search for a subdivision of cubic segments that---   gives an approximation of the offset within the given epsilon tolerance.+--   gives an approximation of the offset within the given epsilon factor+--   (the given epsilon factor is applied to the radius giving a concrete epsilon+--   value). --   We must do this because the offset of a cubic is not a cubic itself (the --   degree of the curve increases).  Cubics do, however, approach constant --   curvature as we subdivide.  In light of this we scale the handles of@@ -57,39 +104,100 @@ --   In the following example the blue lines are the original segments and --   the alternating green and red lines are the resulting offset trail segments. -----   <<diagrams/cubicOffsetExample.svg#diagram=cubicOffsetExample&width=600>>+--   <<diagrams/src_Diagrams_TwoD_Offset_cubicOffsetExample.svg#diagram=cubicOffsetExample&width=600>> -- --   Note that when the original curve has a cusp, the offset curve forms a --   radius around the cusp, and when there is a loop in the original curve, --   there can be two cusps in the offset curve. ---offsetSegment :: Double     -- ^ Epsilon value that represents the maximum ++-- | Options for specifying line join and segment epsilon for an offset+--   involving multiple segments.+data OffsetOpts d = OffsetOpts+    { _offsetJoin       :: LineJoin+    , _offsetMiterLimit :: d+    , _offsetEpsilon    :: d+    }++deriving instance Eq d => Eq (OffsetOpts d)+deriving instance Show d => Show (OffsetOpts d)++makeLensesWith (lensRules & generateSignatures .~ False) ''OffsetOpts++-- | Specifies the style of join for between adjacent offset segments.+offsetJoin :: Lens' (OffsetOpts d) LineJoin++-- | Specifies the miter limit for the join.+offsetMiterLimit :: Lens' (OffsetOpts d) d++-- | Epsilon perimeter for 'offsetSegment'.+offsetEpsilon :: Lens' (OffsetOpts d) d++-- | The default offset options use the default 'LineJoin' ('LineJoinMiter'), a+--   miter limit of 10, and epsilon factor of 0.01.+instance Fractional d => Default (OffsetOpts d) where+    def = OffsetOpts def 10 0.01++-- | Options for specifying how a 'Trail' should be expanded.+data ExpandOpts d = ExpandOpts+    { _expandJoin       :: LineJoin+    , _expandMiterLimit :: d+    , _expandCap        :: LineCap+    , _expandEpsilon    :: d+    } deriving (Eq, Show)++makeLensesWith (lensRules & generateSignatures .~ False) ''ExpandOpts++-- | Specifies the style of join for between adjacent offset segments.+expandJoin :: Lens' (ExpandOpts d) LineJoin++-- | Specifies the miter limit for the join.+expandMiterLimit :: Lens' (ExpandOpts d) d++-- | Specifies how the ends are handled.+expandCap :: Lens' (ExpandOpts d) LineCap++-- | Epsilon perimeter for 'offsetSegment'.+expandEpsilon :: Lens' (ExpandOpts d) d++++-- | The default 'ExpandOpts' is the default 'LineJoin' ('LineJoinMiter'),+--   miter limit of 10, default 'LineCap' ('LineCapButt'), and epsilon factor+--   of 0.01.+instance (Fractional d) => Default (ExpandOpts d) where+    def = ExpandOpts def 10 def 0.01++offsetSegment :: RealFloat n+              => n   -- ^ Epsilon factor that when multiplied to the+                            --   absolute value of the radius gives a+                            --   value that represents the maximum                             --   allowed deviation from the true offset.  In                             --   the current implementation each result segment                             --   should be bounded by arcs that are plus or-                            --   minus epsilon from the radius of curvature of+                            --   minus epsilon factor from the radius of curvature of                             --   the offset.-              -> Double     -- ^ Offset from the original segment, positive is+              -> n   -- ^ Offset from the original segment, positive is                             --   on the right of the curve, negative is on the                             --   left.-              -> Segment Closed R2 -- ^ Original segment-              -> (Point R2, Trail R2) -- ^ Resulting offset point and trail.-offsetSegment _       r s@(Linear (OffsetClosed a))    = (origin .+^ va, trailFromSegments [s])-  where va = r *^ unitPerp a+              -> Segment Closed V2 n  -- ^ Original segment+              -> Located (Trail V2 n) -- ^ Resulting located (at the offset) trail.+offsetSegment _       r s@(Linear (OffsetClosed a))    = trailFromSegments [s] `at` origin .+^ va+  where va = (-r) *^ unitPerp a -offsetSegment epsilon r s@(Cubic a b (OffsetClosed c)) = (origin .+^ va, t)+offsetSegment epsilon r s@(Cubic a b (OffsetClosed c)) = t `at` origin .+^ va   where     t = trailFromSegments (go (radiusOfCurvature s 0.5))     -- Perpendiculars to handles.-    va = r *^ unitPerp a-    vc = r *^ unitPerp (c - b)+    va = (-r) *^ unitPerp a+    vc = (-r) *^ unitPerp (c ^-^ b)     -- Split segments.-    ss = (\(a,b) -> [a,b]) $ splitAtParam s 0.5-    subdivided = concatMap (trailSegments . snd . offsetSegment epsilon r) ss+    ss = (\(x,y) -> [x,y]) $ splitAtParam s 0.5+    subdivided = concatMap (trailSegments . unLoc . offsetSegment epsilon r) ss      -- Offset with handles scaled based on curvature.-    offset factor = bezier3 (a^*factor) ((b - c)^*factor + c + vc - va) (c + vc - va)- +    offset factor = bezier3 (a^*factor) ((b ^-^ c)^*factor ^+^ c ^+^ vc ^-^ va) (c ^+^ vc ^-^ va)+     -- We observe a corner.  Subdivide right away.     go (Finite 0) = subdivided     -- We have some curvature@@ -104,30 +212,355 @@         --         o = offset $ case roc of               Infinity  -> 1          -- Do the right thing.-              Finite sr -> 1 + r / sr +              Finite sr -> 1 + r / sr -        close = and [epsilon > (magnitude (p o + va - p s - pp s))-                    | t <- [0.25, 0.5, 0.75]-                    , let p = (`atParam` t)-                    , let pp = (r *^) . (`perpAtParam` t)+        close = and [epsilon * abs r > norm (p o ^+^ va ^-^ p s ^-^ pp s)+                    | t' <- [0.25, 0.5, 0.75]+                    , let p = (`atParam` t')+                    , let pp = (r *^) . (`perpAtParam` t')                     ]   -- > import Diagrams.TwoD.Offset -- >--- > showExample :: Segment R2 -> Diagram SVG R2--- > showExample s = pad 1.1 . centerXY $ d # lc blue # lw 0.1 <> d' # lw 0.1+-- > showExample :: Segment Closed V2 Double -> Diagram SVG+-- > showExample s = pad 1.1 . centerXY $ d # lc blue # lw thick <> d' # lw thick -- >   where--- >       d  = stroke $ Path [(origin, Trail [s] False)]--- >       d' = mconcat . zipWith lc colors . map stroke . uncurry explodeTrail+-- >       d  = strokeP . fromSegments $ [s]+-- >       d' = mconcat . zipWith lc colors . map strokeP . explodeTrail -- >          $ offsetSegment 0.1 (-1) s--- >            +-- > -- >       colors = cycle [green, red]--- > --- > cubicOffsetExample :: Diagram SVG R2+-- >+-- > cubicOffsetExample :: Diagram SVG -- > cubicOffsetExample = hcat . map showExample $--- >         [ Cubic (10 &  0) (  5  & 18) (10 & 20)--- >         , Cubic ( 0 & 20) ( 10  & 10) ( 5 & 10)--- >         , Cubic (10 & 20) (  0  & 10) (10 &  0)--- >         , Cubic (10 & 20) ((-5) & 10) (10 &  0)+-- >         [ bezier3 (10 ^&  0) (  5  ^& 18) (10 ^& 20)+-- >         , bezier3 ( 0 ^& 20) ( 10  ^& 10) ( 5 ^& 10)+-- >         , bezier3 (10 ^& 20) (  0  ^& 10) (10 ^&  0)+-- >         , bezier3 (10 ^& 20) ((-5) ^& 10) (10 ^&  0) -- >         ]++-- Similar to (=<<).  This is when we want to map a function across something+-- located, but the result of the mapping will be transformable so we can+-- collapse the Located into the result.  This assumes that Located has the+-- meaning of merely taking something that cannot be translated and lifting+-- it into a space with translation.+bindLoc :: (Transformable b, V a ~ V b, N a ~ N b, V a ~ V2, N a ~ n, Num n) => (a -> b) -> Located a -> b+bindLoc f = join' . mapLoc f+  where+    join' (viewLoc -> (p,a)) = translate (p .-. origin) a++-- While we build offsets and expansions we will use the [Located (Segment Closed v)]+-- and [Located (Trail V2 n)] intermediate representations.+locatedTrailSegments :: OrderedField n+                     => Located (Trail V2 n) -> [Located (Segment Closed V2 n)]+locatedTrailSegments t = zipWith at (trailSegments (unLoc t)) (trailPoints t)++-- | Offset a 'Trail' with options and by a given radius.  This generates a new+--   trail that is always radius 'r' away from the given 'Trail' (depending on+--   the line join option) on the right.+--+--   The styles applied to an outside corner can be seen here (with the original+--   trail in blue and the result of 'offsetTrail'' in green):+--+--   <<diagrams/src_Diagrams_TwoD_Offset_offsetTrailExample.svg#diagram=offsetTrailExample&width=600>>+--+--   When a negative radius is given, the offset trail will be on the left:+--+--   <<diagrams/src_Diagrams_TwoD_Offset_offsetTrailLeftExample.svg#diagram=offsetTrailLeftExample&width=200>>+--+--   When offseting a counter-clockwise loop a positive radius gives an outer loop+--   while a negative radius gives an inner loop (both counter-clockwise).+--+--   <<diagrams/src_Diagrams_TwoD_Offset_offsetTrailOuterExample.svg#diagram=offsetTrailOuterExample&width=300>>+--+offsetTrail' :: RealFloat n+             => OffsetOpts n+             -> n -- ^ Radius of offset.  A negative value gives an offset on+                         --   the left for a line and on the inside for a counter-clockwise+                         --   loop.+             -> Located (Trail V2 n)+             -> Located (Trail V2 n)+offsetTrail' opts r t = joinSegments eps j isLoop (opts^.offsetMiterLimit) r ends . offset $ t+    where+      eps = opts^.offsetEpsilon+      offset = map (bindLoc (offsetSegment eps r)) . locatedTrailSegments+      ends | isLoop    = (\(a:as) -> as ++ [a]) . trailPoints $ t+           | otherwise = tail . trailPoints $ t+      j = fromLineJoin (opts^.offsetJoin)++      isLoop = withTrail (const False) (const True) (unLoc t)++-- | Offset a 'Trail' with the default options and a given radius.  See 'offsetTrail''.+offsetTrail :: RealFloat n => n -> Located (Trail V2 n) -> Located (Trail V2 n)+offsetTrail = offsetTrail' def++-- | Offset a 'Path' by applying 'offsetTrail'' to each trail in the path.+offsetPath' :: RealFloat n => OffsetOpts n -> n -> Path V2 n -> Path V2 n+offsetPath' opts r = mconcat+                   . map (bindLoc (trailLike . offsetTrail' opts r) . (`at` origin))+                   . op Path++-- | Offset a 'Path' with the default options and given radius.  See 'offsetPath''.+offsetPath :: RealFloat n => n -> Path V2 n -> Path V2 n+offsetPath = offsetPath' def++-- TODO: Include arrowheads on examples to indicate direction so the "left" and+-- "right" make sense.+--+-- > import Diagrams.TwoD.Offset+-- > import Data.Default+-- >+-- > corner :: (OrderedField n) => Located (Trail V2 n)+-- > corner = fromVertices (map p2 [(0, 0), (10, 0), (5, 6)]) `at` origin+-- >+-- > offsetTrailExample :: Diagram SVG+-- > offsetTrailExample = pad 1.1 . centerXY . lwO 3 . hcat' (def & sep .~ 1 )+-- >                    . map (uncurry showStyle)+-- >                    $ [ (LineJoinMiter, "LineJoinMiter")+-- >                      , (LineJoinRound, "LineJoinRound")+-- >                      , (LineJoinBevel, "LineJoinBevel")+-- >                      ]+-- >  where+-- >    showStyle j s = centerXY (trailLike corner # lc blue+-- >               <> trailLike (offsetTrail' (def & offsetJoin .~ j) 2 corner) # lc green)+-- >            === (strutY 3 <> text s # font "Helvetica" # bold)+-- >+-- > offsetTrailLeftExample :: Diagram SVG+-- > offsetTrailLeftExample = pad 1.1 . centerXY . lwO 3+-- >                        $ (trailLike c # lc blue)+-- >                        <> (lc green . trailLike+-- >                         . offsetTrail' (def & offsetJoin .~ LineJoinRound) (-2) $ c)+-- >   where+-- >     c = reflectY corner+-- >+-- > offsetTrailOuterExample :: Diagram SVG+-- > offsetTrailOuterExample = pad 1.1 . centerXY . lwO 3+-- >                         $ (trailLike c # lc blue)+-- >                         <> (lc green . trailLike+-- >                          . offsetTrail' (def & offsetJoin .~ LineJoinRound) 2 $ c)+-- >   where+-- >     c = hexagon 5++withTrailL :: (Located (Trail' Line V2 n) -> r) -> (Located (Trail' Loop V2 n) -> r) -> Located (Trail V2 n) -> r+withTrailL f g l = withTrail (f . (`at` p)) (g . (`at` p)) (unLoc l)+  where+    p = loc l++-- | Expand a 'Trail' with the given options and radius 'r' around a given 'Trail'.+--   Expanding can be thought of as generating the loop that, when filled, represents+--   stroking the trail with a radius 'r' brush.+--+--   The cap styles applied to an outside corner can be seen here (with the original+--   trail in white and the result of 'expandTrail'' filled in green):+--+--   <<diagrams/src_Diagrams_TwoD_Offset_expandTrailExample.svg#diagram=expandTrailExample&width=600>>+--+--   Loops result in a path with an inner and outer loop:+--+--   <<diagrams/src_Diagrams_TwoD_Offset_expandLoopExample.svg#diagram=expandLoopExample&width=300>>+--+expandTrail' :: (OrderedField n, RealFloat n, RealFrac n)+             => ExpandOpts n+             -> n  -- ^ Radius of offset.  Only non-negative values allowed.+                        --   For a line this gives a loop of the offset.  For a+                        --   loop this gives two loops, the outer counter-clockwise+                        --   and the inner clockwise.+             -> Located (Trail V2 n)+             -> Path V2 n+expandTrail' o r t+  | r < 0     = error "expandTrail' with negative radius"+                -- TODO: consider just reversing the path instead of this error.+  | otherwise = withTrailL (pathFromLocTrail . expandLine o r) (expandLoop o r) t++expandLine :: RealFloat n => ExpandOpts n -> n -> Located (Trail' Line V2 n) -> Located (Trail V2 n)+expandLine opts r (mapLoc wrapLine -> t) = caps cap r s e (f r) (f $ -r)+    where+      eps = opts^.expandEpsilon+      offset r' = map (bindLoc (offsetSegment eps r')) . locatedTrailSegments+      f r' = joinSegments eps (fromLineJoin (opts^.expandJoin)) False (opts^.expandMiterLimit) r' ends+           . offset r' $ t+      ends = tail . trailPoints $ t+      s = atStart t+      e = atEnd t+      cap = fromLineCap (opts^.expandCap)++expandLoop :: RealFloat n => ExpandOpts n -> n -> Located (Trail' Loop V2 n) -> Path V2 n+expandLoop opts r (mapLoc wrapLoop -> t) = trailLike (f r) <> (trailLike . reverseDomain . f $ -r)+    where+      eps = opts^.expandEpsilon+      offset r' = map (bindLoc (offsetSegment eps r')) . locatedTrailSegments+      f r' = joinSegments eps (fromLineJoin (opts^.expandJoin)) True (opts^.expandMiterLimit) r' ends+           . offset r' $ t+      ends = (\(a:as) -> as ++ [a]) . trailPoints $ t++-- | Expand a 'Trail' with the given radius and default options.  See 'expandTrail''.+expandTrail :: RealFloat n => n -> Located (Trail V2 n) -> Path V2 n+expandTrail = expandTrail' def++-- | Expand a 'Path' using 'expandTrail'' on each trail in the path.+expandPath' :: RealFloat n => ExpandOpts n -> n -> Path V2 n -> Path V2 n+expandPath' opts r = mconcat+                   . map (bindLoc (expandTrail' opts r) . (`at` origin))+                   . op Path++-- | Expand a 'Path' with the given radius and default options.  See 'expandPath''.+expandPath :: RealFloat n => n -> Path V2 n -> Path V2 n+expandPath = expandPath' def++-- > import Diagrams.TwoD.Offset+-- > import Data.Default+-- >+-- > expandTrailExample :: Diagram SVG+-- > expandTrailExample = pad 1.1 . centerXY . hcat' (def & sep .~ 1)+-- >                    . map (uncurry showStyle)+-- >                    $ [ (LineCapButt,   "LineCapButt")+-- >                      , (LineCapRound,  "LineCapRound")+-- >                      , (LineCapSquare, "LineCapSquare")+-- >                      ]+-- >  where+-- >    showStyle c s = centerXY (trailLike corner # lc white # lw veryThick+-- >                               <> stroke (expandTrail'+-- >                                              (def & expandJoin .~ LineJoinRound+-- >                                                   & expandCap .~ c+-- >                                                   ) 2 corner)+-- >                                      # lw none # fc green)+-- >               === (strutY 3 <> text s # font "Helvetica" # bold)+-- >+-- > expandLoopExample :: Diagram SVG+-- > expandLoopExample = pad 1.1 . centerXY $ ((strokeLocT t # lw veryThick # lc white)+-- >                                        <> (stroke t' # lw none # fc green))+-- >   where+-- >     t  = mapLoc glueTrail $ fromVertices (map p2 [(0, 0), (5, 0), (10, 5), (10, 10), (0, 0)])+-- >     t' = expandTrail' (def & expandJoin .~ LineJoinRound) 1 t+++-- | When we expand a line (the original line runs through the center of offset+--   lines at  r  and  -r) there is some choice in what the ends will look like.+--   If we are using a circle brush we should see a half circle at each end.+--   Similar caps could be made for square brushes or simply stopping exactly at+--   the end with a straight line (a perpendicular line brush).+--+--   caps  takes the radius and the start and end points of the original line and+--   the offset trails going out and coming back.  The result is a new list of+--   trails with the caps included.+caps :: RealFloat n => (n -> Point V2 n -> Point V2 n -> Point V2 n -> Trail V2 n)+     -> n -> Point V2 n -> Point V2 n -> Located (Trail V2 n) -> Located (Trail V2 n) -> Located (Trail V2 n)+caps cap r s e fs bs = mapLoc glueTrail $ mconcat+    [ cap r s (atStart bs) (atStart fs)+    , unLoc fs+    , cap r e (atEnd fs) (atEnd bs)+    , reverseDomain (unLoc bs)+    ] `at` atStart bs++-- | Take a LineCap style and give a function for building the cap from+fromLineCap :: RealFloat n => LineCap -> n -> Point V2 n -> Point V2 n -> Point V2 n -> Trail V2 n+fromLineCap c = case c of+    LineCapButt   -> capCut+    LineCapRound  -> capArc+    LineCapSquare -> capSquare++-- | Builds a cap that directly connects the ends.+capCut :: RealFloat n => n -> Point V2 n -> Point V2 n -> Point V2 n -> Trail V2 n+capCut _r _c a b = fromSegments [straight (b .-. a)]++-- | Builds a cap with a square centered on the end.+capSquare :: RealFloat n => n -> Point V2 n -> Point V2 n -> Point V2 n -> Trail V2 n+capSquare _r c a b = unLoc $ fromVertices [ a, a .+^ v, b .+^ v, b ]+  where+    v = perp (a .-. c)++-- | Builds an arc to fit with a given radius, center, start, and end points.+--   A Negative r means a counter-clockwise arc+capArc :: RealFloat n => n -> Point V2 n -> Point V2 n -> Point V2 n -> Trail V2 n+capArc r c a b = trailLike . moveTo c $ fs+  where+    fs | r < 0     = scale (-r) $ arcCW  (dirBetween c a) (dirBetween c b)+       | otherwise = scale r    $ arcCCW (dirBetween c a) (dirBetween c b)++-- | Join together a list of located trails with the given join style.  The+--   style is given as a function to compute the join given the local information+--   of the original vertex, the previous trail, and the next trail.  The result+--   is a single located trail.  A join radius is also given to aid in arc joins.+--+--   Note: this is not a general purpose join and assumes that we are joining an+--   offset trail.  For instance, a fixed radius arc will not fit between arbitrary+--   trails without trimming or extending.+joinSegments :: RealFloat n+             => n+             -> (n -> n -> Point V2 n -> Located (Trail V2 n) -> Located (Trail V2 n) -> Trail V2 n)+             -> Bool+             -> n+             -> n+             -> [Point V2 n]+             -> [Located (Trail V2 n)]+             -> Located (Trail V2 n)+joinSegments _ _ _ _ _ _ [] = mempty `at` origin+joinSegments _ _ _ _ _ [] _ = mempty `at` origin+joinSegments epsilon j isLoop ml r es ts@(t:_) = t'+  where+    t' | isLoop    = mapLoc (glueTrail . (<> f (take (length ts * 2 - 1) $ ss es (ts ++ [t])))) t+       | otherwise = mapLoc (<> f (ss es ts)) t+    ss es' ts' = concat [[test a b $ j ml r e a b, Just $ unLoc b] | (e,(a,b)) <- zip es' . (zip <*> tail) $ ts']+    test a b tj+        | atStart b `distance` atEnd a > epsilon = Just tj+        | otherwise                              = Nothing+    f = mconcat . catMaybes++-- | Take a join style and give the join function to be used by joinSegments.+fromLineJoin+  :: RealFloat n => LineJoin -> n -> n -> Point V2 n -> Located (Trail V2 n) -> Located (Trail V2 n) -> Trail V2 n+fromLineJoin j = case j of+    LineJoinMiter -> joinSegmentIntersect+    LineJoinRound -> joinSegmentArc+    LineJoinBevel -> joinSegmentClip++-- TODO: The joinSegmentCut option is not in our standard line joins.  I don't know+-- how useful it is graphically, I mostly had it as it was useful for debugging+{-+-- | Join with segments going back to the original corner.+joinSegmentCut :: (OrderedField n) => n -> n -> Point V2 n -> Located (Trail V2 n) -> Located (Trail V2 n) -> Trail V2 n+joinSegmentCut _ _ e a b = fromSegments+    [ straight (e .-. atEnd a)+    , straight (atStart b .-. e)+    ]+-}++-- | Join by directly connecting the end points.  On an inside corner this+--   creates negative space for even-odd fill.  Here is where we would want to+--   use an arc or something else in the future.+joinSegmentClip :: RealFloat n+  => n -> n -> Point V2 n -> Located (Trail V2 n) -> Located (Trail V2 n) -> Trail V2 n+joinSegmentClip _ _ _ a b = fromSegments [straight $ atStart b .-. atEnd a]++-- | Join with a radius arc.  On an inside corner this will loop around the interior+--   of the offset trail.  With a winding fill this will not be visible.+joinSegmentArc :: RealFloat n+  => n -> n -> Point V2 n -> Located (Trail V2 n) -> Located (Trail V2 n) -> Trail V2 n+joinSegmentArc _ r e a b = capArc r e (atEnd a) (atStart b)++-- | Join to the intersection of the incoming trails projected tangent to their ends.+--   If the intersection is beyond the miter limit times the radius, stop at the limit.+joinSegmentIntersect+    :: RealFloat n => n -> n -> Point V2 n -> Located (Trail V2 n) -> Located (Trail V2 n) -> Trail V2 n+joinSegmentIntersect miterLimit r e a b =+    if cross < 0.000001+      then clip+      else case traceP pa va t of+          -- clip join when we excede the miter limit.  We could instead+          -- Join at exactly the miter limit, but standard behavior seems+          -- to be clipping.+          Nothing -> clip+          Just p+            -- If trace gave us garbage...+            | p `distance` pb > abs (miterLimit * r) -> clip+            | otherwise                              -> unLoc $ fromVertices [ pa, p, pb ]+  where+    t = straight (miter vb) `at` pb+    va = unitPerp (pa .-. e)+    vb = negated $ unitPerp (pb .-. e)+    pa = atEnd a+    pb = atStart b+    miter v = abs (miterLimit * r) *^ v+    clip = joinSegmentClip miterLimit r e a b+    cross = let (xa,ya) = unr2 va; (xb,yb) = unr2 vb in abs (xa * yb - xb * ya)

src/Diagrams/TwoD/Path.hs view

@@ -1,15 +1,23 @@+{-# LANGUAGE ConstraintKinds            #-} {-# LANGUAGE DeriveDataTypeable         #-} {-# LANGUAGE FlexibleContexts           #-} {-# LANGUAGE FlexibleInstances          #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses      #-}+{-# LANGUAGE Rank2Types                 #-}+{-# LANGUAGE StandaloneDeriving         #-}+{-# LANGUAGE TemplateHaskell            #-} {-# LANGUAGE TypeFamilies               #-}+{-# LANGUAGE TypeOperators              #-}+{-# LANGUAGE UndecidableInstances       #-} {-# LANGUAGE ViewPatterns               #-}+ {-# OPTIONS_GHC -fno-warn-orphans #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  Diagrams.TwoD.Path--- Copyright   :  (c) 2011 diagrams-lib team (see LICENSE)+-- Copyright   :  (c) 2011-2015 diagrams-lib team (see LICENSE) -- License     :  BSD-style (see LICENSE) -- Maintainer  :  diagrams-discuss@googlegroups.com --@@ -21,48 +29,66 @@ -----------------------------------------------------------------------------  module Diagrams.TwoD.Path-       ( -- * Constructing path-based diagrams+  ( -- * Constructing path-based diagrams -         stroke, stroke', strokeT, strokeT', strokeLine, strokeLoop-       , strokeLocT, strokeLocLine, strokeLocLoop+    stroke, stroke'+  , strokePath, strokeP, strokePath', strokeP'+  , strokeTrail, strokeT, strokeTrail', strokeT'+  , strokeLine, strokeLoop+  , strokeLocTrail, strokeLocT, strokeLocLine, strokeLocLoop -         -- ** Stroke options+    -- ** Stroke options -       , FillRule(..)-       , FillRuleA(..), getFillRule, fillRule-       , StrokeOpts(..)+  , FillRule(..)+  , getFillRule, fillRule, _fillRule+  , StrokeOpts(..), vertexNames, queryFillRule -         -- ** Inside/outside testing+    -- ** Inside/outside testing -       , isInsideWinding, isInsideEvenOdd+  , Crossings (..)+  , isInsideWinding+  , isInsideEvenOdd -         -- * Clipping+    -- * Clipping -       , Clip(..), clipBy-       ) where+  , Clip(..), _Clip, _clip+  , clipBy, clipTo, clipped -import           Control.Applicative   (liftA2)-import qualified Data.Foldable         as F+    -- * Intersections++  , intersectPoints, intersectPoints'+  , intersectPointsP, intersectPointsP'+  , intersectPointsT, intersectPointsT'+  ) where++import           Control.Applicative       (liftA2)+import           Control.Lens              hiding (at, transform)+import qualified Data.Foldable             as F import           Data.Semigroup import           Data.Typeable -import           Data.AffineSpace-import           Data.Default.Class-import           Data.VectorSpace+import           Data.Default -import           Diagrams.Coordinates+import           Diagrams.Angle+import           Diagrams.Combinators      (withEnvelope, withTrace) import           Diagrams.Core-import           Diagrams.Located      (Located, mapLoc, unLoc)+import           Diagrams.Core.Trace+import           Diagrams.Located          (Located, mapLoc, unLoc) import           Diagrams.Parametric import           Diagrams.Path+import           Diagrams.Query import           Diagrams.Segment-import           Diagrams.Solve+import           Diagrams.Solve.Polynomial import           Diagrams.Trail import           Diagrams.TrailLike import           Diagrams.TwoD.Segment import           Diagrams.TwoD.Types-import           Diagrams.Util         (tau)+import           Diagrams.TwoD.Vector+import           Diagrams.Util             (tau) +import           Linear.Affine+import           Linear.Vector+ ------------------------------------------------------------ --  Trail and path traces  --------------------------------- ------------------------------------------------------------@@ -71,219 +97,304 @@  -- 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+instance RealFloat n => Traced (Trail V2 n) where   getTrace = withLine $       foldr-        (\seg bds -> moveOriginBy (negateV . atEnd $ seg) bds <> getTrace seg)+        (\seg bds -> moveOriginBy (negated . atEnd $ seg) bds <> getTrace seg)         mempty     . lineSegments -instance Traced (Path R2) where-  getTrace = F.foldMap getTrace . pathTrails+instance RealFloat n => Traced (Path V2 n) where+  getTrace = F.foldMap getTrace . op Path  ------------------------------------------------------------ --  Constructing path-based diagrams  ---------------------- ------------------------------------------------------------ --- | Convert a path into a diagram.  The resulting diagram has the+-- | Enumeration of algorithms or \"rules\" for determining which+--   points lie in the interior of a (possibly self-intersecting)+--   path.+data FillRule+  = Winding  -- ^ Interior points are those with a nonzero+             --   /winding/ /number/.  See+             --   <http://en.wikipedia.org/wiki/Nonzero-rule>.+  | EvenOdd  -- ^ Interior points are those where a ray+             --   extended infinitely in a particular direction crosses+             --   the path an odd number of times. See+             --   <http://en.wikipedia.org/wiki/Even-odd_rule>.+    deriving (Show, Typeable, Eq, Ord)++instance AttributeClass FillRule+instance Semigroup FillRule where+  _ <> b = b++instance Default FillRule where+  def = Winding++-- | A record of options that control how a path is stroked.+--   @StrokeOpts@ is an instance of 'Default', so a @StrokeOpts@+--   records can be created using @'with' { ... }@ notation.+data StrokeOpts a+  = StrokeOpts+    { _vertexNames   :: [[a]]++    , _queryFillRule :: FillRule++    }++makeLensesWith (generateSignatures .~ False $ lensRules) ''StrokeOpts++-- | Atomic names that should be assigned to the vertices of the path so that+--   they can be referenced later.  If there are not enough names, the extra+--   vertices are not assigned names; if there are too many, the extra names+--   are ignored.  Note that this is a /list of lists/ of names, since paths+--   can consist of multiple trails.  The first list of names are assigned to+--   the vertices of the first trail, the second list to the second trail, and+--   so on.+--+--   The default value is the empty list.++vertexNames :: Lens (StrokeOpts a) (StrokeOpts a') [[a]] [[a']]++-- | The fill rule used for determining which points are inside the path.+--   The default is 'Winding'.  NOTE: for now, this only affects the resulting+--   diagram's 'Query', /not/ how it will be drawn!  To set the fill rule+--   determining how it is to be drawn, use the 'fillRule' function.+queryFillRule :: Lens' (StrokeOpts a) FillRule++instance Default (StrokeOpts a) where+  def = StrokeOpts+        { _vertexNames    = []+        , _queryFillRule = def+        }++-- | Convert a 'ToPath' object into a diagram.  The resulting diagram has the --   names 0, 1, ... assigned to each of the path's vertices. -- --   See also 'stroke'', which takes an extra options record allowing---   its behavior to be customized.+--   its behaviour to be customized. -----   Note that a bug in GHC 7.0.1 causes a context stack overflow when---   inferring the type of @stroke@.  The solution is to give a type---   signature to expressions involving @stroke@, or (recommended)---   upgrade GHC (the bug is fixed in 7.0.2 onwards).-stroke :: Renderable (Path R2) b-       => Path R2 -> Diagram b R2-stroke = stroke' (def :: StrokeOpts ())--instance Renderable (Path R2) b => TrailLike (QDiagram b R2 Any) where-  trailLike = stroke . trailLike+-- @+-- 'stroke' :: 'Path' 'V2' 'Double'                  -> 'Diagram' b+-- 'stroke' :: 'Located' ('Trail' 'V2' 'Double')       -> 'Diagram' b+-- 'stroke' :: 'Located' ('Trail'' 'Loop' 'V2' 'Double') -> 'Diagram' b+-- 'stroke' :: 'Located' ('Trail'' 'Line' 'V2' 'Double') -> 'Diagram' b+-- @+stroke :: (InSpace V2 n t, ToPath t, TypeableFloat n, Renderable (Path V2 n) b)+       => t -> QDiagram b V2 n Any+stroke = strokeP . toPath  -- | A variant of 'stroke' that takes an extra record of options to---   customize its behavior.  In particular:+--   customize its behaviour.  In particular: -- --     * Names can be assigned to the path's vertices -----   'StrokeOpts' is an instance of 'Default', so @stroke' 'with' {---   ... }@ syntax may be used.-stroke' :: (Renderable (Path R2) b, IsName a) => StrokeOpts a -> Path R2 -> Diagram b R2-stroke' opts path-  | null (pathTrails p1) =           mkP p2-  | null (pathTrails p2) = mkP p1-  | otherwise            = mkP p1 <> mkP p2+--   'StrokeOpts' is an instance of 'Default', so @stroke' ('with' &+--   ... )@ syntax may be used.+stroke' :: (InSpace V2 n t, ToPath t, TypeableFloat n, Renderable (Path V2 n) b, IsName a)+       => StrokeOpts a -> t -> QDiagram b V2 n Any+stroke' opts = strokeP' opts . toPath++-- | 'stroke' specialised to 'Path'.+strokeP :: (TypeableFloat n, Renderable (Path V2 n) b)+        => Path V2 n -> QDiagram b V2 n Any+strokeP = strokeP' (def :: StrokeOpts ())++-- | 'stroke' specialised to 'Path'.+strokePath :: (TypeableFloat n, Renderable (Path V2 n) b)+        => Path V2 n -> QDiagram b V2 n Any+strokePath = strokeP++instance (TypeableFloat n, Renderable (Path V2 n) b)+    => TrailLike (QDiagram b V2 n Any) where+  trailLike = strokeP . trailLike++-- | 'stroke'' specialised to 'Path'.+strokeP' :: (TypeableFloat n, Renderable (Path V2 n) b, IsName a)+    => StrokeOpts a -> Path V2 n -> QDiagram b V2 n Any+strokeP' opts path+  | null (pLines ^. _Wrapped') = mkP pLoops+  | null (pLoops ^. _Wrapped') = mkP pLines+  | otherwise                  = mkP pLines <> mkP pLoops   where-    (p1,p2) = partitionPath (isLine . unLoc) path+    (pLines,pLoops) = partitionPath (isLine . unLoc) path     mkP p       = mkQD (Prim p)          (getEnvelope p)          (getTrace p)          (fromNames . concat $-           zipWith zip (vertexNames opts) ((map . map) subPoint (pathVertices p))+           zipWith zip (opts^.vertexNames) ((map . map) subPoint (pathVertices p))          )-         (Query $ Any . flip (runFillRule (queryFillRule opts)) p)---- | A record of options that control how a path is stroked.---   @StrokeOpts@ is an instance of 'Default', so a @StrokeOpts@---   records can be created using @'with' { ... }@ notation.-data StrokeOpts a-  = StrokeOpts-    { vertexNames   :: [[a]]  -- ^ Atomic names that should be assigned-                            --   to the vertices of the path so that-                            --   they can be referenced later.  If-                            --   there are not enough names, the extra-                            --   vertices are not assigned names; if-                            --   there are too many, the extra names-                            --   are ignored.  Note that this is a-                            --   /list of lists/ of names, since paths-                            --   can consist of multiple trails.  The-                            --   first list of names are assigned to-                            --   the vertices of the first trail, the-                            --   second list to the second trail, and-                            --   so on.-                            ---                            --   The default value is the empty list.+         (Query $ Any . (runFillRule (opts^.queryFillRule)) p) -    , queryFillRule :: FillRule-                            -- ^ The fill rule used for determining-                            --   which points are inside the path.-                            --   The default is 'Winding'.  NOTE: for-                            --   now, this only affects the resulting-                            --   diagram's 'Query', /not/ how it will-                            --   be drawn!  To set the fill rule-                            --   determining how it is to be drawn,-                            --   use the 'fillRule' function.-    }+-- | 'stroke'' specialised to 'Path'.+strokePath' :: (TypeableFloat n, Renderable (Path V2 n) b, IsName a)+    => StrokeOpts a -> Path V2 n -> QDiagram b V2 n Any+strokePath' = strokeP' -instance Default (StrokeOpts a) where-  def = StrokeOpts-        { vertexNames    = []-        , queryFillRule = Winding-        }+-- | 'stroke' specialised to 'Trail'.+strokeTrail :: (TypeableFloat n, Renderable (Path V2 n) b)+            => Trail V2 n -> QDiagram b V2 n Any+strokeTrail = stroke . pathFromTrail --- | A composition of 'stroke' and 'pathFromTrail' for conveniently---   converting a trail directly into a diagram.------   Note that a bug in GHC 7.0.1 causes a context stack overflow when---   inferring the type of 'stroke' and hence of @strokeT@ as well.---   The solution is to give a type signature to expressions involving---   @strokeT@, or (recommended) upgrade GHC (the bug is fixed in 7.0.2---   onwards).-strokeT :: (Renderable (Path R2) b)-        => Trail R2 -> Diagram b R2-strokeT = stroke . pathFromTrail+-- | 'stroke' specialised to 'Trail'.+strokeT :: (TypeableFloat n, Renderable (Path V2 n) b)+        => Trail V2 n -> QDiagram b V2 n Any+strokeT = strokeTrail  -- | A composition of 'stroke'' and 'pathFromTrail' for conveniently --   converting a trail directly into a diagram.-strokeT' :: (Renderable (Path R2) b, IsName a)-         => StrokeOpts a -> Trail R2 -> Diagram b R2-strokeT' opts = stroke' opts . pathFromTrail+strokeTrail' :: (TypeableFloat n, Renderable (Path V2 n) b, IsName a)+             => StrokeOpts a -> Trail V2 n -> QDiagram b V2 n Any+strokeTrail' opts = stroke' opts . pathFromTrail +-- | Deprecated synonym for 'strokeTrail''.+strokeT' :: (TypeableFloat n, Renderable (Path V2 n) b, IsName a)+         => StrokeOpts a -> Trail V2 n -> QDiagram b V2 n Any+strokeT' = strokeTrail'+ -- | A composition of 'strokeT' and 'wrapLine' for conveniently --   converting a line directly into a diagram.-strokeLine :: (Renderable (Path R2) b) => Trail' Line R2 -> Diagram b R2+strokeLine :: (TypeableFloat n, Renderable (Path V2 n) b)+           => Trail' Line V2 n -> QDiagram b V2 n Any strokeLine = strokeT . wrapLine  -- | A composition of 'strokeT' and 'wrapLoop' for conveniently --   converting a loop directly into a diagram.-strokeLoop :: (Renderable (Path R2) b) => Trail' Loop R2 -> Diagram b R2+strokeLoop :: (TypeableFloat n, Renderable (Path V2 n) b)+           => Trail' Loop V2 n -> QDiagram b V2 n Any strokeLoop = strokeT . wrapLoop  -- | A convenience function for converting a @Located Trail@ directly---   into a diagram; @strokeLocT = stroke . trailLike@.-strokeLocT :: (Renderable (Path R2) b) => Located (Trail R2) -> Diagram b R2-strokeLocT = stroke . trailLike+--   into a diagram; @strokeLocTrail = stroke . trailLike@.+strokeLocTrail :: (TypeableFloat n, Renderable (Path V2 n) b)+               => Located (Trail V2 n) -> QDiagram b V2 n Any+strokeLocTrail = strokeP . trailLike +-- | Deprecated synonym for 'strokeLocTrail'.+strokeLocT :: (TypeableFloat n, Renderable (Path V2 n) b)+           => Located (Trail V2 n) -> QDiagram b V2 n Any+strokeLocT = strokeLocTrail+ -- | A convenience function for converting a @Located@ line directly --   into a diagram; @strokeLocLine = stroke . trailLike . mapLoc wrapLine@.-strokeLocLine :: (Renderable (Path R2) b) => Located (Trail' Line R2) -> Diagram b R2-strokeLocLine = stroke . trailLike . mapLoc wrapLine+strokeLocLine :: (TypeableFloat n, Renderable (Path V2 n) b)+              => Located (Trail' Line V2 n) -> QDiagram b V2 n Any+strokeLocLine = strokeP . trailLike . mapLoc wrapLine  -- | A convenience function for converting a @Located@ loop directly --   into a diagram; @strokeLocLoop = stroke . trailLike . mapLoc wrapLoop@.-strokeLocLoop :: (Renderable (Path R2) b) => Located (Trail' Loop R2) -> Diagram b R2-strokeLocLoop = stroke . trailLike . mapLoc wrapLoop+strokeLocLoop :: (TypeableFloat n, Renderable (Path V2 n) b)+              => Located (Trail' Loop V2 n) -> QDiagram b V2 n Any+strokeLocLoop = strokeP . trailLike . mapLoc wrapLoop  ------------------------------------------------------------ --  Inside/outside testing ------------------------------------------------------------ --- | Enumeration of algorithms or \"rules\" for determining which---   points lie in the interior of a (possibly self-intersecting)---   closed path.-data FillRule = Winding  -- ^ Interior points are those with a nonzero-                         --   /winding/ /number/.  See-                         --   <http://en.wikipedia.org/wiki/Nonzero-rule>.-              | EvenOdd  -- ^ Interior points are those where a ray-                         --   extended infinitely in a particular-                         --   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 :: RealFloat n => FillRule -> Path V2 n -> Point V2 n -> Bool runFillRule Winding = isInsideWinding runFillRule EvenOdd = isInsideEvenOdd -newtype FillRuleA = FillRuleA (Last FillRule)-  deriving (Typeable, Semigroup)-instance AttributeClass FillRuleA- -- | Extract the fill rule from a 'FillRuleA' attribute.-getFillRule :: FillRuleA -> FillRule-getFillRule (FillRuleA (Last r)) = r+getFillRule :: FillRule -> FillRule+getFillRule = id  -- | Specify the fill rule that should be used for determining which --   points are inside a path. fillRule :: HasStyle a => FillRule -> a -> a-fillRule = applyAttr . FillRuleA . Last+fillRule = applyAttr -cross :: R2 -> R2 -> Double-cross (coords -> x :& y) (coords -> x' :& y') = x * y' - y * x'+-- | Lens onto the fill rule of a style.+_fillRule :: Lens' (Style V2 n) FillRule+_fillRule = atAttr . non def --- XXX link to more info on this+-- | The sum of /signed/ crossings of a path as we travel in the+--   positive x direction from a given point.+--+--     - A point is filled according to the 'Winding' fill rule, if the+--       number of 'Crossings' is non-zero (see 'isInsideWinding').+--+--     - A point is filled according to the 'EvenOdd' fill rule, if the+--       number of 'Crossings' is odd (see 'isInsideEvenOdd').+--+--   This is the 'HasQuery' result for 'Path's, 'Located' 'Trail's and+--   'Located' 'Loops'.+--+-- @+-- 'sample' :: 'Path' 'V2' 'Double'                  -> 'Point' 'V2' 'Double' -> 'Crossings'+-- 'sample' :: 'Located' ('Trail' 'V2' 'Double')       -> 'Point' 'V2' 'Double' -> 'Crossings'+-- 'sample' :: 'Located' ('Trail'' 'Loop' 'V2' 'Double') -> 'Point' 'V2' 'Double' -> 'Crossings'+-- @+--+--   Note that 'Line's have no inside or outside, so don't contribute+--   crossings+newtype Crossings = Crossings Int+  deriving (Show, Eq, Ord, Num, Enum, Real, Integral) --- | Test whether the given point is inside the given (closed) path,+instance Semigroup Crossings where+  Crossings a <> Crossings b = Crossings (a + b)++instance Monoid Crossings where+  mempty  = Crossings 0+  mappend = (<>)++instance RealFloat n => HasQuery (Located (Trail V2 n)) Crossings where+  getQuery trail = Query $ \p -> trailCrossings p trail++instance RealFloat n => HasQuery (Located (Trail' l V2 n)) Crossings where+  getQuery trail' = getQuery (mapLoc Trail trail')++instance RealFloat n => HasQuery (Path V2 n) Crossings where+  getQuery = foldMapOf each getQuery++-- | Test whether the given point is inside the given path, --   by testing whether the point's /winding number/ is nonzero. Note---   that @False@ is /always/ returned for /open/ paths, regardless of---   the winding number.-isInsideWinding :: P2 -> Path R2 -> Bool-isInsideWinding p = (/= 0) . crossings p+--   that @False@ is /always/ returned for paths consisting of lines+--   (as opposed to loops), regardless of the winding number.+--+-- @+-- 'isInsideWinding' :: 'Path' 'V2' 'Double'                  -> 'Point' 'V2' 'Double' -> 'Bool'+-- 'isInsideWinding' :: 'Located' ('Trail' 'V2' 'Double')       -> 'Point' 'V2' 'Double' -> 'Bool'+-- 'isInsideWinding' :: 'Located' ('Trail'' 'Loop' 'V2' 'Double') -> 'Point' 'V2' 'Double' -> 'Bool'+-- @+isInsideWinding :: HasQuery t Crossings => t -> Point (V t) (N t) -> Bool+isInsideWinding t = (/= 0) . sample t --- | Test whether the given point is inside the given (closed) path,+-- | Test whether the given point is inside the given path, --   by testing whether a ray extending from the point in the positive --   x direction crosses the path an even (outside) or odd (inside) --   number of times.  Note that @False@ is /always/ returned for---   /open/ paths, regardless of the number of crossings.-isInsideEvenOdd :: P2 -> Path R2 -> Bool-isInsideEvenOdd p = odd . crossings p---- | Compute the sum of /signed/ crossings of a path as we travel in the---   positive x direction from a given point.-crossings :: P2 -> Path R2 -> Int-crossings p = F.sum . map (trailCrossings p) . pathTrails+--   paths consisting of lines (as opposed to loops), regardless of+--   the number of crossings.+--+-- @+-- 'isInsideEvenOdd' :: 'Path' 'V2' 'Double'                  -> 'Point' 'V2' 'Double' -> 'Bool'+-- 'isInsideEvenOdd' :: 'Located' ('Trail' 'V2' 'Double')       -> 'Point' 'V2' 'Double' -> 'Bool'+-- 'isInsideEvenOdd' :: 'Located' ('Trail'' 'Loop' 'V2' 'Double') -> 'Point' 'V2' 'Double' -> 'Bool'+-- @+isInsideEvenOdd :: HasQuery t Crossings => t -> Point (V t) (N t) -> Bool+isInsideEvenOdd t = odd . sample t  -- | Compute the sum of signed crossings of a trail starting from the --   given point in the positive x direction.-trailCrossings :: P2 -> Located (Trail R2) -> Int+trailCrossings :: RealFloat n => Point V2 n -> Located (Trail V2 n) -> Crossings    -- non-loop trails have no inside or outside, so don't contribute crossings trailCrossings _ t | not (isLoop (unLoc t)) = 0  trailCrossings p@(unp2 -> (x,y)) tr-  = sum . map test $ fixTrail tr+  = F.foldMap test $ fixTrail tr   where     test (FLinear a@(unp2 -> (_,ay)) b@(unp2 -> (_,by)))       | ay <= y && by > y && isLeft a b > 0 =  1       | by <= y && ay > y && isLeft a b < 0 = -1       | otherwise                           =  0 -    test c@(FCubic (unp2 -> x1@(_,x1y))-                   (unp2 -> c1@(_,c1y))-                   (unp2 -> c2@(_,c2y))-                   (unp2 -> x2@(_,x2y))+    test c@(FCubic (P x1@(V2 _ x1y))+                   (P c1@(V2 _ c1y))+                   (P c2@(V2 _ c2y))+                   (P x2@(V2 _ x2y))            ) =         sum . map testT $ ts       where ts = filter (liftA2 (&&) (>=0) (<=1))@@ -294,15 +405,15 @@             testT t = let (unp2 -> (px,_)) = c `atParam` t                       in  if px > x then signFromDerivAt t else 0             signFromDerivAt t =-              let (dx,dy) = (3*t*t) *^ ((-1)*^x1 ^+^ 3*^c1 ^-^ 3*^c2 ^+^ x2)-                        ^+^ (2*t)   *^ (3*^x1 ^-^ 6*^c1 ^+^ 3*^c2)-                        ^+^            ((-3)*^x1 ^+^ 3*^c1)-                  ang = atan2 dy dx+              let v =  (3*t*t) *^ ((-1)*^x1 ^+^ 3*^c1 ^-^ 3*^c2 ^+^ x2)+                   ^+^ (2*t)   *^ (3*^x1 ^-^ 6*^c1 ^+^ 3*^c2)+                   ^+^            ((-3)*^x1 ^+^ 3*^c1)+                  ang = v ^. _theta . rad               in  case () of _ | 0      < ang && ang < tau/2 && t < 1 ->  1                                | -tau/2 < ang && ang < 0     && t > 0 -> -1                                | otherwise                            ->  0 -    isLeft a b = cross (b .-. a) (p .-. a)+    isLeft a b = cross2 (b .-. a) (p .-. a)  ------------------------------------------------------------ --  Clipping  ----------------------------------------------@@ -313,25 +424,108 @@ --   concatenation, so applying multiple clipping paths is sensible. --   The clipping region is the intersection of all the applied --   clipping paths.-newtype Clip = Clip { getClip :: [Path R2] }+newtype Clip n = Clip [Path V2 n]   deriving (Typeable, Semigroup)-instance AttributeClass Clip -type instance V Clip = R2+makeWrapped ''Clip -instance Transformable Clip where+instance Typeable n => AttributeClass (Clip n)++instance AsEmpty (Clip n) where+  _Empty = _Clip . _Empty++type instance V (Clip n) = V2+type instance N (Clip n) = n++instance (OrderedField n) => Transformable (Clip n) where   transform t (Clip ps) = Clip (transform t ps) +-- | A point inside a clip if the point is in 'All' invididual clipping+--   paths.+instance RealFloat n => HasQuery (Clip n) All where+  getQuery (Clip paths) = Query $ \p ->+    F.foldMap (All . flip isInsideWinding p) paths++_Clip :: Iso (Clip n) (Clip n') [Path V2 n] [Path V2 n']+_Clip = _Wrapped++-- | Lens onto the Clip in a style. An empty list means no clipping.+_clip :: (Typeable n, OrderedField n) => Lens' (Style V2 n) [Path V2 n]+_clip = atTAttr . non' _Empty . _Clip+ -- | Clip a diagram by the given path: -- --   * Only the parts of the diagram which lie in the interior of the --     path will be drawn. -- --   * The envelope of the diagram is unaffected.-clipBy :: (HasStyle a, V a ~ R2) => Path R2 -> a -> a+clipBy :: (HasStyle a, V a ~ V2, N a ~ n, TypeableFloat n) => Path V2 n -> a -> a clipBy = applyTAttr . Clip . (:[]) --- XXX Should include a 'clipTo' function which clips a diagram AND--- restricts its envelope.  It will have to take a *pointwise minimum*--- of the diagram's current envelope and the path's envelope.  Not--- sure of the best way to do this at the moment.+-- | Clip a diagram to the given path setting its envelope to the+--   pointwise minimum of the envelopes of the diagram and path. The+--   trace consists of those parts of the original diagram's trace+--   which fall within the clipping path, or parts of the path's trace+--   within the original diagram.+clipTo :: TypeableFloat n+  => Path V2 n -> QDiagram b V2 n Any -> QDiagram b V2 n Any+clipTo p d = setTrace intersectionTrace . toEnvelope $ clipBy p d+  where+    envP = appEnvelope . getEnvelope $ p+    envD = appEnvelope . getEnvelope $ d+    toEnvelope = case (envP, envD) of+      (Just eP, Just eD) -> setEnvelope . mkEnvelope $ \v -> min (eP v) (eD v)+      (_, _)             -> id+    intersectionTrace = Trace traceIntersections+    traceIntersections pt v =+        -- on boundary of d, inside p+        onSortedList (filter pInside) (appTrace (getTrace d) pt v) <>+        -- or on boundary of p, inside d+        onSortedList (filter dInside) (appTrace (getTrace p) pt v) where+          newPt dist = pt .+^ v ^* dist+          pInside dDist = runFillRule Winding p (newPt dDist)+          dInside pDist = getAny . sample d $ newPt pDist++-- | Clip a diagram to the clip path taking the envelope and trace of the clip+--   path.+clipped :: TypeableFloat n+  => Path V2 n -> QDiagram b V2 n Any -> QDiagram b V2 n Any+clipped p = withTrace p . withEnvelope p . clipBy p++------------------------------------------------------------+--  Intersections  -----------------------------------------+------------------------------------------------------------++-- | Find the intersect points of two objects that can be converted to a path.+intersectPoints :: (InSpace V2 n t, SameSpace t s, ToPath t, ToPath s, OrderedField n)+  => t -> s -> [P2 n]+intersectPoints = intersectPoints' 1e-8++-- | Find the intersect points of two objects that can be converted to a path+--   within the given tolerance.+intersectPoints' :: (InSpace V2 n t, SameSpace t s, ToPath t, ToPath s, OrderedField n)+  => n -> t -> s -> [P2 n]+intersectPoints' eps t s = intersectPointsP' eps (toPath t) (toPath s)++-- | Compute the intersect points between two paths.+intersectPointsP :: OrderedField n => Path V2 n -> Path V2 n -> [P2 n]+intersectPointsP = intersectPointsP' 1e-8++-- | Compute the intersect points between two paths within given tolerance.+intersectPointsP' :: OrderedField n => n -> Path V2 n -> Path V2 n -> [P2 n]+intersectPointsP' eps as bs = do+  a <- pathTrails as+  b <- pathTrails bs+  intersectPointsT' eps a b++-- | Compute the intersect points between two located trails.+intersectPointsT :: OrderedField n => Located (Trail V2 n) -> Located (Trail V2 n) -> [P2 n]+intersectPointsT = intersectPointsT' 1e-8++-- | Compute the intersect points between two located trails within the given+--   tolerance.+intersectPointsT' :: OrderedField n => n -> Located (Trail V2 n) -> Located (Trail V2 n) -> [P2 n]+intersectPointsT' eps as bs = do+  a <- fixTrail as+  b <- fixTrail bs+  intersectPointsS' eps a b

+ src/Diagrams/TwoD/Points.hs view

@@ -0,0 +1,60 @@+{-# LANGUAGE ConstraintKinds #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Diagrams.TwoD.Points+-- Copyright   :  (c) 2014 diagrams-lib team (see LICENSE)+-- License     :  BSD-style (see LICENSE)+-- Maintainer  :  diagrams-discuss@googlegroups.com+--+-- Special functions for points in R2.+--+-----------------------------------------------------------------------------++{-# LANGUAGE TypeFamilies #-}++module Diagrams.TwoD.Points where++import Data.List++import Diagrams.Core+import Diagrams.TwoD.Vector+import Diagrams.TwoD.Types (P2)++import Linear.Affine++-- | Find the convex hull of a list of points using Andrew's monotone chain+--   algorithm O(n log n).+--   +--   Returns clockwise list of points starting from the left-most point.+convexHull2D :: OrderedField n => [P2 n] -> [P2 n]+convexHull2D ps = init upper ++ reverse (tail lower)+  where+    (upper, lower) = sortedConvexHull (sort ps)++-- | Find the convex hull of a set of points already sorted in the x direction. +--   The first list of the tuple is the upper hull going clockwise from +--   left-most to right-most point. The second is the lower hull from +--   right-most to left-most in the anti-clockwise direction.+sortedConvexHull :: OrderedField n => [P2 n] -> ([P2 n], [P2 n])+sortedConvexHull ps = (chain True ps, chain False ps)+ where+   chain upper (p1_:p2_:rest_) =+     case go (p2_ .-. p1_) p2_ rest_ of+       Right l -> p1_:l+       Left l  -> chain upper (p1_:l)+     where+       test = if upper then (>0) else (<0)+       -- find the convex hull by comparing the angles of the vectors with+       -- the cross product and backtracking if necessary+       go dir p1 l@(p2:rest)+         -- backtrack if the direction is outward+         | test $ dir `cross2` dir' = Left l+         | otherwise                =+             case go dir' p2 rest of+               Left m  -> go dir p1 m+               Right m -> Right (p1:m)+         where+           dir' = p2 .-. p1+       go _ p1 p = Right (p1:p)++   chain _ l = l

src/Diagrams/TwoD/Polygons.hs view

@@ -1,8 +1,10 @@-{-# LANGUAGE DeriveFunctor             #-}-{-# LANGUAGE ExistentialQuantification #-}-{-# LANGUAGE ScopedTypeVariables       #-}-{-# LANGUAGE TypeFamilies              #-}-{-# LANGUAGE ViewPatterns              #-}+{-# LANGUAGE ConstraintKinds     #-}+{-# LANGUAGE DeriveFunctor       #-}+{-# LANGUAGE FlexibleContexts    #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell     #-}+{-# LANGUAGE TypeFamilies        #-}+{-# LANGUAGE ViewPatterns        #-}  ----------------------------------------------------------------------------- -- |@@ -20,7 +22,7 @@         -- * Polygons           PolyType(..)         , PolyOrientation(..)-        , PolygonOpts(..)+        , PolygonOpts(..), polyType, polyOrient, polyCenter          , polygon         , polyTrail@@ -44,36 +46,34 @@      ) where -import           Control.Monad           (forM, liftM)-import           Control.Monad.ST        (ST, runST)-import           Data.Array.ST           (STUArray, newArray, readArray,-                                          writeArray)-import qualified Data.Foldable           as F-import           Data.List               (maximumBy, minimumBy)-import qualified Data.List.NonEmpty      as NEL-import           Data.Maybe              (catMaybes)-import           Data.Monoid             (mconcat, mempty)-import           Data.Ord                (comparing)--import           Data.AffineSpace        ((.+^), (.-.))-import           Data.Default.Class-import           Data.VectorSpace        (magnitude, normalized, project, (<.>),-                                          (^*))+import           Control.Lens         (Lens', generateSignatures, lensRules,+                                       makeLensesWith, view, (.~), (^.))+import           Control.Monad        (forM, liftM)+import           Control.Monad.ST     (ST, runST)+import           Data.Array.ST        (STUArray, newArray, readArray,+                                       writeArray)+import           Data.Default+import           Data.List            (maximumBy, minimumBy)+import           Data.Maybe           (catMaybes)+import           Data.Ord             (comparing) +import           Diagrams.Angle import           Diagrams.Core import           Diagrams.Located import           Diagrams.Path-import           Diagrams.Points         (centroid)-import           Diagrams.Segment+import           Diagrams.Points      (centroid) import           Diagrams.Trail import           Diagrams.TrailLike-import           Diagrams.TwoD.Transform import           Diagrams.TwoD.Types-import           Diagrams.TwoD.Vector    (leftTurn, unitX, unitY, unit_Y)-import           Diagrams.Util           (tau, ( # ))+import           Diagrams.TwoD.Vector (leftTurn, unitX, unitY, unit_Y)+import           Diagrams.Util        (tau, ( # )) +import           Linear.Affine+import           Linear.Metric+import           Linear.Vector+ -- | Method used to determine the vertices of a polygon.-data PolyType = forall a. Angle a => PolyPolar [a] [Double]+data PolyType n = PolyPolar [Angle n] [n]                 -- ^ A \"polar\" polygon.                 --                 --   * The first argument is a list of /central/@@ -90,21 +90,21 @@                 --   circle) can be constructed using a second                 --   argument of @(repeat r)@. -              | forall a. Angle a => PolySides [a] [Double]+              | PolySides [Angle n] [n]                 -- ^ A polygon determined by the distance between-                --   successive vertices and the angles formed by-                --   each three successive vertices.  In other+                --   successive vertices and the external angles formed+                --   by each three successive vertices. In other                 --   words, a polygon specified by \"turtle                 --   graphics\": go straight ahead x1 units; turn by-                --   angle a1; go straght ahead x2 units; turn by-                --   angle a2; etc. The polygon will be centered at-                --   the /centroid/ of its vertices.+                --   external angle a1; go straight ahead x2 units; turn by+                --   external angle a2; etc. The polygon will be centered+                --   at the /centroid/ of its vertices.                 --                 --   * The first argument is a list of /vertex/-                --     /angles/, giving the angle at each vertex+                --     /angles/, giving the external angle at each vertex                 --     from the previous vertex to the next.  The-                --     first angle in the list is the angle at the-                --     /second/ vertex; the first edge always starts+                --     first angle in the list is the external angle at+                --     the /second/ vertex; the first edge always starts                 --     out heading in the positive y direction from                 --     the first vertex.                 --@@ -115,69 +115,73 @@                 --   angles and /n-1/ edge lengths.  Extra angles or                 --   lengths are ignored. -              | PolyRegular Int Double+              | PolyRegular Int n                 -- ^ A regular polygon with the given number of                 --   sides (first argument) and the given radius                 --   (second argument).  -- | Determine how a polygon should be oriented.-data PolyOrientation = NoOrient     -- ^ No special orientation; the first-                                    --   vertex will be at (1,0).-                                    --   This is the default.-                     | OrientH      -- ^ Orient /horizontally/, so the-                                    --   bottommost edge is parallel to-                                    --   the x-axis.-                     | OrientV      -- ^ Orient /vertically/, so the-                                    --   leftmost edge is parallel to the-                                    --   y-axis.-                     | OrientTo R2  -- ^ Orient so some edge is-                                    --   /facing/ /in/ /the/ /direction/-                                    --   /of/, that is, perpendicular-                                    --   to, the given vector.-  deriving (Eq, Ord, Show, Read)+data PolyOrientation n = NoOrient        -- ^ No special orientation; the first+                                         --   vertex will be at (1,0).+                       | OrientH         -- ^ Orient /horizontally/, so the+                                         --   bottommost edge is parallel to+                                         --   the x-axis.+                                         --   This is the default.+                       | OrientV         -- ^ Orient /vertically/, so the+                                         --   leftmost edge is parallel to the+                                         --   y-axis.+                       | OrientTo (V2 n) -- ^ Orient so some edge is+                                         --   /facing/ /in/ /the/ /direction/+                                         --   /of/, that is, perpendicular+                                         --   to, the given vector.+                       deriving (Eq, Ord, Show, Read)  -- | Options for specifying a polygon.-data PolygonOpts = PolygonOpts-                   { polyType   :: PolyType-                     -- ^ Specification for the polygon's vertices.+data PolygonOpts n = PolygonOpts+                   { _polyType   :: PolyType n+                   , _polyOrient :: PolyOrientation n+                   , _polyCenter :: Point V2 n+                   } -                   , polyOrient :: PolyOrientation-                     -- ^ Should a rotation be applied to the-                     --   polygon in order to orient it in a-                     --   particular way?+makeLensesWith (generateSignatures .~ False $ lensRules) ''PolygonOpts -                   , polyCenter :: P2-                     -- ^ Should a translation be applied to the-                     --   polygon in order to place the center at a-                     --   particular location?-                   }+-- | Specification for the polygon's vertices.+polyType :: Lens' (PolygonOpts n) (PolyType n) +-- | Should a rotation be applied to the polygon in order to orient it in a+--   particular way?+polyOrient :: Lens' (PolygonOpts n) (PolyOrientation n)++-- | Should a translation be applied to the polygon in order to place the center+--   at a particular location?+polyCenter :: Lens' (PolygonOpts n) (Point V2 n)+ -- | The default polygon is a regular pentagon of radius 1, centered --   at the origin, aligned to the x-axis.-instance Default PolygonOpts where+instance Num n => Default (PolygonOpts n) where     def = PolygonOpts (PolyRegular 5 1) OrientH origin  -- | Generate a polygon.  See 'PolygonOpts' for more information.-polyTrail :: PolygonOpts -> Located (Trail R2)+polyTrail :: OrderedField n => PolygonOpts n -> Located (Trail V2 n) polyTrail po = transform ori tr     where-        tr = case polyType po of+        tr = case po^.polyType of             PolyPolar ans szs -> polyPolarTrail ans szs             PolySides ans szs -> polySidesTrail ans szs             PolyRegular n r   -> polyRegularTrail n r-        ori = case polyOrient po of-            OrientH      -> orient unit_Y tr-            OrientV      -> orient unitX  tr-            OrientTo v   -> orient v      tr-            NoOrient     -> mempty+        ori = case po^.polyOrient of+            OrientH    -> orient unit_Y tr+            OrientV    -> orient unitX  tr+            OrientTo v -> orient v      tr+            NoOrient   -> mempty  -- | Generate the polygon described by the given options.-polygon :: (TrailLike t, V t ~ R2) => PolygonOpts -> t+polygon :: (InSpace V2 n t, TrailLike t) => PolygonOpts n -> t polygon = trailLike . polyTrail  -- | Generate the located trail of a polygon specified by polar data --   (central angles and radii). See 'PolyPolar'.-polyPolarTrail :: Angle a => [a] -> [Double] -> Located (Trail R2)+polyPolarTrail :: OrderedField n =>  [Angle n] -> [n] -> Located (Trail V2 n) polyPolarTrail [] _ = emptyTrail `at` origin polyPolarTrail _ [] = emptyTrail `at` origin polyPolarTrail ans (r:rs) = tr `at` p1@@ -186,51 +190,57 @@     tr = closeTrail . trailFromVertices $            zipWith              (\a l -> rotate a . scale l $ p2 (1,0))-             (scanl (+) 0 ans)+             (scanl (^+^) zero ans)              (r:rs)  -- | Generate the vertices of a polygon specified by side length and --   angles, and a starting point for the trail such that the origin --   is at the centroid of the vertices.  See 'PolySides'.-polySidesTrail :: Angle a => [a] -> [Double] -> Located (Trail R2)+polySidesTrail :: OrderedField n =>  [Angle n] -> [n] -> Located (Trail V2 n) polySidesTrail ans ls = tr `at` (centroid ps # scale (-1))   where-    ans'    = scanl (+) 0 ans+    ans'    = scanl (^+^) zero ans     offsets = zipWith rotate ans' (map (unitY ^*) ls)     ps      = scanl (.+^) origin offsets     tr      = closeTrail . trailFromOffsets $ offsets  -- | Generate the vertices of a regular polygon.  See 'PolyRegular'.-polyRegularTrail :: Int -> Double -> Located (Trail R2)+polyRegularTrail :: OrderedField n =>  Int -> n -> Located (Trail V2 n) polyRegularTrail n r = polyPolarTrail-                         (take (n-1) . repeat $ (tau::Rad) / fromIntegral n)+                         (replicate (n - 1) $ fullTurn ^/ fromIntegral n)                          (repeat r)  -- | Generate a transformation to orient a trail.  @orient v t@ --   generates the smallest rotation such that one of the segments --   adjacent to the vertex furthest in the direction of @v@ is --   perpendicular to @v@.-orient :: R2 -> Located (Trail R2) -> T2+orient :: OrderedField n => V2 n -> Located (Trail V2 n) -> Transformation V2 n orient v = orientPoints v . trailVertices -orientPoints :: R2 -> [P2] -> T2+orientPoints :: OrderedField n => V2 n -> [Point V2 n] -> Transformation V2 n+orientPoints _ [] = mempty+orientPoints _ [_] = mempty orientPoints v xs = rotation a   where     (n1,x,n2) = maximumBy (comparing (distAlong v . sndOf3))                   (zip3 (tail (cycle xs)) xs (last xs : init xs))-    distAlong w ((.-. origin) -> p) = signum (w <.> p) * magnitude (project w p)-    sndOf3 (_,x,_) = x-    a = minimumBy (comparing abs) . map (angleFromNormal . (.-. x)) $ [n1,n2]-    v' = normalized v+    distAlong w ((.-. origin) -> p) = signum (w `dot` p) * norm (project w p)+    sndOf3 (_,b,_) = b+    -- a :: Angle (Scalar v)+    a = minimumBy (comparing $ abs . view rad)+        . map (angleFromNormal . (.-. x)) $ [n1,n2]+    v' = signorm v+    -- angleFromNormal :: v -> Angle (Scalar v)     angleFromNormal o       | leftTurn o' v' = phi-      | otherwise      = negate phi+      | otherwise      = negated phi       where-        o' = normalized o-        theta = acos (v' <.> o')+        o' = signorm o+        theta = acos (v' `dot` o')+        -- phi :: Angle (Scalar v)         phi-          | theta <= tau/4 = Rad $ tau/4 - theta-          | otherwise      = Rad $ theta - tau/4+          | theta <= tau/4 = tau/4 - theta @@ rad+          | otherwise      = theta - tau/4 @@ rad  ------------------------------------------------------------ -- Function graphs@@ -267,10 +277,10 @@     markRho :: Int -> STUArray s Int Bool -> ST s [Int]     markRho i marks = do       isMarked <- readArray marks i-      case isMarked of-        True  -> return []-        False -> writeArray marks i True >>-                 liftM (i:) (markRho (f_n i) marks)+      if isMarked+        then return []+        else writeArray marks i True >>+               liftM (i:) (markRho (f_n i) marks)      splitParts :: [Int] -> [GraphPart Int]     splitParts tr = hair ++ cyc@@ -309,13 +319,13 @@ -- | Create a generalized /star/ /polygon/.  The 'StarOpts' are used --   to determine in which order the given vertices should be --   connected.  The intention is that the second argument of type---   @[P2]@ could be generated by a call to 'polygon', 'regPoly', or+--   @[Point v]@ could be generated by a call to 'polygon', 'regPoly', or --   the like, since a list of vertices is 'TrailLike'.  But of course---   the list can be generated any way you like.  A @'Path' 'R2'@ is+--   the list can be generated any way you like.  A @'Path' 'v'@ is --   returned (instead of any 'TrailLike') because the resulting path --   may have more than one component, for example if the vertices are --   to be connected in several disjoint cycles.-star :: StarOpts -> [P2] -> Path R2+star :: OrderedField n => StarOpts -> [Point V2 n] -> Path V2 n star sOpts vs = graphToPath $ mkGraph f vs   where f = case sOpts of               StarFun g  -> g

src/Diagrams/TwoD/Segment.hs view

@@ -1,7 +1,15 @@+{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE FlexibleContexts     #-} {-# LANGUAGE FlexibleInstances    #-}+{-# LANGUAGE TypeFamilies         #-}+{-# LANGUAGE ViewPatterns         #-} {-# LANGUAGE UndecidableInstances #-} +{-# OPTIONS_GHC -fno-warn-orphans #-}+-- Orphan Traced instances for Segment Closed V2 and FixedSegment V2.+-- They can't go in Traced; but they shouldn't really go in+-- Diagrams.Segment either because we only have Traced instances for+-- the special case of R2. ----------------------------------------------------------------------------- -- | -- Module      :  Diagrams.TwoD.Segment@@ -14,90 +22,358 @@ -- ----------------------------------------------------------------------------- -module Diagrams.TwoD.Segment where+module Diagrams.TwoD.Segment+  ( -- * Segment intersections -import           Control.Applicative     (liftA2)+    intersectPointsS+  , intersectPointsS' -import           Data.AffineSpace-import           Data.Monoid.Inf         hiding (minimum)-import           Data.VectorSpace+    -- * Closest point on a segment +  , closestPoint+  , closestPoint'+  , closestDistance+  , closestDistance'+  , closestParam+  , closestParam'++    -- ** Low level functions+  , segmentSegment+  , lineSegment+  )+  where++import           Control.Lens                    hiding (at, contains, transform, ( # ))+import           Data.Maybe+ import           Diagrams.Core-import           Diagrams.Core.Trace +import           Diagrams.Direction import           Diagrams.Located import           Diagrams.Parametric import           Diagrams.Segment-import           Diagrams.Solve+import           Diagrams.TwoD.Points+import           Diagrams.TwoD.Segment.Bernstein import           Diagrams.TwoD.Transform-import           Diagrams.TwoD.Types+import           Diagrams.TwoD.Types             hiding (p2) import           Diagrams.TwoD.Vector-import           Diagrams.Util -instance Traced (Segment Closed R2) where+import           Linear.Affine+import           Linear.Metric++{- All instances of Traced should maintain the invariant that the list of+   traces is sorted in increasing order.+-}++instance OrderedField n => Traced (Segment Closed V2 n) where   getTrace = getTrace . mkFixedSeg . (`at` origin) -instance Traced (FixedSegment R2) where+instance OrderedField n => Traced (FixedSegment V2 n) where+  getTrace seg = mkTrace $ \p v ->+    mkSortedList . map (view _1) $ lineSegment defEps (v `at` p) seg -{- Given lines defined by p0 + t0 * v0 and p1 + t1 * v1, their point of-   intersection in 2D is given by+defEps :: Fractional n => n+defEps = 1e-8 -     t_i = (v_(1-i)^ . (p1 - p0)) / (v1^ . v0)+-- | Compute the intersections between two fixed segments.+intersectPointsS :: OrderedField n => FixedSegment V2 n -> FixedSegment V2 n -> [P2 n]+intersectPointsS = intersectPointsS' defEps -   where v^ denotes the perpendicular to v, i.e. v rotated by-   -tau/4.+-- | Compute the intersections between two segments using the given tolerance.+intersectPointsS' :: OrderedField n => n -> FixedSegment V2 n -> FixedSegment V2 n -> [P2 n]+intersectPointsS' eps s1 s2 = map (view _3) $ segmentSegment eps s1 s2 -   This can be derived by starting with the parametric equation+-- | Get the closest distance(s) from a point to a 'FixedSegment'.+closestDistance :: OrderedField n => FixedSegment V2 n -> P2 n -> [n]+closestDistance = closestDistance' defEps -     p0 + v0 t0 = p1 + v1 t1+-- | Get the closest distance(s) from a point to a 'FixedSegment' within given+--   tolerance.+closestDistance' :: OrderedField n => n -> FixedSegment V2 n -> P2 n -> [n]+closestDistance' eps seg p = map (distanceA p) $ closestPoint' eps seg p -   and rearranging to get the matrix equation+-- | Get the closest point(s) on a 'FixedSegment' from a point.+closestPoint :: OrderedField n => FixedSegment V2 n -> P2 n -> [P2 n]+closestPoint = closestPoint' defEps -     [v0 -v1] [ t0 ]  =  (p1 - p0)-              [ t1 ]+-- | Get the closest point(s) on a 'FixedSegment' from a point within given+--   tolerance.+closestPoint' :: OrderedField n => n -> FixedSegment V2 n -> P2 n -> [P2 n]+closestPoint' eps seg = map (seg `atParam`) . closestParam' eps seg -   Working out the product of the inverse of [v0 -v1] with (p1 - p0)-   results in the above formulas for t_i.--}+-- | Find the closest value(s) on the Bêzier to the given point.+closestParam :: OrderedField n => FixedSegment V2 n -> P2 n -> [n]+closestParam = closestParam' defEps -  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 Infinity-        else Finite t1+-- | Find the closest value(s) on the Bêzier to the given point within given+--   tolerance.+closestParam' :: OrderedField n => n -> FixedSegment V2 n -> P2 n -> [n]+closestParam' _ (FLinear p0 p1) p+  | t < 0     = [0]+  | t > 1     = [1]+  | otherwise = [t]+  where+    vp = p  .-. p0+    v  = p1 .-. p0+    dp = vp `dot` v+    t  = dp / quadrance v+closestParam' eps cb (P (V2 px py)) = bezierFindRoot eps poly 0 1+  where+    (bx, by) = bezierToBernstein cb+    bx'  = bernsteinDeriv bx+    by'  = bernsteinDeriv by+    poly = (bx - listToBernstein [px, px, px, px]) * bx'+         + (by - listToBernstein [py, py, py, py]) * by' -{- 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.+------------------------------------------------------------------------+-- Low level+------------------------------------------------------------------------ -   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.--}+-- | Return the intersection points with the parameters at which each segment+--   intersects.+segmentSegment :: OrderedField n => n -> FixedSegment V2 n -> FixedSegment V2 n -> [(n, n, P2 n)]+segmentSegment eps s1 s2 =+  case (s1,s2) of+    (FCubic{}, FCubic{})  -> map (\(t1,t2) -> (t1,t2, s1 `atParam` t1))+                           $ bezierClip eps s1 s2+    (FCubic{}, FLinear{}) -> map flip12 $ linearSeg (segLine s2) s1+    _                     -> linearSeg (segLine s1) s2 -- s1 is linear+  where+    linearSeg l s  = filter (inRange . view _1) $ lineSegment eps l s+    flip12 (a,b,c) = (b,a,c) -  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 . atParam bez') ts-    in-      case xs of-        [] -> Infinity-        _  -> Finite (minimum xs)+-- | Return the intersection points with the parameters at which the line and segment+--   intersect.+lineSegment :: OrderedField n => n -> Located (V2 n) -> FixedSegment V2 n -> [(n, n, P2 n)]+lineSegment _ l1 p@(FLinear p0 p1)+  = map (\(tl,tp) -> (tl, tp, p `atParam` tp))+  . filter (inRange . snd) . maybeToList $ lineLine l1 (mkLine p0 p1)+lineSegment eps (viewLoc -> (p,r)) cb = map addPoint params+  where+    params = bezierFindRoot eps (listToBernstein $ cb' ^.. each . _y) 0 1+    cb'    = transform (inv (rotationTo $ dir r)) . moveOriginTo p $ cb+    --+    addPoint bt = (lt, bt, intersect)+      where+        intersect = cb `atParam` bt+        lt        = (cb' `atParam` bt) ^. _x / norm r++-- Adapted from from kuribas's cubicbezier package https://github.com/kuribas/cubicbezier++-- | Use the Bêzier clipping algorithm to return the parameters at which the+--   Bêzier curves intersect.+bezierClip :: OrderedField n => n -> FixedSegment V2 n -> FixedSegment V2 n -> [(n, n)]+bezierClip eps p_ q_ = filter (allOf both inRange) -- sometimes this returns NaN+                     $ go p_ q_ 0 1 0 1 0 False+  where+  go p q tmin tmax umin umax clip revCurves+    | isNothing chopInterval = []++    -- This check happens before the subdivision+    -- test to avoid non-termination as values+    -- transition to within epsilon.+    | max (umax - umin) (tmax' - tmin') < eps =+      if revCurves -- return parameters in correct order+      then [ (avg umin  umax,  avg tmin' tmax') ]+      else [ (avg tmin' tmax', avg umin  umax ) ]++    -- split the curve if there isn't enough reduction+    | clip > 0.8 && clip' > 0.8 =+      if tmax' - tmin' > umax - umin -- split the longest segment+      then let (pl, pr) = p' `splitAtParam` 0.5+               tmid = avg tmin' tmax'+           in  go q pl umin umax tmin' tmid  clip' (not revCurves) +++               go q pr umin umax tmid  tmax' clip' (not revCurves)+      else let (ql, qr) = q `splitAtParam` 0.5+               umid = avg umin umax+           in  go ql p' umin umid tmin' tmax' clip' (not revCurves) +++               go qr p' umid umax tmin' tmax' clip' (not revCurves)++    -- iterate with the curves reversed.+    | otherwise = go q p' umin umax tmin' tmax' clip' (not revCurves)+    where+      chopInterval              = chopCubics p q+      Just (tminChop, tmaxChop) = chopInterval+      p'    = section p tminChop tmaxChop+      clip' = tmaxChop - tminChop+      tmin' = tmax * tminChop + tmin * (1 - tminChop)+      tmax' = tmax * tmaxChop + tmin * (1 - tmaxChop)++-- | Find the zero of a 1D Bêzier curve of any degree.  Note that this+--   can be used as a Bernstein polynomial root solver by converting from+--   the power basis to the Bernstein basis.+bezierFindRoot :: OrderedField n+               => n   -- ^ The accuracy+               -> BernsteinPoly n -- ^ the Bernstein coefficients of the polynomial+               -> n   -- ^ The lower bound of the interval+               -> n   -- ^ The upper bound of the interval+               -> [n] -- ^ The roots found+bezierFindRoot eps p tmin tmax+  -- If we generated the max number of roots and tmax is also a root+  -- (which is not among the generated ones), there must in fact be an+  -- infinite number of roots, so just include tmax.+  | length roots == bernsteinDegree p && last roots /= tmax && abs (evaluateBernstein p tmax) <= eps+  = roots ++ [tmax]+  | otherwise = roots+ where+  -- Lazily take a number of roots at most the degree of the bernstein+  -- polynomial, to avoid generating a ton of roots in the case of a+  -- straight Bezier segment along the x-axis. See https://github.com/diagrams/diagrams-contrib/issues/91 .+  roots = take (bernsteinDegree p) $ go p tmin tmax+  go p tmin tmax+    | isNothing chopInterval = []+    | tmax' - tmin' < eps = [avg tmin' tmax']+    | clip > 0.8 = let (p1, p2) = splitAtParam newP 0.5+                       tmid     = tmin' + (tmax' - tmin') / 2+                   in  go p1 tmin' tmid  +++                       go p2 tmid  tmax'+    | otherwise = bezierFindRoot eps newP tmin' tmax'+    where+      chopInterval              = chopYs (bernsteinCoeffs p)+      Just (tminChop, tmaxChop) = chopInterval+      newP  = section p tminChop tmaxChop+      clip  = tmaxChop - tminChop+      tmin' = tmax * tminChop + tmin * (1 - tminChop)+      tmax' = tmax * tmaxChop + tmin * (1 - tmaxChop)++------------------------------------------------------------------------+-- Internal+------------------------------------------------------------------------++-- | An approximation of the fat line for a cubic Bêzier segment. Returns+--   @(0,0)@ for a linear segment.+fatLine :: OrderedField n => FixedSegment V2 n -> (n,n)+fatLine (FCubic p0 p1 p2 p3)+  = case (d1 > 0, d2 > 0) of+      (True,  True)  -> (0,                0.75 * max d1 d2)+      (False, False) -> (0.75 * min d1 d2, 0               )+      (True,  False) -> (4/9 * d2,         4/9 * d1        )+      (False, True)  -> (4/9 * d1,         4/9 * d2        )+  where+    d = lineDistance p0 p3+    d1 = d p1; d2 = d p2+fatLine _ = (0,0)++chopYs :: OrderedField n => [n] -> Maybe (n, n)+chopYs ds = chopHull 0 0 points+  where+    points = zipWith mkP2 [fromIntegral i / fromIntegral n | i <- [0..n]] ds+    n      = length ds - 1++chopCubics :: OrderedField n => FixedSegment V2 n -> FixedSegment V2 n -> Maybe (n,n)+chopCubics p q@(FCubic q0 _ _ q3)+  = chopHull dmin dmax dps+  where+    dps = zipWith mkP2 [0, 1/3, 2/3, 1] ds+    ds  = p ^.. each . to d+    d   = lineDistance q0 q3+    --+    (dmin,dmax) = fatLine q+chopCubics _ _ = Nothing++-- Reduce the interval which the intersection is known to lie in using the fat+-- line of one curve and convex hull of the points formed from the distance to+-- the thin line of the other+chopHull :: OrderedField n => n -> n -> [P2 n] -> Maybe (n, n)+chopHull dmin dmax dps = do+  tL <- testBelow upper           $ testBetween (head upper) $ testAbove lower+  tR <- testBelow (reverse upper) $ testBetween (last upper) $ testAbove (reverse lower)+  Just (tL, tR)+    where+      (upper, lower) = sortedConvexHull dps++      testBelow (p1@(P (V2 _ y1)) : p2@(P (V2 _ y2)) : ps) continue+        | y1 >= dmin = continue+        | y1 >  y2   = Nothing+        | y2 <  dmin = testBelow (p2:ps) continue+        | otherwise  = Just $ intersectPt dmin p1 p2+      testBelow _ _  = Nothing++      testBetween (P (V2 x y)) continue+        | y <= dmax = Just x+        | otherwise = continue++      testAbove (p1@(P (V2 _ y1)) : p2@(P (V2 _ y2)) : ps)+        | y1 < y2      = Nothing+        | y2 > dmax    = testAbove (p2:ps)+        | y2 - y1 == 0 = Nothing  -- Check this condition to prevent+                                  -- division by zero in `intersectPt`.+        | otherwise    = Just $ intersectPt dmax p1 p2+      testAbove _      = Nothing++      -- find the x value where the line through the two points+      -- intersect the line y=d.  Note that `y2 - y1 != 0` due+      -- to checks above.+      intersectPt d (P (V2 x1 y1)) (P (V2 x2 y2)) =+          x1 + (d - y1) * (x2 - x1) / (y2 - y1)++++bezierToBernstein :: Fractional n => FixedSegment V2 n -> (BernsteinPoly n, BernsteinPoly n)+bezierToBernstein seg =+    (listToBernstein $ map (view _x) coeffs, listToBernstein $ map (view _y) coeffs)+  where coeffs = toListOf each seg++------------------------------------------------------------------------+-- Lines+------------------------------------------------------------------------++-- Could split this into a separate module.++-- | Returns @(a, b, c, d)@ such that @ax + by + c = 0@ is the line going through+--   @p1@ and @p2@ with @(a^2)/d + (b^2)/d = 1@.  We delay the division by+--   @d@ as it may not be needed in all cases and @d@ may be zero.+lineEquation :: Floating n => P2 n -> P2 n -> (n, n, n, n)+lineEquation (P (V2 x1 y1)) (P (V2 x2 y2)) = (a, b, c, d)+  where+    c  = -(x1*a + y1*b)+    a = y1 - y2+    b = x2 - x1+    d  = a*a + b*b++-- | Return the distance from a point to the line.+lineDistance :: (Ord n, Floating n) => P2 n -> P2 n -> P2 n -> n+lineDistance p1 p2 p3@(P (V2 x y))+    -- I have included the check that d' <= 0 in case+    -- there exists some d > 0 where sqrt d == 0.  I don't+    -- think this can happen as sqrt is at least recommended+    -- to be within one value of correct for sqrt and near+    -- zero values get bigger.+    | d <= 0 || d' <= 0 = norm (p1 .-. p3)+    | otherwise = (a*x + b*y + c) / d'+  where+    (a, b, c, d) = lineEquation p1 p2+    d' = sqrt d++-- clockwise :: (Num n, Ord n) => V2 n -> V2 n -> Bool+-- clockwise a b = a `cross2` b <= 0++avg :: Fractional n => n -> n -> n+avg a b = (a + b)/2++lineLine :: (Fractional n, Eq n) => Located (V2 n) -> Located (V2 n) -> Maybe (n,n)+lineLine (viewLoc -> (p,r)) (viewLoc -> (q,s))+  | x1 == 0 && x2 /= 0 = Nothing                 -- parallel+  | otherwise          = Just (x3 / x1, x2 / x1) -- intersecting or collinear+  where+    x1 = r × s+    x2 = v × r+    x3 = v × s+    v  = q .-. p++(×) :: Num n => V2 n -> V2 n -> n+(×) = cross2++mkLine :: InSpace v n (v n) => Point v n -> Point v n -> Located (v n)+mkLine p0 p1 = (p1 .-. p0) `at` p0++segLine :: InSpace v n (v n) => FixedSegment v n -> Located (v n)+segLine (FLinear p0 p1)    = mkLine p0 p1+segLine (FCubic p0 _ _ p3) = mkLine p0 p3++-- This function uses `defEps`, but is used in functions+-- above that take an epsilon parameter.  It would be nice+-- to clearify the meaning of each of these epsilons.+inRange :: (Fractional n, Ord n) => n -> Bool+inRange x = x < (1+defEps) && x > (-defEps)

+ src/Diagrams/TwoD/Segment/Bernstein.hs view

@@ -0,0 +1,138 @@+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE TypeFamilies  #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Diagrams.TwoD.Segment.Bernstein+-- Copyright   :  (c) 2014-2015 diagrams-lib team (see LICENSE)+-- License     :  BSD-style (see LICENSE)+-- Maintainer  :  diagrams-discuss@googlegroups.com+--+-- Bernstein polynomials, used internally by code to find+-- intersections of paths.  This module is probably not of any+-- relevance to most users of diagrams.+-----------------------------------------------------------------------------+module Diagrams.TwoD.Segment.Bernstein+  ( BernsteinPoly (..)+  , listToBernstein+  , evaluateBernstein++  , degreeElevate+  , bernsteinDeriv+  , evaluateBernsteinDerivs+  ) where++import           Data.List           (tails)+import           Diagrams.Core.V+import           Diagrams.Parametric+import           Linear.V1++-- | Compute the binomial coefficients of degree n.+binomials :: Num n => Int -> [n]+binomials n = map fromIntegral $ scanl (\x m -> x * (n - m+1) `quot` m) 1 [1..n]++data BernsteinPoly n = BernsteinPoly+  { bernsteinDegree :: Int+  , bernsteinCoeffs :: [n]+  } deriving (Show, Functor)++type instance V        (BernsteinPoly n) = V1+type instance N        (BernsteinPoly n) = n+type instance Codomain (BernsteinPoly n) = V1++-- | Create a bernstein polynomial from a list of coëfficients.+listToBernstein :: Fractional n => [n] -> BernsteinPoly n+listToBernstein [] = 0+listToBernstein l  = BernsteinPoly (length l - 1) l++-- | Degree elevate a bernstein polynomial a number of times.+degreeElevate :: Fractional n => BernsteinPoly n -> Int -> BernsteinPoly n+degreeElevate b                    0     = b+degreeElevate (BernsteinPoly lp p) times =+  degreeElevate (BernsteinPoly (lp+1) (head p:inner p 1)) (times-1)+  where+    n = fromIntegral lp++    inner []         _ = [0]+    inner [a]        _ = [a]+    inner (a:b:rest) i = (i*a/(n+1) + b*(1 - i/(n+1))) : inner (b:rest) (i+1)++-- | Evaluate the bernstein polynomial.+evaluateBernstein :: Fractional n => BernsteinPoly n -> n -> n+evaluateBernstein (BernsteinPoly _ [])       _ = 0+evaluateBernstein (BernsteinPoly _ [b])      _ = b+evaluateBernstein (BernsteinPoly lp (b':bs)) t = go t n (b'*u) 2 bs+  where+    u = 1-t+    n = fromIntegral lp++    go tn bc tmp _ [b]      = tmp + tn*bc*b+    go tn bc tmp i (b:rest) =+      go (tn*t)              -- tn+         (bc*(n - i+1)/i)    -- bc+         ((tmp + tn*bc*b)*u) -- tmp+         (i+1)               -- i+         rest+    go _ _ _ _ []           = error "evaluateBernstein: impossible"++-- | Evaluate the bernstein polynomial and its derivatives.+evaluateBernsteinDerivs :: Fractional n => BernsteinPoly n -> n -> [n]+evaluateBernsteinDerivs b t+  | bernsteinDegree b == 0 = [evaluateBernstein b t]+  | otherwise              = evaluateBernstein b t : evaluateBernsteinDerivs (bernsteinDeriv b) t++-- | Find the derivative of a bernstein polynomial.+bernsteinDeriv :: Fractional n => BernsteinPoly n -> BernsteinPoly n+bernsteinDeriv (BernsteinPoly 0 _)  = 0+bernsteinDeriv (BernsteinPoly lp p) =+  -- BernsteinPoly (lp-1) $ map (* fromIntegral lp) $ zipWith (-) (tail p) p+  BernsteinPoly (lp-1) $ zipWith (\a b -> (a - b) * fromIntegral lp) (tail p) p++instance Fractional n => Parametric (BernsteinPoly n) where+  atParam b = V1 . evaluateBernstein b+instance Num n        => DomainBounds (BernsteinPoly n)+instance Fractional n => EndValues    (BernsteinPoly n)+instance Fractional n => Sectionable  (BernsteinPoly n) where+  splitAtParam  = bernsteinSplit+  reverseDomain (BernsteinPoly i xs) = BernsteinPoly i (reverse xs)++-- | Split a bernstein polynomial.+bernsteinSplit :: Num n => BernsteinPoly n -> n -> (BernsteinPoly n, BernsteinPoly n)+bernsteinSplit (BernsteinPoly lp p) t =+  (BernsteinPoly lp $ map head controls,+   BernsteinPoly lp $ reverse $ map last controls)+  where+    interp a b = (1-t)*a + t*b++    terp [_] = []+    terp l   = let ctrs = zipWith interp l (tail l)+               in  ctrs : terp ctrs+    controls = p : terp p++instance Fractional n => Num (BernsteinPoly n) where+  ba@(BernsteinPoly la a) + bb@(BernsteinPoly lb b)+    | la < lb   = BernsteinPoly lb $ zipWith (+) (bernsteinCoeffs $ degreeElevate ba $ lb - la) b+    | la > lb   = BernsteinPoly la $ zipWith (+) a (bernsteinCoeffs $ degreeElevate bb $ la - lb)+    | otherwise = BernsteinPoly la $ zipWith (+) a b++  ba@(BernsteinPoly la a) - bb@(BernsteinPoly lb b)+    | la < lb   = BernsteinPoly lb $ zipWith (-) (bernsteinCoeffs $ degreeElevate ba (lb - la)) b+    | la > lb   = BernsteinPoly la $ zipWith (-) a (bernsteinCoeffs $ degreeElevate bb (la - lb))+    | otherwise = BernsteinPoly la $ zipWith (-) a b++  (BernsteinPoly la a) * (BernsteinPoly lb b) =+    BernsteinPoly (la+lb) $+    zipWith (flip (/)) (binomials (la + lb)) $+                   init $ map sum $+                   map (zipWith (*) a') (down b') +++                   map (zipWith (*) (reverse b')) (tail $ tails a')+                   -- zipWith (zipWith (*)) (tail $ tails a') (repeat $ reverse b')+    where down l = tail $ scanl (flip (:)) [] l -- [[1], [2, 1], [3, 2, 1], ...+          a' = zipWith (*) a (binomials la)+          b' = zipWith (*) b (binomials lb)++  fromInteger a = BernsteinPoly 0 [fromInteger a]++  signum (BernsteinPoly _ [])    = 0+  signum (BernsteinPoly _ (a:_)) = BernsteinPoly 0 [signum a]++  abs = fmap abs

src/Diagrams/TwoD/Shapes.hs view

@@ -1,6 +1,11 @@+{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TemplateHaskell  #-} {-# LANGUAGE TypeFamilies     #-} +{-# OPTIONS_GHC -fno-warn-unused-imports #-}+  -- for Data.Semigroup+ ----------------------------------------------------------------------------- -- | -- Module      :  Diagrams.TwoD.Shapes@@ -25,6 +30,7 @@        , square        , pentagon        , hexagon+       , heptagon        , septagon        , octagon        , nonagon@@ -39,13 +45,17 @@          -- * Other shapes         , roundedRect-       , RoundedRectOpts(..)+       , RoundedRectOpts(..), radiusTL, radiusTR, radiusBL, radiusBR        , roundedRect'        ) where +import           Control.Lens            (makeLenses, op, (&), (.~), (<>~), (^.))+import           Data.Default+import           Data.Semigroup+ import           Diagrams.Core -import           Diagrams.Coordinates+import           Diagrams.Angle import           Diagrams.Located        (at) import           Diagrams.Path import           Diagrams.Segment@@ -55,56 +65,54 @@ import           Diagrams.TwoD.Polygons import           Diagrams.TwoD.Transform import           Diagrams.TwoD.Types-+import           Diagrams.TwoD.Vector import           Diagrams.Util -import           Data.Default.Class-import           Data.Semigroup  -- | Create a centered horizontal (L-R) line of the given length. -----   <<diagrams/hruleEx.svg#diagram=hruleEx&width=300>>+--   <<diagrams/src_Diagrams_TwoD_Shapes_hruleEx.svg#diagram=hruleEx&width=300>> -----   > hruleEx = vcat' with {sep = 0.2} (map hrule [1..5])+--   > hruleEx = vcat' (with & sep .~ 0.2) (map hrule [1..5]) --   >         # centerXY # pad 1.1-hrule :: (TrailLike t, V t ~ R2) => Double -> t-hrule d = trailLike $ trailFromSegments [straight (d & 0)] `at` (p2 (-d/2,0))+hrule :: (InSpace V2 n t, TrailLike t) => n -> t+hrule d = trailLike $ trailFromSegments [straight $ r2 (d, 0)] `at` p2 (-d/2,0)  -- | Create a centered vertical (T-B) line of the given length. -----   <<diagrams/vruleEx.svg#diagram=vruleEx&height=100>>+--   <<diagrams/src_Diagrams_TwoD_Shapes_vruleEx.svg#diagram=vruleEx&height=100>> -----   > vruleEx = hcat' with {sep = 0.2} (map vrule [1, 1.2 .. 2])+--   > vruleEx = hcat' (with & sep .~ 0.2) (map vrule [1, 1.2 .. 2]) --   >         # centerXY # pad 1.1-vrule :: (TrailLike t, V t ~ R2) => Double -> t-vrule d = trailLike $ trailFromSegments [straight (0 & (-d))] `at` (p2 (0,d/2))+vrule :: (InSpace V2 n t, TrailLike t) => n -> t+vrule d = trailLike $ trailFromSegments [straight $ r2 (0, -d)] `at` p2 (0,d/2)  -- | A square with its center at the origin and sides of length 1, --   oriented parallel to the axes. -----   <<diagrams/unitSquareEx.svg#diagram=unitSquareEx&width=100>>-unitSquare :: (TrailLike t, V t ~ R2) => t-unitSquare = polygon with { polyType   = PolyRegular 4 (sqrt 2 / 2)-                          , polyOrient = OrientH }+--   <<diagrams/src_Diagrams_TwoD_Shapes_unitSquareEx.svg#diagram=unitSquareEx&width=100>>+unitSquare :: (InSpace V2 n t, TrailLike t) => t+unitSquare = polygon (def & polyType   .~ PolyRegular 4 (sqrt 2 / 2)+                          & polyOrient .~ OrientH)  -- > unitSquareEx = unitSquare # pad 1.1 # showOrigin  -- | A square with its center at the origin and sides of the given --   length, oriented parallel to the axes. -----   <<diagrams/squareEx.svg#diagram=squareEx&width=200>>-square :: (TrailLike t, Transformable t, V t ~ R2) => Double -> t+--   <<diagrams/src_Diagrams_TwoD_Shapes_squareEx.svg#diagram=squareEx&width=200>>+square :: (InSpace V2 n t, TrailLike t) => n -> t square d = rect d d --- > squareEx = hcat' with {sep = 0.5} [square 1, square 2, square 3]--- >          # centerXY # pad 1.1 # lw 0.03+-- > squareEx = hcat' (with & sep .~ 0.5) [square 1, square 2, square 3]+-- >          # centerXY # pad 1.1  -- | @rect w h@ is an axis-aligned rectangle of width @w@ and height --   @h@, centered at the origin. -----   <<diagrams/rectEx.svg#diagram=rectEx&width=150>>-rect :: (TrailLike t, Transformable t, V t ~ R2) => Double -> Double -> t-rect w h = trailLike . head . pathTrails $ unitSquare # scaleX w # scaleY h+--   <<diagrams/src_Diagrams_TwoD_Shapes_rectEx.svg#diagram=rectEx&width=150>>+rect :: (InSpace V2 n t, TrailLike t) => n -> n -> t+rect w h = trailLike . head . op Path $ unitSquare # scaleX w # scaleY h  -- > rectEx = rect 1 0.7 # pad 1.1 @@ -135,19 +143,19 @@ --   polygons of a given /radius/). -- --   The polygon will be oriented with one edge parallel to the x-axis.-regPoly :: (TrailLike t, V t ~ R2) => Int -> Double -> t-regPoly n l = polygon with { polyType =+regPoly :: (InSpace V2 n t, TrailLike t) => Int -> n -> t+regPoly n l = polygon (def & polyType .~                                PolySides-                                 (repeat (1/ fromIntegral n :: Turn))+                                 (repeat (1/fromIntegral n @@ turn))                                  (replicate (n-1) l)-                           , polyOrient = OrientH-                           }+                           & polyOrient .~ OrientH+                           )  -- > shapeEx sh   = sh 1 # pad 1.1 -- > triangleEx   = shapeEx triangle -- > pentagonEx   = shapeEx pentagon -- > hexagonEx    = shapeEx hexagon--- > septagonEx   = shapeEx septagon+-- > heptagonEx   = shapeEx heptagon -- > octagonEx    = shapeEx octagon -- > nonagonEx    = shapeEx nonagon -- > decagonEx    = shapeEx decagon@@ -155,76 +163,92 @@ -- > dodecagonEx  = shapeEx dodecagon  -- | A synonym for 'triangle', provided for backwards compatibility.-eqTriangle :: (TrailLike t, V t ~ R2) => Double -> t+eqTriangle :: (InSpace V2 n t, TrailLike t) => n -> t eqTriangle = triangle  -- | An equilateral triangle, with sides of the given length and base --   parallel to the x-axis. -----   <<diagrams/triangleEx.svg#diagram=triangleEx&width=100>>-triangle :: (TrailLike t, V t ~ R2) => Double -> t+--   <<diagrams/src_Diagrams_TwoD_Shapes_triangleEx.svg#diagram=triangleEx&width=100>>+triangle :: (InSpace V2 n t, TrailLike t) => n -> t triangle = regPoly 3  -- | A regular pentagon, with sides of the given length and base --   parallel to the x-axis. -----   <<diagrams/pentagonEx.svg#diagram=pentagonEx&width=100>>-pentagon :: (TrailLike t, V t ~ R2) => Double -> t+--   <<diagrams/src_Diagrams_TwoD_Shapes_pentagonEx.svg#diagram=pentagonEx&width=100>>+pentagon :: (InSpace V2 n t, TrailLike t) => n -> t pentagon = regPoly 5  -- | A regular hexagon, with sides of the given length and base --   parallel to the x-axis. -----   <<diagrams/hexagonEx.svg#diagram=hexagonEx&width=100>>-hexagon :: (TrailLike t, V t ~ R2) => Double -> t+--   <<diagrams/src_Diagrams_TwoD_Shapes_hexagonEx.svg#diagram=hexagonEx&width=100>>+hexagon :: (InSpace V2 n t, TrailLike t) => n -> t hexagon = regPoly 6 --- | A regular septagon, with sides of the given length and base+-- | A regular heptagon, with sides of the given length and base --   parallel to the x-axis. -----   <<diagrams/septagonEx.svg#diagram=septagonEx&width=100>>-septagon :: (TrailLike t, V t ~ R2) => Double -> t-septagon = regPoly 7+--   <<diagrams/src_Diagrams_TwoD_Shapes_heptagonEx.svg#diagram=heptagonEx&width=100>>+heptagon :: (InSpace V2 n t, TrailLike t) => n -> t+heptagon = regPoly 7 +-- | A synonym for 'heptagon'.  It is, however, completely inferior,+--   being a base admixture of the Latin /septum/ (seven) and the+--   Greek γωνία (angle).+septagon :: (InSpace V2 n t, TrailLike t) => n -> t+septagon = heptagon+ -- | A regular octagon, with sides of the given length and base --   parallel to the x-axis. -----   <<diagrams/octagonEx.svg#diagram=octagonEx&width=100>>-octagon :: (TrailLike t, V t ~ R2) => Double -> t+--   <<diagrams/src_Diagrams_TwoD_Shapes_octagonEx.svg#diagram=octagonEx&width=100>>+octagon :: (InSpace V2 n t, TrailLike t) => n -> t octagon = regPoly 8  -- | A regular nonagon, with sides of the given length and base --   parallel to the x-axis. -----   <<diagrams/nonagonEx.svg#diagram=nonagonEx&width=100>>-nonagon :: (TrailLike t, V t ~ R2) => Double -> t+--   <<diagrams/src_Diagrams_TwoD_Shapes_nonagonEx.svg#diagram=nonagonEx&width=100>>+nonagon :: (InSpace V2 n t, TrailLike t) => n -> t nonagon = regPoly 9  -- | A regular decagon, with sides of the given length and base --   parallel to the x-axis. -----   <<diagrams/decagonEx.svg#diagram=decagonEx&width=100>>-decagon :: (TrailLike t, V t ~ R2) => Double -> t+--   <<diagrams/src_Diagrams_TwoD_Shapes_decagonEx.svg#diagram=decagonEx&width=100>>+decagon :: (InSpace V2 n t, TrailLike t) => n -> t decagon = regPoly 10  -- | A regular hendecagon, with sides of the given length and base --   parallel to the x-axis. -----   <<diagrams/hendecagonEx.svg#diagram=hendecagonEx&width=100>>-hendecagon :: (TrailLike t, V t ~ R2) => Double -> t+--   <<diagrams/src_Diagrams_TwoD_Shapes_hendecagonEx.svg#diagram=hendecagonEx&width=100>>+hendecagon :: (InSpace V2 n t, TrailLike t) => n -> t hendecagon = regPoly 11  -- | A regular dodecagon, with sides of the given length and base --   parallel to the x-axis. -----   <<diagrams/dodecagonEx.svg#diagram=dodecagonEx&width=100>>-dodecagon :: (TrailLike t, V t ~ R2) => Double -> t+--   <<diagrams/src_Diagrams_TwoD_Shapes_dodecagonEx.svg#diagram=dodecagonEx&width=100>>+dodecagon :: (InSpace V2 n t, TrailLike t) => n -> t dodecagon = regPoly 12  ------------------------------------------------------------ --  Other shapes  ------------------------------------------ ------------------------------------------------------------+data RoundedRectOpts d = RoundedRectOpts { _radiusTL :: d+                                         , _radiusTR :: d+                                         , _radiusBL :: d+                                         , _radiusBR :: d+                                         } +makeLenses ''RoundedRectOpts++instance (Num d) => Default (RoundedRectOpts d) where+  def = RoundedRectOpts 0 0 0 0+ -- | @roundedRect w h r@ generates a closed trail, or closed path --   centered at the origin, of an axis-aligned rectangle with width --   @w@, height @h@, and circular rounded corners of radius @r@.  If@@ -236,30 +260,30 @@ --   a different radius for each corner individually, use --   'roundedRect'' instead. -----   <<diagrams/roundedRectEx.svg#diagram=roundedRectEx&width=400>>+--   <<diagrams/src_Diagrams_TwoD_Shapes_roundedRectEx.svg#diagram=roundedRectEx&width=400>> -----   > roundedRectEx = pad 1.1 . centerXY $ hcat' with { sep = 0.2 }+--   > roundedRectEx = pad 1.1 . centerXY $ hcat' (with & sep .~ 0.2) --   >   [ roundedRect  0.5 0.4 0.1 --   >   , roundedRect  0.5 0.4 (-0.1)---   >   , roundedRect' 0.7 0.4 with { radiusTL = 0.2---   >                               , radiusTR = -0.2---   >                               , radiusBR = 0.1 }+--   >   , roundedRect' 0.7 0.4 (with & radiusTL .~ 0.2+--   >                                & radiusTR .~ -0.2+--   >                                & radiusBR .~ 0.1) --   >   ] -roundedRect :: (TrailLike t, V t ~ R2) => Double -> Double -> Double -> t-roundedRect w h r = roundedRect' w h (with { radiusTL = r,-                                             radiusBR = r,-                                             radiusTR = r,-                                             radiusBL = r})+roundedRect :: (InSpace V2 n t, TrailLike t, RealFloat n) => n -> n -> n -> t+roundedRect w h r = roundedRect' w h (def & radiusTL .~ r+                                          & radiusBR .~ r+                                          & radiusTR .~ r+                                          & radiusBL .~ r)  -- | @roundedRect'@ works like @roundedRect@ but allows you to set the radius of --   each corner indivually, using @RoundedRectOpts@. The default corner radius is 0. --   Each radius can also be negative, which results in the curves being reversed --   to be inward instead of outward.-roundedRect' :: (TrailLike t, V t ~ R2) => Double -> Double -> RoundedRectOpts -> t+roundedRect' :: (InSpace V2 n t, TrailLike t, RealFloat n) => n -> n -> RoundedRectOpts n -> t roundedRect' w h opts    = trailLike-   . (`at` (p2 (w/2, abs rBR - h/2)))+   . (`at` p2 (w/2, abs rBR - h/2))    . wrapTrail    . glueLine    $ seg (0, h - abs rTR - abs rBR)@@ -279,7 +303,7 @@         rBL                 = clampCnr radiusBR radiusTL radiusTR radiusBL         rTR                 = clampCnr radiusTL radiusBR radiusBL radiusTR         rBR                 = clampCnr radiusBL radiusTR radiusTL radiusBR-        clampCnr rx ry ro r = let (rx',ry',ro',r') = (rx opts, ry opts, ro opts, r opts)+        clampCnr rx ry ro r = let (rx',ry',ro',r') = (opts^.rx, opts^.ry, opts^.ro, opts^.r)                                 in clampDiag ro' . clampAdj h ry' . clampAdj w rx' $ r'         -- prevent curves of adjacent corners from overlapping         clampAdj len adj r  = if abs r > len/2@@ -291,14 +315,8 @@                                 else r         sign n = if n < 0 then -1 else 1         mkCorner k r | r == 0    = mempty-                     | r < 0     = doArc 3 2+                     | r < 0     = doArc 3 (-1)                      | otherwise = doArc 0 1-                     where doArc d d' = arc' r ((k+d)/4) ((k+d')/4:: Turn)--data RoundedRectOpts = RoundedRectOpts { radiusTL :: Double-                                       , radiusTR :: Double-                                       , radiusBL :: Double-                                       , radiusBR :: Double-                                       }-instance Default RoundedRectOpts where-  def = RoundedRectOpts 0 0 0 0+                     where+                       doArc d s =+                           arc' r (xDir & _theta <>~ ((k+d)/4 @@ turn)) (s/4 @@ turn)

src/Diagrams/TwoD/Size.hs view

@@ -1,5 +1,7 @@+{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TypeFamilies     #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  Diagrams.TwoD.Size@@ -12,132 +14,65 @@ ----------------------------------------------------------------------------- module Diagrams.TwoD.Size        (-         -- * Size and extent of diagrams in R2          -- ** Computing sizes-         width, height, size2D, sizeSpec2D-       , extentX, extentY, center2D+         width, height+       , extentX, extentY           -- ** Specifying sizes-       , SizeSpec2D(..)-       , mkSizeSpec--       , requiredScaleT, requiredScale+       , mkSizeSpec2D+       , mkWidth+       , mkHeight+       , dims2D -         -- ** Changing the size of things-       , sized, sizedAs        ) where  import           Diagrams.Core+import           Diagrams.Core.Envelope+import           Diagrams.Size import           Diagrams.TwoD.Types import           Diagrams.TwoD.Vector -import           Control.Applicative  (liftA2, (<$>))-import           Control.Arrow        ((&&&), (***))- ------------------------------------------------------------ -- Computing diagram sizes ------------------------------------------------------------  -- | Compute the width of an enveloped object.-width :: (Enveloped a, V a ~ R2) => a -> Double-width = maybe 0 (negate . uncurry (-)) . extentX+--+--   Note this is just @diameter unitX@.+width :: (InSpace V2 n a, Enveloped a) => a -> n+width = diameter unitX  -- | Compute the height of an enveloped object.-height :: (Enveloped a, V a ~ R2) => a -> Double-height = maybe 0 (negate . uncurry (-)) . extentY---- | Compute the width and height of an enveloped object.-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+height :: (InSpace V2 n a, Enveloped a) => a -> n+height = diameter unitY --- | 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.-extentX :: (Enveloped a, V a ~ R2) => a -> Maybe (Double, Double)-extentX d = (\f -> (-f unit_X, f unitX)) <$> (appEnvelope . getEnvelope $ d)+-- | Compute the absolute x-coordinate range of an enveloped object in+--   the form @(lo,hi)@. Return @Nothing@ for objects with an empty+--   envelope.+--+--   Note this is just @extent unitX@.+extentX :: (InSpace v n a, R1 v, Enveloped a) => a -> Maybe (n, n)+extentX = extent unitX  -- | Compute the absolute y-coordinate range of an enveloped object in---   R2, in the form (lo,hi).-extentY :: (Enveloped a, V a ~ R2) => a -> Maybe (Double, Double)-extentY d = (\f -> (-f unit_Y, f unitY)) <$> (appEnvelope . getEnvelope $ d)---- | Compute the point at the center (in the x- and y-directions) of a---   enveloped object.  Return the origin for objects with an empty+--   the form @(lo,hi)@. Return @Nothing@ for objects with an empty --   envelope.-center2D :: (Enveloped a, V a ~ R2) => a -> P2-center2D = maybe origin (p2 . (mid *** mid)) . mm . (extentX &&& extentY)-  where mm = uncurry (liftA2 (,))-        mid = (/2) . uncurry (+)----------------------------------------------------------------- Size specifications----------------------------------------------------------------- | A specification of a (requested) rectangular size.-data SizeSpec2D = Width  Double       -- ^ Specify an explicit-                                      -- width. The height should be-                                      -- determined automatically (so-                                      -- as to preserve aspect ratio).-                | Height Double       -- ^ Specify an explicit-                                      -- height. The width should be-                                      -- determined automatically (so-                                      -- as to preserve aspect ratio).-                | Dims Double Double  -- ^ An explicit specification-                                      -- of a width and height.-                | Absolute            -- ^ Absolute size: use whatever-                                      -- size an object already has;-                                      -- do not rescale.-  deriving (Eq, Ord, Show)+extentY :: (InSpace v n a, R2 v, Enveloped a) => a -> Maybe (n, n)+extentY = extent unitY --- | Create a size specification from a possibly-specified width and---   height.-mkSizeSpec :: Maybe Double -> Maybe Double -> SizeSpec2D-mkSizeSpec Nothing  Nothing  = Absolute-mkSizeSpec (Just w) Nothing  = Width w-mkSizeSpec Nothing  (Just h) = Height h-mkSizeSpec (Just w) (Just h) = Dims w h+-- | Make a 'SizeSpec' from possibly-specified width and height.+mkSizeSpec2D :: Num n => Maybe n -> Maybe n -> SizeSpec V2 n+mkSizeSpec2D x y = mkSizeSpec (V2 x y) --- | @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)+-- | Make a 'SizeSpec' from a width and height.+dims2D :: n -> n -> SizeSpec V2 n+dims2D x y = dims (V2 x y) --- | @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'+-- | Make a 'SizeSpec' with only width defined.+mkWidth :: Num n => n -> SizeSpec V2 n+mkWidth w = dims (V2 w 0) --- | 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+-- | Make a 'SizeSpec' with only height defined.+mkHeight :: Num n => n -> SizeSpec V2 n+mkHeight h = dims (V2 0 h) --- | 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)

src/Diagrams/TwoD/Text.hs view

@@ -1,13 +1,17 @@-{-# LANGUAGE DeriveDataTypeable-           , GeneralizedNewtypeDeriving-           , FlexibleContexts-           , TypeFamilies-           , MultiParamTypeClasses-  #-}+{-# LANGUAGE ConstraintKinds            #-}+{-# LANGUAGE DeriveDataTypeable         #-}+{-# LANGUAGE FlexibleContexts           #-}+{-# LANGUAGE FlexibleInstances          #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses      #-}+{-# LANGUAGE TypeFamilies               #-}+{-# LANGUAGE TypeOperators              #-}+{-# LANGUAGE UndecidableInstances       #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  Diagrams.TwoD.Text--- Copyright   :  (c) 2011 diagrams-lib team (see LICENSE)+-- Copyright   :  (c) 2011-2015 diagrams-lib team (see LICENSE) -- License     :  BSD-style (see LICENSE) -- Maintainer  :  diagrams-discuss@googlegroups.com --@@ -19,66 +23,99 @@   -- * Creating text diagrams     Text(..), TextAlignment(..)   , text, topLeftText, alignedText, baselineText+  , mkText, mkText'    -- * Text attributes+   -- ** Font family-  , Font(..), getFont, font-  -- ** Font size-  , FontSize(..), getFontSize, fontSize, fontSizeA-  -- ** Font slant-  , FontSlant(..), FontSlantA, getFontSlant, fontSlant, italic, oblique-  -- ** Font weight-  , FontWeight(..), FontWeightA, getFontWeight, fontWeight, bold-  ) where+  , Font(..), _Font+  , getFont, font, _font -import Diagrams.Attributes-import Diagrams.Core-import Diagrams.TwoD.Types+  -- ** Font size+  , FontSize(..), _FontSize+  , fontSize, recommendFontSize+  , fontSizeN, fontSizeO, fontSizeL, fontSizeG+  , getFontSize, fontSizeM+  , _fontSizeR, _fontSize, _fontSizeU -import Data.AffineSpace ((.-.))+  -- ** Font slant+  , FontSlant(..)+  , getFontSlant, fontSlant, italic, oblique, _fontSlant -import Data.Semigroup+  -- ** Font weight+  , FontWeight(..)+  , getFontWeight, fontWeight, bold, bolder, lighter, _fontWeight+  , thinWeight, ultraLight, light, mediumWeight, heavy, semiBold, ultraBold -import Data.Colour+  ) where -import           Data.Default.Class+import           Control.Lens             hiding (transform)+import           Diagrams.Attributes      (committed)+import           Diagrams.Core+import           Diagrams.Core.Envelope   (pointEnvelope)+import           Diagrams.TwoD.Attributes (recommendFillColor)+import           Diagrams.TwoD.Types +import           Data.Colour              hiding (over)+import           Data.Default+import           Data.Monoid.Recommend+import           Data.Semigroup import           Data.Typeable +import           Linear.Affine+ ------------------------------------------------------------ -- Text diagrams ------------------------------------------------------------ --- | A text primitive consists of the string contents and alignment---   specification, along with a transformation mapping from the local---   vector space of the text to the vector space in which it is---   embedded.-data Text = Text T2 TextAlignment String--type instance V Text = R2+-- | A 'Text' primitive consists of the string contents, text alignment+--   and the transformation to be applied. The transformation is scale+--   invarient, the average scale of the transform should always be 1.+--   All text scaling is obtained from the 'FontSize' attribute.+--+--   This constructor should not be used directly. Use 'text',+--   'alignedText' or 'baselineText'.+data Text n = Text (T2 n) (TextAlignment n) String+  deriving Typeable -instance Transformable Text where-  transform t (Text tt a s) = Text (t <> tt) a s+type instance V (Text n) = V2+type instance N (Text n) = n -instance IsPrim Text+instance Floating n => Transformable (Text n) where+  transform t (Text tt a s) = Text (t <> tt <> t') a s+    where t' = scaling (1 / avgScale t) -instance HasOrigin Text where+instance Floating n => HasOrigin (Text n) where   moveOriginTo p = translate (origin .-. p) -instance Renderable Text NullBackend where+instance Floating n => Renderable (Text n) NullBackend where   render _ _ = mempty  -- | @TextAlignment@ specifies the alignment of the text's origin.-data TextAlignment = BaselineText | BoxAlignedText Double Double+data TextAlignment n = BaselineText | BoxAlignedText n n -mkText :: Renderable Text b => TextAlignment -> String -> Diagram b R2-mkText a t = recommendFillColor black   -- See Note [recommendFillColor]-           $ mkQD (Prim (Text mempty a t))-                       mempty-                       mempty-                       mempty-                       mempty+-- | Make a text from a 'TextAlignment', recommending a fill colour of+--   'black' and 'fontSize' of @'local' 1@.+mkText :: (TypeableFloat n, Renderable (Text n) b)+  => TextAlignment n -> String -> QDiagram b V2 n Any+mkText a = recommendFillColor black+           -- See Note [recommendFillColor]+         . recommendFontSize (local 1)+           -- See Note [recommendFontSize]+         . mkText' a +-- | Make a text from a 'TextAlignment' without any default size or fill+--   colour. This is useful is you want to recommend your own using+--   'recommendFillColor' or 'recommendFontSize'.+mkText' :: (TypeableFloat n, Renderable (Text n) b)+  => TextAlignment n -> String -> QDiagram b V2 n Any+mkText' a t = mkQD (Prim $ Text mempty a t)+                   (pointEnvelope origin)+                   mempty+                   mempty+                   mempty++ -- ~~~~ Note [recommendFillColor]  -- The reason we "recommend" a fill color of black instead of setting@@ -101,12 +138,16 @@ -- recommendation; normally, the innermost occurrence of an attribute -- would override all outer occurrences. +-- ~~~~ Note [recommendFontSize]+-- The reason we "recommend" a font size is so any local scales get+-- recorded.+ -- | Create a primitive text diagram from the given string, with center --   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 :: (TypeableFloat n, Renderable (Text n) b) => String -> QDiagram b V2 n Any text = alignedText 0.5 0.5  -- | Create a primitive text diagram from the given string, origin at@@ -114,19 +155,21 @@ --   @'alignedText' 0 1@. -- --   Note that it /takes up no space/.-topLeftText :: Renderable Text b => String -> Diagram b R2+topLeftText :: (TypeableFloat n, Renderable (Text n) b) => String -> QDiagram b V2 n Any topLeftText = alignedText 0 1  -- | Create a primitive text diagram from the given string, with the --   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).+--   parameter from 0 (bottom) to 1 (top). Some backends do not+--   implement this and instead snap to closest corner or the center. -- --   The height of this box is determined by the font's potential ascent --   and descent, rather than the height of the particular string. -- --   Note that it /takes up no space/.-alignedText :: Renderable Text b => Double -> Double -> String -> Diagram b R2+alignedText :: (TypeableFloat n, Renderable (Text n) b)+  => n -> n -> String -> QDiagram b V2 n Any alignedText w h = mkText (BoxAlignedText w h)  -- | Create a primitive text diagram from the given string, with the@@ -135,7 +178,8 @@ --   graphics library. -- --   Note that it /takes up no space/.-baselineText :: Renderable Text b => String -> Diagram b R2+baselineText :: (TypeableFloat n, Renderable (Text n) b)+  => String -> QDiagram b V2 n Any baselineText = mkText BaselineText  ------------------------------------------------------------@@ -149,6 +193,10 @@ --   @Font@ attributes override outer ones. newtype Font = Font (Last String)   deriving (Typeable, Semigroup, Eq)++_Font :: Iso' Font String+_Font = iso getFont (Font . Last)+ instance AttributeClass Font  -- | Extract the font family name from a @Font@ attribute.@@ -159,58 +207,123 @@ font :: HasStyle a => String -> a -> a font = applyAttr . Font . Last +-- | Lens onto the font name of a style.+_font :: Lens' (Style v n) (Maybe String)+_font = atAttr . mapping _Font+ -------------------------------------------------- -- Font size  -- | The @FontSize@ attribute specifies the size of a font's---   em-square, measured with respect to the current local vector space.---   Inner @FontSize@ attributes override outer ones.-newtype FontSize = FontSize (Last Double)-  deriving (Typeable, Semigroup, Eq)-instance AttributeClass FontSize+--   em-square.  Inner @FontSize@ attributes override outer ones.+newtype FontSize n = FontSize (Recommend (Last n))+  deriving (Typeable, Semigroup) -instance Default FontSize where-    def = FontSize (Last 1)+-- not sure why this can't be derived+instance Functor FontSize where+  fmap f (FontSize (Recommend (Last a))) = FontSize (Recommend (Last (f a)))+  fmap f (FontSize (Commit (Last a)))    = FontSize (Commit (Last (f a))) +_FontSize :: Iso' (FontSize n) (Recommend n)+_FontSize = iso getter setter+  where getter (FontSize (Recommend (Last a))) = Recommend a+        getter (FontSize (Commit    (Last a))) = Commit a+        setter (Recommend a) = FontSize $ Recommend (Last a)+        setter (Commit    a) = FontSize $ Commit (Last a)+      -- = iso (\(FontSize a) -> a) FontSize . mapping _Wrapped+      -- once we depend on monoid-extras-0.4++_FontSizeM :: Iso' (FontSizeM n) (Measured n (Recommend n))+_FontSizeM = mapping _FontSize++type FontSizeM n = Measured n (FontSize n)++instance Typeable n => AttributeClass (FontSize n)++instance Num n => Default (FontSizeM n) where+  def = FontSize . Recommend . Last <$> local 1+ -- | Extract the size from a @FontSize@ attribute.-getFontSize :: FontSize -> Double-getFontSize (FontSize (Last s)) = s+getFontSize :: FontSize n -> n+getFontSize (FontSize (Recommend (Last s))) = s+getFontSize (FontSize (Commit (Last s)))    = s  -- | Set the font size, that is, the size of the font's em-square as---   measured within the current local vector space.  The default size---   is @1@.-fontSize :: HasStyle a => Double -> a -> a-fontSize = applyAttr . FontSize . Last+--   measured within the current local vector space. The default size+--   is @local 1@ (which is applied by 'recommendFontSize').+fontSize :: (N a ~ n, Typeable n, HasStyle a) => Measure n -> a -> a+fontSize = applyMAttr . fmap (FontSize . Commit . Last) +-- | 'Recommend' a font size. Any use of 'fontSize' above this will+--   overwrite any recommended size. This should only be used with+--   'mkText'', other text functions already has a recommended font+--   size so this will be ignored.+recommendFontSize :: (N a ~ n, Typeable n, HasStyle a) => Measure n -> a -> a+recommendFontSize = applyMAttr . fmap (FontSize . Recommend . Last)++-- | A convenient synonym for 'fontSize (Global w)'.+fontSizeG :: (N a ~ n, Typeable n, Num n, HasStyle a) => n -> a -> a+fontSizeG = fontSize . global++-- | A convenient synonym for 'fontSize (Normalized w)'.+fontSizeN :: (N a ~ n, Typeable n, Num n, HasStyle a) => n -> a -> a+fontSizeN = fontSize . normalized++-- | A convenient synonym for 'fontSize (Output w)'.+fontSizeO :: (N a ~ n, Typeable n, HasStyle a) => n -> a -> a+fontSizeO = fontSize . output++-- | A convenient sysnonym for 'fontSize (Local w)'.+fontSizeL :: (N a ~ n, Typeable n, Num n, HasStyle a) => n -> a -> a+fontSizeL = fontSize . local+ -- | Apply a 'FontSize' attribute.-fontSizeA :: HasStyle a => FontSize -> a -> a-fontSizeA = applyAttr+fontSizeM :: (N a ~ n, Typeable n, HasStyle a) => FontSizeM n -> a -> a+fontSizeM = applyMAttr +_fontSizeR :: (Typeable n, OrderedField n) => Lens' (Style v n) (Measured n (Recommend n))+_fontSizeR = atMAttr . anon def (const False) . _FontSizeM++-- | Lens to commit a font size. This is *not* a valid lens (see+--   'commited'.+_fontSize :: (Typeable n, OrderedField n) => Lens' (Style v n) (Measure n)+_fontSize = _fontSizeR . mapping committed++_fontSizeU :: (Typeable n) => Lens' (Style v n) (Maybe n)+_fontSizeU = atAttr . mapping (_FontSize . committed)+ -------------------------------------------------- -- Font slant +-- | 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. data FontSlant = FontSlantNormal                | FontSlantItalic                | FontSlantOblique-    deriving (Eq)+  deriving (Eq, Show, Typeable, Ord) --- | 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, Eq)-instance AttributeClass FontSlantA+instance AttributeClass FontSlant where+instance Semigroup FontSlant where+  _ <> b = b +instance Default FontSlant where+  def = FontSlantNormal+ -- | Extract the font slant from a 'FontSlantA' attribute.-getFontSlant :: FontSlantA -> FontSlant-getFontSlant (FontSlantA (Last s)) = s+getFontSlant :: FontSlant -> FontSlant+getFontSlant = id  -- | Specify the slant (normal, italic, or oblique) that should be --   used for all text within a diagram.  See also 'italic' and --   'oblique' for useful special cases. fontSlant :: HasStyle a => FontSlant -> a -> a-fontSlant = applyAttr . FontSlantA . Last+fontSlant = applyAttr +-- | Lens onto the font slant in a style.+_fontSlant :: Lens' (Style v n) FontSlant+_fontSlant = atAttr . non def+ -- | Set all text in italics. italic :: HasStyle a => a -> a italic = fontSlant FontSlantItalic@@ -222,27 +335,82 @@ -------------------------------------------------- -- Font weight -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, Eq)-instance AttributeClass FontWeightA+data FontWeight = FontWeightNormal+                | FontWeightBold+                | FontWeightBolder+                | FontWeightLighter+                | FontWeightThin+                | FontWeightUltraLight+                | FontWeightLight+                | FontWeightMedium+                | FontWeightSemiBold+                | FontWeightUltraBold+                | FontWeightHeavy+    deriving (Eq,+              Ord, Show, Typeable) --- | Extract the font weight from a 'FontWeightA' attribute.-getFontWeight :: FontWeightA -> FontWeight-getFontWeight (FontWeightA (Last w)) = w+instance AttributeClass FontWeight --- | Specify the weight (normal or bold) that should be+-- | Last semigroup structure+instance Semigroup FontWeight where+  _ <> b = b++instance Default FontWeight where+  def = FontWeightNormal++-- | Extract the font weight.+getFontWeight :: FontWeight -> FontWeight+getFontWeight = id++-- | Specify the weight (normal, bolder, lighter or bold) that should be --   used for all text within a diagram.  See also 'bold' --   for a useful special case. fontWeight :: HasStyle a => FontWeight -> a -> a-fontWeight = applyAttr . FontWeightA . Last+fontWeight = applyAttr  -- | Set all text using a bold font weight. bold :: HasStyle a => a -> a bold = fontWeight FontWeightBold++-- | Set all text using a thin font weight.+thinWeight :: HasStyle a => a -> a+thinWeight = fontWeight FontWeightThin++-- | Set all text using a extra light font weight.+ultraLight :: HasStyle a => a -> a+ultraLight = fontWeight FontWeightUltraLight++-- | Set all text using a light font weight.+light :: HasStyle a => a -> a+light = fontWeight FontWeightLight++-- | Set all text using a medium font weight.+mediumWeight :: HasStyle a => a -> a+mediumWeight = fontWeight FontWeightMedium++-- | Set all text using a semi-bold font weight.+semiBold :: HasStyle a => a -> a+semiBold = fontWeight FontWeightSemiBold++-- | Set all text using an ultra-bold font weight.+ultraBold :: HasStyle a => a -> a+ultraBold = fontWeight FontWeightUltraBold++-- | Set all text using a heavy/black font weight.+heavy :: HasStyle a => a -> a+heavy = fontWeight FontWeightHeavy++-- | Set all text to be bolder than the inherited font weight.+bolder :: HasStyle a => a -> a+bolder = fontWeight FontWeightBolder++-- | Set all text to be lighter than the inherited font weight.+lighter :: HasStyle a => a -> a+lighter = fontWeight FontWeightLighter++-- | Lens onto the font weight in a style.+_fontWeight :: Lens' (Style v n) FontWeight+_fontWeight = atAttr . non def

src/Diagrams/TwoD/Transform.hs view

@@ -1,12 +1,19 @@+{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE FlexibleContexts      #-} {-# LANGUAGE FlexibleInstances     #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes            #-} {-# LANGUAGE TypeFamilies          #-}+{-# LANGUAGE TypeOperators         #-} {-# LANGUAGE ViewPatterns          #-}++{-# OPTIONS_GHC -fno-warn-unused-imports #-}+  -- for Data.Semigroup+ ----------------------------------------------------------------------------- -- | -- Module      :  Diagrams.TwoD.Transform--- Copyright   :  (c) 2011 diagrams-lib team (see LICENSE)+-- Copyright   :  (c) 2011-2015 diagrams-lib team (see LICENSE) -- License     :  BSD-style (see LICENSE) -- Maintainer  :  diagrams-discuss@googlegroups.com --@@ -18,10 +25,11 @@  module Diagrams.TwoD.Transform        (+         T2          -- * Rotation-         rotation, rotate, rotateBy--       , rotationAbout, rotateAbout+       , rotation, rotate, rotateBy, rotated+       , rotationAround, rotateAround+       , rotationTo, rotateTo           -- * Scaling        , scalingX, scaleX@@ -36,323 +44,262 @@        , translationY, translateY        , translation, translate +         -- * Conformal affine maps+       , scalingRotationTo, scaleRotateTo+          -- * Reflection        , reflectionX, reflectX        , reflectionY, reflectY+       , reflectionXY, reflectXY        , reflectionAbout, reflectAbout           -- * Shears        , shearingX, shearX        , shearingY, shearY -         -- * Scale invariance-       , ScaleInv(..), scaleInv, scaleInvPrim--         -- * component-wise-       , onBasis        ) where +import           Diagrams.Angle import           Diagrams.Core-import qualified Diagrams.Core.Transform as T--import           Control.Newtype         (over)--import           Diagrams.Coordinates+import           Diagrams.Core.Transform+import           Diagrams.Direction import           Diagrams.Transform-import           Diagrams.TwoD.Size      (height, width)+import           Diagrams.Transform.Matrix import           Diagrams.TwoD.Types-import           Diagrams.TwoD.Vector    (direction)+import           Diagrams.TwoD.Vector +import           Control.Lens              hiding (at, transform) import           Data.Semigroup -import           Data.AffineSpace--import           Control.Arrow           (first, second)+import           Linear.Affine+import           Linear.Metric+import           Linear.V2+import           Linear.Vector  -- Rotation ------------------------------------------------ --- | 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 (coords -> x :& y) = (cos th * x - sin th * y) & (sin th * x + cos th * y)+-- For the definitions of 'rotation' and 'rotate', see Diagrams.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 ::---   'Turn')@, @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---   you want to use.  In this common situation you can use---   'rotateBy', which is specialized to take a 'Turn' argument.-rotate :: (Transformable t, V t ~ R2, Angle a) => a -> t -> t-rotate = transform . rotation+-- | A synonym for 'rotate', interpreting its argument in units of+-- turns; it can be more convenient to write @rotateBy (1\/4)@ than+-- @'rotate' (1\/4 \@\@ 'turn')@.+rotateBy :: (InSpace V2 n t, Transformable t, Floating n) => n -> t -> t+rotateBy = transform . rotation . review turn --- | A synonym for 'rotate', specialized to only work with---   @Turn@ arguments; it can be more convenient to write---   @rotateBy (1\/4)@ than @'rotate' (1\/4 :: 'Turn')@.-rotateBy :: (Transformable t, V t ~ R2) => Turn -> t -> t-rotateBy = transform . rotation+-- | Use an 'Angle' to make an 'Iso' between an object+--   rotated and unrotated. This us useful for performing actions+--   'under' a rotation:+--+-- @+-- under (rotated t) f = rotate (negated t) . f . rotate t+-- rotated t ## a      = rotate t a+-- a ^. rotated t      = rotate (-t) a+-- over (rotated t) f  = rotate t . f . rotate (negated t)+-- @+rotated :: (InSpace V2 n a, Floating n, SameSpace a b, Transformable a, Transformable b)+        => Angle n -> Iso a b a b+rotated a = transformed $ rotation a  -- | @rotationAbout p@ is a rotation about the point @p@ (instead of --   around the local origin).-rotationAbout :: Angle a => P2 -> a -> T2-rotationAbout p angle = conjugate (translation (origin .-. p)) (rotation angle)+rotationAround :: Floating n => P2 n -> Angle n -> T2 n+rotationAround p theta =+  conjugate (translation (origin .-. p)) (rotation theta)  -- | @rotateAbout p@ is like 'rotate', except it rotates around the --   point @p@ instead of around the local origin.-rotateAbout :: (Transformable t, V t ~ R2, Angle a) => P2 -> a -> t -> t-rotateAbout p angle = rotate angle `under` translation (origin .-. p)+rotateAround :: (InSpace V2 n t, Transformable t, Floating n)+             => P2 n -> Angle n -> t -> t+rotateAround p theta = transform (rotationAround p theta) +-- | The rotation that aligns the x-axis with the given direction.+rotationTo :: OrderedField n => Direction V2 n -> T2 n+rotationTo (view _Dir -> V2 x y) = rotation (atan2A' y x)++-- | Rotate around the local origin such that the x axis aligns with the+--   given direction.+rotateTo :: (InSpace V2 n t, OrderedField n, Transformable t) => Direction V2 n -> t -> t+rotateTo = transform . rotationTo+ -- Scaling -------------------------------------------------  -- | Construct a transformation which scales by the given factor in --   the x (horizontal) direction.-scalingX :: Double -> T2-scalingX c = fromLinear s s-  where s = (over r2 . first) (*c) <-> (over r2 . first) (/c)+scalingX :: (Additive v, R1 v, Fractional n) => n -> Transformation v n+scalingX c = fromSymmetric $ (_x *~ c) <-> (_x //~ c)  -- | Scale a diagram by the given factor in the x (horizontal) --   direction.  To scale uniformly, use 'scale'.-scaleX :: (Transformable t, V t ~ R2) => Double -> t -> t+scaleX :: (InSpace v n t, R2 v, Fractional n, Transformable t) => n -> t -> t scaleX = transform . scalingX  -- | Construct a transformation which scales by the given factor in --   the y (vertical) direction.-scalingY :: Double -> T2-scalingY c = fromLinear s s-  where s = (over r2 . second) (*c) <-> (over r2 . second) (/c)+scalingY :: (Additive v, R2 v, Fractional n) => n -> Transformation v n+scalingY c = fromSymmetric $ (_y *~ c) <-> (_y //~ c)  -- | Scale a diagram by the given factor in the y (vertical) --   direction.  To scale uniformly, use 'scale'.-scaleY :: (Transformable t, V t ~ R2) => Double -> t -> t+scaleY :: (InSpace v n t, R2 v, Fractional n, Transformable t)+  => n -> t -> t scaleY = transform . scalingY  -- | @scaleToX w@ scales a diagram in the x (horizontal) direction by --   whatever factor required to make its width @w@.  @scaleToX@ --   should not be applied to diagrams with a width of 0, such as --   'vrule'.-scaleToX :: (Enveloped t, Transformable t, V t ~ R2) => Double -> t -> t-scaleToX w d = scaleX (w / width d) d+scaleToX :: (InSpace v n t, R2 v, Enveloped t, Transformable t) => n -> t -> t+scaleToX w d = scaleX (w / diameter unitX d) d  -- | @scaleToY h@ scales a diagram in the y (vertical) direction by --   whatever factor required to make its height @h@.  @scaleToY@ --   should not be applied to diagrams with a height of 0, such as --   'hrule'.-scaleToY :: (Enveloped t, Transformable t, V t ~ R2) => Double -> t -> t-scaleToY h d = scaleY (h / height d) d+scaleToY :: (InSpace v n t, R2 v, Enveloped t, Transformable t) => n -> t -> t+scaleToY h d = scaleY (h / diameter unitY d) d  -- | @scaleUToX w@ scales a diagram /uniformly/ by whatever factor --   required to make its width @w@.  @scaleUToX@ should not be --   applied to diagrams with a width of 0, such as 'vrule'.-scaleUToX :: (Enveloped t, Transformable t, V t ~ R2) => Double -> t -> t-scaleUToX w d = scale (w / width d) d+scaleUToX :: (InSpace v n t, R1 v, Enveloped t, Transformable t) => n -> t -> t+scaleUToX w d = scale (w / diameter unitX d) d  -- | @scaleUToY h@ scales a diagram /uniformly/ by whatever factor --   required to make its height @h@.  @scaleUToY@ should not be applied --   to diagrams with a height of 0, such as 'hrule'.-scaleUToY :: (Enveloped t, Transformable t, V t ~ R2) => Double -> t -> t-scaleUToY h d = scale (h / height d) d+scaleUToY :: (InSpace v n t, R2 v, Enveloped t, Transformable t) => n -> t -> t+scaleUToY h d = scale (h / diameter unitY d) d  -- Translation ---------------------------------------------  -- | Construct a transformation which translates by the given distance --   in the x (horizontal) direction.-translationX :: Double -> T2-translationX x = translation (x & 0)+translationX :: (Additive v, R1 v, Num n) => n -> Transformation v n+translationX x = translation (zero & _x .~ x)  -- | Translate a diagram by the given distance in the x (horizontal) --   direction.-translateX :: (Transformable t, V t ~ R2) => Double -> t -> t+translateX :: (InSpace v n t, R1 v, Transformable t) => n -> t -> t translateX = transform . translationX  -- | Construct a transformation which translates by the given distance --   in the y (vertical) direction.-translationY :: Double -> T2-translationY y = translation (0 & y)+translationY :: (Additive v, R2 v, Num n) => n -> Transformation v n+translationY y = translation (zero & _y .~ y)  -- | Translate a diagram by the given distance in the y (vertical) --   direction.-translateY :: (Transformable t, V t ~ R2) => Double -> t -> t+translateY :: (InSpace v n t, R2 v, Transformable t)+  => n -> t -> t translateY = transform . translationY +-- Conformal affine maps -----------------------------------++-- | The angle-preserving linear map that aligns the x-axis unit vector+--   with the given vector.  See also 'scaleRotateTo'.+scalingRotationTo :: (Floating n) => V2 n -> T2 n+scalingRotationTo v = fromMatWithInv (conf v) (conf w) zero+  where+    w = reflectY (v ^/ quadrance v)+    conf (V2 a b) = (V2 (V2 a (-b)) (V2 b a))++-- | Rotate and uniformly scale around the local origin such that the+--   x-axis aligns with the given vector.  This satisfies the equation+--+-- @+-- scaleRotateTo v = rotateTo (dir v) . scale (norm v)+-- @+--+-- up to floating point rounding errors, but is more accurate and+-- performant since it avoids cancellable uses of trigonometric functions.+scaleRotateTo :: (InSpace V2 n t, Transformable t, Floating n)+              => V2 n -> t -> t+scaleRotateTo = transform . scalingRotationTo+ -- Reflection ----------------------------------------------  -- | Construct a transformation which flips a diagram from left to --   right, i.e. sends the point (x,y) to (-x,y).-reflectionX :: T2-reflectionX = scalingX (-1)+reflectionX :: (Additive v, R1 v, Num n) => Transformation v n+reflectionX = fromSymmetric $ (_x *~ (-1)) <-> (_x *~ (-1))  -- | Flip a diagram from left to right, i.e. send the point (x,y) to --   (-x,y).-reflectX :: (Transformable t, V t ~ R2) => t -> t+reflectX :: (InSpace v n t, R1 v, Transformable t) => t -> t reflectX = transform reflectionX  -- | Construct a transformation which flips a diagram from top to --   bottom, i.e. sends the point (x,y) to (x,-y).-reflectionY :: T2-reflectionY = scalingY (-1)+reflectionY :: (Additive v, R2 v, Num n) => Transformation v n+reflectionY = fromSymmetric $ (_y *~ (-1)) <-> (_y *~ (-1))  -- | Flip a diagram from top to bottom, i.e. send the point (x,y) to --   (x,-y).-reflectY :: (Transformable t, V t ~ R2) => t -> t+reflectY :: (InSpace v n t, R2 v, Transformable t) => t -> t reflectY = transform reflectionY --- | @reflectionAbout p v@ is a reflection in the line determined by---   the point @p@ and vector @v@.-reflectionAbout :: P2 -> R2 -> T2-reflectionAbout p v =-  conjugate (rotation (-direction v :: Rad) <> translation (origin .-. p))+-- | Construct a transformation which flips the diagram about x=y, i.e.+--   sends the point (x,y) to (y,x).+reflectionXY :: (Additive v, R2 v, Num n) => Transformation v n+reflectionXY = fromSymmetric $ (_xy %~ view _yx) <-> (_xy %~ view _yx)++-- | Flips the diagram about x=y, i.e. send the point (x,y) to (y,x).+reflectXY :: (InSpace v n t, R2 v, Transformable t) => t -> t+reflectXY = transform reflectionXY++-- | @reflectionAbout p d@ is a reflection in the line determined by+--   the point @p@ and direction @d@.+reflectionAbout :: OrderedField n => P2 n -> Direction V2 n -> T2 n+reflectionAbout p d =+  conjugate (rotationTo (reflectY d) <> translation (origin .-. p))             reflectionY --- | @reflectAbout p v@ reflects a diagram in the line determined by---   the point @p@ and the vector @v@.-reflectAbout :: (Transformable t, V t ~ R2) => P2 -> R2 -> t -> t++++-- | @reflectAbout p d@ reflects a diagram in the line determined by+--   the point @p@ and direction @d@.+reflectAbout :: (InSpace V2 n t, OrderedField n, Transformable t)+             => P2 n -> Direction V2 n -> t -> t reflectAbout p v = transform (reflectionAbout p v)  -- Shears -------------------------------------------------- +-- auxiliary functions for shearingX/shearingY+sh :: (n -> n -> n -> n) -> (n -> n -> n -> n) -> n -> V2 n -> V2 n+sh f g k (V2 x y) = V2 (f k x y) (g k x y)++sh' :: (n -> n -> n -> n) -> (n -> n -> n -> n) -> n -> V2 n -> V2 n+sh' f g k = swap . sh f g k . swap++swap :: V2 n -> V2 n+swap (V2 x y) = V2 y x+{-# INLINE swap #-}+ -- | @shearingX d@ is the linear transformation which is the identity on --   y coordinates and sends @(0,1)@ to @(d,1)@.-shearingX :: Double -> T2-shearingX d = fromLinear (over r2 (sh d)  <-> over r2 (sh (-d)))-                         (over r2 (sh' d) <-> over r2 (sh' (-d)))-  where sh  k (x, y) = (x+k*y, y)-        sh' k        = swap . sh k . swap-        swap (x,y) = (y,x)+shearingX :: Num n => n -> T2 n+shearingX d = fromLinear (sh f g d  <-> sh f g (-d))+                         (sh' f g d <-> sh' f g (-d))+  where+    f k x y = x + k*y+    g _ _ y = y  -- | @shearX d@ performs a shear in the x-direction which sends --   @(0,1)@ to @(d,1)@.-shearX :: (Transformable t, V t ~ R2) => Double -> t -> t+shearX :: (InSpace V2 n t, Transformable t) => n -> t -> t shearX = transform . shearingX  -- | @shearingY d@ is the linear transformation which is the identity on --   x coordinates and sends @(1,0)@ to @(1,d)@.-shearingY :: Double -> T2-shearingY d = fromLinear (over r2 (sh d)  <-> over r2 (sh (-d)))-                         (over r2 (sh' d) <-> over r2 (sh' (-d)))-  where sh  k (x,y) = (x, y+k*x)-        sh' k       = swap . sh k . swap-        swap (x,y) = (y,x)+shearingY :: Num n => n -> T2 n+shearingY d = fromLinear (sh f g d  <-> sh f g (-d))+                         (sh' f g d <-> sh' f g (-d))+        where+          f _ x _ = x+          g k x y = y + k*x  -- | @shearY d@ performs a shear in the y-direction which sends --   @(1,0)@ to @(1,d)@.-shearY :: (Transformable t, V t ~ R2) => Double -> t -> t+shearY :: (InSpace V2 n t, Transformable t) => n -> t -> t shearY = transform . shearingY----- Scale invariance -------------------------------------------- | 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,---   located at the origin.-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)---- This is how we handle freezing properly with ScaleInv wrappers.--- Normal transformations are applied ignoring scaling; "frozen"--- transformations (i.e. transformations applied after a freeze) are--- applied directly to the underlying object, scales and all.  We must--- take care to transform the reference point and direction vector--- appropriately.-instance (V t ~ R2, Transformable t) => IsPrim (ScaleInv t) where-  transformWithFreeze t1 t2 s = ScaleInv t'' d'' origin''-    where-      -- first, apply t2 normally, i.e. ignoring scaling-      s'@(ScaleInv t' _ _)      = transform t2 s--      -- now apply t1 to get the new direction and origin-      (ScaleInv _ d'' origin'') = transform t1 s'--      -- but apply t1 directly to the underlying thing, scales and all.-      t''                       = transform t1 t'--instance (Renderable t b, V t ~ R2) => Renderable (ScaleInv t) b where-  render b = render b . unScaleInv---- | Create a diagram from a single scale-invariant primitive.  The---   vector argument specifies the direction in which the primitive is---   \"pointing\" (for the purpose of keeping it rotated correctly---   under non-uniform scaling).  The primitive is assumed to be---   \"located\" at the origin (for the purpose of translating it---   correctly under scaling).------   Note that the resulting diagram will have an /empty/ envelope,---   trace, and query.  The reason is that the envelope, trace, and---   query cannot be cached---applying a transformation would cause---   the cached envelope, etc. to get \"out of sync\" with the---   scale-invariant object.  The intention, at any rate, is that---   scale-invariant things will be used only as \"decorations\" (/e.g./---   arrowheads) which should not affect the envelope, trace, and---   query.-scaleInvPrim :: (Transformable t, Renderable t b, V t ~ R2, Monoid m)-             => t -> R2 -> QDiagram b R2 m-scaleInvPrim t d = mkQD (Prim $ scaleInv t d) mempty mempty mempty mempty---- | Get the matrix equivalent of the linear transform,---   (as a pair of columns) and the translation vector.  This---   is mostly useful for implementing backends.-onBasis :: Transformation R2 -> ((R2, R2), R2)-onBasis t = ((x, y), v)-  where ((x:y:[]), v) = T.onBasis t

src/Diagrams/TwoD/Types.hs view

@@ -1,13 +1,7 @@-{-# LANGUAGE DeriveDataTypeable         #-}-{-# LANGUAGE FlexibleInstances          #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE MultiParamTypeClasses      #-}-{-# LANGUAGE TypeFamilies               #-}-{-# LANGUAGE TypeOperators              #-}-{-# LANGUAGE TypeSynonymInstances       #-}-{-# LANGUAGE ViewPatterns               #-}+{-# LANGUAGE TypeFamilies #-}  {-# OPTIONS_GHC -fno-warn-orphans #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  Diagrams.TwoD.Types@@ -21,204 +15,80 @@  module Diagrams.TwoD.Types        ( -- * 2D Euclidean space-         R2, r2, unr2-       , P2, p2, unp2-       , T2--         -- * Angles-       , Angle(..)-       , Turn(..), CircleFrac, Rad(..), Deg(..)-       , fullCircle, convertAngle+         V2 (..), R1 (..), R2 (..)+       , P2, T2+       , r2, unr2, mkR2, r2Iso+       , p2, mkP2, unp2, p2Iso+       , r2PolarIso+       , HasR (..)        ) where -import           Diagrams.Coordinates-import           Diagrams.Core-import           Diagrams.Util           (tau)--import           Control.Newtype--import           Data.Basis-import           Data.NumInstances.Tuple ()-import           Data.VectorSpace--import           Data.Typeable----------------------------------------------------------------- 2D Euclidean space---- | The two-dimensional Euclidean vector space R^2.  This type is---   intentionally abstract.------   * To construct a vector, use 'r2', or '&' (from "Diagrams.Coordinates"):------ @--- r2 (3,4) :: R2--- 3 & 4    :: R2--- @------     Note that "Diagrams.Coordinates" is not re-exported by---     "Diagrams.Prelude" and must be explicitly imported.------   * To construct the vector from the origin to a point @p@, use---     @p 'Data.AffineSpace..-.' 'origin'@.------   * To convert a vector @v@ into the point obtained by following---     @v@ from the origin, use @'origin' 'Data.AffineSpace..+^' v@.------   * 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) = ...--- @+import           Control.Lens            (Iso', Lens', iso, _1, _2) -newtype R2 = R2 { unR2 :: (Double, Double) }-  deriving (AdditiveGroup, Eq, Ord, Typeable, Num, Fractional)+import           Diagrams.Angle+import           Diagrams.Points -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+import           Diagrams.Core.Transform+import           Diagrams.Core.V+import           Linear.Metric+import           Linear.V2 -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+type P2 = Point V2+type T2 = Transformation V2 -instance Newtype R2 (Double, Double) where-  pack   = R2-  unpack = unR2+type instance V (V2 n) = V2+type instance N (V2 n) = n  -- | Construct a 2D vector from a pair of components.  See also '&'.-r2 :: (Double, Double) -> R2-r2 = pack+r2 :: (n, n) -> V2 n+r2 = uncurry V2  -- | Convert a 2D vector back into a pair of components.  See also 'coords'.-unr2 :: R2 -> (Double, Double)-unr2 = unpack--type instance V R2 = R2--instance VectorSpace R2 where-  type Scalar R2 = Double-  (*^) = over R2 . (*^)--instance HasBasis R2 where-  type Basis R2 = Either () () -- = Basis (Double, Double)-  basisValue = R2 . basisValue-  decompose  = decompose  . unR2-  decompose' = decompose' . unR2--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+unr2 :: V2 n -> (n, n)+unr2 (V2 x y) = (x, y) -  x & y                  = r2 (x,y)-  coords (unR2 -> (x,y)) = x :& y+-- | Curried form of `r2`.+mkR2 :: n -> n -> V2 n+mkR2 = V2 --- | Points in R^2.  This type is intentionally abstract.------   * To construct a point, use 'p2', or '&' (see---     "Diagrams.Coordinates"):------ @--- 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 'Data.AffineSpace..-.' 'origin'@.------   * 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+r2Iso :: Iso' (V2 n) (n, n)+r2Iso = iso unr2 r2 --- | Construct a 2D point from a pair of coordinates.  See also '&'.-p2 :: (Double, Double) -> P2-p2 = pack . pack+-- | Construct a 2D point from a pair of coordinates.  See also '^&'.+p2 :: (n, n) -> P2 n+p2 = P . uncurry V2  -- | Convert a 2D point back into a pair of coordinates.  See also 'coords'.-unp2 :: P2 -> (Double, Double)-unp2 = unpack . unpack---- | Transformations in R^2.-type T2 = Transformation R2--instance Transformable R2 where-  transform = apply----------------------------------------------------------------- Angles---- | Newtype wrapper used to represent angles as fractions of a---   circle.  For example, 1\/3 turn = tau\/3 radians = 120 degrees.-newtype Turn = Turn { getTurn :: Double }-  deriving (Read, Show, Eq, Ord, Enum, Floating, Fractional, Num, Real, RealFloat, RealFrac)---- | Deprecated synonym for 'Turn', retained for backwards compatibility.-type CircleFrac = Turn---- | Newtype wrapper for representing angles in radians.-newtype Rad = Rad { getRad :: Double }-  deriving (Read, Show, Eq, Ord, Enum, Floating, Fractional, Num, Real, RealFloat, RealFrac)---- | Newtype wrapper for representing angles in degrees.-newtype Deg = Deg { getDeg :: Double }-  deriving (Read, Show, Eq, Ord, Enum, Floating, Fractional, Num, Real, RealFloat, RealFrac)+unp2 :: P2 n -> (n,n)+unp2 (P (V2 x y)) = (x,y) --- | Type class for types that measure angles.-class Num a => Angle a where-  -- | Convert to a turn, /i.e./ a fraction of a circle.-  toTurn   :: a -> Turn+-- | Curried form of `p2`.+mkP2 :: n -> n -> P2 n+mkP2 x y = P (V2 x y) -  -- | Convert from a turn, /i.e./ a fraction of a circle.-  fromTurn :: Turn -> a+p2Iso :: Iso' (Point V2 n) (n, n)+p2Iso = iso unp2 p2 -instance Angle Turn where-  toTurn   = id-  fromTurn = id+instance Transformable (V2 n) where+  transform = apply --- | tau radians = 1 full turn.-instance Angle Rad where-  toTurn   = Turn . (/tau) . getRad-  fromTurn = Rad . (*tau) . getTurn+r2PolarIso :: RealFloat n => Iso' (V2 n) (n, Angle n)+r2PolarIso = iso (\v@(V2 x y) -> (norm v, atan2A y x))+              (\(r,θ)      -> V2 (r * cosA θ) (r * sinA θ))+{-# INLINE r2PolarIso #-} --- | 360 degrees = 1 full turn.-instance Angle Deg where-  toTurn   = Turn . (/360) . getDeg-  fromTurn = Deg . (*360) . getTurn+-- | A space which has magnitude '_r' that can be calculated numerically.+class HasR t where+  _r :: RealFloat n => Lens' (t n) n --- | An angle representing one full turn.-fullTurn :: Angle a => a-fullTurn = fromTurn 1+instance HasR v => HasR (Point v) where+  _r = lensP . _r+  {-# INLINE _r #-} --- | Deprecated synonym for 'fullTurn', retained for backwards compatibility.-fullCircle :: Angle a => a-fullCircle = fullTurn+instance HasR V2 where+  _r = r2PolarIso . _1+  {-# INLINE _r #-} --- | Convert between two angle representations.-convertAngle :: (Angle a, Angle b) => a -> b-convertAngle = fromTurn . toTurn+instance HasTheta V2 where+  _theta = r2PolarIso . _2+  {-# INLINE _theta #-}

src/Diagrams/TwoD/Vector.hs view

@@ -1,6 +1,3 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE TypeFamilies     #-}-{-# LANGUAGE ViewPatterns     #-} ----------------------------------------------------------------------------- -- | -- Module      :  Diagrams.TwoD.Vector@@ -14,57 +11,82 @@ module Diagrams.TwoD.Vector        ( -- * Special 2D vectors          unitX, unitY, unit_X, unit_Y+       , xDir, yDir           -- * Converting between vectors and angles-       , direction, fromDirection,  e+       , angleV, angleDir, e, signedAngleBetween, signedAngleBetweenDirs           -- * 2D vector utilities-       , perp, leftTurn+       , perp, leftTurn, cross2+        ) where -import           Data.VectorSpace     ((<.>))-import           Diagrams.Coordinates+import           Control.Lens        (view, (&), (.~), (^.))++import           Diagrams.Angle+import           Diagrams.Direction import           Diagrams.TwoD.Types-import           Diagrams.Util        (( # )) --- | The unit vector in the positive X direction.-unitX :: R2-unitX = 1 & 0+import           Linear.Metric+import           Linear.V2+import           Linear.Vector --- | The unit vector in the positive Y direction.-unitY :: R2-unitY = 0 & 1+-- | The unit vector in the positive X direction.+unitX :: (R1 v, Additive v, Num n) => v n+unitX = zero & _x .~ 1  -- | The unit vector in the negative X direction.-unit_X :: R2-unit_X = (-1) & 0+unit_X :: (R1 v, Additive v, Num n) => v n+unit_X = zero & _x .~ (-1) +-- | The unit vector in the positive Y direction.+unitY :: (R2 v, Additive v, Num n) => v n+unitY = zero & _y .~ 1+ -- | The unit vector in the negative Y direction.-unit_Y :: R2-unit_Y = 0 & (-1)+unit_Y :: (R2 v, Additive v, Num n) => v n+unit_Y = zero & _y .~ (-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 (coords -> x :& y) = convertAngle . Rad $ atan2 y x+-- | A 'Direction' pointing in the X direction.+xDir :: (R1 v, Additive v, Num n) => Direction v n+xDir = dir unitX --- | Convert an angle into a unit vector pointing in that direction.-fromDirection :: Angle a => a -> R2-fromDirection a = cos a' & sin a'-  where Rad a' = convertAngle a+-- | A 'Direction' pointing in the Y direction.+yDir :: (R2 v, Additive v, Num n) => Direction v n+yDir = dir unitY --- | A convenient synonym for 'fromDirection'.-e :: Angle a => a -> R2-e = fromDirection+-- | A direction at a specified angle counter-clockwise from the 'xDir'.+angleDir :: Floating n => Angle n -> Direction V2 n+angleDir = dir . angleV --- | @perp v@ is perpendicular to and has the same magnitude as @v@.---   In particular @perp v == rotateBy (1/4) v@.-perp :: R2 -> R2-perp (coords -> x :& y) = (-y) & x+-- | A unit vector at a specified angle counter-clockwise from the+--   positive x-axis+angleV :: Floating n => Angle n -> V2 n+angleV = angle . view rad +-- | A unit vector at a specified angle counter-clockwise from the+--   positive X axis.+e :: Floating n => Angle n -> V2 n+e = angleV+ -- | @leftTurn v1 v2@ tests whether the direction of @v2@ is a left --   turn from @v1@ (that is, if the direction of @v2@ can be obtained --   from that of @v1@ by adding an angle 0 <= theta <= tau/2).-leftTurn :: R2 -> R2 -> Bool-leftTurn v1 v2 = (v1 <.> perp v2) < 0+leftTurn :: (Num n, Ord n) => V2 n -> V2 n -> Bool+leftTurn v1 v2 = (v1 `dot` perp v2) < 0++-- | Cross product on vectors in R2.+cross2 :: Num n => V2 n -> V2 n -> n+cross2 (V2 x1 y1) (V2 x2 y2) = x1 * y2 - y1 * x2++-- | Signed angle between two vectors. Currently defined as+--+-- @+-- signedAngleBetween u v = (u ^. _theta) ^-^ (v ^. _theta)+-- @+signedAngleBetween :: RealFloat n => V2 n -> V2 n -> Angle n+signedAngleBetween u v = (u ^. _theta) ^-^ (v ^. _theta)++-- | Same as 'signedAngleBetween' but for 'Directions's.+signedAngleBetweenDirs :: RealFloat n => Direction V2 n -> Direction V2 n -> Angle n+signedAngleBetweenDirs u v = (u ^. _theta) ^-^ (v ^. _theta)

src/Diagrams/Util.hs view

@@ -1,7 +1,9 @@+{-# LANGUAGE CPP #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  Diagrams.Util--- Copyright   :  (c) 2011 diagrams-lib team (see LICENSE)+-- Copyright   :  (c) 2011-2015 diagrams-lib team (see LICENSE) -- License     :  BSD-style (see LICENSE) -- Maintainer  :  diagrams-discuss@googlegroups.com --@@ -10,24 +12,44 @@ -----------------------------------------------------------------------------  module Diagrams.Util-       ( -- * Utilities for users+  ( -- * Utilities for users -         with-       , applyAll-       , (#)+    with+  , applyAll+  , (#)+  , (##) -       , iterateN+  , iterateN -       , tau+  , tau -         -- * Internal utilities-       , Proxy(..)-       , foldB+    -- * Finding files+  , findHsFile -       ) where+    -- * Finding sandboxes+  , findSandbox+  , globalPackage -import           Data.Default.Class+    -- * Internal utilities+  , foldB++  ) where++import           Control.Applicative+import           Control.Lens              hiding (( # ))+import           Control.Monad+import           Control.Monad.Catch+import           Control.Monad.Trans+import           Control.Monad.Trans.Maybe+import           Data.Default+import           Data.List+import           Data.Maybe import           Data.Monoid+import           System.Directory+import           System.Environment+import           System.FilePath+import           System.FilePath.Lens+import           System.Process  -- | Several functions exported by the diagrams library take a number --   of arguments giving the user control to \"tweak\" various aspects@@ -68,6 +90,13 @@ (#) :: a -> (a -> b) -> b (#) = flip ($) +-- | A replacement for lenses' 'Control.Lens.Review.#' operator.+(##) :: AReview t b -> b -> t+(##) = review+{-# INLINE (##) #-}+infixr 8 ##++ -- | @iterateN n f x@ returns the list of the first @n@ iterates of --   @f@ starting at @x@, that is, the list @[x, f x, f (f x), ...]@ --   of length @n@. (Note that the last element of the list will be@@ -87,10 +116,6 @@ tau :: Floating a => a tau = 2*pi --- | A value of @Proxy a@ carries no information; it's used only to---   fix the type @a@.-data Proxy a = Proxy- -- | Given an associative binary operation and a default value to use --   in the case of an empty list, perform a /balanced/ fold over a --   list.  For example,@@ -107,3 +132,127 @@         go []         = []         go [x]        = [x]         go (x1:x2:xs) = f x1 x2 : go xs++------------------------------------------------------------------------+-- Files+------------------------------------------------------------------------++-- | Given some file (no extension or otherwise) try to find a haskell+--   source file.+findHsFile :: FilePath -> IO (Maybe FilePath)+findHsFile file = runMaybeT $ hs <|> lhs+  where+    hs      = check (addExtension file "hs")+    lhs     = check (addExtension file "lhs")+    check f = do+      lift (doesFileExist f) >>= guard+      pure f++------------------------------------------------------------------------+-- Sandbox+------------------------------------------------------------------------++-- | Parse cabal config file to find the location of the package+--   database.+parseConfig :: FilePath -> MaybeT IO FilePath+parseConfig file = do+  config <- maybeIO $ readFile file+  hoistMaybe $ config ^? lined . prefixed "package-db: "++-- | Seach the given directory and all parent directories until a cabal+--   config file is found. First search for \"cabal.config\", then+--   \"cabal.sandbox.config\". Return the location of the package+--   database in the config file.+configSearch :: FilePath -> MaybeT IO FilePath+configSearch p0 = do+  p0' <- maybeIO $ canonicalizePath p0++  let mkPaths p+        | all isPathSeparator p || p == "."+                    = []+        | otherwise = (p </> "cabal.sandbox.config")+                    : mkPaths (p ^. directory)++  foldMaybeT parseConfig (mkPaths p0')++-- | Check if the folder is a database, or if it contains a database.+--   Returns the database location if it's found.+isDB :: FilePath -> MaybeT IO FilePath+isDB path =+  if isConf path+    then return path+    else maybeIO (getDirectoryContents path) >>= hoistMaybe . find isConf+    where+      isConf = isSuffixOf ".conf.d"++-- | Search for a sandbox in the following order:+--+--   * Test given FilePaths if they point directly to a database or+--     contain a cabal config file (or any parent directory containing a+--     config file).+--+--   * Same test for @DIAGRAMS_SANDBOX@ environment value+--+--   * Environment values of @GHC_PACKAGE_PATH@, @HSENV@ and+--     @PACKAGE_DB_FOR_GHC@ that point to a database.+--+--   * Test for config file (cabal.sandbox.config) in the current+--     directory and its parents.+--+findSandbox :: [FilePath] -> IO (Maybe FilePath)+findSandbox paths = runMaybeT $ pathsTest <|> diaSB <|> envDB <|> wdConfig+  where+    -- first path in environment+    lookEnv = MaybeT . (fmap . fmap) (head . splitSearchPath) . lookupEnv+    envDB   = foldMaybeT lookEnv ["GHC_PACKAGE_PATH", "HSENV", "PACKAGE_DB_FOR_GHC"]++    -- test if path points directly to db or contains a config file+    test x    = isDB x <|> configSearch x+    pathsTest = foldMaybeT test paths+    diaSB     = lookEnv "DIAGRAMS_SANDBOX" >>= test+    wdConfig  = maybeIO getCurrentDirectory >>= configSearch++-- -- | Use the given path for the sandbox in the @GHC_PACKAGE_PATH@+-- --   environment (appending the ghc global package database from @ghc+-- --   --info@. @GHC_PACKAGE_PATH@ if the variable ghc and other tools use+-- --   to find the package database. (This is what @cabal exec@ sets)+-- ghcPackagePath :: FilePath -> IO ()+-- ghcPackagePath db = do+--   gdb <- globalPackage+--   let dbs = intercalate [searchPathSeparator] [db,gdb]+--   setEnv "GHC_PACKAGE_PATH" dbs+-- -- setEnv is only in base > 4.7, either need to use setenv package or+-- -- -package-db flag++-- | Find ghc's global package database. Throws an error if it isn't+--   found.+globalPackage :: IO FilePath+globalPackage = do+  info <- read <$> readProcess "ghc" ["--info"] ""+  return $ fromMaybe (error "Unable to parse ghc --info.")+                     (lookup "Global Package DB" info)++-- MaybeT utilities++-- | Lift an 'IO' action. If any exceptions are raised, return Nothing.+maybeIO :: (MonadCatch m, MonadIO m) => IO a -> MaybeT m a+maybeIO io = liftIO io `catchAll` const mzero++-- hoistMaybe is exported from transformers as of version 0.6+#if MIN_VERSION_transformers(0,6,0)+#else+-- | Lift a maybe value to a MaybeT of any monad.+hoistMaybe :: Monad m => Maybe a -> MaybeT m a+hoistMaybe = MaybeT . return+#endif++-- | Fold a list of 'MaybeT's that short-circuits as soon as a Just value+--   is found (instead going through the whole list).+foldMaybeT :: Monad m => (a -> MaybeT m b) -> [a] -> MaybeT m b+foldMaybeT _ []     = mzero+foldMaybeT f (a:as) = MaybeT $ do+  x <- runMaybeT (f a)+  if isJust x+    then return x+    else runMaybeT (foldMaybeT f as)+

+ src/Linear/Vector/Compat.hs view

@@ -0,0 +1,24 @@+{-# LANGUAGE CPP #-}++-- |+-- Module      :  Linear.Vector.Compat+-- Copyright   :  (c) 2024 diagrams-lib team (see LICENSE)+-- License     :  BSD-style (see LICENSE)+-- Maintainer  :  diagrams-discuss@googlegroups.com+--+-- Compatibility layer for working with versions of linear both before+-- (< 1.23) and after (>= 1.23) the interpolation direction of `lerp`+-- was reversed.+module Linear.Vector.Compat (lerp) where++import qualified Linear.Vector as V++-- | Linearly interpolate between two vectors, such that @lerp 0 x y =+--   x@ and @lerp 1 x y = 1@.+lerp :: (V.Additive f, Num a) => a -> f a -> f a -> f a+lerp =+#if MIN_VERSION_linear(1,23,0)+  V.lerp+#else+  V.lerp . (1-)+#endif

+ test/Diagrams/Test/Angle.hs view

@@ -0,0 +1,29 @@+-- |++module Diagrams.Test.Angle where+++import           Test.Tasty+import           Test.Tasty.QuickCheck+import           Diagrams.Prelude+import Instances++tests :: TestTree+tests = testGroup "Angle" [+         testProperty "2π radians per turn" $+           \θ -> θ^.rad =~ θ^.turn*2*(pi :: Double)+         , testProperty "360 degrees per turn" $+           \θ -> θ^.deg =~ θ^.turn*(360 :: Double)+         , testProperty "Angle vector addition is commutative" $+           \θ φ -> (θ :: Angle Double) ^+^ φ =~ φ ^+^ θ+         , testProperty "Angle subtraction is the inverse of addition" $+           \θ φ -> (θ :: Angle Double) ^+^ φ ^-^ φ =~ θ+         , testProperty "Angle vector negation squared is identity" $+           \θ -> negated (negated (θ :: Angle Double)) =~ θ+         , testProperty "A negated angle is the additive inverse of the original" $+           \θ -> (θ :: Angle Double) ^+^ (negated θ) =~ 0@@turn+         , testProperty "A negated angle is the additive inverse of the original" $+           \θ -> (θ :: Angle Double) ^+^ (negated θ) =~ 0@@turn+++      ]

+ test/Diagrams/Test/Direction.hs view

@@ -0,0 +1,34 @@+-- |++module Diagrams.Test.Direction where+++import           Diagrams.Direction+import           Diagrams.Prelude+import           Instances+import           Test.Tasty+import           Test.Tasty.QuickCheck++tests :: TestTree+tests = testGroup "Direction" [+         testProperty "Length does not effect from direction" $+           \(Positive f) (NonZero v) -> fromDirection(dir ((v  :: V2 Double) ^* (f+0.001))) =~ fromDirection(dir v)+         , testProperty "HasTheta subtraction yeilds same result as anglebetween" $+            (anglebetsub)+         , testProperty "anglebetweenDirs is commutative" $+           \a b -> angleBetweenDirs (a :: Direction V2 Double) b =~ angleBetweenDirs b a+         , testProperty "fromdirection does not effect angleBetweenDirs" $+           \a b -> angleBetween (fromDirection (a  :: Direction V2 Double)) (fromDirection b) =~ angleBetweenDirs a b++++      ]++if' :: Bool -> a -> a -> a+if' True  x _ = x+if' False _ y = y++anglebetsub :: Direction V2 Double -> Direction V2 Double -> Bool+anglebetsub a b = (if' (abs (a ^.  _theta^.rad  - b ^. _theta^.rad) < pi)+                       (abs ((a ^.  _theta  ^-^ b ^. _theta)^.rad))+                       (2*pi - abs (a ^.  _theta^.rad  - b ^. _theta^.rad) ) =~ angleBetweenDirs a b ^.rad)

+ test/Diagrams/Test/Trail.hs view

@@ -0,0 +1,113 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies     #-}++module Diagrams.Test.Trail where++import           Diagrams.Prelude+import           Instances+import           Test.Tasty+import           Test.Tasty.QuickCheck++import           Data.Fixed+import           Data.List++tests :: TestTree+tests = testGroup "Trail"+  [ let wrap :: Trail' Line V2 Double -> Located (Trail V2 Double)+        wrap = (`at` origin) . wrapLine+    in+    testProperty "unfixTrail . fixTrail == id for lines" $+    \l -> (unfixTrail . fixTrail $ wrap l) =~ (wrap l)++  , testProperty "glueLine . cutLoop == id" $+    \loop -> (glueLine . cutLoop $ loop) =~ (loop :: Trail' Loop V2 Double)++  , testProperty "trailOffset == sumV . trailOffsets" $+    \t -> trailOffset t =~ (sumV . trailOffsets $ (t :: Trail V2 Double))++  , testProperty "reverseTrail . reverseTrail == id" $+    \t -> (reverseTrail . reverseTrail $ t) =~ (t :: Trail V2 Double)++  , testProperty "reverseLocTrail . reverseLocTrail == id" $+    \t -> (reverseLocTrail . reverseLocTrail $ t) =~+          (t :: Located (Trail V2 Double))++  , testProperty "reverseLine . reverseLine == id" $+    \t -> (reverseLine . reverseLine $ t) =~+          (t :: Trail' Line V2 Double)++  , testProperty "reverseLocLine . reverseLocLine == id" $+    \t -> (reverseLocLine . reverseLocLine $ t) =~+          (t :: Located (Trail' Line V2 Double))++  , testProperty "reverseLoop . reverseLoop == id" $+    \t -> (reverseLoop . reverseLoop $ t) =~+          (t :: Trail' Loop V2 Double)++  , testProperty "reverseLocLoop . reverseLocLoop == id" $+    \t -> (reverseLocLoop . reverseLocLoop $ t) =~+          (t :: Located (Trail' Loop V2 Double))++  , testProperty "section on Trail' Line endpoints match paramaters" $+    \t (Param a) (Param b) ->+      let s = section (t :: Located (Trail' Line V2 Double)) a b+      in  t `atParam` a =~ s `atParam` 0 &&+          t `atParam` b =~ s `atParam` 1++  , testProperty "section on Trail' Line where a paramater is 0 or 1" $+    \t (Param a) ->+      let l = section (t :: Located (Trail' Line V2 Double)) 0 a+          r = section (t :: Located (Trail' Line V2 Double)) a 1+      in  t `atParam` 0 =~ l `atParam` 0 &&+          t `atParam` a =~ l `atParam` 1 &&+          t `atParam` a =~ r `atParam` 0 &&+          t `atParam` 1 =~ r `atParam` 1++  , testProperty "section on Trail' Line where a segment paramater is 0 or 1" $+    \t (Param a) i ->+      let st = unLoc t # \(Line st') -> st' :: SegTree V2 Double+          b | (numSegs st :: Word) > 0 = (fromIntegral (i `mod` (numSegs st + 1) :: Word)) / numSegs st+            | otherwise                = 0+          s = section (t :: Located (Trail' Line V2 Double)) a b+      in  t `atParam` a =~ s `atParam` 0 &&+          t `atParam` b =~ s `atParam` 1++  , testProperty "section on Trail' Line matches section on FixedSegment" $+    \t (Param a) (Param b) -> sectionTrailSectionFixedSegment t a b++  ]++data Param = Param Double deriving Show++instance Arbitrary Param where+  arbitrary = Param <$> choose (-0.5, 1.5)++sectionTrailSectionFixedSegment :: Located (Trail' Line V2 Double) -> Double -> Double -> Bool+sectionTrailSectionFixedSegment t k1 k2+  | null segs = t == t'+  | otherwise = aSecT =~ aSecFS && bSecT =~ bSecFS+  where+    a = min k1 k2+    b = max k1 k2+    t' = section t a b++    segs  = fixTrail $ mapLoc wrapLine t+    segs' = fixTrail $ mapLoc wrapLine t'++    aSecT = head segs'+    bSecT = last segs'++    (aSegIx, a') = splitParam a+    (bSegIx, b') = splitParam b++    aSecFS = section (segs !! floor aSegIx) a' x+      where x = if aSegIx == bSegIx then b' else 1+    bSecFS = section (segs !! floor bSegIx) x  b'+      where x = if aSegIx == bSegIx then a' else 0++    splitParam p | p <  0    = (0    , p           * n)+                 | p >= 1    = (n - 1, 1 + (p - 1) * n)+                 | otherwise = propFrac $  p       * n+      where+        propFrac x = let m = x `mod'` 1 in (x - m, m)+        n = genericLength segs

+ test/Diagrams/Test/Transform.hs view

@@ -0,0 +1,76 @@+{-# LANGUAGE ConstraintKinds       #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE TypeFamilies          #-}+++module Diagrams.Test.Transform where++import           Test.Tasty+import           Test.Tasty.QuickCheck+import           Diagrams.Prelude+import           Diagrams.Direction+import Instances++tests :: TestTree+tests = testGroup "Transform" [++        testProperty "rotating a vector by a number then its additive inverse will yield the original vector" $+          \θ a -> rotate ((θ * (-1)) @@ deg) (rotate ((θ :: Double) @@ deg) (a ::  V2 Double)) =~ a+        , testProperty "under rotated allows scaling along an angle" $+          \θ f a -> under (rotated ((θ :: Double) @@ deg)) (scaleX (f :: Double)) (a ::  V2 Double) =~ (rotate (negated (θ @@ deg)) . (scaleX f) . rotate (θ @@ deg)) a+        , testProperty "a rotation of 0 does nothing" $+          \a -> rotate (0 @@ deg) (a ::  V2 Double) =~ a+        , testProperty "adding 360 degrees to a turn does nothing" $+          \c a -> rotate (((c :: Double) + 360) @@ deg) (a ::  V2 Double) =~ rotate (c @@ deg) a+        , testProperty "over rotated allows scaling along x of a rotated shape" $+          \θ f a -> over (rotated ((θ :: Double) @@ deg)) (scaleX (f :: Double)) (a ::  V2 Double) =~ (rotate (θ @@ deg) . (scaleX f) . rotate (negated (θ @@ deg))) a+        , testProperty "scaleX" $+          \f a b -> (scaleX (f :: Double)) (V2 (a ::  Double) b) =~ V2 (a * f) b+        , testProperty "scaleY" $+          \f a b -> (scaleY (f :: Double)) (V2 (a ::  Double) b) =~ V2 a  (f * b)+        , testProperty "reflectX" $+          \a b -> reflectX (V2 (a ::  Double) b) =~ V2 (a * (-1))  b+        , testProperty "reflectY" $+          \a b -> reflectY (V2 (a ::  Double) b) =~ V2 a  ((-1) * b)+        , testProperty "reflectXY" $+          \a b -> reflectXY (V2 (a ::  Double) b) =~ V2 b a+        , testProperty "translate" $+          \a b c d -> translateX (a :: Double) (translateY b (P (V2 c d ))) =~ P (V2 (a + c) (b + d))+        , testProperty "shear" $+          \a b c d -> shearX (a :: Double) (shearY b (V2 c d)) =~ V2 ((c*b + d) * a + c) (c*b + d)+        , testProperty "(1,0) rotateTo some dir will return normalised dir" $+          \(NonZero a) b -> rotateTo  (dir (V2 (a :: Double) b)) (V2 1 0) =~ signorm (V2 a b)+        , testProperty "rotates" $+          \a c -> rotate ((a :: Double)@@ deg) (c :: V2 Double)   =~ rotate'' ((a :: Double)@@ deg) (c :: V2 Double) && rotate ((a :: Double)@@ deg) (c :: V2 Double)   =~ rotate' ((a :: Double)@@ deg) (c :: V2 Double)+        , testProperty "reflectAbout works for a vector" $+          \a b c d e f -> reflectAbout (P (V2 (a :: Double) b)) (dir (V2 c d)) (V2 e f) =~  over (rotated (atan2A' d c)) reflectY (V2 e f)+        , testProperty "reflectAbout works for a point" $+          \a b c d e f -> reflectAbout (P (V2 (a :: Double) b)) (dir (V2 c d)) (P (V2 e f)) =~ translate (V2 a b)  ((over (rotated (atan2A' d c)) reflectY) ((translate (V2 (-a) (-b)) )  (P (V2 e f))))+++        ]++--the original " '' " and a secondary " ' " rotate function for testing++rotation'' :: Floating n => Angle n -> T2 n+rotation'' theta = fromLinear r (linv r)+          where+            r               = rot theta <-> rot (negated theta)+            rot th (V2 x y) = V2 (cosA th * x - sinA th * y)+                                 (sinA th * x + cosA th * y)++rotate'' :: (InSpace V2 n t, Transformable t, Floating n) => Angle n -> t -> t+rotate'' = transform . rotation''++rotation' :: Floating n => Angle n -> T2 n+rotation' theta = fromLinear r (linv r)+            where+            r               = rot theta <-> rot (negated theta)+            rot th (V2 x y) = V2 (c * x - s * y)+                                 (s * x + c * y)+                                  where+                                    c = cosA th+                                    s = sinA th++rotate' :: (InSpace V2 n t, Transformable t, Floating n) => Angle n -> t -> t+rotate'  = transform . rotation'

+ test/Diagrams/Test/Transform/Matrix.hs view

@@ -0,0 +1,26 @@+{-# LANGUAGE ScopedTypeVariables #-}++-- |++module Diagrams.Test.Transform.Matrix where+++import           Test.Tasty+import           Test.Tasty.QuickCheck+import           Diagrams.Transform.Matrix+import           Diagrams.Prelude+import           Data.Distributive (distribute)++import Instances++tests :: TestTree+tests = testGroup "Transform.Matrix"+  [+    testProperty "mkMat column vectors (2D)" $+      \(Blind (t :: T2 Double)) -> distribute (mkMat t) =~ V2 (transform t unitX) (transform t unitY)+  , testProperty "mkMat / fromMat22" $+      \(m :: V2 (V2 Double)) -> mkMat (fromMat22 m zero) =~ m++  , testProperty "mkMat / fromMat33" $+      \(m :: V3 (V3 Double)) -> mkMat (fromMat33 m zero) =~ m+  ]

+ test/Diagrams/Test/TwoD.hs view

@@ -0,0 +1,65 @@+-- |++module Diagrams.Test.TwoD where++import           Diagrams.Prelude+import qualified Diagrams.Query as Query (sample)+import           Diagrams.Trail        (linePoints)+import           Instances+import           Test.Tasty+import           Test.Tasty.QuickCheck as QC++newtype SmallAngle = SmallAngle (Angle Double)+  deriving (Eq, Ord, Show)++-- Generate random angles within a reasonably small range (+/- 5+-- turns).+instance Arbitrary SmallAngle where+  arbitrary = SmallAngle . (@@turn) <$> choose (-5, 5)++tests :: TestTree+tests = testGroup "TwoD"+    [ testGroup "TwoD.Arc" [+           testProperty "arc start point is at radius 1 in the starting direction" $ \d (SmallAngle a) ->+               pathVertices (arc d a :: Path V2 Double) ^? _head . _head =~ Just (origin .+^ fromDirection d )+           , testProperty "arc end point is at radius 1 in the ending direction" $ \d (SmallAngle a) ->+               pathVertices (arc d a :: Path V2 Double) ^? _head . _last =~ Just (origin .+^ fromDirection (rotate a d))+         ]+    , testGroup "TwoD.Types" [+         testProperty "R2 vector addition is commutative" $+           \u v -> (u :: V2 Double) ^+^ v =~ v ^+^ u+         , testProperty "R2 subtraction is the inverse of addition" $+           \u v -> u ^+^ v ^-^ v =~ (u :: V2 Double)+         , testProperty "R2 vector negation squared is identity" $+           \u -> negated (negated (u :: V2 Double)) =~ u+         ]+      , testGroup "cubicSpline" [+         testProperty "Open cubic spline interpolates all points" $+         \pts -> length pts > 1 ==> and (zipWith (=~) pts (cubicSpline False pts :: [P2 Double]))+         , testProperty "Closed cubic spline interpolates all points" $+           \pts -> length pts > 1 ==> and (zipWith (=~) pts (cubicSpline True pts :: [P2 Double]))+    ]+      , testGroup "Trail" [+         testProperty "glueLine . cutLoop === id" $+         \l -> glueLine (cutLoop l :: Trail' Line V2 Double) =~ l+         , testProperty "cutLoop ends at starting point" $+           \l -> let ps = linePoints (cutLoop (l :: Trail' Loop V2 Double) `at` origin) in (ps ^? _head) =~ (ps ^? _last)+         , testProperty "cutTrail makes a Line" $+           \t -> isLine (cutTrail (t :: Trail V2 Double))+          , testProperty "fromSegments . lineSegments === id" $+            \l -> fromSegments (lineSegments l) =~ (l :: Trail' Line V2 Double)+          , testProperty "lineSegments . fromSegments === id" $+            \segs -> lineSegments (fromSegments segs) =~ (segs :: [Segment Closed V2 Double])+          ]+    , testGroup "Queries and Backgrounds"+        (let dia :: QDiagram NullBackend V2 Double [Int]+             dia = circle 5 # scaleX 2 # rotateBy (1/14) # value [1]+                   <>+                   circle 2 # scaleX 5 # rotateBy (-4/14) # value [2]+         in [+           testProperty "sample dia pt === sample (dia # bg color) pt" $+           \pt -> Query.sample dia pt QC.=== Query.sample (dia # bg orange) pt+         , testProperty "sample dia pt === sample (dia # bgFrame 0.1 color) pt" $+           \pt -> Query.sample dia pt QC.=== Query.sample (dia # bgFrame 0.1 green) pt+         ])+    ]

+ test/Diagrams/Test/TwoD/Offset.hs view

@@ -0,0 +1,48 @@+module Diagrams.Test.TwoD.Offset+    (+      tests+    ) where++import Test.Tasty (TestTree)+import Test.Tasty.HUnit++import Diagrams.Prelude+import Diagrams.TwoD.Offset++tests :: [TestTree]+tests =+    [ testCase "line"+          (offsetTrailVertices+              [p2 (0, 0), p2 (1, 0)]+              [p2 (0, -1), p2 (1, -1)])+    , testCase "square"+          (offsetTrailVertices+              [p2 (0, 0), p2 (1, 0), p2 (1, 1), p2 (0, 1), p2 (0, 0)]+              [p2 (0, -1), p2 (2, -1), p2 (2, 2), p2 (-1, 2), p2 (-1, 0)])+    , testCase "square loop"+          (offsetTrailLoopVertices+              [p2 (0, 0), p2 (1, 0), p2 (1, 1), p2 (0, 1), p2 (0, 0)]+              [p2 (2, -1), p2 (2, 2), p2 (-1, 2), p2 (-1, -1)])+    , testCase "redundant line"+          (offsetTrailVertices+              [p2 (0, 0), p2 (0.5, 0), p2 (1, 0)]+              [p2 (0, -1), p2 (1, -1)])+    , testCase "redundant square"+          (offsetTrailVertices+              [p2 (0, 0), p2 (1, 0), p2 (1, 0.5), p2 (1, 1), p2 (0, 1), p2 (0, 0)]+              [p2 (0, -1), p2 (2, -1), p2 (2, 2), p2 (-1, 2), p2 (-1, 0)])+    , testCase "redundant square loop"+          (offsetTrailLoopVertices+              [p2 (0, 0), p2 (1, 0), p2 (1, 0.5), p2 (1, 1), p2 (0, 1), p2 (0, 0)]+              [p2 (2, -1), p2 (2, 2), p2 (-1, 2), p2 (-1, -1)])+    ]++offsetTrailVertices :: [Point V2 Double] -> [Point V2 Double] -> Assertion+offsetTrailVertices orig off =+    (trailVertices . offsetTrail 1 . fromVertices $ orig) @?= off++offsetTrailLoopVertices :: [Point V2 Double] -> [Point V2 Double] -> Assertion+offsetTrailLoopVertices orig off =+    (trailVertices . offsetTrail 1 . loopTrailFromVertices $ orig) @?= off+  where+    loopTrailFromVertices = (`at` origin) . wrapTrail . glueLine . lineFromVertices

+ test/Diagrams/Test/TwoD/Segment.hs view

@@ -0,0 +1,54 @@+{-# LANGUAGE FlexibleContexts  #-}+{-# LANGUAGE FlexibleInstances #-}++{-# OPTIONS_GHC -fno-warn-orphans #-}++module Diagrams.Test.TwoD.Segment+    (+      tests+    ) where++import qualified Test.QuickCheck.Property as Q+import           Test.Tasty               (TestTree)+import           Test.Tasty.QuickCheck++import           Diagrams.Prelude+import           Diagrams.TwoD.Segment++newtype InBox = InBox { unInBox :: Double }++instance Arbitrary InBox where+  arbitrary = InBox <$> choose (-1, 1)++instance Arbitrary (Point V2 Double) where+  arbitrary = curry p2 <$> (unInBox <$> arbitrary)+                       <*> (unInBox <$> arbitrary)++instance Arbitrary (FixedSegment V2 Double) where+   arbitrary = oneof [FLinear <$> arbitrary <*> arbitrary, FCubic <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary]++epsT, epsE :: Double+epsT = 1.0e-9 -- parameter space epsilon+epsE = 1.0e-8 -- Euclidean space epsilon++(.=~.) :: P2 Double -> P2 Double -> Bool+x .=~. y = norm (x .-. y) < epsE++tests :: [TestTree]+tests =+    [ testProperty "segmentSegment" $+        \a b -> validateIntersections a b (segmentSegment epsT a b)+    ]++validateIntersections :: FixedSegment V2 Double -> FixedSegment V2 Double -> [(Double, Double, P2 Double)] -> Q.Result+validateIntersections _ _ [] = Q.rejected -- TODO: check for false negatives (rasterize both and look for overlap?)+validateIntersections a b isects = go isects+  where+    go [] = Q.succeeded+    go ((ta,tb,p):is)+      | and [ 0 <= ta && ta <= 1+            , 0 <= tb && tb <= 1+            , a `atParam` ta .=~. p+            , b `atParam` tb .=~. p+            ] = go is+      | otherwise = Q.failed

+ test/Instances.hs view

@@ -0,0 +1,157 @@+{-# LANGUAGE FlexibleContexts     #-}+{-# LANGUAGE FlexibleInstances    #-}+{-# LANGUAGE GADTs                #-}+{-# LANGUAGE ScopedTypeVariables  #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE ViewPatterns         #-}++{-# OPTIONS_GHC -fno-warn-orphans #-}++-- | instances for QuickCheck Arbitrary and approximate equality++module Instances where++import           Diagrams.Prelude+import           Numeric.Extras+import           Test.Tasty.QuickCheck (Arbitrary (..), Gen)+import qualified Test.Tasty.QuickCheck as QC++------------------------------------------------------------+    -- Approximate Comparison for Doubles, Points++epsilon :: Double+epsilon = 0.001++class Approx a where+  (=~) :: a -> a -> Bool++infix 4 =~++--instance (Fractional a, Ord a) => Approx a where+instance Approx Double where+  (=~) a b = abs (a - b) < epsilon++instance Approx Float where+    (=~) a b = abs (a - b) < 0.001++instance Approx n => Approx (V2 n) where+    z1 =~ z2 = (z1^._x) =~ (z2^._x) && (z1^._y) =~ (z2^._y)++instance Approx n => Approx (V3 n) where+    z1 =~ z2 = (z1^._x) =~ (z2^._x) && (z1^._y) =~ (z2^._y) && (z1^._z) =~ (z2^._z)++instance Approx (v n) => Approx (Point v n) where+    p =~ q = view _Point p =~ view _Point q++instance (Approx n, RealExtras n) => Approx (Angle n) where+    a =~ b = normA (a^.rad) =~ normA (b^.rad) where+      normA ang = let ang' = ang `fmod` pi in if ang' >= 0 then ang' else ang'+pi++instance Approx n => Approx (Offset Closed V2 n) where+    OffsetClosed v0 =~ OffsetClosed v1 = v0 =~ v1++instance Approx n => Approx (Segment Closed V2 n) where+    Linear o0 =~ Linear o1 = o0 =~ o1+    Cubic c0 d0 o0 =~ Cubic c1 d1 o1 = c0 =~ c1 && d0 =~ d1 && o0 =~ o1+    _ =~ _ = False+    -- The above is conservative:+    -- Cubic never equals Linear even if they describe the same points++instance Approx n => Approx (FixedSegment V2 n) where+    FLinear a0 b0 =~ FLinear a1 b1 = a0 =~ a1 && b0 =~ b1+    FCubic a0 b0 c0 d0 =~ FCubic a1 b1 c1 d1 = a0 =~ a1 && b0 =~ b1 && c0 =~ c1 && d0 =~ d1+    _ =~ _ = False++instance Approx n => Approx (Trail' Line V2 n) where+    l0 =~ l1 = and $ zipWith (=~) (lineSegments l0) (lineSegments l1)++instance Approx n => Approx (Trail' Loop V2 n) where+    l0 =~ l1 = fst (loopSegments l0) =~ fst (loopSegments l1)++instance (Approx n, Floating n, Ord n) => Approx (Trail V2 n) where+    t0 =~ t1 = and $ zipWith (=~) (trailSegments t0) (trailSegments t1)++instance (Approx a, Approx (Vn a), Num (N a), Additive (V a)) =>+         Approx (Located a) where+           a0 =~ a1 = (loc a0 .-. origin) =~ (loc a1 .-. origin) && unLoc a0 =~ unLoc a1++instance Approx a => Approx (Maybe a) where+    Nothing =~ Nothing = True+    Nothing =~ Just _ = False+    Just _ =~ Nothing = False+    Just l =~ Just r = l =~ r++-- These may be too general+instance Approx a => Approx [a] where+    a =~ b = and $ zipWith (=~) a b++instance (Approx a, Approx b) => Approx (a, b) where+    (a0, b0) =~ (a1,b1) = (a0 =~ a1) && (b0 =~ b1)++------------------------------------------------------------+-- Arbitrary instances for Points, Paths++instance Arbitrary n => Arbitrary (V2 n) where+    arbitrary = (^&) <$> arbitrary <*> arbitrary+    shrink (coords -> x :& y) = (^&) <$> shrink x <*> shrink y++instance Arbitrary n => Arbitrary (V3 n) where+    arbitrary = V3 <$> arbitrary <*> arbitrary <*> arbitrary+    shrink (coords -> x :& y :& z) = V3 <$> shrink x <*> shrink y <*> shrink z++instance Arbitrary (v n) => Arbitrary (Point v n) where+    arbitrary = P <$> arbitrary+    shrink (P v) = P <$> shrink v++instance (Arbitrary n, Floating n, Ord n) => Arbitrary (Transformation V2 n) where+    arbitrary = QC.sized arbT+      where+        arbT 0 = return mempty+        arbT n = QC.oneof+          [ rotation    <$> arbitrary+          , scaling     <$> arbitrary+          , translation <$> arbitrary+          , reflectionAbout <$> arbitrary <*> arbitrary+          , (<>) <$> arbT (n `div` 2) <*> arbT (n `div` 2)+          ]++instance Arbitrary n => Arbitrary (Angle n) where+    arbitrary = review rad <$> arbitrary++instance (Arbitrary n, Floating n) => Arbitrary (Direction V2 n) where+    arbitrary = rotate <$> arbitrary <*> pure xDir++-- -- | Not a valid Show instance because not valid Haskell input+-- instance (Show n, RealFloat n) => Show (Direction V2 n) where+--     show d = "Dir" <> ( show $ d ^. _theta . turn )++-- NOTE on shrinks: Adding definitions of 'shrink' below seems to work+--   in simple tests, but test case failures hang for a very long time+--   (presumably trying lots and lots of expensive shrinks).  Not sure+--   how to make shrinking more tractable.++instance (Arbitrary a, Arbitrary (Vn a)) => Arbitrary (Located a) where+    arbitrary = at <$> arbitrary <*> arbitrary+--    shrink (viewLoc -> (p,a)) = uncurry at <$> shrink (a,p)++instance Arbitrary n => Arbitrary (Offset Closed V2 n) where+    arbitrary = OffsetClosed <$> arbitrary+--    shrink (OffsetClosed x) = OffsetClosed <$> shrink x++instance Arbitrary n =>  Arbitrary (Segment Closed V2 n) where+    arbitrary = QC.oneof [Linear <$> arbitrary, Cubic <$> arbitrary <*> arbitrary <*> arbitrary]+    -- shrink (Linear x) = Linear <$> shrink x+    -- shrink (Cubic x y z) = Linear z+    --                      : [Cubic x' y' z' | (x',y',z') <- shrink (x,y,z)]++instance (Arbitrary n, Floating n, Ord n) => Arbitrary (Trail' Line V2 n) where+    arbitrary = lineFromSegments <$> arbitrary+--    shrink (lineSegments -> segs) = lineFromSegments <$> shrink segs++instance (Arbitrary n, Floating n, Ord n) => Arbitrary (Trail' Loop V2 n) where+    arbitrary = closeLine <$> arbitrary+--    shrink (cutLoop -> l) = closeLine <$> shrink l++instance (Arbitrary n, Floating n, Ord n) => Arbitrary (Trail V2 n) where+    arbitrary = QC.oneof [Trail <$> (arbitrary :: Gen (Trail' Loop V2 n)), Trail <$> (arbitrary :: Gen (Trail' Line V2 n))]+

+ test/Speed.hs view

@@ -0,0 +1,47 @@+{-# LANGUAGE ConstraintKinds       #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE TypeFamilies          #-}++module Main where++import Criterion+import Criterion.Main (defaultMain)++import Diagrams.Prelude+++main :: IO ()+main = defaultMain+    [ bgroup "rotates"+        [ bench "rotate"  $ whnf (rotate (90 @@ deg :: Angle Double)) (V2 3 3)+         ,bench "rotate1" $ whnf (rotate' (90 @@ deg :: Angle Double)) (V2 3 3)+         ,bench "rotate2" $ whnf (rotate'' (90 @@ deg :: Angle Double)) (V2 3 3)+        ]+    ]++--the original " '' " and a secondary " ' " rotate function for comparing speed testing+--note: function time changes dramatically when function is in this file rather than imported+++rotation' :: Floating n => Angle n -> T2 n+rotation' theta = fromLinear r (linv r)+                where+                r               = rot theta <-> rot (negated theta)+                rot th (V2 x y) = V2 (c * x - s * y)+                                     (s * x + c * y)+                                      where+                                        c = cosA th+                                        s = sinA th++rotate' :: (InSpace V2 n t, Transformable t, Floating n) => Angle n -> t -> t+rotate'  = transform . rotation'++rotation'' :: Floating n => Angle n -> T2 n+rotation'' theta = fromLinear r (linv r)+              where+                r               = rot theta <-> rot (negated theta)+                rot th (V2 x y) = V2 (cosA th * x - sinA th * y)+                                     (sinA th * x + cosA th * y)++rotate'' :: (InSpace V2 n t, Transformable t, Floating n) => Angle n -> t -> t+rotate'' = transform . rotation''

+ test/Test.hs view

@@ -0,0 +1,26 @@+import           Test.Tasty                (TestTree, defaultMain, testGroup)++import qualified Diagrams.Test.Angle            as Angle+import qualified Diagrams.Test.Direction        as Direction+import qualified Diagrams.Test.Transform        as Transform+import qualified Diagrams.Test.Transform.Matrix as TransformMatrix+import qualified Diagrams.Test.TwoD             as TwoD+import qualified Diagrams.Test.TwoD.Offset      as TwoD.Offset+import qualified Diagrams.Test.TwoD.Segment     as TwoD.Segment++import qualified Diagrams.Test.Trail            as Trail++tests :: TestTree+tests = testGroup "unit tests"+    [ testGroup "TwoD.Offset" TwoD.Offset.tests+    , testGroup "TwoD.Segment" TwoD.Segment.tests+    , TwoD.tests+    , Angle.tests+    , Direction.tests+    , Transform.tests+    , TransformMatrix.tests+    , Trail.tests+    ]++main :: IO ()+main = defaultMain tests