diagrams-lib 0.6.0.3 → 0.7

raw patch · 72 files changed

+3530/−1129 lines, 72 filesdep +data-default-classdep +fingertreedep +intervalsdep −data-defaultdep ~NumInstancesdep ~basedep ~diagrams-corebuild-type:Customsetup-changedPVP ok

version bump matches the API change (PVP)

Dependencies added: data-default-class, fingertree, intervals

Dependencies removed: data-default

Dependency ranges changed: NumInstances, base, diagrams-core, monoid-extras

API changes (from Hackage documentation)

Files

• CHANGES.markdown +82/−1
• LICENSE +4/−1
• Setup.hs +29/−3
• diagrams-lib.cabal +24/−11
• diagrams/besideEx.svg +4/−0
• diagrams/closeLineEx.svg +4/−0
• diagrams/cubicOffsetExample.svg +4/−0
• diagrams/cubicSplineEx.svg +4/−0
• diagrams/decagonEx.svg +4/−0
• diagrams/diagramA.svg +4/−0
• diagrams/diagramNeg.svg +4/−0
• diagrams/diagramPos.svg +4/−0
• diagrams/diagramZero.svg +4/−0
• diagrams/dodecagonEx.svg +4/−0
• diagrams/glueLineEx.svg +4/−0
• diagrams/hendecagonEx.svg +4/−0
• diagrams/hexagonEx.svg +4/−0
• diagrams/hruleEx.svg +4/−0
• diagrams/lineFromOffsetsEx.svg +4/−0
• diagrams/lineFromVerticesEx.svg +4/−0
• diagrams/nonagonEx.svg +4/−0
• diagrams/octagonEx.svg +4/−0
• diagrams/pentagonEx.svg +4/−0
• diagrams/rectEx.svg +4/−0
• diagrams/roundedRectEx.svg +4/−0
• diagrams/septagonEx.svg +4/−0
• diagrams/squareEx.svg +4/−0
• diagrams/trailOffsetEx.svg +4/−0
• diagrams/triangleEx.svg +4/−0
• diagrams/unitSquareEx.svg +4/−0
• diagrams/vruleEx.svg +4/−0
• src/Diagrams/Align.hs +9/−10
• src/Diagrams/Animation.hs +19/−19
• src/Diagrams/Animation/Active.hs +11/−11
• src/Diagrams/Attributes.hs +30/−19
• src/Diagrams/Backend/Show.hs +19/−24
• src/Diagrams/Combinators.hs +51/−31
• src/Diagrams/Coordinates.hs +14/−5
• src/Diagrams/CubicSpline.hs +39/−20
• src/Diagrams/Envelope.hs +30/−0
• src/Diagrams/Located.hs +144/−0
• src/Diagrams/Names.hs +60/−0
• src/Diagrams/Parametric.hs +243/−0
• src/Diagrams/Path.hs +114/−293
• src/Diagrams/Points.hs +13/−8
• src/Diagrams/Prelude.hs +61/−25
• src/Diagrams/Query.hs +19/−0
• src/Diagrams/Segment.hs +314/−218
• src/Diagrams/Solve.hs +7/−4
• src/Diagrams/ThreeD/Shapes.hs +3/−1
• src/Diagrams/Trace.hs +50/−0
• src/Diagrams/Trail.hs +880/−0
• src/Diagrams/TrailLike.hs +157/−0
• src/Diagrams/Transform.hs +26/−8
• src/Diagrams/TwoD.hs +23/−19
• src/Diagrams/TwoD/Arc.hs +41/−41
• src/Diagrams/TwoD/Combinators.hs +43/−40
• src/Diagrams/TwoD/Curvature.hs +163/−0
• src/Diagrams/TwoD/Ellipse.hs +17/−17
• src/Diagrams/TwoD/Image.hs +2/−0
• src/Diagrams/TwoD/Model.hs +22/−22
• src/Diagrams/TwoD/Offset.hs +133/−0
• src/Diagrams/TwoD/Path.hs +66/−32
• src/Diagrams/TwoD/Polygons.hs +108/−92
• src/Diagrams/TwoD/Segment.hs +22/−21
• src/Diagrams/TwoD/Shapes.hs +133/−45
• src/Diagrams/TwoD/Size.hs +8/−8
• src/Diagrams/TwoD/Text.hs +25/−1
• src/Diagrams/TwoD/Transform.hs +75/−27
• src/Diagrams/TwoD/Types.hs +60/−42
• src/Diagrams/TwoD/Vector.hs +21/−6
• src/Diagrams/Util.hs +8/−4

@@ -1,3 +1,85 @@+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) -------------------- @@ -295,4 +377,3 @@ ----------------  * initial preview release-

@@ -1,5 +1,8 @@-Copyright (c) 2011-2012 diagrams-lib team:+Copyright (c) 2011-2013 diagrams-lib team: +  Daniel Bergey <bergey@alum.mit.edu>+  Daniil Frumin <difrumin@gmail.com>+  Niklas Haas <nand@lavabit.com>   Peter Hall <peter.hall@memorphic.com>   Claude Heiland-Allen <claudiusmaximus@goto10.org>   Deepak Jois <deepak.jois@gmail.com>

@@ -1,3 +1,29 @@-#!/usr/bin/env runhaskell-import Distribution.Simple-main = defaultMain+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+         }

@@ -1,5 +1,5 @@ Name:                diagrams-lib-Version:             0.6.0.3+Version:             0.7 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@@ -15,10 +15,10 @@ Maintainer:          diagrams-discuss@googlegroups.com Bug-reports:         http://github.com/diagrams/diagrams-lib/issues Category:            Graphics-Build-type:          Simple-Cabal-version:       >=1.6-Extra-source-files:  CHANGES.markdown, README.markdown-Tested-with:         GHC == 7.0.4, GHC == 7.2.1, GHC == 7.4.2, GHC == 7.6.1+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 Source-repository head   type:     git   location: http://github.com/diagrams/diagrams-lib.git@@ -30,13 +30,21 @@                        Diagrams.Coordinates,                        Diagrams.Attributes,                        Diagrams.Points,+                       Diagrams.Located,+                       Diagrams.Parametric,                        Diagrams.Segment,+                       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.TwoD,                        Diagrams.TwoD.Types,                        Diagrams.TwoD.Align,@@ -45,6 +53,8 @@                        Diagrams.TwoD.Ellipse,                        Diagrams.TwoD.Arc,                        Diagrams.TwoD.Segment,+                       Diagrams.TwoD.Curvature,+                       Diagrams.TwoD.Offset,                        Diagrams.TwoD.Path,                        Diagrams.TwoD.Polygons,                        Diagrams.TwoD.Shapes,@@ -60,17 +70,20 @@                        Diagrams.Animation.Active,                        Diagrams.Util,                        Diagrams.Backend.Show-  Build-depends:       base >= 4.2 && < 4.7,+  Build-depends:       base >= 4.2 && < 4.8,                        containers >= 0.3 && < 0.6,                        array >= 0.3 && < 0.5,                        semigroups >= 0.3.4 && < 0.10,-                       monoid-extras >= 0.2.2 && < 0.3,-                       diagrams-core >= 0.6 && < 0.7,+                       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.0 && < 1.4,+                       NumInstances >= 1.2 && < 1.4,                        colour >= 2.3.2 && < 2.4,-                       data-default >= 0.2 && < 0.6,+                       data-default-class < 0.1,                        pretty >= 1.0.1.2 && < 1.2,-                       newtype >= 0.2 && < 0.3+                       newtype >= 0.2 && < 0.3,+                       fingertree >= 0.1 && < 0.2,+                       intervals >= 0.2.2 && < 0.3   Hs-source-dirs:      src+  default-language:    Haskell2010

@@ -0,0 +1,4 @@+<?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>

@@ -0,0 +1,4 @@+<?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>

@@ -0,0 +1,4 @@+<?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>

@@ -0,0 +1,4 @@+<?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>

@@ -0,0 +1,4 @@+<?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>

@@ -0,0 +1,4 @@+<?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>

@@ -0,0 +1,4 @@+<?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>

@@ -0,0 +1,4 @@+<?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>

@@ -0,0 +1,4 @@+<?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>

@@ -0,0 +1,4 @@+<?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>

@@ -0,0 +1,4 @@+<?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>

@@ -0,0 +1,4 @@+<?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>

@@ -0,0 +1,4 @@+<?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>

@@ -0,0 +1,4 @@+<?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>

@@ -0,0 +1,4 @@+<?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>

@@ -0,0 +1,4 @@+<?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>

@@ -0,0 +1,4 @@+<?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>

@@ -0,0 +1,4 @@+<?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>

@@ -0,0 +1,4 @@+<?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>

@@ -0,0 +1,4 @@+<?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>

@@ -0,0 +1,4 @@+<?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>

@@ -0,0 +1,4 @@+<?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>

@@ -0,0 +1,4 @@+<?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>

@@ -0,0 +1,4 @@+<?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>

@@ -0,0 +1,4 @@+<?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>

@@ -0,0 +1,4 @@+<?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>

@@ -0,0 +1,4 @@+<?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>

@@ -1,12 +1,11 @@-{-# LANGUAGE TypeFamilies-           , FlexibleContexts-           , UndecidableInstances-  #-}+{-# LANGUAGE FlexibleContexts     #-}+{-# LANGUAGE TypeFamilies         #-}+{-# LANGUAGE UndecidableInstances #-}  ----------------------------------------------------------------------------- -- | -- Module      :  Diagrams.Align--- Copyright   :  (c) 2011 diagrams-lib team (see LICENSE)+-- Copyright   :  (c) 2011-2013 diagrams-lib team (see LICENSE) -- License     :  BSD-style (see LICENSE) -- Maintainer  :  diagrams-discuss@googlegroups.com --@@ -31,13 +30,13 @@         ) where -import Diagrams.Core+import           Diagrams.Core -import Data.VectorSpace-import Data.AffineSpace (alerp)+import           Data.AffineSpace (alerp)+import           Data.VectorSpace -import qualified Data.Set as S-import qualified Data.Map as M+import qualified Data.Map         as M+import qualified Data.Set         as S  -- | Class of things which can be aligned. class Alignable a where

@@ -1,6 +1,6 @@-{-# LANGUAGE TypeFamilies-           , FlexibleContexts-  #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies          #-} ----------------------------------------------------------------------------- -- | -- Module      :  Diagrams.Animation@@ -29,21 +29,21 @@         ) where -import Diagrams.Core+import           Diagrams.Core -import Diagrams.Combinators-import Diagrams.Animation.Active ()-import Diagrams.BoundingBox-import Diagrams.TwoD.Shapes-import Diagrams.TwoD.Types-import Diagrams.Path+import           Diagrams.Animation.Active ()+import           Diagrams.BoundingBox+import           Diagrams.Combinators+import           Diagrams.TrailLike+import           Diagrams.TwoD.Shapes+import           Diagrams.TwoD.Types -import Data.Active-import Data.Semigroup+import           Data.Active+import           Data.Semigroup -import Control.Applicative ((<$>))-import Data.Foldable       (foldMap)-import Data.VectorSpace+import           Control.Applicative       ((<$>))+import           Data.Foldable             (foldMap)+import           Data.VectorSpace  -- | A value of type @QAnimation b v m@ is an animation (a --   time-varying diagram with start and end times) that can be@@ -109,16 +109,16 @@ -- --   Uses 30 samples per time unit by default; to adjust this number --   see 'animRect''.-animRect :: (PathLike p, Enveloped p, Transformable p, V p ~ R2)-         => QAnimation b R2 m -> p+animRect :: (TrailLike t, Enveloped t, Transformable t, Monoid t, V t ~ R2)+         => QAnimation b R2 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' :: (PathLike p, Enveloped p, Transformable p, V p ~ R2)-          => Rational -> QAnimation b R2 m -> p+animRect' :: (TrailLike t, Enveloped t, Transformable t, Monoid t, V t ~ R2)+          => Rational -> QAnimation b R2 m -> t animRect' r anim     | null results = rect 1 1     | otherwise    = boxFit (foldMap boundingBox results) (rect 1 1)

@@ -1,5 +1,4 @@-{-# LANGUAGE TypeFamilies-  #-}+{-# LANGUAGE TypeFamilies #-} {-# OPTIONS_GHC -fno-warn-orphans #-}  -----------------------------------------------------------------------------@@ -17,8 +16,8 @@ --   * 'HasOrigin', 'Transformable', and 'HasStyle' instances for --     'Active' which all work pointwise. -----   * A 'PathLike' instance for @'Active' p@ where @p@ is also---     'PathLike', which simply lifts a pathlike thing to a constant+--   * A 'TrailLike' instance for @'Active' p@ where @p@ is also+--     'TrailLike', which simply lifts a pathlike thing to a constant --     active value. -- --   * A 'Juxtaposable' instance for @'Active' a@ where @a@ is also@@ -38,13 +37,14 @@  module Diagrams.Animation.Active where -import Diagrams.Core-import Control.Applicative ((<$>), pure)+import           Control.Applicative (pure, (<$>)) -import Diagrams.Align-import Diagrams.Path+import           Diagrams.Align+import           Diagrams.Core+import           Diagrams.Path+import           Diagrams.TrailLike -import Data.Active+import           Data.Active  type instance V (Active a) = V a @@ -63,8 +63,8 @@ instance HasStyle a => HasStyle (Active a) where   applyStyle = fmap . applyStyle -instance PathLike p => PathLike (Active p) where-  pathLike st cl segs = pure (pathLike st cl segs)+instance TrailLike t => TrailLike (Active t) where+  trailLike = pure . trailLike  -- | An active value can be juxtaposed against another by doing the --   juxtaposition pointwise over time.  The era of @juxtapose v a1

@@ -37,6 +37,9 @@   -- ** Opacity   , Opacity, getOpacity, opacity +  -- ** Converting colors+  , toRGBAUsingSpace, colorToSRGBA, colorToRGBA+   -- * Lines   -- ** Width   , LineWidth, getLineWidth, lineWidth, lw@@ -55,7 +58,8 @@ import           Diagrams.Core  import           Data.Colour-import qualified Data.Colour.SRGB as RGB+import           Data.Colour.RGBSpace+import           Data.Colour.SRGB (sRGBSpace)  import           Data.Typeable @@ -79,9 +83,8 @@ --   both the 'Data.Colour.Colour' and 'Data.Colour.AlphaColour' types --   from the "Data.Colour" library. class Color c where-  -- | Convert a color to red, green, blue, and alpha channels in the-  --   range [0,1].-  colorToRGBA :: c -> (Double,Double,Double,Double)+  -- | Convert a color to its standard representation, AlphaColour+  toAlphaColour :: c -> AlphaColour Double  -- | An existential wrapper for instances of the 'Color' class. data SomeColor = forall c. Color c => SomeColor c@@ -152,29 +155,37 @@ fcA = fillColor  instance (Floating a, Real a) => Color (Colour a) where-  colorToRGBA col = (r,g,b,1)-    where c' = RGB.toSRGB . colourConvert $ col-          r  = RGB.channelRed c'-          g  = RGB.channelGreen c'-          b  = RGB.channelBlue c'+  toAlphaColour = opaque . colourConvert  instance (Floating a, Real a) => Color (AlphaColour a) where-  colorToRGBA col = (r,g,b,a)-    where col' = alphaColourConvert col-          a  = alphaChannel col'-          c' = RGB.toSRGB . alphaToColour $ col'-          r  = RGB.channelRed c'-          g  = RGB.channelGreen c'-          b  = RGB.channelBlue c'+  toAlphaColour = alphaColourConvert  instance Color SomeColor where-  colorToRGBA (SomeColor c) = colorToRGBA c+  toAlphaColour (SomeColor c) = toAlphaColour c  instance Color LineColor where-  colorToRGBA (LineColor (Last c)) = colorToRGBA c+  toAlphaColour (LineColor (Last c)) = toAlphaColour c  instance Color FillColor where-  colorToRGBA (FillColor c) = colorToRGBA . getLast . getRecommend $ c+  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++-- | Convert to sRGBA.+colorToSRGBA, colorToRGBA :: Color c => c -> (Double, Double, Double, Double)+colorToSRGBA = toRGBAUsingSpace sRGBSpace++colorToRGBA = colorToSRGBA+{-# DEPRECATED colorToRGBA "Renamed to colorToSRGBA." #-}  alphaToColour :: (Floating a, Ord a, Fractional a) => AlphaColour a -> Colour a alphaToColour ac | alphaChannel ac == 0 = ac `over` black

@@ -1,11 +1,10 @@-{-# LANGUAGE FlexibleInstances-           , FlexibleContexts-           , MultiParamTypeClasses-           , ScopedTypeVariables-           , TypeSynonymInstances-           , TypeFamilies-           , GeneralizedNewtypeDeriving-  #-}+{-# LANGUAGE FlexibleContexts           #-}+{-# LANGUAGE FlexibleInstances          #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses      #-}+{-# LANGUAGE ScopedTypeVariables        #-}+{-# LANGUAGE TypeFamilies               #-}+{-# LANGUAGE TypeSynonymInstances       #-} ----------------------------------------------------------------------------- -- | -- Module      :  Diagrams.Backend.Show@@ -18,14 +17,16 @@ ----------------------------------------------------------------------------- module Diagrams.Backend.Show where -import Diagrams.Prelude+import           Diagrams.Core.Transform (onBasis)+import           Diagrams.Prelude+import           Diagrams.Trail -import Data.Basis+import           Data.Basis -import Text.PrettyPrint (Doc, empty, ($+$), parens, hsep)-import qualified Text.PrettyPrint as PP+import           Text.PrettyPrint        (Doc, empty, hsep, parens, ($+$))+import qualified Text.PrettyPrint        as PP -import Data.List (transpose)+import           Data.List               (transpose)  -- | Token for identifying this backend. data ShowBackend = ShowBackend@@ -46,14 +47,8 @@ renderTransf :: forall v. (Num (Scalar v), HasLinearMap v, Show (Scalar v))              => Transformation v -> Doc renderTransf t = renderMat mat-  where tr :: v-        tr    = transl t-        basis :: [Basis v]-        basis = map fst (decompose tr)-        es :: [v]-        es    = map basisValue basis-        vmat :: [v]-        vmat = map (apply t) es+  where vmat :: [v]+        (vmat, _) = onBasis t         mat :: [[Scalar v]]         mat = map decompV vmat --        mat' :: [[Scalar v]]@@ -64,11 +59,11 @@ renderMat = PP.vcat . map renderRow . transpose   where renderRow = parens . hsep . map (PP.text . show) -instance (Show v, HasLinearMap v) => Renderable (Segment v) ShowBackend where+instance (Show v, HasLinearMap v) => Renderable (Segment o v) ShowBackend where   render _ s = SR $ PP.text (show s) -instance (Show v, HasLinearMap v) => Renderable (Trail v) ShowBackend where+instance (Show v, OrderedField (Scalar v), InnerSpace v, HasLinearMap v) => Renderable (Trail v) ShowBackend where   render _ t = SR $ PP.text (show t) -instance (Ord v, Show v, HasLinearMap v) => Renderable (Path v) ShowBackend where+instance (Show v, OrderedField (Scalar v), InnerSpace v, HasLinearMap v) => Renderable (Path v) ShowBackend where   render _ p = SR $ PP.text (show p)

@@ -1,7 +1,7 @@-{-# LANGUAGE TypeFamilies-           , FlexibleContexts-           , UndecidableInstances-  #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies          #-}+{-# LANGUAGE UndecidableInstances  #-} ----------------------------------------------------------------------------- -- | -- Module      :  Diagrams.Combinators@@ -22,28 +22,30 @@        , extrudeEnvelope, intrudeEnvelope           -- * Binary operations+       , atop        , beneath        , beside           -- * n-ary operations        , appends-       , position, decorateTrail, decoratePath+       , position, decorateTrail, decorateLocatedTrail, decoratePath        , cat, cat', CatOpts(..), CatMethod(..)         ) where -import Diagrams.Core--import Diagrams.Segment (Segment(..))-import Diagrams.Path-import Diagrams.Util--import Data.AdditiveGroup-import Data.VectorSpace--import Data.Semigroup+import           Data.AdditiveGroup+import           Data.AffineSpace   ((.+^))+import           Data.Default.Class+import           Data.Semigroup+import           Data.VectorSpace -import Data.Default+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.Util  ------------------------------------------------------------ -- Working with envelopes@@ -91,7 +93,7 @@          )       => v -> QDiagram b v m strut v = mkQD nullPrim env mempty mempty mempty-  where env = translate ((-0.5) *^ v) . getEnvelope $ Linear v+  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   -- in 2D; see Diagrams.TwoD.Segment).  This is a good reason to have@@ -161,13 +163,23 @@ --   from the local origin of the first object to the local origin of --   the second object, at a distance so that their envelopes are just --   tangent.  The local origin of the new, combined object is the---   local origin of the first object.+--   local origin of the first object (unless the first object is the+--   identity element, in which case the second object is returned+--   unchanged). --+--   <<diagrams/besideEx.svg#diagram=besideEx&height=200>>+--+--   > besideEx = beside (r2 (20,30))+--   >                   (circle 1 # fc orange)+--   >                   (circle 1.5 # fc purple)+--   >            # showOrigin+--   >            # centerXY # pad 1.1+-- --   Note that @beside v@ is associative, so objects under @beside v@---   form a semigroup for any given vector @v@.  However, they do---   /not/ form a monoid, since there is no identity element. 'mempty'---   is a right identity (@beside v d1 mempty === d1@) but not a left---   identity (@beside v mempty d1 === d1 # align (negateV v)@).+--   form a semigroup for any given vector @v@.  In fact, they also+--   form a monoid: 'mempty' is clearly a right identity (@beside v d1+--   mempty === d1@), and there should also be a special case to make+--   it a left identity, as described above. -- --   In older versions of diagrams, @beside@ put the local origin of --   the result at the point of tangency between the two inputs.  That@@ -183,8 +195,6 @@ beside :: (Juxtaposable a, Semigroup a) => V a -> a -> a -> a beside v d1 d2 = d1 <> juxtapose v d1 d2 --- XXX add picture to above documentation?- ------------------------------------------------------------ -- Combining multiple objects ------------------------------------------------------------@@ -208,15 +218,26 @@ --   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 :: (HasOrigin a, Monoid' a) => Trail (V a) -> [a] -> a-decorateTrail t = position . zip (trailVertices origin t)+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 :: (HasOrigin a, Monoid' a) => Path (V a) -> [a] -> a+decoratePath :: (InnerSpace (V a), OrderedField (Scalar (V a)), HasOrigin a, Monoid' a)+             => Path (V a) -> [a] -> a decoratePath p = position . zip (concat $ pathVertices p)  -- | Methods for concatenating diagrams.@@ -277,7 +298,7 @@ --   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), Floating (Scalar (V a))+       , InnerSpace (V a), OrderedField (Scalar (V a))        )        => V a -> [a] -> a cat v = cat' v def@@ -300,7 +321,7 @@ --   (distributing with a separation of 0 is the same as --   superimposing). cat' :: ( Juxtaposable a, Monoid' a, HasOrigin a-        , InnerSpace (V a), Floating (Scalar (V 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@@ -308,5 +329,4 @@         vs = s *^ normalized (negateV v)  cat' v (CatOpts { catMethod = Distrib, sep = s }) =-  decorateTrail . fromOffsets . repeat $ s *^ normalized v-  -- infinite trail, no problem for Haskell =D+  position . zip (iterate (.+^ (s *^ normalized v)) origin)

@@ -1,4 +1,4 @@-{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeFamilies  #-} {-# LANGUAGE TypeOperators #-} ----------------------------------------------------------------------------- -- |@@ -10,6 +10,11 @@ -- 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@@ -30,8 +35,10 @@ --   'coords'.  A common pattern is to use 'coords' in conjunction --   with the @ViewPatterns@ extension, like so: ----- > foo :: Vector3 -> ...--- > foo (coords -> x :& y :& z) = ...+-- @+-- foo :: Vector3 -> ...+-- foo (coords -> x :& y :& z) = ...+-- @ class Coordinates c where    -- | The type of the final coordinate.@@ -48,8 +55,10 @@   --   less dimension (which is perhaps itself recursively constructed   --   using @(&)@) and a final coordinate.  For example,   ---  -- > 2 & 3 :: P2-  -- > 3 & 5 & 6 :: R3+  -- @+  -- 2 & 3 :: P2+  -- 3 & 5 & 6 :: R3+  -- @   --   --   Note that @&@ is left-associative.   (&)    :: PrevDim c -> FinalCoord c -> c

@@ -1,6 +1,5 @@-{-# LANGUAGE TypeFamilies-           , FlexibleContexts-  #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies     #-} {-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} ----------------------------------------------------------------------------- -- |@@ -13,8 +12,9 @@ -- 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, see--- "Diagrams.CubicSpline.Internal".+-- internals of the spline generation algorithm (including in+-- particular a solver for cyclic tridiagonal systems of linear+-- equations), see "Diagrams.CubicSpline.Internal". -- ----------------------------------------------------------------------------- module Diagrams.CubicSpline@@ -23,27 +23,46 @@          cubicSpline        ) where -import Diagrams.CubicSpline.Internal--import Diagrams.Core-import Diagrams.Core.Points--import Diagrams.Segment-import Diagrams.Path+import           Diagrams.Core+import           Diagrams.Core.Points+import           Diagrams.CubicSpline.Internal+import           Diagrams.Located              (at)+import           Diagrams.Located+import           Diagrams.Path+import           Diagrams.Segment+import           Diagrams.Trail+import           Diagrams.TrailLike            (TrailLike (..)) -import Data.NumInstances ()   -- for e.g. the Fractional (Double, Double) instance+-- for e.g. the Fractional (Double, Double) instance+import           Data.NumInstances.Tuple       () -import Control.Newtype-import Data.Semigroup+import           Control.Newtype+import           Data.Semigroup+import           Data.VectorSpace  -- | 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.---   See: <http://mathworld.wolfram.com/CubicSpline.html>-cubicSpline :: (PathLike p, Fractional (V p)) => Bool -> [Point (V p)] -> p-cubicSpline _      [] = mempty-cubicSpline closed ps = flattenBeziers . map f . solveCubicSplineCoefficients closed . map unpack $ ps+--+--   <<diagrams/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+--   > 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   where     f [a,b,c,d] = [a, (3*a+b)/3, (3*a+2*b+c)/3, a+b+c+d]-    flattenBeziers bs@((b:_):_) = pathLike (P b) False (map bez bs)+    flattenBeziers bs@((b:_):_)+      = trailLike . closeIf c $ 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 c = mapLoc (if c then wrapLoop . glueLine else wrapLine)

@@ -0,0 +1,30 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Diagrams.Envelope+-- Copyright   :  (c) 2013 diagrams-lib team (see LICENSE)+-- License     :  BSD-style (see LICENSE)+-- Maintainer  :  diagrams-discuss@googlegroups.com+--+-- \"Envelopes\", aka functional bounding regions.  See+-- "Diagrams.Core.Envelope" for internal implementation details.+--+-----------------------------------------------------------------------------++module Diagrams.Envelope+    ( -- * Types+      Envelope, Enveloped++      -- * Diagram envelopes+    , envelope, setEnvelope, withEnvelope, phantom+    , pad, extrudeEnvelope, intrudeEnvelope++      -- * Querying envelopes+    , envelopeVMay, envelopeV, envelopePMay, envelopeP+    , diameter, radius++    ) where++import           Diagrams.Core          (envelope, setEnvelope)+import           Diagrams.Core.Envelope++import           Diagrams.Combinators

@@ -0,0 +1,144 @@+{-# LANGUAGE FlexibleContexts     #-}+{-# LANGUAGE StandaloneDeriving   #-}+{-# LANGUAGE TypeFamilies         #-}+{-# LANGUAGE UndecidableInstances #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Diagrams.Located+-- Copyright   :  (c) 2013 diagrams-lib team (see LICENSE)+-- License     :  BSD-style (see LICENSE)+-- Maintainer  :  diagrams-discuss@googlegroups.com+--+-- \"Located\" things, /i.e./ things with a concrete location:+-- intuitively, @Located a ~ (a, Point)@.  Wrapping a translationally+-- invariant thing (/e.g./ a 'Segment' or 'Trail') in @Located@ pins+-- it down to a particular location and makes it no longer+-- translationally invariant.+--+-----------------------------------------------------------------------------++module Diagrams.Located+    ( Located+    , at, viewLoc, unLoc, loc, mapLoc+    )+    where++import           Data.AffineSpace+import           Data.VectorSpace++import           Diagrams.Core+import           Diagrams.Core.Points+import           Diagrams.Core.Transform+import           Diagrams.Parametric+  -- for GHC 7.4 type family bug++-- | \"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+--   it down to a particular location and makes it no longer+--   translationally invariant.+--+--   @Located@ is intentionally abstract.  To construct @Located@+--   values, use 'at'.  To destruct, use 'viewLoc', 'unLoc', or 'loc'.+--   To map, use 'mapLoc'.+--+--   Much of the utility of having a concrete type for the @Located@+--   concept lies in the type class instances we can give it.  The+--   '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.+                     }++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 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 (Loc p a) = (p,a)++-- | 'Located' is not a @Functor@, since changing the type could+--   change the type of the associated vector space, in which case the+--   associated location would no longer have the right type. 'mapLoc'+--   has an extra constraint specifying that the vector space must+--   stay the same.+--+--   (Technically, one can say that for every vector space @v@,+--   @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 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)++type instance V (Located a) = V 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+  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+  transform t@(Transformation t1 t2 _) (Loc p a)+    = Loc (transform t p) (transform (Transformation t1 t2 zeroV) a)++-- | The envelope of a @Located a@ is the envelope of the @a@,+--   translated to the location.+instance Enveloped a => Enveloped (Located a) where+  getEnvelope (Loc p a) = moveTo p (getEnvelope a)++instance Enveloped a => Juxtaposable (Located a) where+  juxtapose = juxtaposeDefault++-- | The trace of a @Located a@ is the trace of the @a@,+--   translated to the location.+instance Traced a => Traced (Located a) where+  getTrace (Loc p a) = moveTo p (getTrace a)++instance Qualifiable a => Qualifiable (Located a) where+  n |> (Loc p a) = Loc p (n |> a)++type instance Codomain (Located a) = Located (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 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 ( Codomain a ~ V a, Fractional (Scalar (V a)), AdditiveGroup (V a)+         , Sectionable a, Parametric a+         )+    => 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))+    => HasArcLength (Located a) where+  arcLengthBounded eps (Loc _ a)   = arcLengthBounded eps a+  arcLengthToParam eps (Loc _ a) l = arcLengthToParam eps a l

@@ -0,0 +1,60 @@+{-# LANGUAGE FlexibleContexts #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Diagrams.Names+-- Copyright   :  (c) 2013 diagrams-lib team (see LICENSE)+-- License     :  BSD-style (see LICENSE)+-- Maintainer  :  diagrams-discuss@googlegroups.com+--+-- Names can be given to subdiagrams, and subdiagrams can later be+-- queried by name.  This module exports types for representing names+-- and subdiagrams, and various functions for working with them.+--+-----------------------------------------------------------------------------++module Diagrams.Names+    ( -- * Names++      AName, Name, IsName(..), (.>)+    , Qualifiable(..)++      -- * Subdiagrams++    , Subdiagram, mkSubdiagram, subPoint, getSub, rawSub, location++      -- * Subdiagram maps++    , SubMap, fromNames, rememberAs, lookupSub++      -- * Naming things++    , named, nameSub, namePoint, localize++      -- * Querying by name++    , names+    , withName, withNameAll, withNames++    ) where++import           Data.Semigroup+import           Data.VectorSpace++import           Diagrams.Core       (HasLinearMap, OrderedField, Point)+import           Diagrams.Core.Names+import           Diagrams.Core.Types++-- | Attach an atomic name to a diagram.+named :: ( IsName n+         , HasLinearMap v, InnerSpace v, OrderedField (Scalar v), Semigroup m)+      => n -> QDiagram b v m -> QDiagram b v m+named = nameSub mkSubdiagram++-- | Attach an atomic name to a certain point (which may be computed+--   from the given diagram), treated as a subdiagram with no content+--   and a point envelope.+namePoint :: ( IsName n+             , HasLinearMap v, InnerSpace v, OrderedField (Scalar v), Semigroup m)+          => (QDiagram b v m -> Point v) -> n -> QDiagram b v m -> QDiagram b v m+namePoint p = nameSub (subPoint . p)+

@@ -0,0 +1,243 @@+{-# LANGUAGE DefaultSignatures    #-}+{-# LANGUAGE FlexibleContexts     #-}+{-# LANGUAGE TypeFamilies         #-}+{-# LANGUAGE UndecidableInstances #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Diagrams.Parametric+-- Copyright   :  (c) 2013 diagrams-lib team (see LICENSE)+-- License     :  BSD-style (see LICENSE)+-- Maintainer  :  diagrams-discuss@googlegroups.com+--+-- Type classes for things which are parameterized in some way, /e.g./+-- segments and trails.+--+-----------------------------------------------------------------------------+module Diagrams.Parametric+  (+  -- * Parametric functions+    stdTolerance+  , Codomain, Parametric(..)++  , DomainBounds(..), EndValues(..), Sectionable(..), HasArcLength(..)++  -- * Adjusting+  , adjust+  , AdjustOpts(..), AdjustMethod(..), AdjustSide(..)++  ) where++import           Diagrams.Core+import           Diagrams.Util++import           Data.Default.Class+import           Data.VectorSpace+import qualified Numeric.Interval   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 class for parametric functions.+class Parametric p where++  -- | '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++-- | Type class for parametric functions with a bounded domain.  The+--   default bounds are @[0,1]@.+--+--   Note that this domain indicates the main \"interesting\" portion of the+--   function.  It must be defined within this range, but for some instances may+--   still have sensible values outside.+class DomainBounds p where+  -- | 'domainLower' defaults to being constantly 0 (for vector spaces with+  --   numeric scalars).+  domainLower :: p -> Scalar (V p)++  default domainLower :: Num (Scalar (V p)) => p -> Scalar (V p)+  domainLower = const 0++  -- | 'domainUpper' defaults to being constantly 1 (for vector spaces+  --   with numeric scalars).+  domainUpper :: p -> Scalar (V p)++  default domainUpper :: Num (Scalar (V p)) => p -> Scalar (V p)+  domainUpper = const 1++-- | Type class for querying the values of a parametric object at the+--   ends of its domain.+class (Parametric p, DomainBounds p) => EndValues p where+  -- | 'atStart' is the value at the start of the domain.  That is,+  --+  --   > atStart x = x `atParam` domainLower x+  --+  --   This is the default implementation, but some representations will+  --   have a more efficient and/or precise implementation.+  atStart :: p -> Codomain p+  atStart x = x `atParam` domainLower x++  -- | 'atEnd' is the value at the end of the domain. That is,+  --+  --   > atEnd x = x `atParam` domainUpper x+  --+  --   This is the default implementation, but some representations will+  --   have a more efficient and/or precise implementation.+  atEnd :: p -> Codomain 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 x = (domainLower x, domainUpper x)++-- | Type class for parametric objects which can be split into+--   subobjects.+--+--   Minimal definition: Either 'splitAtParam' or 'section'.+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+  --+  --   where @(???) = (^+^)@ if the codomain is a vector type, or+  --   @const flip@ if the codomain is a point type.  Stated more+  --   intuitively, all this is to say that the parameterization+  --   scales linearly with splitting.+  --+  --   'splitAtParam' can also be used with parameters outside the+  --   range of the domain.  For example, using the parameter @2@ with+  --   a path (where the domain is the default @[0,1]@) gives two+  --   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 x t+    = ( section x (domainLower x) t+      , section x t (domainUpper x))++  -- | Extract a particular section of the domain, linearly+  --   reparameterized to the same domain as the original.  Should+  --   satisfy the property:+  --+  -- > prop_section x l u t =+  -- >   let s = section x l u+  -- >   in     domainBounds x == domainBounds x+  -- >       && (x `atParam` lerp l u t) == (s `atParam` t)+  --+  --   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 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)+  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+--   @1e-6@.+stdTolerance :: Fractional a => a+stdTolerance = 1e-6++-- | Type class for parametric things with a notion of arc length.+class Parametric p => HasArcLength p where++  -- | @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))++  -- | @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 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 = arcLength stdTolerance++  -- | @'arcLengthToParam' eps s l@ converts the absolute arc length+  --   @l@, measured from the start of the domain, to a parameter on+  --   the object @s@.  The true arc length at the parameter returned+  --   is guaranteed to be within @eps@ of the requested arc length.+  --+  --   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)++  -- | 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 = 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

@@ -1,12 +1,13 @@-{-# LANGUAGE TypeFamilies-           , MultiParamTypeClasses-           , FlexibleInstances-           , FlexibleContexts-           , DeriveFunctor-           , GeneralizedNewtypeDeriving-           , UndecidableInstances-           , ScopedTypeVariables-  #-}+{-# LANGUAGE DeriveFunctor              #-}+{-# LANGUAGE FlexibleContexts           #-}+{-# LANGUAGE FlexibleInstances          #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses      #-}+{-# LANGUAGE ScopedTypeVariables        #-}+{-# LANGUAGE StandaloneDeriving         #-}+{-# LANGUAGE TypeFamilies               #-}+{-# LANGUAGE UndecidableInstances       #-}+{-# LANGUAGE ViewPatterns               #-} ----------------------------------------------------------------------------- -- | -- Module      :  Diagrams.Path@@ -14,288 +15,98 @@ -- License     :  BSD-style (see LICENSE) -- Maintainer  :  diagrams-discuss@googlegroups.com ----- This module defines /trails/ (translationally invariant sequences--- of linear or cubic Bézier segments) and /paths/ (collections of--- concretely located trails).  Trails and paths can be used for--- drawing shapes, laying out other diagrams, clipping, and other--- things.+-- This module defines /paths/, which are collections of concretely+-- located 'Trail's.  Many drawing systems (cairo, svg, ...) have a+-- similar notion of \"path\".  Note that paths with multiple trails+-- are necessary for being able to draw /e.g./ filled objects with+-- holes in them. -- -----------------------------------------------------------------------------  module Diagrams.Path        (-         -- * Constructing path-like things -         PathLike(..), fromSegments, fromOffsets, fromVertices, segmentsFromVertices-       , pathLikeFromTrail--         -- * Closeable things--       , Closeable(..)--         -- * Trails--       , Trail(..)--         -- ** Computing with trails--       , trailSegments'-       , trailOffsets, trailOffset-       , trailVertices, reverseTrail-       , addClosingSegment-       , fixTrail-          -- * Paths -       , Path(..)+         Path(..) -         -- ** Constructing paths from trails+         -- * Constructing paths+         -- $construct         , pathFromTrail        , pathFromTrailAt+       , pathFromLocTrail -         -- ** Computing with paths+         -- * Eliminating paths         , pathVertices        , pathOffsets        , pathCentroid+       , fixPath++         -- * Modifying paths+        , scalePath        , reversePath-       , fixPath           -- * Miscellaneous -       , explodeTrail        , explodePath-       , (~~)+       , partitionPath         ) where -import Diagrams.Core-import Diagrams.Core.Points--import Diagrams.Align-import Diagrams.Segment-import Diagrams.Points-import Diagrams.Transform--import Data.VectorSpace-import Data.AffineSpace--import Control.Newtype hiding (under)-import Data.Semigroup-import qualified Data.Foldable as F--import Data.List (mapAccumL)--import Control.Arrow ((***), first, second)-----------------------------------------------------------------  PathLike class----------------------------------------------------------------- | Type class for path-like things, which must be monoids.---   Instances include 'Trail's, 'Path's, and two-dimensional 'Diagram's.-class (Monoid' p, VectorSpace (V p)) => PathLike p where--  pathLike :: Point (V p)      -- ^ The starting point of the-                               --   path.  Some path-like things-                               --   (e.g. 'Trail's) may ignore this.-           -> Bool             -- ^ Should the path be closed?-           -> [Segment (V p)]  -- ^ Segments of the path.-           -> p---- | A list of points is path-like; this instance simply computes the---   vertices of a path-like thing.-instance VectorSpace v => PathLike [Point v] where-  pathLike start cl segs = trailVertices start (pathLike start cl segs)---- | Construct an open path-like thing with the origin as a starting---   point.-fromSegments :: PathLike p => [Segment (V p)] -> p-fromSegments = pathLike origin False---- | Construct an open path-like thing of linear segments from a list---   of offsets.  The starting point is the origin.-fromOffsets :: PathLike p => [V p] -> p-fromOffsets = pathLike origin False . map Linear---- | Construct a path-like thing of linear segments from a list of---   vertices, with the first vertex as the starting point.-fromVertices :: PathLike p => [Point (V p)] -> p-fromVertices []         = mempty-fromVertices vvs@(v:_) = pathLike v False (segmentsFromVertices vvs)---- | Construct a list of linear segments from a list of vertices.  The---   input list must contain at least two points to generate a---   non-empty list of segments.-segmentsFromVertices :: AdditiveGroup v => [Point v] -> [Segment v]-segmentsFromVertices [] = []-segmentsFromVertices vvs@(_:vs) = map Linear (zipWith (flip (.-.)) vvs vs)-----------------------------------------------------------------  Closeable class----------------------------------------------------------------- | Path-like things that can be \"open\" or \"closed\".-class PathLike p => Closeable p where-  -- | \"Open\" a path-like thing.-  open  :: p -> p--  -- | \"Close\" a path-like thing, by implicitly connecting the-  --   endpoint(s) back to the starting point(s).-  close :: p -> p--instance VectorSpace v => Closeable (Trail v) where-  close (Trail segs _) = Trail segs True-  open  (Trail segs _) = Trail segs False--instance VectorSpace v => Closeable (Path v) where-  close = (over Path . map . second) close-  open  = (over Path . map . second) open-----------------------------------------------------------------  Trails  ----------------------------------------------------------------------------------------------------------------- | A /trail/ is a sequence of segments placed end-to-end.  Trails---   are thus translationally invariant, and form a monoid under---   concatenation.  Trails can also be /open/ (the default) or---   /closed/ (the final point in a closed trail is implicitly---   connected back to the starting point).-data Trail v = Trail { trailSegments :: [Segment v]-                     , isClosed      :: Bool-                     }-  deriving (Show, Functor, Eq, Ord)--type instance V (Trail v) = v--instance Semigroup (Trail v) where-  Trail t1 c1 <> Trail t2 c2 = Trail (t1 ++ t2) (c1 || c2)---- | The empty trail has no segments.  Trails are composed via---   concatenation.  @t1 ``mappend`` t2@ is closed iff either @t1@ or---   @t2@ are.-instance Monoid (Trail v) where-  mempty = Trail [] False-  mappend = (<>)---- | Trails are 'PathLike' things.  Note that since trails are---   translationally invariant, 'setStart' has no effect.---   'fromSegments' creates an open trail.-instance VectorSpace v => PathLike (Trail v) where-  pathLike _ cl segs = Trail segs cl--instance HasLinearMap v => Transformable (Trail v) where-  transform t (Trail segs c) = Trail (transform t segs) c---- | The envelope for a trail is based at the trail's start.-instance (InnerSpace v, OrderedField (Scalar v)) => Enveloped (Trail v) where--  getEnvelope (Trail segs _) =-    foldr (\seg bds -> moveOriginBy (negateV . segOffset $ seg) bds <> getEnvelope seg)-          mempty-          segs--  -- XXX can we improve the efficiency of the above?  E.g. note the-  -- last segment in each trail ends up getting translated O(n) times,-  -- so overall we do O(n^2) work!  (to find the max over the bounds-  -- for O(n) segments, where the ith segment requires working through-  -- a stack of i translations...)-  ---  -- The idea would be to first convert to a list of FixedSegments (to-  -- cache the translation work) then take the bounds of those.-  ---  -- Also, use a balanced fold!-  ---  -- Need to make some benchmarks I guess.--instance HasLinearMap v => Renderable (Trail v) NullBackend where-  render _ _ = mempty-----------------------------------------------------------------  Computing with trails  -------------------------------------------------------------------------------------------------- | @trailSegments'@ is like 'trailSegments', but explicitly includes---   the implicit closing segment at the end of the list for closed trails.-trailSegments' :: AdditiveGroup v => Trail v -> [Segment v]-trailSegments' t | isClosed t = trailSegments t-                                ++ [straight . negateV . trailOffset $ t]-                 | otherwise  = trailSegments t---- | Extract the offsets of the segments of a trail.-trailOffsets :: Trail v -> [v]-trailOffsets (Trail segs _) = map segOffset segs---- | Compute the offset from the start of a trail to the end.-trailOffset :: AdditiveGroup v => Trail v -> v-trailOffset = sumV . trailOffsets---- | Extract the vertices of a trail, given a concrete location at---   which to place the first vertex.-trailVertices :: AdditiveGroup v => Point v -> Trail v -> [Point v]-trailVertices p = scanl (.+^) p . trailOffsets---- | Reverse a trail's direction of travel.-reverseTrail :: AdditiveGroup v => Trail v -> Trail v-reverseTrail t@(Trail {trailSegments = []}) = t-reverseTrail t@(Trail {trailSegments = ss})-  | isClosed t = t { trailSegments = straight (trailOffset t) : reverseSegs ss }-  | otherwise  = t { trailSegments = reverseSegs ss }-  where reverseSegs = fmap reverseSegment . reverse---- | Reverse a trail with a fixed starting point.-reverseRootedTrail :: AdditiveGroup v => (Point v, Trail v) -> (Point v, Trail v)-reverseRootedTrail (p, t)-  | isClosed t = (p, reverseTrail t)-  | otherwise  = (p .+^ trailOffset t, reverseTrail t)---- | Convert a trail to any path-like thing.  @pathLikeFromTrail@ is the---   identity on trails.-pathLikeFromTrail :: PathLike p => Trail (V p) -> p-pathLikeFromTrail t = pathLike origin (isClosed t) (trailSegments t)---- | If the trail is closed, this adds in the closing segment. Otherwise,---   the trail is returned unmodified.-addClosingSegment :: AdditiveGroup v => Trail v -> Trail v-addClosingSegment t | isClosed t = Trail (trailSegments t ++ [closeSeg]) False-                    | otherwise = t- where closeSeg = Linear . negateV $ trailOffset t+import           Diagrams.Align+import           Diagrams.Core+import           Diagrams.Core.Points+import           Diagrams.Located+import           Diagrams.Points+import           Diagrams.Segment+import           Diagrams.Trail+import           Diagrams.TrailLike+import           Diagrams.Transform --- | Convert a starting point and a trail into a list of fixed segments.-fixTrail :: AdditiveGroup v => Point v -> Trail v -> [FixedSegment v]-fixTrail start t = zipWith mkFixedSeg (trailVertices start t)-                                      (trailSegments $ addClosingSegment t)+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  ------------------------------------------------------------ --  Paths  ------------------------------------------------- ------------------------------------------------------------ --- | A /path/ is a (possibly empty) list of trails, with each---   trail paired with an absolute starting point. Hence, paths---   are /not/ translationally invariant, and form a monoid under---   superposition.-newtype Path v = Path { pathTrails :: [(Point v, Trail v)] }-  deriving (Show, Semigroup, Monoid, Eq, Ord)+-- | A /path/ is a (possibly empty) list of 'Located' 'Trail's.+--   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) +deriving instance Show v => Show (Path v)+deriving instance Eq   v => Eq   (Path v)+deriving instance Ord  v => Ord  (Path v)+ type instance V (Path v) = v -instance Newtype (Path v) [(Point v, Trail v)] where+instance Newtype (Path v) [Located (Trail v)] where   pack   = Path   unpack = pathTrails  instance VectorSpace v => HasOrigin (Path v) where-  moveOriginTo = over Path . map . first . moveOriginTo+  moveOriginTo = over Path . map . moveOriginTo --- | Paths are (of course) path-like. 'fromSegments' creates a path---   with start point at the origin.-instance VectorSpace v => PathLike (Path v) where-  pathLike s cl segs = Path [(s, pathLike origin cl segs)]+-- | 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 . (:[])  -- See Note [Transforming paths]-instance HasLinearMap v => Transformable (Path v) where-  transform t = (over Path . map) (transform t *** transform t)+instance (HasLinearMap v, InnerSpace v, OrderedField (Scalar v))+    => Transformable (Path v) where+  transform = over Path . map . transform  {- ~~~~ Note [Transforming paths] @@ -307,11 +118,13 @@ of the v's are inside Points and hence ought to be translated. -} +instance (HasLinearMap v, InnerSpace v, OrderedField (Scalar v)) => IsPrim (Path v)+ instance (InnerSpace v, OrderedField (Scalar v)) => Enveloped (Path v) where   getEnvelope = F.foldMap trailEnvelope . pathTrails           -- this type signature is necessary to work around an apparent bug in ghc 6.12.1-    where trailEnvelope :: (Point v, Trail v) -> Envelope v-          trailEnvelope (p, t) = moveOriginTo ((-1) *. p) (getEnvelope t)+    where trailEnvelope :: Located (Trail v) -> Envelope v+          trailEnvelope (viewLoc -> (p, t)) = moveOriginTo ((-1) *. p) (getEnvelope t)  instance (InnerSpace v, OrderedField (Scalar v)) => Juxtaposable (Path v) where   juxtapose = juxtaposeDefault@@ -319,68 +132,76 @@ instance (InnerSpace v, OrderedField (Scalar v)) => Alignable (Path v) where   alignBy = alignByDefault -instance HasLinearMap v => Renderable (Path v) NullBackend where+instance (HasLinearMap v, InnerSpace v, OrderedField (Scalar v))+    => Renderable (Path v) NullBackend where   render _ _ = mempty  ---------------------------------------------------------------  Constructing paths from trails  ------------------------+--  Constructing paths  ------------------------------------ ------------------------------------------------------------ +-- $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 :: AdditiveGroup v => Trail v -> Path v-pathFromTrail t = Path [(origin, t)]+pathFromTrail :: (InnerSpace v, OrderedField (Scalar v)) => Trail v -> Path v+pathFromTrail = trailLike . (`at` origin)  -- | Convert a trail to a path with a particular starting point.-pathFromTrailAt :: Trail v -> Point v -> Path v-pathFromTrailAt t p = Path [(p, t)]+pathFromTrailAt :: (InnerSpace v, OrderedField (Scalar v)) => Trail v -> Point v -> Path v+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 = trailLike+ ---------------------------------------------------------------  Computing with paths  ----------------------------------+--  Eliminating paths  ------------------------------------- ------------------------------------------------------------ --- | Extract the vertices of a path.-pathVertices :: AdditiveGroup v => Path v -> [[Point v]]-pathVertices = map (uncurry trailVertices) . pathTrails+-- | 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 --- | Compute the total offset of each trail comprising a path.-pathOffsets :: AdditiveGroup v => Path v -> [v]-pathOffsets = map (trailOffset . snd) . pathTrails+-- | 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 --- | Compute the /centroid/ of a path (/i.e./ the average of its---   vertices).-pathCentroid :: (VectorSpace v, Fractional (Scalar v)) => Path v -> Point v+-- | Compute the /centroid/ of a path (/i.e./ the average location of+--   its vertices).+pathCentroid :: (InnerSpace v, OrderedField (Scalar v)) => Path v -> Point v pathCentroid = centroid . concat . pathVertices --- | Scale a path using its centroid (see 'pathCentroid') as the base---   point for the scale.-scalePath :: (HasLinearMap v, VectorSpace v, Fractional (Scalar v), Eq (Scalar v))-          => Scalar v -> Path v -> Path v-scalePath d p = (scale d `under` translation (origin .-. pathCentroid p)) p+-- | 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 --- | Reverse the direction of all the component trails of a path.-reversePath :: AdditiveGroup v => Path v -> Path v-reversePath = (over Path . map) reverseRootedTrail+-- | \"Explode\" a path by exploding every component trail (see+--   'explodeTrail').+explodePath :: (VectorSpace (V t), TrailLike t) => Path (V t) -> [[t]]+explodePath = map explodeTrail . pathTrails --- | Convert a path into a list of lists of 'FixedSegment's.-fixPath :: AdditiveGroup v => Path v -> [[FixedSegment v]]-fixPath = map (uncurry fixTrail) . unpack+-- | 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  ---------------------------------------------------------------  Other functions  ---------------------------------------+--  Modifying paths  --------------------------------------- ------------------------------------------------------------ --- | Given a starting point, \"explode\" a trail by turning each---   segment (including the implicit closing segment, if the trail is---   closed) into its own separate path.  Useful for (say) applying a---   different style to each segment.-explodeTrail :: (VectorSpace (V p), PathLike p) => Point (V p) -> Trail (V p) -> [p]-explodeTrail start = snd . mapAccumL mkPath start . trailSegments'-  where mkPath p seg = (p .+^ segOffset seg, pathLike p False [seg])---- | \"Explode\" a path by exploding every component trail (see 'explodeTrail').-explodePath :: (VectorSpace (V p), PathLike p) => Path (V p) -> [[p]]-explodePath = map (uncurry explodeTrail) . pathTrails+-- | 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 --- | Create a single-segment path between two given points.-(~~) :: PathLike p => Point (V p) -> Point (V p) -> p-p1 ~~ p2 = fromVertices [p1, p2]+-- | Reverse all the component trails of a path.+reversePath :: (InnerSpace v, OrderedField (Scalar v)) => Path v -> Path v+reversePath = (over Path . map) reverseLocTrail

@@ -1,5 +1,5 @@-{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies     #-}  ----------------------------------------------------------------------------- -- |@@ -8,23 +8,28 @@ -- License     :  BSD-style (see LICENSE) -- Maintainer  :  diagrams-discuss@googlegroups.com ----- Some miscellaneous utilities for working with points.+-- Points in space.  For more tools for working with points and+-- vectors, see "Data.AffineSpace" and "Diagrams.Coordinates". -- -----------------------------------------------------------------------------  module Diagrams.Points-       ( centroid+       ( -- * Points+         Point, origin, (*.) +         -- * Point-related utilities+       , centroid+        ) where -import Diagrams.Coordinates-import Diagrams.Core.Points+import           Diagrams.Coordinates+import           Diagrams.Core.Points -import Control.Newtype+import           Control.Newtype -import Control.Arrow ((&&&))+import           Control.Arrow        ((&&&)) -import Data.VectorSpace+import           Data.VectorSpace  -- | The centroid of a set of /n/ points is their sum divided by /n/. centroid :: (VectorSpace v, Fractional (Scalar v)) => [Point v] -> Point v

@@ -20,10 +20,6 @@           -- * Standard library -         -- | Nice syntax for constructing and pattern-matching-         --   literal points and vectors.-       , module Diagrams.Coordinates-          -- | Attributes (color, line style, etc.) and styles.        , module Diagrams.Attributes @@ -33,10 +29,22 @@          -- | 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 and paths.+         -- | Trails.+       , module Diagrams.Trail++         -- | Parametrization of segments and trails.+       , module Diagrams.Parametric++         -- | Trail-like things.+       , module Diagrams.TrailLike++         -- | Paths.        , module Diagrams.Path           -- | Cubic splines.@@ -50,6 +58,25 @@          --   good old-fashioned, axis-aligned bounding boxes.        , module Diagrams.BoundingBox +         -- | 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+          -- | A wide range of things (shapes, transformations,          --   combinators) specific to creating two-dimensional          --   diagrams.@@ -80,25 +107,34 @@        , Applicative(..), (*>), (<*), (<$>), (<$), liftA, liftA2, liftA3        ) where -import Diagrams.Core+import           Diagrams.Core -import Diagrams.Align-import Diagrams.Animation-import Diagrams.Attributes-import Diagrams.BoundingBox-import Diagrams.Combinators-import Diagrams.Coordinates-import Diagrams.CubicSpline-import Diagrams.Path-import Diagrams.Segment-import Diagrams.Transform-import Diagrams.TwoD-import Diagrams.Util+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 -import Data.Colour hiding (atop, AffineSpace(..))-import Data.Colour.Names-import Data.Semigroup-import Data.VectorSpace hiding (Sum(..))-import Data.AffineSpace-import Data.Active-import Control.Applicative+import           Control.Applicative+import           Data.Active+import           Data.AffineSpace+import           Data.Colour          hiding (AffineSpace (..), atop)+import           Data.Colour.Names+import           Data.Semigroup+import           Data.VectorSpace     hiding (Sum (..))

@@ -0,0 +1,19 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Diagrams.Query+-- Copyright   :  (c) 2013 diagrams-lib team (see LICENSE)+-- License     :  BSD-style (see LICENSE)+-- Maintainer  :  diagrams-discuss@googlegroups.com+--+-- A query is a function that maps points in a vector space to values+-- in some monoid. Queries naturally form a monoid, with two queries+-- being combined pointwise.+--+-----------------------------------------------------------------------------++module Diagrams.Query+    ( Query(..), query, sample, value, resetValue, clearValue++    ) where++import           Diagrams.Core

@@ -1,134 +1,205 @@-{-# LANGUAGE TypeFamilies-           , FlexibleContexts-           , FlexibleInstances-           , MultiParamTypeClasses-           , DeriveFunctor-           , UndecidableInstances-  #-}+{-# LANGUAGE DeriveFunctor              #-}+{-# LANGUAGE EmptyDataDecls             #-}+{-# LANGUAGE FlexibleContexts           #-}+{-# LANGUAGE FlexibleInstances          #-}+{-# LANGUAGE GADTs                      #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses      #-}+{-# LANGUAGE StandaloneDeriving         #-}+{-# LANGUAGE TypeFamilies               #-}+{-# LANGUAGE TypeOperators              #-}+{-# LANGUAGE UndecidableInstances       #-}+{-# LANGUAGE ViewPatterns               #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  Diagrams.Segment--- Copyright   :  (c) 2011 diagrams-lib team (see LICENSE)+-- Copyright   :  (c) 2011-2013 diagrams-lib team (see LICENSE) -- License     :  BSD-style (see LICENSE) -- Maintainer  :  diagrams-discuss@googlegroups.com ----- A /segment/ is a translation-invariant, atomic path.  There are two--- types: linear (/i.e./ just a straight line to the endpoint) and--- cubic Bézier curves (/i.e./ a curve to an endpoint with two control--- points).  This module contains tools for creating and manipulating--- segments, as well as a definition of segments with a fixed location--- (useful for backend implementors).+-- A /segment/ is a translation-invariant, atomic path.  Currently,+-- there are two types: linear (/i.e./ just a straight line to the+-- endpoint) and cubic Bézier curves (/i.e./ a curve to an endpoint+-- with two control points).  This module contains tools for creating+-- and manipulating segments, as well as a definition of segments with+-- a fixed location (useful for backend implementors). -- -- Generally speaking, casual users of diagrams should not need this--- module; the higher-level functionality provided by "Diagrams.Path"--- should usually suffice instead.  However, directly manipulating--- segments can occasionally be useful.+-- module; the higher-level functionality provided by+-- "Diagrams.Trail", "Diagrams.TrailLike", and "Diagrams.Path" should+-- usually suffice.  However, directly manipulating segments can+-- occasionally be useful. -- -----------------------------------------------------------------------------  module Diagrams.Segment-       ( -- * Constructing segments+       ( -- * Open/closed tags -         Segment(..), straight, bezier3+         Open, Closed -         -- * Computing with segments-       , atParam, segOffset-       , reverseSegment-       , splitAtParam, arcLength-       , arcLengthToParam+         -- * Segment offsets -         -- * Adjusting segments-       , adjustSegment-       , AdjustOpts(..)-       , AdjustMethod(..)-       , AdjustSide(..)+       , Offset(..), segOffset -       , adjustSegmentToParams+         -- * Constructing and modifying segments +       , Segment(..), straight, bezier3, bézier3, reverseSegment+          -- * Fixed (absolutely located) segments        , FixedSegment(..)        , mkFixedSeg, fromFixedSeg-       , fAtParam +         -- * Segment measures+         -- $segmeas++       , SegCount(..)+       , ArcLength(..), getArcLengthCached, getArcLengthFun, getArcLengthBounded+       , TotalOffset(..)+       , OffsetEnvelope(..)+       , SegMeasure+        ) where -import Diagrams.Core+import           Control.Applicative (liftA2)+import           Data.AffineSpace+import           Data.Default.Class+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 Diagrams.Solve-import Diagrams.Util+import           Diagrams.Core+import           Diagrams.Located+import           Diagrams.Parametric+import           Diagrams.Solve+import           Diagrams.Util -import Data.Default-import Data.AffineSpace-import Data.VectorSpace -import Control.Applicative (liftA2)-import Data.Semigroup+------------------------------------------------------------+--  Open/closed type tags  ---------------------------------+------------------------------------------------------------ +-- Eventually we should use DataKinds for this, but not until we drop+-- support for GHC 7.4.++-- | Type tag for open segments.+data Open++-- | Type tag for closed segments.+data Closed+ ------------------------------------------------------------+--  Segment offsets  ---------------------------------------+------------------------------------------------------------++-- | The /offset/ of a segment is the vector from its starting point+--   to its end.  The offset for an /open/ segment is determined by+--   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++deriving instance Show v => Show (Offset c v)+deriving instance Eq   v => Eq   (Offset c v)+deriving instance Ord  v => Ord  (Offset c v)++instance Functor (Offset c) where+  fmap _ OffsetOpen       = OffsetOpen+  fmap f (OffsetClosed v) = OffsetClosed (f v)++type instance V (Offset c v) = v++instance HasLinearMap v => Transformable (Offset c v) where+  transform = fmap . apply++------------------------------------------------------------ --  Constructing segments  --------------------------------- ------------------------------------------------------------ --- | The atomic constituents of paths are /segments/, which are single---   straight lines or cubic Bézier curves.  Segments are+-- | The atomic constituents of the concrete representation currently+--   used for trails are /segments/, currently limited to+--   single straight lines or cubic Bézier curves.  Segments are --   /translationally invariant/, that is, they have no particular --   \"location\" and are unaffected by translations.  They are, --   however, affected by other transformations such as rotations and --   scales.-data Segment v = Linear v     -- ^ A linear segment with given offset.-               | Cubic v v v  -- ^ 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.+data Segment c v+    = Linear (Offset c v)+      -- ^ A linear segment with given offset.++    | Cubic v v (Offset c v)+      -- ^ 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) -type instance V (Segment v) = v+-- 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. (?) -instance HasLinearMap v => Transformable (Segment v) where+type instance V (Segment c v) = v++instance HasLinearMap v => Transformable (Segment c v) where   transform = fmap . apply -instance HasLinearMap v => Renderable (Segment v) NullBackend where+instance HasLinearMap v => Renderable (Segment c v) NullBackend where   render _ _ = mempty  -- | @'straight' v@ constructs a translationally invariant linear --   segment with direction and length given by the vector @v@.-straight :: v -> Segment v-straight = Linear+straight :: v -> Segment Closed v+straight = Linear . OffsetClosed  -- Note, if we didn't have a Linear constructor we could also create -- linear segments with @Cubic (v ^/ 3) (2 *^ (v ^/ 3)) v@.  Those -- would not be precisely the same, however, since we can actually -- observe how segments are parametrized. --- | @bezier3 v1 v2 v3@ constructs a translationally invariant cubic+-- | @bezier3 c1 c2 x@ constructs a translationally invariant cubic --   Bézier curve where the offsets from the first endpoint to the --   first and second control point and endpoint are respectively---   given by @v1@, @v2@, and @v3@.-bezier3 :: v -> v -> v -> Segment v-bezier3 = Cubic+--   given by @c1@, @c2@, and @x@.+bezier3 :: v -> v -> v -> Segment Closed v+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 = bezier3++type instance Codomain (Segment Closed v) = 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@.-atParam :: (VectorSpace v, Num (Scalar v)) => Segment v -> Scalar v -> v-atParam (Linear x) t       = t *^ x-atParam (Cubic c1 c2 x2) t =     (3 * t'*t'*t ) *^ c1-                             ^+^ (3 * t'*t *t ) *^ c2-                             ^+^ (    t *t *t ) *^ x2-  where t' = 1-t+instance (VectorSpace v, Num (Scalar v)) => Parametric (Segment Closed v) 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 (VectorSpace v, Num (Scalar v)) => EndValues (Segment Closed v) where+  atStart                            = const zeroV+  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 v -> v-segOffset (Linear v)    = v-segOffset (Cubic _ _ v) = v---- | Reverse the direction of a segment.-reverseSegment :: AdditiveGroup v => Segment v -> Segment v-reverseSegment (Linear v)       = Linear (negateV v)-reverseSegment (Cubic c1 c2 x2) = Cubic (c2 ^-^ x2) (c1 ^-^ x2) (negateV x2)+segOffset :: Segment Closed v -> v+segOffset (Linear (OffsetClosed v))    = v+segOffset (Cubic _ _ (OffsetClosed v)) = v  ------------------------------------------------------------ --  Computing segment envelope  ------------------------------@@ -157,12 +228,12 @@ -}  -- | The envelope for a segment is based at the segment's start.-instance (InnerSpace v, OrderedField (Scalar v)) => Enveloped (Segment v) where+instance (InnerSpace v, OrderedField (Scalar v)) => Enveloped (Segment Closed v) where    getEnvelope (s@(Linear {})) = mkEnvelope $ \v ->     maximum . map (\t -> ((s `atParam` t) <.> v) / magnitudeSq v) $ [0,1] -  getEnvelope (s@(Cubic c1 c2 x2)) = mkEnvelope $ \v ->+  getEnvelope (s@(Cubic c1 c2 (OffsetClosed x2))) = mkEnvelope $ \v ->     maximum .     map (\t -> ((s `atParam` t) <.> v) / magnitudeSq v) $     [0,1] ++@@ -175,143 +246,66 @@ --  Manipulating segments ------------------------------------------------------------ --- | 'splitAtParam' splits a segment @s@ into two new segments @(l,r)@---   at the parameter @t@ where @l@ corresponds to the portion of---   @s@ for parameter values from @0@ to @t@ and @r@ for @s@ from @t@ to @1@.---   The following should hold for splitting:------ > paramSplit s t u--- >   | u < t     = atParam s u == atParam l (u / t)--- >   | otherwise = atParam s u == atParam s t ^+^ atParam l ((u - t) / (1.0 - t))--- >   where (l,r) = splitAtParam s t------   That is to say, the parameterization scales linearly with splitting.------   'splitAtParam' can also be used with parameters outside the range---   (0,1).  For example, using the parameter @2@ gives two result---   segments where the first is the original segment extended to the---   parameter 2, and the second result segment travels /backwards/---   from the end of the first to the end of the original segment.-splitAtParam :: (VectorSpace v) => Segment v -> Scalar v -> (Segment v, Segment v)-splitAtParam (Linear x1) t = (left, right)-  where left  = Linear p-        right = Linear (x1 ^-^ p)-        p = lerp zeroV x1 t-splitAtParam (Cubic c1 c2 x2) t = (left, right)-  where left  = Cubic a b e-        right = Cubic (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---- | 'arcLength' @s m@ approximates the arc length of the segment curve @s@ with---   accuracy of at least plus or minus @m@.  For a 'Cubic' segment this is computed---   by subdividing until the arc length of the path through the control points is---   within @m@ of distance from start to end.-arcLength :: (InnerSpace v, Floating (Scalar v), Ord (Scalar v))-          => Segment v -> Scalar v -> Scalar v-arcLength (Linear x1) _ = magnitude x1-arcLength s@(Cubic c1 c2 x2) m-  | ub - lb < m = (ub + lb) / 2-  | otherwise   = arcLength l m + arcLength r m- where (l,r) = splitAtParam s 0.5-       ub    = sum (map magnitude [c1, c2 ^-^ c1, x2 ^-^ c2])-       lb    = magnitude x2---- | @'arcLengthToParam' s l m@ converts the absolute arc length @l@,---   measured from the segment starting point, to a parameter on the---   segment @s@, with accuracy of at least plus or minus @m@.  Works---   for /any/ arc length, and may return any parameter value (not---   just parameters between 0 and 1).-arcLengthToParam :: (InnerSpace v, Floating (Scalar v), Ord (Scalar v), AdditiveGroup v)-                 => Segment v -> Scalar v -> Scalar v -> Scalar v-arcLengthToParam s _ m | arcLength s m == 0 = 0.5-arcLengthToParam s@(Linear {}) len m = len / arcLength s m-arcLengthToParam s@(Cubic {})  len m-  | len == 0             = 0-  | len < 0              = - arcLengthToParam (fst (splitAtParam s (-1))) (-len) m-  | abs (len - slen) < m = 1-  | len > slen           = 2 * arcLengthToParam (fst (splitAtParam s 2)) len m-  | len < ll             = (*0.5) $ arcLengthToParam l len m-  | otherwise            = (+0.5) . (*0.5) $ arcLengthToParam r (len - ll) m-  where (l,r) = splitAtParam s 0.5-        ll    = arcLength l m-        slen  = arcLength s m---- Note, the above seems to be quite slow since it duplicates a lot of--- work.  We could trade off some time for space by building a tree of--- parameter values (up to a certain depth...)-------------------------------------------------------  Adjusting segment 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)+instance (VectorSpace v, Fractional (Scalar v)) => Sectionable (Segment Closed v) where+  splitAtParam (Linear (OffsetClosed x1)) t = (left, right)+    where left  = straight p+          right = straight (x1 ^-^ p)+          p = lerp zeroV x1 t+  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 --- | How should a segment, trail, or path be adjusted?-data AdjustOpts v = ALO { adjMethod :: AdjustMethod v-                        , adjSide   :: AdjustSide-                        , adjEps    :: Scalar v-                        , adjOptsvProxy__ :: Proxy v-                        }+  reverseDomain = reverseSegment -instance Fractional (Scalar v) => Default (AdjustMethod v) where-  def = ByParam 0.2+-- | 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) -instance Default AdjustSide where-  def = Both+instance (InnerSpace v, Floating (Scalar v), Ord (Scalar v), AdditiveGroup v)+      => HasArcLength (Segment Closed v) where -instance Fractional (Scalar v) => Default (AdjustOpts v) where-  def = ALO def def (1/10^(10 :: Integer)) Proxy+  arcLengthBounded _ (Linear (OffsetClosed x1)) = I.singleton $ magnitude 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 --- | Adjust the length of a segment.  The second parameter is an---   option record which controls how the adjustment should be---   performed; see 'AdjustOpts'.-adjustSegment :: (InnerSpace v, OrderedField (Scalar v))-              => Segment v -> AdjustOpts v -> Segment v-adjustSegment s opts = adjustSegmentToParams s-    (if adjSide opts == End   then 0 else getParam s)-    (if adjSide opts == Start then 0 else 1 - getParam (reverseSegment 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 l = arcLengthToParam seg l eps-        absDelta len = arcLength s eps - len-    bothCoef = if adjSide opts == Both then 0.5 else 1-    eps = adjEps opts+  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 < 0              = - arcLengthToParam m (fst (splitAtParam s (-1))) (-len)+    | len `I.elem` 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)+                           $ arcLengthToParam (9*m/10) r (len - I.midpoint llen)+    where (l,r) = s `splitAtParam` 0.5+          llen  = arcLengthBounded (m/10) l+          slen  = arcLengthBounded m s --- | Given a segment and parameters @t1@, @t2@, produce the segment---   which lies on the (infinitely extended) original segment---   beginning at @t1@ and ending at @t2@.-adjustSegmentToParams :: (Fractional (Scalar v), VectorSpace v)-                      => Segment v -> Scalar v -> Scalar v -> Segment v-adjustSegmentToParams s t1 t2 = snd (splitAtParam (fst (splitAtParam s t2)) (t1/t2))+  -- Note, the above seems to be quite slow since it duplicates a lot of+  -- work.  We could trade off some time for space by building a tree of+  -- parameter values (up to a certain depth...)  ------------------------------------------------------------ --  Fixed segments ------------------------------------------------------------  -- | @FixedSegment@s are like 'Segment's except that they have---   absolute locations.+--   absolute locations.  @FixedSegment v@ is isomorphic to @Located+--   (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@@ -346,34 +340,136 @@  instance (InnerSpace v, OrderedField (Scalar v)) => Enveloped (FixedSegment v) where   getEnvelope f = moveTo p (getEnvelope s)-    where (p, s) = fromFixedSeg f+    where (p, s) = viewLoc $ fromFixedSeg f      -- Eventually we might decide it's cleaner/more efficient (?) to     -- have all the computation in the FixedSegment instance of     -- Envelope, and implement the Segment instance in terms of it,     -- instead of the other way around --- | Create a 'FixedSegment' from a starting point and a 'Segment'.-mkFixedSeg :: AdditiveGroup v => Point v -> Segment v -> FixedSegment v-mkFixedSeg p (Linear v)       = FLinear p (p .+^ v)-mkFixedSeg p (Cubic c1 c2 x2) = FCubic p (p .+^ c1) (p .+^ c2) (p .+^ x2)+-- | 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) --- | Decompose a 'FixedSegment' into a starting point and a 'Segment'.-fromFixedSeg :: AdditiveGroup v => FixedSegment v -> (Point v, Segment v)-fromFixedSeg (FLinear p1 p2)      = (p1, Linear (p2 .-. p1))-fromFixedSeg (FCubic x1 c1 c2 x2) = (x1, Cubic (c1 .-. x1) (c2 .-. x1) (x2 .-. x1))+-- | Convert a 'FixedSegment' back into a located 'Segment'.+fromFixedSeg :: AdditiveGroup v => FixedSegment v -> Located (Segment Closed v)+fromFixedSeg (FLinear p1 p2)      = straight (p2 .-. p1) `at` p1+fromFixedSeg (FCubic x1 c1 c2 x2) = bezier3 (c1 .-. x1) (c2 .-. x1) (x2 .-. x1) `at` x1 --- | Compute the point on a fixed segment at a given parameter.  A---   parameter of 0 corresponds to the starting point and 1 corresponds---   to the ending point.-fAtParam :: VectorSpace v => FixedSegment v -> Scalar v -> Point v-fAtParam (FLinear p1 p2) t = alerp p1 p2 t-fAtParam (FCubic x1 c1 c2 x2) t = p3-  where p11 = alerp x1 c1 t-        p12 = alerp c1 c2 t-        p13 = alerp c2 x2 t+type instance Codomain (FixedSegment v) = Point v -        p21 = alerp p11 p12 t-        p22 = alerp p12 p13 t+instance VectorSpace v => Parametric (FixedSegment v) where+  atParam (FLinear p1 p2) t = alerp p1 p2 t+  atParam (FCubic x1 c1 c2 x2) t = p3+    where p11 = alerp x1 c1 t+          p12 = alerp c1 c2 t+          p13 = alerp c2 x2 t -        p3  = alerp p21 p22 t+          p21 = alerp p11 p12 t+          p22 = alerp p12 p13 t++          p3  = alerp p21 p22 t++------------------------------------------------------------+--  Segment measures  --------------------------------------+------------------------------------------------------------++-- $segmeas+-- Trails store a sequence of segments in a fingertree, which can+-- automatically track various monoidal \"measures\" on segments.++-- | A type to track the count of segments in a 'Trail'.+newtype SegCount = SegCount { getSegCount :: Sum Int }+  deriving (Semigroup, Monoid)++-- | 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))) }++-- | Project out the cached arc length, stored together with error+--   bounds.+getArcLengthCached :: ArcLength v -> Interval (Scalar v)+getArcLengthCached = getSum . fst . getArcLength++-- | 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++-- | 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 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)++-- | A type to represent the total cumulative offset of a chain of+--   segments.+newtype TotalOffset v = TotalOffset { getTotalOffset :: v }++instance AdditiveGroup v => Semigroup (TotalOffset v) where+  TotalOffset v1 <> TotalOffset v2 = TotalOffset (v1 ^+^ v2)++instance AdditiveGroup v => Monoid (TotalOffset v) where+  mempty  = TotalOffset zeroV+  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+  }++instance (InnerSpace v, OrderedField (Scalar v)) => Semigroup (OffsetEnvelope v) where+  (OffsetEnvelope o1 e1) <> (OffsetEnvelope o2 e2)+    = OffsetEnvelope+        (o1 <> o2)+        (e1 <> moveOriginBy (negateV . getTotalOffset $ o1) e2)++-- | @SegMeasure@ collects up all the measurements over a chain of+--   segments.+type SegMeasure v = SegCount+                ::: ArcLength v+                ::: OffsetEnvelope v+                ::: ()+  -- 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+  measure = id++instance (OrderedField (Scalar v), InnerSpace v)+    => Measured (SegMeasure v) (Segment Closed v) 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+                           )+              )++           *: (OffsetEnvelope+                (TotalOffset . segOffset $ s)+                (getEnvelope s)+              )+           *: ()

@@ -14,10 +14,10 @@        , cubForm        ) where -import Data.List (maximumBy)-import Data.Ord (comparing)+import           Data.List     (maximumBy)+import           Data.Ord      (comparing) -import Diagrams.Util (tau)+import           Diagrams.Util (tau)  ------------------------------------------------------------ -- Quadratic formula@@ -31,7 +31,7 @@     -- so arbitrarily return 0   | a == 0 && b == 0 && c == 0 = [0] -    -- c = 0+    -- c /= 0   | a == 0 && b == 0 = []      -- linear@@ -39,6 +39,9 @@      -- 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)]

@@ -24,7 +24,7 @@ import Data.Semigroup  import Data.AffineSpace-import Data.Monoid.PosInf (minimum)+import Data.Monoid.Inf (minimum) import Data.VectorSpace  import Diagrams.Core@@ -38,6 +38,8 @@  instance Transformable Ellipsoid where   transform t1 (Ellipsoid t2) = Ellipsoid (t1 <> t2)++instance IsPrim Ellipsoid  instance Renderable Ellipsoid NullBackend where   render _ _ = mempty

@@ -0,0 +1,50 @@+{-# LANGUAGE FlexibleContexts #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Diagrams.Trace+-- Copyright   :  (c) 2013 diagrams-lib team (see LICENSE)+-- License     :  BSD-style (see LICENSE)+-- Maintainer  :  diagrams-discuss@googlegroups.com+--+-- \"Traces\", aka embedded raytracers, for finding points on the edge+-- of a diagram.  See "Diagrams.Core.Trace" for internal+-- implementation details.+--+-----------------------------------------------------------------------------++module Diagrams.Trace+    ( -- * Types+      Trace, Traced++      -- * Diagram traces+    , trace, setTrace, withTrace++      -- * Querying traces+    , traceV, traceP, maxTraceV, maxTraceP++      -- * Subdiagram traces+    , boundaryFrom, boundaryFromMay++    ) where++import           Diagrams.Core        (HasLinearMap, Point, Subdiagram,+                                       location, origin, setTrace, trace)+import           Diagrams.Core.Trace++import           Data.Maybe+import           Data.VectorSpace     (Scalar, negateV)+import           Diagrams.Combinators (withTrace)++-- | 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 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

@@ -0,0 +1,880 @@+{-# 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

@@ -0,0 +1,157 @@+{-# LANGUAGE FlexibleContexts     #-}+{-# LANGUAGE FlexibleInstances    #-}+{-# LANGUAGE TypeFamilies         #-}+{-# LANGUAGE UndecidableInstances #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Diagrams.TrailLike+-- Copyright   :  (c) 2013 diagrams-lib team (see LICENSE)+-- License     :  BSD-style (see LICENSE)+-- Maintainer  :  diagrams-discuss@googlegroups.com+--+-- The 'TrailLike' class abstracts over anything which can be+-- constructed from a concretely located 'Trail', including+-- lines, loops, trails, paths, vertex lists, and diagrams.+--+-----------------------------------------------------------------------------++module Diagrams.TrailLike+       (+         -- * The TrailLike class++         TrailLike(..)++         -- * Constructing TrailLikes++       , fromSegments, fromLocSegments, fromOffsets, fromLocOffsets, fromVertices+       , (~~), explodeTrail++       ) where++import           Data.AffineSpace ((.-.))+import           Data.VectorSpace++import           Diagrams.Core+import           Diagrams.Located+import           Diagrams.Segment+import           Diagrams.Trail++------------------------------------------------------------+--  TrailLike class+------------------------------------------------------------++-- | A type class for trail-like things, /i.e./ things which can be+--   constructed from a concretely located 'Trail'.  Instances include+--   lines, loops, trails, paths, lists of vertices, two-dimensional+--   'Diagram's, and 'Located' variants of all the above.+--+--   Usually, type variables with 'TrailLike' constraints are used as+--   the /output/ types of functions, like+--+--   @+--   foo :: (TrailLike t) => ... -> t+--   @+--+--   Functions with such a type can be used to construct trails,+--   paths, diagrams, lists of points, and so on, depending on the+--   context.+--+--   To write a function with a signature like the above, you can of+--   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++  trailLike+    :: Located (Trail (V 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++-- | 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+  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+  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+  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++-- | 'Located' things are trail-like as long as the underlying type+--   is.  The location is taken to be the location of the input+--   located trail.+instance TrailLike t => TrailLike (Located t) where+  trailLike t = trailLike t `at` loc t++------------------------------------------------------------+--  Constructing TrailLike things  -------------------------+------------------------------------------------------------++-- | 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+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 . 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+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 = trailLike . mapLoc trailFromOffsets++-- | Construct a trail-like thing connecting the given vertices with+--   linear segments, with the first vertex as the location.  If no+--   vertices are given, the empty trail is used with the origin as+--   the location.+--+--   XXX example/picture+fromVertices :: TrailLike t => [Point (V 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 []         = []+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+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]+explodeTrail = map (mkTrail . fromFixedSeg) . fixTrail+  where+    mkTrail = trailLike . mapLoc (trailFromSegments . (:[]))

@@ -1,22 +1,38 @@ ----------------------------------------------------------------------------- -- | -- Module      :  Diagrams.Transform--- Copyright   :  (c) 2011 diagrams-lib team (see LICENSE)+-- Copyright   :  (c) 2011-13 diagrams-lib team (see LICENSE) -- License     :  BSD-style (see LICENSE) -- Maintainer  :  diagrams-discuss@googlegroups.com ----- Some convenient functions related to transformations.+-- Affine transformations, parameterized by any vector space.  For+-- transformations on particular vector spaces, see /e.g./+-- "Diagrams.TwoD.Transform". -- -----------------------------------------------------------------------------  module Diagrams.Transform-       ( conjugate, under+    ( -- * Transformations+      Transformation, inv, transl, apply, papply -       ) where+      -- * The Transformable class+    , Transformable(..) -import Diagrams.Core-import Data.Semigroup+      -- * Some specific transformations+    , translation, translate, moveTo, place, scaling, scale +      -- * Miscellaneous transformation-related utilities+    , conjugate, under++      -- * The HasOrigin class++    , HasOrigin(..), moveOriginBy++    ) where++import           Data.Semigroup+import           Diagrams.Core+ -- | Conjugate one transformation by another. @conjugate t1 t2@ is the --   transformation which performs first @t1@, then @t2@, then the --   inverse of @t1@.@@ -25,13 +41,15 @@  -- | Carry out some transformation \"under\" another one: @f ``under`` --   t@ first applies @t@, then @f@, then the inverse of @t@.  For---   example, @'scaleX' 2 ``under`` 'rotationBy' (-1/8 :: CircleFrac)@+--   example, @'scaleX' 2 ``under`` 'rotationBy' (-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) `under` t1 == transform (conjugate t1 t2)+--   @ -- --   for all transformations @t1@ and @t2@. under :: Transformable a => (a -> a) -> Transformation (V a) -> a -> a

@@ -1,4 +1,6 @@-{-# LANGUAGE TypeSynonymInstances, FlexibleContexts, TypeFamilies #-}+{-# LANGUAGE FlexibleContexts     #-}+{-# LANGUAGE TypeFamilies         #-}+{-# LANGUAGE TypeSynonymInstances #-} ----------------------------------------------------------------------------- -- | -- Module      :  Diagrams.TwoD@@ -65,12 +67,13 @@          -- * Angles        , tau        , Angle(..)-       , CircleFrac(..), Rad(..), Deg(..)+       , Turn(..), CircleFrac, Rad(..), Deg(..)        , fullCircle, convertAngle           -- * Paths          -- ** Stroking-       , stroke, stroke', strokeT, strokeT'+       , stroke, stroke', strokeT, strokeT', strokeLine, strokeLoop+       , strokeLocT, strokeLocLine, strokeLocLoop        , FillRule(..), fillRule        , StrokeOpts(..) @@ -92,7 +95,7 @@        , wedge           -- ** General polygons-       , polygon, polyVertices+       , polygon, polyTrail        , PolygonOpts(..), PolyType(..), PolyOrientation(..)           -- ** Star polygons@@ -100,6 +103,7 @@           -- ** Regular polygons        , regPoly+       , triangle        , eqTriangle        , square        , pentagon@@ -191,19 +195,19 @@         ) where -import Diagrams.TwoD.Types-import Diagrams.TwoD.Path-import Diagrams.TwoD.Ellipse-import Diagrams.TwoD.Arc-import Diagrams.TwoD.Polygons-import Diagrams.TwoD.Shapes-import Diagrams.TwoD.Transform-import Diagrams.TwoD.Align-import Diagrams.TwoD.Combinators-import Diagrams.TwoD.Vector-import Diagrams.TwoD.Size-import Diagrams.TwoD.Model-import Diagrams.TwoD.Text-import Diagrams.TwoD.Image+import           Diagrams.TwoD.Align+import           Diagrams.TwoD.Arc+import           Diagrams.TwoD.Combinators+import           Diagrams.TwoD.Ellipse+import           Diagrams.TwoD.Image+import           Diagrams.TwoD.Model+import           Diagrams.TwoD.Path+import           Diagrams.TwoD.Polygons+import           Diagrams.TwoD.Shapes+import           Diagrams.TwoD.Size+import           Diagrams.TwoD.Text+import           Diagrams.TwoD.Transform+import           Diagrams.TwoD.Types+import           Diagrams.TwoD.Vector -import Diagrams.Util (tau)+import           Diagrams.Util             (tau)

@@ -1,6 +1,5 @@-{-# LANGUAGE TypeFamilies-           , ViewPatterns-  #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE ViewPatterns #-} ----------------------------------------------------------------------------- -- | -- Module      :  Diagrams.TwoD.Arc@@ -22,18 +21,20 @@     , wedge     ) where -import Diagrams.Core--import Diagrams.Coordinates-import Diagrams.Path-import Diagrams.Segment-import Diagrams.TwoD.Transform-import Diagrams.TwoD.Types-import Diagrams.TwoD.Vector (unitX, e)-import Diagrams.Util ((#), tau)+import           Diagrams.Coordinates+import           Diagrams.Core+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 Data.Semigroup ((<>))-import Data.VectorSpace((^-^), (*^), negateV)+import           Data.Semigroup          ((<>))+import           Data.VectorSpace        (negateV, (*^), (^-^))  -- For details of this approximation see: --   http://www.tinaja.com/glib/bezcirc2.pdf@@ -42,8 +43,8 @@ --   the positive y direction and sweeps counterclockwise through @s@ --   radians.  The approximation is only valid for angles in the first --   quadrant.-bezierFromSweepQ1 :: Rad -> Segment R2-bezierFromSweepQ1 s = fmap (^-^ v) . rotate (s/2) $ Cubic c2 c1 p0+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@@ -55,7 +56,7 @@ --   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 R2]+bezierFromSweep :: Rad -> [Segment Closed R2] bezierFromSweep s   | s > tau    = bezierFromSweep tau   | s < 0      = fmap reflectY . bezierFromSweep $ (-s)@@ -89,50 +90,49 @@ arcT :: Angle a => a -> a -> Trail R2 arcT start end     | e < s     = arcT s (e + fromIntegral d)-    | otherwise = Trail bs (sweep >= tau)+    | otherwise = (if sweep >= tau then glueTrail else id)+                $ trailFromSegments bs   where sweep = convertAngle $ end - start         bs    = map (rotate start) . bezierFromSweep $ sweep-        +         -- We want to compare the start and the end and in case         -- there isn't some law about 'Angle' ordering, we use a         -- known 'Angle' for that.-        s = convertAngle start :: CircleFrac+        s = convertAngle start :: Turn         e = convertAngle end         d = ceiling (s - e) :: Integer  -- | Given a start angle @s@ and an end angle @e@, @'arc' s e@ is the --   path of a radius one arc counterclockwise between the two angles. --   The origin of the arc is its center.-arc :: (Angle a, PathLike p, V p ~ R2) => a -> a -> p-arc start end = pathLike (rotate start $ p2 (1,0))-                         False-                         (trailSegments $ arcT start end)+arc :: (Angle a, TrailLike t, V t ~ R2) => a -> a -> t+arc start end = trailLike $ arcT start end `at` (rotate start $ p2 (1,0))  -- | Like 'arc' but clockwise.-arcCW :: (Angle a, PathLike p, V p ~ R2) => a -> a -> p-arcCW start end = pathLike (rotate start $ p2 (1,0))-                           False-                           -- flipped arguments to get the path we want-                           -- then reverse the trail to get the cw direction.-                           (trailSegments . reverseTrail $ arcT end start)+arcCW :: (Angle a, TrailLike t, V t ~ R2) => a -> a -> 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 `PathLike`.+                   -- 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 +--   @'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 +--   be clockwise, otherwise it will be counterclockwise. The origin --   of the arc is its center.-arc' :: (Angle a, PathLike p, V p ~ R2) => Double -> a -> a -> p-arc' r start end = pathLike (rotate start $ p2 (abs r,0))-                   False-                   (trailSegments . scale (abs r) $ ts)+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  -- | Create a circular wedge of the given radius, beginning at the --   first angle and extending counterclockwise to the second.-wedge :: (Angle a, PathLike p, V p ~ R2) => Double -> a -> a -> p-wedge r a1 a2 = pathLikeFromTrail $ fromOffsets [r *^ e a1]-                                 <> arc a1 a2 # scale r-                                 <> fromOffsets [r *^ negateV (e a2)]+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)]

@@ -1,7 +1,7 @@-{-# LANGUAGE FlexibleContexts-           , TypeFamilies-           , ViewPatterns-  #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies          #-}+{-# LANGUAGE ViewPatterns          #-} ----------------------------------------------------------------------------- -- | -- Module      :  Diagrams.TwoD.Combinators@@ -37,54 +37,57 @@      ) where -import Data.AffineSpace-import Data.Colour-import Data.Default-import Data.Semigroup-import Data.VectorSpace+import           Data.AffineSpace+import           Data.Colour+import           Data.Default.Class+import           Data.Semigroup+import           Data.VectorSpace -import Diagrams.Core+import           Diagrams.Core -import Diagrams.Attributes (lw, fc)-import Diagrams.BoundingBox-import Diagrams.Combinators-import Diagrams.Coordinates-import Diagrams.Path-import Diagrams.Segment-import Diagrams.TwoD.Align-import Diagrams.TwoD.Path ()   -- for PathLike (D R2) instance-import Diagrams.TwoD.Segment-import Diagrams.TwoD.Shapes-import Diagrams.TwoD.Transform (scaleX, scaleY)-import Diagrams.TwoD.Types-import Diagrams.TwoD.Vector (unitX, unitY, fromDirection)-import Diagrams.Util ((#))+import           Diagrams.Attributes     (fc, lw)+import           Diagrams.BoundingBox+import           Diagrams.Combinators+import           Diagrams.Coordinates+import           Diagrams.Path+import           Diagrams.Segment+import           Diagrams.TrailLike+import           Diagrams.TwoD.Align+import           Diagrams.TwoD.Path      ()+import           Diagrams.TwoD.Segment+import           Diagrams.TwoD.Shapes+import           Diagrams.TwoD.Transform (scaleX, scaleY)+import           Diagrams.TwoD.Types+import           Diagrams.TwoD.Vector    (fromDirection, unitX, unitY)+import           Diagrams.Util           (( # ))   infixl 6 === infixl 6 ||| --- | Place two diagrams (or other objects) vertically---   adjacent to one another, with the first diagram above the second.---   Since Haskell ignores whitespace in expressions, one can thus write+-- | Place two diagrams (or other objects) vertically adjacent to one+--   another, with the first diagram above the second.  Since Haskell+--   ignores whitespace in expressions, one can thus write -----   >    c---   >   ===---   >    d+--   @+--       c+--      ===+--       d+--   @ -- --   to place @c@ above @d@.  The local origin of the resulting --   combined diagram is the same as the local origin of the first.---   @(===)@ is associative and has 'mempty' as a right (but not left)---   identity.  See the documentation of 'beside' for more information.+--   @(===)@ 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)  -- | 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 associative and has 'mempty' as a right (but not left)---   identity.  See the documentation of 'beside' for more information.+--   the second.  The local origin of the resulting 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 unitX @@ -151,13 +154,13 @@   where     seg = FLinear (origin .+^ 0.5 *^ v) (origin .+^ (-0.5) *^ v) --- | @strutX d@ is an empty diagram with width @d@, height 0, and a+-- | @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) --- | @strutY d@ is an empty diagram with height @d@, width 0, and a+-- | @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@@ -232,10 +235,10 @@  -- | Construct a bounding rectangle for an enveloped object, that is, --   the smallest axis-aligned rectangle which encloses the object.-boundingRect :: ( Enveloped p, Transformable p, PathLike p, V p ~ R2+boundingRect :: ( Enveloped t, Transformable t, TrailLike t, Monoid t, V t ~ R2                 , Enveloped a, V a ~ R2                 )-             => a -> p+             => a -> t boundingRect = (`boxFit` rect 1 1) . boundingBox  -- | \"Set the background color\" of a diagram.  That is, place a

@@ -0,0 +1,163 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GADTs            #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Diagrams.TwoD.Curvature+-- Copyright   :  (c) 2013 diagrams-lib team (see LICENSE)+-- License     :  BSD-style (see LICENSE)+-- Maintainer  :  diagrams-discuss@googlegroups.com+--+-- Compute curvature for segments in two dimensions.+--+-----------------------------------------------------------------------------++module Diagrams.TwoD.Curvature+    (+      curvature+    , radiusOfCurvature+    , squaredCurvature+    , squaredRadiusOfCurvature+    ) where++import           Data.AffineSpace+import           Data.Monoid.Inf+import           Data.VectorSpace++import           Control.Arrow        (first, second)+import           Control.Monad        (join)++import           Diagrams.Core++import           Diagrams.Segment+import           Diagrams.TwoD.Types+import           Diagrams.TwoD.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.+-- When turning a corner to the left we will have positive curvature.  When+-- turning to the right we will have negative curvature.+--+-- Another way to measure this idea is to find the largest circle that we can+-- push up against the curve and have it touch (locally) at exactly the point+-- and not cross the curve.  This is a tangent circle.  The radius of that+-- circle is the \"Radius of Curvature\" and it is the reciprocal of curvature.+-- Note that if the circle is on the \"left\" of the curve, we have a positive+-- radius, and if it is to the right we have a negative radius.  Straight+-- segments have an infinite radius which leads us to our representation.  We+-- result in a pair of numerator and denominator so we can include infinity and+-- zero for both the radius and the curvature.+--+--+-- Lets consider the following curve:+--+-- <<diagrams/diagramA.svg#diagram=diagramA&height=200&width=400>>+--+-- The curve starts with positive curvature,+--+-- <<diagrams/diagramPos.svg#diagram=diagramPos&height=200&width=400>>+--+-- approaches zero curvature+--+-- <<diagrams/diagramZero.svg#diagram=diagramZero&height=200&width=400>>+--+-- then has negative curvature+--+-- <<diagrams/diagramNeg.svg#diagram=diagramNeg&height=200&width=400>>+--+-- > {-# LANGUAGE GADTs #-}+-- >+-- > import Diagrams.TwoD.Curvature+-- > import Data.Monoid.Inf+-- > import Diagrams.Coordinates+-- >+-- > segmentA = Cubic (12 & 0) (8 & 10) (OffsetClosed (20 & 8))+-- >+-- > curveA = lw 0.1 . stroke . fromSegments $ [segmentA]+-- >+-- > diagramA = pad 1.1 . centerXY $ curveA+-- >+-- > diagramPos = diagramWithRadius 0.2+-- >+-- > diagramZero = diagramWithRadius 0.5+-- >+-- > diagramNeg = diagramWithRadius 0.8+-- >+-- > diagramWithRadius t = pad 1.1 . centerXY+-- >          $ curveA+-- >         <> showCurvature segmentA t+-- >          # withEnvelope (curveA :: D R2)+-- >          # lw 0.05 # lc red+-- >+-- > showCurvature bez@(Cubic b c (OffsetClosed d)) t+-- >   | v == 0    = mempty+-- >   | otherwise = go (radiusOfCurvature bez t)+-- >   where+-- >     v@(x,y) = unr2 $ firstDerivative b c d t+-- >     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)))+-- >                   # moveTo (origin .+^ atParam bez t)+-- >       where+-- >         vpr = r2 (normalized 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++-- | 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+++-- | 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)++-- | Reciprocal of @squaredCurvature@+squaredRadiusOfCurvature :: Segment Closed R2 -> Double -> PosInf Double+squaredRadiusOfCurvature s = toPosInf . (\(p,q) -> (q,p)) . first (join (*)) . curvaturePair (fmap unr2 s)+++-- Package up problematic values with the appropriate infinity.+toPosInf :: RealFloat a => (a,a) -> PosInf a+toPosInf (_,0) = Infinity+toPosInf (p,q)+  | isInfinite r || isNaN r = Infinity+  | otherwise               = Finite r+  where r = p / q++-- 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))+  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++-- 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.+

@@ -1,8 +1,7 @@-{-# LANGUAGE FlexibleContexts-           , TypeSynonymInstances-           , MultiParamTypeClasses-           , TypeFamilies-  #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies          #-}+{-# LANGUAGE TypeSynonymInstances  #-} ----------------------------------------------------------------------------- -- | -- Module      :  Diagrams.TwoD.Ellipse@@ -23,28 +22,29 @@     , ellipseXY     ) where -import Diagrams.Core--import Diagrams.TwoD.Types-import Diagrams.TwoD.Transform-import Diagrams.TwoD.Arc+import           Diagrams.Core -import Diagrams.Path-import Diagrams.Util+import           Diagrams.Located        (at)+import           Diagrams.Path+import           Diagrams.TrailLike+import           Diagrams.TwoD.Arc+import           Diagrams.TwoD.Transform+import           Diagrams.TwoD.Types+import           Diagrams.Util  -- | A circle of radius 1, with center at the origin.-unitCircle :: (PathLike p, V p ~ R2) => p-unitCircle = pathLike (p2 (1,0)) True $ trailSegments (arcT 0 (tau::Rad))+unitCircle :: (TrailLike t, V t ~ R2) => t+unitCircle = trailLike $ arcT 0 (tau::Rad) `at` (p2 (1,0))  -- | A circle of the given radius, centered at the origin.  As a path, --   it begins at (r,0).-circle :: (PathLike p, V p ~ R2, Transformable p) => Double -> p+circle :: (TrailLike t, V t ~ R2, Transformable t) => Double -> 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 :: (PathLike p, V p ~ R2, Transformable p) => Double -> p+ellipse :: (TrailLike t, V t ~ R2, Transformable t) => Double -> 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 +52,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 :: (PathLike p, V p ~ R2, Transformable p) => Double -> Double -> p+ellipseXY :: (TrailLike t, V t ~ R2, Transformable t) => Double -> Double -> t ellipseXY x y = unitCircle # scaleX x # scaleY y

@@ -43,6 +43,8 @@ instance Transformable Image where   transform t1 (Image file sz t2) = Image file sz (t1 <> t2) +instance IsPrim Image+ instance HasOrigin Image where   moveOriginTo p = translate (origin .-. p) 

@@ -1,5 +1,5 @@-{-# LANGUAGE FlexibleContexts-  #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE MultiParamTypeClasses #-} ----------------------------------------------------------------------------- -- | -- Module      :  Diagrams.TwoD.Model@@ -19,29 +19,29 @@        , showLabels        ) where -import Diagrams.Core-import Diagrams.Core.Names+import           Diagrams.Core+import           Diagrams.Core.Names -import Diagrams.Path+import           Diagrams.Path -import Diagrams.TwoD.Types-import Diagrams.TwoD.Ellipse-import Diagrams.TwoD.Size    (size2D)-import Diagrams.TwoD.Text-import Diagrams.TwoD.Path-import Diagrams.Attributes-import Diagrams.Util+import           Diagrams.Attributes+import           Diagrams.TwoD.Ellipse+import           Diagrams.TwoD.Path+import           Diagrams.TwoD.Size    (size2D)+import           Diagrams.TwoD.Text+import           Diagrams.TwoD.Types+import           Diagrams.Util -import Control.Arrow (second)-import Data.Semigroup-import Data.Default-import Data.AffineSpace ((.-.))-import Data.VectorSpace ((^*))+import           Control.Arrow         (second)+import           Data.AffineSpace      ((.-.))+import           Data.Default.Class+import           Data.Semigroup+import           Data.VectorSpace      ((^*)) -import qualified Data.Map as M+import qualified Data.Map              as M -import Data.Colour.Names-import Data.Colour (Colour)+import           Data.Colour           (Colour)+import           Data.Colour.Names  ------------------------------------------------------------ -- Marking the origin@@ -64,8 +64,8 @@         (w,h) = size2D d ^* oScale oo         sz = maximum [w, h, oMinSize oo] -data OriginOpts = OriginOpts { oColor :: Colour Double-                             , oScale :: Double+data OriginOpts = OriginOpts { oColor   :: Colour Double+                             , oScale   :: Double                              , oMinSize :: Double                              } 

@@ -0,0 +1,133 @@+{-# LANGUAGE GADTs #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Diagrams.TwoD.Offset+-- Copyright   :  (c) 2012 diagrams-lib team (see LICENSE)+-- License     :  BSD-style (see LICENSE)+-- Maintainer  :  diagrams-discuss@googlegroups.com+--+-- Compute offsets to segments in two dimensions.+-- +-----------------------------------------------------------------------------+module Diagrams.TwoD.Offset +    ( offsetSegment+    ) where++import Data.AffineSpace+import Data.Monoid.Inf+import Data.VectorSpace++import Diagrams.Core++import Diagrams.Parametric+import Diagrams.Path+import Diagrams.Segment+import Diagrams.Trail+import Diagrams.TwoD.Curvature+import Diagrams.TwoD.Transform+import Diagrams.TwoD.Types++perp :: R2 -> R2+perp v = rotateBy (-1/4) v++unitPerp :: R2 -> R2+unitPerp = normalized . perp++perpAtParam :: Segment Closed R2 -> Double -> R2+perpAtParam   (Linear (OffsetClosed a))  t = unitPerp a +perpAtParam s@(Cubic _ _ _)              t = unitPerp a+  where+    (Cubic a _ _) = snd $ splitAtParam s 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+--   segments nothing special happens, the same linear segment is returned+--   with a point that is offset by a perpendicular vector of the given offset+--   length.+--+--   Cubic segments require a search for a subdivision of cubic segments that+--   gives an approximation of the offset within the given epsilon tolerance.+--   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+--   the offset cubic segment in proportion to the radius of curvature difference+--   between the original subsegment and the offset which will have a radius+--   increased by the offset parameter.+--+--   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>>+--+--   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 +                            --   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+                            --   the offset.+              -> Double     -- ^ 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++offsetSegment epsilon r s@(Cubic a b (OffsetClosed c)) = (origin .+^ va, t)+  where+    t = trailFromSegments (go (radiusOfCurvature s 0.5))+    -- Perpendiculars to handles.+    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++    -- Offset with handles scaled based on curvature.+    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+    go roc+      | close     = [o]+      | otherwise = subdivided+      where+        -- We want the multiplicative factor that takes us from the original+        -- segment's radius of curvature roc, to roc + r.+        --+        -- r + sr = x * sr+        --+        o = offset $ case roc of+              Infinity  -> 1          -- Do the right thing.+              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)+                    ]+++-- > 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+-- >   where+-- >       d  = stroke $ Path [(origin, Trail [s] False)]+-- >       d' = mconcat . zipWith lc colors . map stroke . uncurry explodeTrail+-- >          $ offsetSegment 0.1 (-1) s+-- >            +-- >       colors = cycle [green, red]+-- > +-- > cubicOffsetExample :: Diagram SVG R2+-- > 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)+-- >         ]

@@ -1,10 +1,10 @@-{-# LANGUAGE FlexibleContexts-           , FlexibleInstances-           , DeriveDataTypeable-           , GeneralizedNewtypeDeriving-           , TypeFamilies-           , ViewPatterns-  #-}+{-# LANGUAGE DeriveDataTypeable         #-}+{-# LANGUAGE FlexibleContexts           #-}+{-# LANGUAGE FlexibleInstances          #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses      #-}+{-# LANGUAGE TypeFamilies               #-}+{-# LANGUAGE ViewPatterns               #-} {-# OPTIONS_GHC -fno-warn-orphans #-} ----------------------------------------------------------------------------- -- |@@ -23,7 +23,8 @@ module Diagrams.TwoD.Path        ( -- * Constructing path-based diagrams -         stroke, stroke', strokeT, strokeT'+         stroke, stroke', strokeT, strokeT', strokeLine, strokeLoop+       , strokeLocT, strokeLocLine, strokeLocLoop           -- ** Stroke options @@ -40,24 +41,27 @@        , Clip(..), clipBy        ) where -import           Control.Applicative (liftA2)-import qualified Data.Foldable as F+import           Control.Applicative   (liftA2)+import qualified Data.Foldable         as F import           Data.Semigroup import           Data.Typeable  import           Data.AffineSpace-import           Data.Default+import           Data.Default.Class import           Data.VectorSpace -import           Diagrams.Core- import           Diagrams.Coordinates+import           Diagrams.Core+import           Diagrams.Located      (Located, mapLoc, unLoc)+import           Diagrams.Parametric import           Diagrams.Path import           Diagrams.Segment import           Diagrams.Solve+import           Diagrams.Trail+import           Diagrams.TrailLike import           Diagrams.TwoD.Segment import           Diagrams.TwoD.Types-import           Diagrams.Util (tau)+import           Diagrams.Util         (tau)  ------------------------------------------------------------ --  Trail and path traces  ---------------------------------@@ -68,15 +72,14 @@ -- XXX can the efficiency of this be improved?  See the comment in -- Diagrams.Path on the Enveloped instance for Trail. instance Traced (Trail R2) where-  getTrace t = case addClosingSegment t of-    (Trail segs _) ->-      foldr (\seg bds -> moveOriginBy (negateV . segOffset $ seg) bds <> getTrace seg)-            mempty-            segs+  getTrace = withLine $+      foldr+        (\seg bds -> moveOriginBy (negateV . atEnd $ seg) bds <> getTrace seg)+        mempty+    . lineSegments  instance Traced (Path R2) where-  getTrace = F.foldMap trailTrace . pathTrails-    where trailTrace (p, t) = moveOriginTo ((-1) *. p) (getTrace t)+  getTrace = F.foldMap getTrace . pathTrails  ------------------------------------------------------------ --  Constructing path-based diagrams  ----------------------@@ -96,8 +99,8 @@        => Path R2 -> Diagram b R2 stroke = stroke' (def :: StrokeOpts ()) -instance Renderable (Path R2) b => PathLike (QDiagram b R2 Any) where-  pathLike st cl segs = stroke $ pathLike st cl segs+instance Renderable (Path R2) b => TrailLike (QDiagram b R2 Any) where+  trailLike = stroke . trailLike  -- | A variant of 'stroke' that takes an extra record of options to --   customize its behavior.  In particular:@@ -107,8 +110,14 @@ --   '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 p-  = mkQD (Prim p)+stroke' opts path+  | null (pathTrails p1) =           mkP p2+  | null (pathTrails p2) = mkP p1+  | otherwise            = mkP p1 <> mkP p2+  where+    (p1,p2) = partitionPath (isLine . unLoc) path+    mkP p+      = mkQD (Prim p)          (getEnvelope p)          (getTrace p)          (fromNames . concat $@@ -121,7 +130,7 @@ --   records can be created using @'with' { ... }@ notation. data StrokeOpts a   = StrokeOpts-    { vertexNames :: [[a]]  -- ^ Atomic names that should be assigned+    { 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@@ -172,6 +181,31 @@          => StrokeOpts a -> Trail R2 -> Diagram b R2 strokeT' opts = stroke' opts . pathFromTrail +-- | 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 = 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 = 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++-- | 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++-- | 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+ ------------------------------------------------------------ --  Inside/outside testing ------------------------------------------------------------@@ -233,13 +267,13 @@  -- | Compute the sum of signed crossings of a trail starting from the --   given point in the positive x direction.-trailCrossings :: P2 -> (P2, Trail R2) -> Int+trailCrossings :: P2 -> Located (Trail R2) -> Int -  -- open trails have no inside or outside, so don't contribute crossings-trailCrossings _ (_, t) | not (isClosed t) = 0+  -- 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)) (start, tr)-  = sum . map test $ fixTrail start tr+trailCrossings p@(unp2 -> (x,y)) tr+  = sum . map test $ fixTrail tr   where     test (FLinear a@(unp2 -> (_,ay)) b@(unp2 -> (_,by)))       | ay <= y && by > y && isLeft a b > 0 =  1@@ -257,7 +291,7 @@                          ( 3*x1y - 6*c1y + 3*c2y)                          (-3*x1y + 3*c1y)                          (x1y - y)-            testT t = let (unp2 -> (px,_)) = c `fAtParam` t+            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)

@@ -1,9 +1,8 @@-{-# LANGUAGE TypeFamilies-           , ScopedTypeVariables-           , DeriveFunctor-           , ExistentialQuantification-           , ViewPatterns-  #-}+{-# LANGUAGE DeriveFunctor             #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE ScopedTypeVariables       #-}+{-# LANGUAGE TypeFamilies              #-}+{-# LANGUAGE ViewPatterns              #-}  ----------------------------------------------------------------------------- -- |@@ -22,15 +21,15 @@           PolyType(..)         , PolyOrientation(..)         , PolygonOpts(..)-        , polyVertices          , polygon+        , polyTrail          -- ** Generating polygon vertices -        , polyPolarVs-        , polySidesVs, polySidesVs'-        , polyRegularVs+        , polyPolarTrail+        , polySidesTrail+        , polyRegularTrail          , orient @@ -45,28 +44,33 @@      ) where -import Data.Ord          (comparing)-import Data.List         (maximumBy)-import Data.Maybe        (catMaybes)-import Data.Monoid       (mconcat)--import Control.Monad     (forM, liftM)--import Control.Monad.ST  (runST, ST)-import Data.Array.ST     (STUArray, newArray, readArray, writeArray)--import Data.AffineSpace  ((.-.), (.+^))-import Data.VectorSpace  (magnitude, normalized, project, (<.>), (^*))-import Data.Default+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 Diagrams.Core+import           Data.AffineSpace        ((.+^), (.-.))+import           Data.Default.Class+import           Data.VectorSpace        (magnitude, normalized, project, (<.>),+                                          (^*)) -import Diagrams.TwoD.Types-import Diagrams.TwoD.Transform-import Diagrams.TwoD.Vector (unitX, unitY, unit_Y)-import Diagrams.Path-import Diagrams.Points      (centroid)-import Diagrams.Util        ((#), tau)+import           Diagrams.Core+import           Diagrams.Located+import           Diagrams.Path+import           Diagrams.Points         (centroid)+import           Diagrams.Segment+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, ( # ))  -- | Method used to determine the vertices of a polygon. data PolyType = forall a. Angle a => PolyPolar [a] [Double]@@ -134,15 +138,15 @@  -- | Options for specifying a polygon. data PolygonOpts = PolygonOpts-                   { polyType       :: PolyType+                   { polyType   :: PolyType                      -- ^ Specification for the polygon's vertices. -                   , polyOrient     :: PolyOrientation+                   , polyOrient :: PolyOrientation                      -- ^ Should a rotation be applied to the                      --   polygon in order to orient it in a                      --   particular way? -                   , polyCenter     :: P2+                   , polyCenter :: P2                      -- ^ Should a translation be applied to the                      --   polygon in order to place the center at a                      --   particular location?@@ -153,74 +157,81 @@ instance Default PolygonOpts where     def = PolygonOpts (PolyRegular 5 1) OrientH origin --- | Generate the vertices of a polygon.  See 'PolygonOpts' for more---   information.-polyVertices :: PolygonOpts -> [P2]-polyVertices po = moveTo (polyCenter po) ori+-- | Generate a polygon.  See 'PolygonOpts' for more information.+polyTrail :: PolygonOpts -> Located (Trail R2)+polyTrail po = transform ori tr     where-        ps = case polyType po of-            PolyPolar ans szs -> polyPolarVs ans szs-            PolySides ans szs -> polySidesVs ans szs-            PolyRegular n r   -> polyRegularVs n r+        tr = case polyType po 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 ps-            OrientV      -> orient unitX  ps-            OrientTo v   -> orient v      ps-            NoOrient     -> ps+            OrientH      -> orient unit_Y tr+            OrientV      -> orient unitX  tr+            OrientTo v   -> orient v      tr+            NoOrient     -> mempty -polygon :: (PathLike p, V p ~ R2) => PolygonOpts -> p-polygon opts = case pts of-                 []     -> pathLike origin True []-                 (p1:_) -> pathLike p1 True (segmentsFromVertices pts)-  where pts = polyVertices opts+-- | Generate the polygon described by the given options.+polygon :: (TrailLike t, V t ~ R2) => PolygonOpts -> t+polygon = trailLike . polyTrail --- | Generate the vertices of a polygon specified by polar data+-- | Generate the located trail of a polygon specified by polar data --   (central angles and radii). See 'PolyPolar'.-polyPolarVs :: Angle a => [a] -> [Double] -> [P2]-polyPolarVs ans ls = zipWith (\a l -> rotate a . scale l $ p2 (1,0))-                             (scanl (+) 0 ans)-                             ls---- | Generate the vertices of a polygon specified by side length and---   angles, with the origin corresponding to the first vertex.  See---   'PolySides'.-polySidesVs' :: Angle a => [a] -> [Double] -> [P2]-polySidesVs' ans ls = scanl (.+^) origin-                      $ zipWith rotate ans' (map (unitY ^*) ls)+polyPolarTrail :: Angle a => [a] -> [Double] -> Located (Trail R2)+polyPolarTrail [] _ = emptyTrail `at` origin+polyPolarTrail _ [] = emptyTrail `at` origin+polyPolarTrail ans (r:rs) = tr `at` p1   where-    ans' = scanl (+) 0 ans+    p1 = p2 (1,0) # scale r+    tr = closeTrail . trailFromVertices $+           zipWith+             (\a l -> rotate a . scale l $ p2 (1,0))+             (scanl (+) 0 ans)+             (r:rs)  -- | Generate the vertices of a polygon specified by side length and---   angles, with the origin placed at the centroid.  See 'PolySides'.-polySidesVs :: Angle a => [a] -> [Double] -> [P2]-polySidesVs ans ls = p0 # moveOriginTo (centroid p0)-  where p0 = polySidesVs' ans ls+--   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 ans ls = tr `at` (centroid ps # scale (-1))+  where+    ans'    = scanl (+) 0 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'.-polyRegularVs :: Int -> Double -> [P2]-polyRegularVs n r = polyPolarVs (take (n-1) . repeat $ (tau::Rad) / fromIntegral n)-                                (repeat r)+polyRegularTrail :: Int -> Double -> Located (Trail R2)+polyRegularTrail n r = polyPolarTrail+                         (take (n-1) . repeat $ (tau::Rad) / fromIntegral n)+                         (repeat r) --- | Orient a list of points, rotating them as little as possible.---   The points are rotated so that the edge furthest in the direction---   of the given vector is perpendicular to it.  (Note: this may do odd---   things to non-convex lists of points.)-orient :: R2 -> [P2] -> [P2]-orient _ [] = []-orient v xs = rotate a xs-    where-        (n1,x,n2) = maximumBy (comparing (distAlong v . sndOf3))-                       (zip3 (tail xs ++ take 1 xs) xs (last xs : init xs))-        distAlong w ((.-. origin) -> p) = signum (w <.> p) * magnitude (project w p)-        x'        = maximumBy (comparing (distAlong v)) [n1, n2]-        e         = x' .-. x-        th        = Rad $ acos ((e <.> normalized v) / magnitude e)-        a | rightTurn (x .+^ v) x x' = tau/4 - th-          | otherwise                = th - tau/4-        sndOf3 (_,b,_) = b-        rightTurn (unp2 -> (x1,y1)) (unp2 -> (x2, y2)) (unp2 -> (x3,y3)) =-          (x2 - x1)*(y3 - y1) - (y2 - y1)*(x3-x1) < 0+-- | 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 v = orientPoints v . trailVertices +orientPoints :: R2 -> [P2] -> T2+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+    angleFromNormal o+      | leftTurn o' v' = phi+      | otherwise      = negate phi+      where+        o' = normalized o+        theta = acos (v' <.> o')+        phi+          | theta <= tau/4 = Rad $ tau/4 - theta+          | otherwise      = Rad $ theta - tau/4+ ------------------------------------------------------------ -- Function graphs ------------------------------------------------------------@@ -299,9 +310,9 @@ --   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---   the like, since a list of vertices is 'PathLike'.  But of course+--   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---   returned (instead of any 'PathLike') because the resulting path+--   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@@ -310,5 +321,10 @@               StarFun g  -> g               StarSkip k -> (+k)         graphToPath = mconcat . map partToPath-        partToPath (Cycle ps) = close $ fromVertices ps++        partToPath (Cycle ps) = pathFromLocTrail+                              . mapLoc closeTrail+                              . fromVertices+                              $ ps+         partToPath (Hair ps)  = fromVertices ps

@@ -1,7 +1,6 @@-{-# LANGUAGE FlexibleContexts-           , FlexibleInstances-           , UndecidableInstances-  #-}+{-# LANGUAGE FlexibleContexts     #-}+{-# LANGUAGE FlexibleInstances    #-}+{-# LANGUAGE UndecidableInstances #-}  ----------------------------------------------------------------------------- -- |@@ -17,24 +16,26 @@  module Diagrams.TwoD.Segment where -import Control.Applicative (liftA2)+import           Control.Applicative     (liftA2) -import Data.AffineSpace-import Data.Monoid.PosInf hiding (minimum)-import Data.VectorSpace+import           Data.AffineSpace+import           Data.Monoid.Inf         hiding (minimum)+import           Data.VectorSpace -import Diagrams.Core-import Diagrams.Core.Trace+import           Diagrams.Core+import           Diagrams.Core.Trace -import Diagrams.Segment-import Diagrams.Solve-import Diagrams.TwoD.Transform-import Diagrams.TwoD.Types-import Diagrams.TwoD.Vector-import Diagrams.Util+import           Diagrams.Located+import           Diagrams.Parametric+import           Diagrams.Segment+import           Diagrams.Solve+import           Diagrams.TwoD.Transform+import           Diagrams.TwoD.Types+import           Diagrams.TwoD.Vector+import           Diagrams.Util -instance Traced (Segment R2) where-  getTrace = getTrace . mkFixedSeg origin+instance Traced (Segment Closed R2) where+  getTrace = getTrace . mkFixedSeg . (`at` origin)  instance Traced (FixedSegment R2) where @@ -69,7 +70,7 @@       t1     = (perp v0 <.> p) / det     in       if det == 0 || t0 < 0 || t0 > 1-        then PosInfty+        then Infinity         else Finite t1  {- To do intersection of a line with a cubic Bezier, we first rotate@@ -94,9 +95,9 @@       c  = -3*y0 + 3*y1       d  = y0       ts = filter (liftA2 (&&) (>= 0) (<= 1)) (cubForm a b c d)-      xs = map (fst . unp2 . fAtParam bez') ts+      xs = map (fst . unp2 . atParam bez') ts     in       case xs of-        [] -> PosInfty+        [] -> Infinity         _  -> Finite (minimum xs) 

@@ -1,7 +1,5 @@-{-# LANGUAGE TypeFamilies-           , FlexibleContexts-           , ViewPatterns-  #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies     #-}  ----------------------------------------------------------------------------- -- |@@ -22,6 +20,7 @@          -- * Regular polygons         , regPoly+       , triangle        , eqTriangle        , square        , pentagon@@ -44,45 +43,88 @@        , roundedRect'        ) where -import Diagrams.Core+import           Diagrams.Core -import Diagrams.Coordinates-import Diagrams.Path-import Diagrams.Segment-import Diagrams.TwoD.Arc-import Diagrams.TwoD.Polygons-import Diagrams.TwoD.Transform-import Diagrams.TwoD.Types+import           Diagrams.Coordinates+import           Diagrams.Located        (at)+import           Diagrams.Path+import           Diagrams.Segment+import           Diagrams.Trail+import           Diagrams.TrailLike+import           Diagrams.TwoD.Arc+import           Diagrams.TwoD.Polygons+import           Diagrams.TwoD.Transform+import           Diagrams.TwoD.Types -import Diagrams.Util+import           Diagrams.Util -import Data.Default-import Data.Semigroup+import           Data.Default.Class+import           Data.Semigroup  -- | Create a centered horizontal (L-R) line of the given length.-hrule :: (PathLike p, V p ~ R2) => Double -> p-hrule d = pathLike (p2 (-d/2,0)) False [Linear (d & 0)]+--+--   <<diagrams/hruleEx.svg#diagram=hruleEx&width=300>>+--+--   > 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))  -- | Create a centered vertical (T-B) line of the given length.-vrule :: (PathLike p, V p ~ R2) => Double -> p-vrule d = pathLike (p2 (0,d/2)) False [Linear (0 & (-d))]+--+--   <<diagrams/vruleEx.svg#diagram=vruleEx&height=100>>+--+--   > 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))  -- | A square with its center at the origin and sides of length 1, --   oriented parallel to the axes.-unitSquare :: (PathLike p, V p ~ R2) => p+--+--   <<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 } +-- > 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.-square :: (PathLike p, Transformable p, V p ~ R2) => Double -> p-square d = unitSquare # scale d+--+--   <<diagrams/squareEx.svg#diagram=squareEx&width=200>>+square :: (TrailLike t, Transformable t, V t ~ R2) => Double -> 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+ -- | @rect w h@ is an axis-aligned rectangle of width @w@ and height --   @h@, centered at the origin.-rect :: (PathLike p, Transformable p, V p ~ R2) => Double -> Double -> p-rect w h = unitSquare # scaleX w # scaleY h+--+--   <<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 +-- > rectEx = rect 1 0.7 # pad 1.1++    -- The above may seem a bit roundabout.  In fact, we used to have+    --+    --   rect w h = unitSquare # scaleX w # scaleY h+    --+    -- since unitSquare can produce any TrailLike.  The current code+    -- instead uses (unitSquare # scaleX w # scaleY h) to specifically+    -- produce a Path, which is then deconstructed and passed back into+    -- 'trailLike' to create any TrailLike.+    --+    -- The difference is that while scaling by zero works fine for+    -- Path it does not work very well for, say, Diagrams (leading to+    -- NaNs or worse).  This way, we force the scaling to happen on a+    -- Path, where we know it will behave properly, and then use the+    -- resulting geometry to construct an arbitrary TrailLike.+    --+    -- See https://github.com/diagrams/diagrams-lib/issues/43 .+ ------------------------------------------------------------ --  Regular polygons ------------------------------------------------------------@@ -93,57 +135,90 @@ --   polygons of a given /radius/). -- --   The polygon will be oriented with one edge parallel to the x-axis.-regPoly :: (PathLike p, V p ~ R2) => Int -> Double -> p+regPoly :: (TrailLike t, V t ~ R2) => Int -> Double -> t regPoly n l = polygon with { polyType =                                PolySides-                                 (repeat (1/ fromIntegral n :: CircleFrac))+                                 (repeat (1/ fromIntegral n :: Turn))                                  (replicate (n-1) l)                            , polyOrient = OrientH                            } --- | An equilateral triangle, with sides of the given length and base parallel---   to the x-axis.-eqTriangle :: (PathLike p, V p ~ R2) => Double -> p-eqTriangle = regPoly 3+-- > shapeEx sh   = sh 1 # pad 1.1+-- > triangleEx   = shapeEx triangle+-- > pentagonEx   = shapeEx pentagon+-- > hexagonEx    = shapeEx hexagon+-- > septagonEx   = shapeEx septagon+-- > octagonEx    = shapeEx octagon+-- > nonagonEx    = shapeEx nonagon+-- > decagonEx    = shapeEx decagon+-- > hendecagonEx = shapeEx hendecagon+-- > dodecagonEx  = shapeEx dodecagon +-- | A synonym for 'triangle', provided for backwards compatibility.+eqTriangle :: (TrailLike t, V t ~ R2) => Double -> 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+triangle = regPoly 3+ -- | A regular pentagon, with sides of the given length and base --   parallel to the x-axis.-pentagon :: (PathLike p, V p ~ R2) => Double -> p+--+--   <<diagrams/pentagonEx.svg#diagram=pentagonEx&width=100>>+pentagon :: (TrailLike t, V t ~ R2) => Double -> t pentagon = regPoly 5  -- | A regular hexagon, with sides of the given length and base --   parallel to the x-axis.-hexagon :: (PathLike p, V p ~ R2) => Double -> p+--+--   <<diagrams/hexagonEx.svg#diagram=hexagonEx&width=100>>+hexagon :: (TrailLike t, V t ~ R2) => Double -> t hexagon = regPoly 6  -- | A regular septagon, with sides of the given length and base --   parallel to the x-axis.-septagon :: (PathLike p, V p ~ R2) => Double -> p+--+--   <<diagrams/septagonEx.svg#diagram=septagonEx&width=100>>+septagon :: (TrailLike t, V t ~ R2) => Double -> t septagon = regPoly 7  -- | A regular octagon, with sides of the given length and base --   parallel to the x-axis.-octagon :: (PathLike p, V p ~ R2) => Double -> p+--+--   <<diagrams/octagonEx.svg#diagram=octagonEx&width=100>>+octagon :: (TrailLike t, V t ~ R2) => Double -> t octagon = regPoly 8  -- | A regular nonagon, with sides of the given length and base --   parallel to the x-axis.-nonagon :: (PathLike p, V p ~ R2) => Double -> p+--+--   <<diagrams/nonagonEx.svg#diagram=nonagonEx&width=100>>+nonagon :: (TrailLike t, V t ~ R2) => Double -> t nonagon = regPoly 9  -- | A regular decagon, with sides of the given length and base --   parallel to the x-axis.-decagon :: (PathLike p, V p ~ R2) => Double -> p+--+--   <<diagrams/decagonEx.svg#diagram=decagonEx&width=100>>+decagon :: (TrailLike t, V t ~ R2) => Double -> t decagon = regPoly 10  -- | A regular hendecagon, with sides of the given length and base --   parallel to the x-axis.-hendecagon :: (PathLike p, V p ~ R2) => Double -> p+--+--   <<diagrams/hendecagonEx.svg#diagram=hendecagonEx&width=100>>+hendecagon :: (TrailLike t, V t ~ R2) => Double -> t hendecagon = regPoly 11  -- | A regular dodecagon, with sides of the given length and base --   parallel to the x-axis.-dodecagon :: (PathLike p, V p ~ R2) => Double -> p+--+--   <<diagrams/dodecagonEx.svg#diagram=dodecagonEx&width=100>>+dodecagon :: (TrailLike t, V t ~ R2) => Double -> t dodecagon = regPoly 12  ------------------------------------------------------------@@ -159,8 +234,19 @@ --   the corners from overlapping.  The trail or path begins with the --   right edge and proceeds counterclockwise.  If you need to specify --   a different radius for each corner individually, use---   @roundedRect'@ instead.-roundedRect :: (PathLike p, V p ~ R2) => Double -> Double -> Double -> p+--   'roundedRect'' instead.+--+--   <<diagrams/roundedRectEx.svg#diagram=roundedRectEx&width=400>>+--+--   > 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 :: (TrailLike t, V t ~ R2) => Double -> Double -> Double -> t roundedRect w h r = roundedRect' w h (with { radiusTL = r,                                              radiusBR = r,                                              radiusTR = r,@@ -170,10 +256,12 @@ --   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' :: (PathLike p, V p ~ R2) => Double -> Double -> RoundedRectOpts -> p+roundedRect' :: (TrailLike t, V t ~ R2) => Double -> Double -> RoundedRectOpts -> t roundedRect' w h opts-   = pathLike (p2 (w/2, abs rBR - h/2)) True-   . trailSegments+   = trailLike+   . (`at` (p2 (w/2, abs rBR - h/2)))+   . wrapTrail+   . glueLine    $ seg (0, h - abs rTR - abs rBR)    <> mkCorner 0 rTR    <> seg (abs rTR + abs rTL - w, 0)@@ -182,7 +270,7 @@    <> mkCorner 2 rBL    <> seg (w - abs rBL - abs rBR, 0)    <> mkCorner 3 rBR-  where seg   = fromOffsets . (:[]) . r2+  where seg   = lineFromOffsets . (:[]) . r2         diag  = sqrt (w * w + h * h)         -- to clamp corner radius, need to compare with other corners that share an         -- edge. If the corners overlap then reduce the largest corner first, as far@@ -205,7 +293,7 @@         mkCorner k r | r == 0    = mempty                      | r < 0     = doArc 3 2                      | otherwise = doArc 0 1-                     where doArc d d' = arc' r ((k+d)/4) ((k+d')/4:: CircleFrac)+                     where doArc d d' = arc' r ((k+d)/4) ((k+d')/4:: Turn)  data RoundedRectOpts = RoundedRectOpts { radiusTL :: Double                                        , radiusTR :: Double

@@ -1,6 +1,5 @@-{-# LANGUAGE FlexibleContexts-           , TypeFamilies-  #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies     #-} ----------------------------------------------------------------------------- -- | -- Module      :  Diagrams.TwoD.Size@@ -28,12 +27,12 @@        , sized, sizedAs        ) where -import Diagrams.Core-import Diagrams.TwoD.Types-import Diagrams.TwoD.Vector+import           Diagrams.Core+import           Diagrams.TwoD.Types+import           Diagrams.TwoD.Vector -import Control.Arrow ((***), (&&&))-import Control.Applicative ((<$>), liftA2)+import           Control.Applicative  (liftA2, (<$>))+import           Control.Arrow        ((&&&), (***))  ------------------------------------------------------------ -- Computing diagram sizes@@ -92,6 +91,7 @@                 | Absolute            -- ^ Absolute size: use whatever                                       -- size an object already has;                                       -- do not rescale.+  deriving (Eq, Ord, Show)  -- | Create a size specification from a possibly-specified width and --   height.

@@ -58,6 +58,8 @@ instance Transformable Text where   transform t (Text tt a s) = Text (t <> tt) a s +instance IsPrim Text+ instance HasOrigin Text where   moveOriginTo p = translate (origin .-. p) @@ -68,12 +70,34 @@ data TextAlignment = BaselineText | BoxAlignedText Double Double  mkText :: Renderable Text b => TextAlignment -> String -> Diagram b R2-mkText a t = recommendFillColor black+mkText a t = recommendFillColor black   -- See Note [recommendFillColor]            $ mkQD (Prim (Text mempty a t))                        mempty                        mempty                        mempty                        mempty++-- ~~~~ Note [recommendFillColor]++-- The reason we "recommend" a fill color of black instead of setting+-- it directly (or instead of simply not specifying a fill color at+-- all) was originally to support the SVG backend, though it is+-- actually in some sense the "right thing" to do, and other backends+-- we add later may conceivably need it as well.  The cairo backend+-- defaults happen to be to use a transparent fill for paths and a+-- black fill for text.  The SVG standard, however, specifies a+-- default fill of black for everything (both text and paths).  In+-- order to correctly render paths with no fill set, the SVG backend+-- must therefore explicitly set the fill to transparent -- but this+-- meant that it was also drawing text with a transparent fill.  The+-- solution is that we now explicitly inform all backends that the+-- *default* ("recommended") fill color for text should be black; an+-- absence of fill specification now consistently means to use a+-- "transparent" fill no matter what the primitive.  The reason we+-- need the special recommend/commit distinction is because if the+-- user explicitly sets a fill color later it should override this+-- recommendation; normally, the innermost occurrence of an attribute+-- would override all outer occurrences.  -- | Create a primitive text diagram from the given string, with center --   alignment, equivalent to @'alignedText' 0.5 0.5@.

@@ -1,8 +1,8 @@-{-# LANGUAGE FlexibleContexts-           , FlexibleInstances-           , TypeFamilies-           , ViewPatterns-  #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies          #-}+{-# LANGUAGE ViewPatterns          #-} ----------------------------------------------------------------------------- -- | -- Module      :  Diagrams.TwoD.Transform@@ -46,25 +46,28 @@        , shearingY, shearY           -- * Scale invariance-       , ScaleInv(..), scaleInv+       , ScaleInv(..), scaleInv, scaleInvPrim +         -- * component-wise+       , onBasis        ) where -import Diagrams.Core+import           Diagrams.Core+import qualified Diagrams.Core.Transform as T -import Control.Newtype (over)+import           Control.Newtype         (over) -import Diagrams.Coordinates-import Diagrams.Transform-import Diagrams.TwoD.Size   (width, height)-import Diagrams.TwoD.Types-import Diagrams.TwoD.Vector (direction)+import           Diagrams.Coordinates+import           Diagrams.Transform+import           Diagrams.TwoD.Size      (height, width)+import           Diagrams.TwoD.Types+import           Diagrams.TwoD.Vector    (direction) -import Data.Semigroup+import           Data.Semigroup -import Data.AffineSpace+import           Data.AffineSpace -import Control.Arrow (first, second)+import           Control.Arrow           (first, second)  -- Rotation ------------------------------------------------ @@ -81,7 +84,7 @@ --   correspond to counterclockwise rotation, negative to --   clockwise. The angle can be expressed using any type which is an --   instance of 'Angle'.  For example, @rotate (1\/4 ::---   'CircleFrac')@, @rotate (tau\/4 :: 'Rad')@, and @rotate (90 ::+--   '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'.@@ -89,14 +92,14 @@ --   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 'CircleFrac' argument.+--   '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', specialized to only work with---   @CircleFrac@ arguments; it can be more convenient to write---   @rotateBy (1\/4)@ than @'rotate' (1\/4 :: 'CircleFrac')@.-rotateBy :: (Transformable t, V t ~ R2) => CircleFrac -> t -> t+--   @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  -- | @rotationAbout p@ is a rotation about the point @p@ (instead of@@ -248,9 +251,6 @@  -- Scale invariance ---------------------------------------- --- XXX what about freezing?  Doesn't interact with ScaleInv the way it--- ought.- -- | The @ScaleInv@ wrapper creates two-dimensional /scale-invariant/ --   objects.  Intuitively, a scale-invariant object is affected by --   transformations like translations and rotations, but not by scales.@@ -284,13 +284,14 @@  data ScaleInv t =   ScaleInv-  { unScaleInv :: t+  { unScaleInv  :: t   , scaleInvDir :: R2   , scaleInvLoc :: P2   }   deriving (Show) --- | Create a scale-invariant object pointing in the given direction.+-- | 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 @@ -304,7 +305,54 @@     where       angle :: Rad       angle = direction (transform tr v) - direction v-      rot :: ( Transformable t,  (V t ~ R2) ) => t -> t+      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

@@ -1,11 +1,11 @@-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeSynonymInstances #-}-{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE DeriveDataTypeable         #-}+{-# LANGUAGE FlexibleInstances          #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE ViewPatterns #-}-{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE MultiParamTypeClasses      #-}+{-# LANGUAGE TypeFamilies               #-}+{-# LANGUAGE TypeOperators              #-}+{-# LANGUAGE TypeSynonymInstances       #-}+{-# LANGUAGE ViewPatterns               #-}  {-# OPTIONS_GHC -fno-warn-orphans #-} -----------------------------------------------------------------------------@@ -27,21 +27,21 @@           -- * Angles        , Angle(..)-       , CircleFrac(..), Rad(..), Deg(..)+       , Turn(..), CircleFrac, Rad(..), Deg(..)        , fullCircle, convertAngle        ) where -import Diagrams.Coordinates-import Diagrams.Util (tau)-import Diagrams.Core+import           Diagrams.Coordinates+import           Diagrams.Core+import           Diagrams.Util           (tau) -import Control.Newtype+import           Control.Newtype -import Data.Basis-import Data.NumInstances ()-import Data.VectorSpace+import           Data.Basis+import           Data.NumInstances.Tuple ()+import           Data.VectorSpace -import Data.Typeable+import           Data.Typeable  ------------------------------------------------------------ -- 2D Euclidean space@@ -51,9 +51,14 @@ -- --   * To construct a vector, use 'r2', or '&' (from "Diagrams.Coordinates"): ----- > r2 (3,4) :: R2--- > 3 & 4    :: R2+-- @+-- 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'@. --@@ -64,8 +69,10 @@ --     or 'coords' (from "Diagrams.Coordinates").  These are typically --     used in conjunction with the @ViewPatterns@ extension: ----- > foo (unr2 -> (x,y)) = ...--- > foo (coords -> x :& y) = ...+-- @+-- foo (unr2 -> (x,y)) = ...+-- foo (coords -> x :& y) = ...+-- @  newtype R2 = R2 { unR2 :: (Double, Double) }   deriving (AdditiveGroup, Eq, Ord, Typeable, Num, Fractional)@@ -129,8 +136,10 @@ --   * To construct a point, use 'p2', or '&' (see --     "Diagrams.Coordinates"): ----- > p2 (3,4)  :: P2--- > 3 & 4     :: P2+-- @+-- p2 (3,4)  :: P2+-- 3 & 4     :: P2+-- @ -- --   * To construct a point from a vector @v@, use @'origin' 'Data.AffineSpace..+^' v@. --@@ -141,8 +150,10 @@ --     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) = ...+-- @+-- foo (unp2 -> (x,y)) = ...+-- foo (coords -> x :& y) = ...+-- @ type P2 = Point R2  -- | Construct a 2D point from a pair of coordinates.  See also '&'.@@ -163,10 +174,13 @@ -- Angles  -- | Newtype wrapper used to represent angles as fractions of a---   circle.  For example, 1\/3 = tau\/3 radians = 120 degrees.-newtype CircleFrac = CircleFrac { getCircleFrac :: Double }+--   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)@@ -177,30 +191,34 @@  -- | Type class for types that measure angles. class Num a => Angle a where-  -- | Convert to a fraction of a circle.-  toCircleFrac   :: a -> CircleFrac+  -- | Convert to a turn, /i.e./ a fraction of a circle.+  toTurn   :: a -> Turn -  -- | Convert from a fraction of a circle.-  fromCircleFrac :: CircleFrac -> a+  -- | Convert from a turn, /i.e./ a fraction of a circle.+  fromTurn :: Turn -> a -instance Angle CircleFrac where-  toCircleFrac   = id-  fromCircleFrac = id+instance Angle Turn where+  toTurn   = id+  fromTurn = id --- | tau radians = 1 full circle.+-- | tau radians = 1 full turn. instance Angle Rad where-  toCircleFrac   = CircleFrac . (/tau) . getRad-  fromCircleFrac = Rad . (*tau) . getCircleFrac+  toTurn   = Turn . (/tau) . getRad+  fromTurn = Rad . (*tau) . getTurn --- | 360 degrees = 1 full circle.+-- | 360 degrees = 1 full turn. instance Angle Deg where-  toCircleFrac   = CircleFrac . (/360) . getDeg-  fromCircleFrac = Deg . (*360) . getCircleFrac+  toTurn   = Turn . (/360) . getDeg+  fromTurn = Deg . (*360) . getTurn --- | An angle representing a full circle.+-- | An angle representing one full turn.+fullTurn :: Angle a => a+fullTurn = fromTurn 1++-- | Deprecated synonym for 'fullTurn', retained for backwards compatibility. fullCircle :: Angle a => a-fullCircle = fromCircleFrac 1+fullCircle = fullTurn  -- | Convert between two angle representations. convertAngle :: (Angle a, Angle b) => a -> b-convertAngle = fromCircleFrac . toCircleFrac+convertAngle = fromTurn . toTurn

@@ -1,7 +1,6 @@-{-# LANGUAGE FlexibleContexts-           , TypeFamilies-           , ViewPatterns-  #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies     #-}+{-# LANGUAGE ViewPatterns     #-} ----------------------------------------------------------------------------- -- | -- Module      :  Diagrams.TwoD.Vector@@ -18,10 +17,15 @@           -- * Converting between vectors and angles        , direction, fromDirection,  e++         -- * 2D vector utilities+       , perp, leftTurn        ) where -import Diagrams.Coordinates-import Diagrams.TwoD.Types+import           Data.VectorSpace     ((<.>))+import           Diagrams.Coordinates+import           Diagrams.TwoD.Types+import           Diagrams.Util        (( # ))  -- | The unit vector in the positive X direction. unitX :: R2@@ -53,3 +57,14 @@ -- | A convenient synonym for 'fromDirection'. e :: Angle a => a -> R2 e = fromDirection++-- | @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++-- | @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

@@ -26,8 +26,8 @@         ) where -import Data.Monoid-import Data.Default+import           Data.Default.Class+import           Data.Monoid  -- | Several functions exported by the diagrams library take a number --   of arguments giving the user control to \"tweak\" various aspects@@ -42,7 +42,9 @@ --   a synonym for 'def', which provides nice-looking syntax for --   simulating optional, named arguments in Haskell.  For example, -----   > polygon with {sides = 7, edgeSkip = 2}+--   @+--   polygon with {sides = 7, edgeSkip = 2}+--   @ -- --   calls the 'polygon' function with a single argument (note that --   record update binds more tightly than function application!),@@ -93,7 +95,9 @@ --   in the case of an empty list, perform a /balanced/ fold over a --   list.  For example, -----   > foldB (+) z [a,b,c,d,e,f] == ((a+b) + (c+d)) + (e+f)+--   @+--   foldB (+) z [a,b,c,d,e,f] == ((a+b) + (c+d)) + (e+f)+--   @ -- foldB :: (a -> a -> a) -> a -> [a] -> a foldB _ z [] = z