diagrams-contrib 1.4.3 → 1.4.4

raw patch · 8 files changed

+303/−9 lines, 8 filesdep ~MonadRandomdep ~QuickCheckdep ~basebinary-addedPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: MonadRandom, QuickCheck, base, diagrams-core, hashable, lens, linear, monoid-extras, random, semigroups, text

API changes (from Hackage documentation)

Files

• CHANGES.markdown +6/−0
• CONTRIBUTORS +1/−0
• diagrams-contrib.cabal +10/−9
• diagrams/src_Diagrams_TwoD_Path_IntersectionExtras_cutByEx.svg binary
• diagrams/src_Diagrams_TwoD_Path_IntersectionExtras_explodeBothEx.svg binary
• diagrams/src_Diagrams_TwoD_Path_IntersectionExtras_explodeIntersectionsEx.svg binary
• diagrams/src_Diagrams_TwoD_Path_IntersectionExtras_explodeSegmentsEx.svg binary
• src/Diagrams/TwoD/Path/IntersectionExtras.hs +286/−0

@@ -1,3 +1,9 @@+1.4.4 (12 Nov 2019)+-------------------++- Updated to build on GHC 8.8+- New module `Diagrams.TwoD.Path.IntersectionExtras`+ 1.4.3 (14 May 2018) ------------------- 

@@ -9,3 +9,4 @@ Dominic Steinitz <dominic@steinitz.org> Ryan Yates <ryates@cs.rochester.edu> Brent Yorgey <byorgey@gmail.com>+Mike Zuser <mikezuser@gmail.com>

@@ -1,5 +1,5 @@ name:                diagrams-contrib-version:             1.4.3+version:             1.4.4 synopsis:            Collection of user contributions to diagrams EDSL description:         A collection of user contributions for diagrams,                      an embedded domain-specific language for generation@@ -15,7 +15,7 @@ cabal-version:       1.18 extra-source-files:  README.markdown, CHANGES.markdown, diagrams/*.svg, CONTRIBUTORS extra-doc-files:     diagrams/*.svg-tested-with:         GHC == 7.10.3, GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.2+tested-with:         GHC ==7.10.3 || ==8.0.2 || ==8.2.2 || ==8.4.3 || ==8.6.5 || ==8.8.1 Source-repository head   type:     git   location: http://github.com/diagrams/diagrams-contrib.git@@ -40,6 +40,7 @@                        Diagrams.TwoD.Path.Boolean,                        Diagrams.TwoD.Path.Calligraphic,                        Diagrams.TwoD.Path.Follow,+                       Diagrams.TwoD.Path.IntersectionExtras                        Diagrams.TwoD.Path.IteratedSubset,                        Diagrams.TwoD.Path.LSystem,                        Diagrams.TwoD.Path.Turtle,@@ -50,10 +51,10 @@                        Diagrams.TwoD.Path.Metafont.Internal                        Diagrams.TwoD.Path.Metafont.Combinators                        Diagrams.TwoD.Path.Metafont.Parser-  build-depends:       base >= 4.2 && < 4.12,+  build-depends:       base >= 4.8 && < 4.14,                        mtl >= 2.0 && < 2.3,                        mtl-compat >= 0.2.1 && < 0.3,-                       containers > 0.4 && < 0.6,+                       containers > 0.4 && < 0.7,                        split >= 0.2.1 && < 0.3,                        colour >= 2.3.1 && < 2.4,                        split >= 0.2.1 && < 0.3,@@ -61,7 +62,7 @@                        diagrams-core >= 1.4 && < 1.5,                        diagrams-lib >= 1.4 && < 1.5,                        diagrams-solve >= 0.1 && < 0.2,-                       lens >= 4.0 && < 4.17,+                       lens >= 4.0 && < 4.19,                        linear >= 1.11.3 && < 1.21,                        force-layout >= 0.4 && < 0.5,                        data-default >= 0.5.2 && < 0.8,@@ -71,9 +72,9 @@                        parsec >= 3.1 && < 3.2,                        text >= 0.11 && < 1.3,                        data-default-class < 0.2,-                       semigroups >= 0.3.4 && < 0.19,+                       semigroups >= 0.3.4 && < 0.20,                        cubicbezier >= 0.6 && < 0.7,-                       hashable >= 0.1.2 && < 1.3,+                       hashable >= 0.1.2 && < 1.4,                        mfsolve >= 0.3 && < 0.4   hs-source-dirs:      src   default-language:    Haskell2010@@ -88,8 +89,8 @@                        Diagrams.TwoD.Path.Turtle.Internal    build-depends:       HUnit                      >= 1.2 && < 1.7,-                       QuickCheck                 >= 2.4 && < 2.12,-                       containers                 >= 0.3 && < 0.6,+                       QuickCheck                 >= 2.4 && < 2.14,+                       containers                 >= 0.3 && < 0.7,                        test-framework             >= 0.4 && < 0.9,                        test-framework-hunit       >= 0.2 && < 0.4,                        test-framework-quickcheck2 >= 0.2 && < 0.4,

binary file changed (absent → 2805 bytes)

binary file changed (absent → 3774 bytes)

binary file changed (absent → 3716 bytes)

binary file changed (absent → 3666 bytes)

@@ -0,0 +1,286 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Diagrams.TwoD.Path.IntersectionExtras+-- Copyright   :  (c) 2018 Mike Zuser+-- License     :  BSD-style (see LICENSE)+-- Maintainer  :  Mike Zuser <mikezuser@gmail.com>+--+-- Extra functions for working with the intersections of `Path`s. This+-- module was motivated by `explodeIntersections`. The rest of the module is+-- either functions that where needed to build it or functions to help+-- consume it.+-----------------------------------------------------------------------------+module Diagrams.TwoD.Path.IntersectionExtras+  ( -- * Intersection Parameters+    intersectParams, intersectParams'+  , intersectParamsP, intersectParamsP'+  , intersectParamsT, intersectParamsT'+  , intersectParamsTS, intersectParamsTS'+    -- * Cutting Paths and Trails+  , cutBy, cutBy'+  , cutPBy, cutPBy'+  , cutTBy, cutTBy'+    -- * Rad Explosions+  , explodeSegments+  , explodeIntersections, explodeIntersections'+  , explodeBoth, explodeBoth'+    -- * Consuming Cut Paths+  , OnSections(..)+  ) where+import Data.List++import Diagrams.Prelude+import Diagrams.TwoD.Segment++-- defEps uses the value from Diagrams.TwoD.Path+defEps :: Fractional n => n+defEps = 1e-8++-----------------------------------------------------------------------------+-- Intersection Parameters --------------------------------------------------+-----------------------------------------------------------------------------++-- | Find the intersect parameters for each component trail of two pathlike+--   objects when the objects are intersected, returning a seperate list for+--   each trail.+intersectParams :: (InSpace V2 n t, SameSpace t s, ToPath t, ToPath s, OrderedField n) =>+  t -> s -> ([[n]], [[n]])+intersectParams = intersectParams' defEps++-- | `intersectParams` using the given tolerance.+intersectParams' :: (InSpace V2 n t, SameSpace t s, ToPath t, ToPath s, OrderedField n) =>+  n -> t -> s -> ([[n]], [[n]])+intersectParams' eps as bs = intersectParamsP' eps (toPath as) (toPath bs)++-- | Find the intersect parameters for each component trail of two+--   paths when the paths are intersected, returning a seperate list for+--   each trail.+intersectParamsP :: OrderedField n => Path V2 n -> Path V2 n -> ([[n]], [[n]])+intersectParamsP = intersectParamsP' defEps++-- | `intersectParamsP` using the given tolerance.+intersectParamsP' :: OrderedField n => n -> Path V2 n -> Path V2 n -> ([[n]], [[n]])+intersectParamsP' eps as bs = (ps, qs)+  where+    is = map (flip map (pathTrails bs) . intersectParamsT' eps) (pathTrails as)+    ps = map (concat . map fst) is+    qs = map (concat . map snd) (transpose is)++-- | Find the intersect parameters between two located trails.+intersectParamsT :: OrderedField n =>+  Located (Trail V2 n) -> Located (Trail V2 n) -> ([n], [n])+intersectParamsT = intersectParamsT' defEps++-- | `intersectParamsT` using the given tolerance.+intersectParamsT' :: OrderedField n =>+  n -> Located (Trail V2 n) -> Located (Trail V2 n) -> ([n], [n])+intersectParamsT' eps as bs = (reparam ps, reparam qs)+  where+    (ps, qs) = intersectParamsTS' eps as bs+    reparam segs = concat $ zipWith f [(0::Int)..] segs+      where f segNo = map $ \p -> (fromIntegral segNo + p) / genericLength segs++-- | Find the intersect parameters for each component segment of two+--   located trails when the trails are intersected, returning a+--   list for each trail containing a list of intersections for+--   each segemnt of that trail.+intersectParamsTS :: OrderedField n =>+  Located (Trail V2 n) -> Located (Trail V2 n) -> ([[n]], [[n]])+intersectParamsTS = intersectParamsTS' defEps++-- | `intersectParamsTS` using the given tolerance.+intersectParamsTS' :: OrderedField n =>+  n -> Located (Trail V2 n) -> Located (Trail V2 n) -> ([[n]], [[n]])+intersectParamsTS' eps as bs = (ps, qs)+  where+    (as', bs') = (as, bs) & both %~ (zip [0..] . fixTrail)+    is = map (flip map bs' . isect) as'+    isect (i, a) (j, b)+      | a == b    = []+      | otherwise = filter (not . ends)+                  . map (\(p, q, _) -> (p, q))+                  $ segmentSegment eps a b+      where+        ends (p, q) = adjacent && min p q `near` 0 && max p q `near` 1+        adjacent = as == bs && (abs (i - j) == 1 || min i j == 0 && max i j == length as' - 1)+        near x n = abs (x - n) < eps+    ps = map (map fst . concat) is+    qs = map (map snd . concat) (transpose is)++-----------------------------------------------------------------------------+-- Cutting Paths and Trails -------------------------------------------------+-----------------------------------------------------------------------------++-- | Seperate a pathlike object into sections at every point it intersects+--   a second pathlike object, returning a list of sections for each component+--   trail.+--+--   <<diagrams/src_Diagrams_TwoD_Path_IntersectionExtras_cutByEx.svg#diagram=cutByEx&width=300>>+--+--   > cutByEx = onSections (squares `cutBy` line) colorLines+--   >        <> stroke line+--   >   where+--   >     squares, line :: Path V2 Double+--   >     squares = square 1+--   >            <> square 1 # rotate (1/8 @@ turn)+--   >     line  = hrule 2+--   >     colorLines = map (map lc)+--   >       [ [ red, orange]+--   >       , [blue, purple] ]+cutBy :: (OrderedField n, Real n, InSpace V2 n t, SameSpace t s, ToPath t, ToPath s) =>+  t -> s -> [[Located (Trail V2 n)]]+cutBy = cutBy' defEps++-- | `cutBy` using the given tolerance for calculating intersections.+cutBy' :: (OrderedField n, Real n, InSpace V2 n t, SameSpace t s, ToPath t, ToPath s) =>+  n -> t -> s -> [[Located (Trail V2 n)]]+cutBy' eps a b = cutPBy' eps (toPath a) (toPath b)++-- | Seperate a path into sections at every point it intersects a second path,+--   returning a list of sections for each component trail.+cutPBy :: (OrderedField n, Real n) => Path V2 n -> Path V2 n -> [[Located (Trail V2 n)]]+cutPBy = cutPBy' defEps++-- | `cutPBy` using the given tolerance for calculating intersections.+cutPBy' :: (OrderedField n, Real n) => n -> Path V2 n -> Path V2 n -> [[Located (Trail V2 n)]]+cutPBy' eps p1 p2 = map (flip (cutTBy' eps) p2) (pathTrails p1)++-- | Seperate a located trail into sections at every point it intersects a path.+cutTBy :: (OrderedField n, Real n) => Located (Trail V2 n) -> Path V2 n -> [Located (Trail V2 n)]+cutTBy = cutTBy' defEps++-- | `cutTBy` using the given tolerance for calculating intersections.+cutTBy' :: (OrderedField n, Real n) => n -> Located (Trail V2 n) -> Path V2 n -> [Located (Trail V2 n)]+cutTBy' eps t p+  | null isects                                 = [t]+  | null nearEnds && norm (start .-. end) < eps = gluedEnds+  | otherwise                                   = subsections+  where+    subsections = zipWith (section t) (0:isects) (isects++[1])+    isects = sortAndAvoidEmpty notNearEnds+    sortAndAvoidEmpty = map head . groupBy (\a b -> abs (a - b) < eps) . sort+    (notNearEnds, nearEnds) = partition (\p -> (eps < p) && (p < 1-eps)) rawIsects+    rawIsects = concatMap (fst . intersectParamsT' eps t) (pathTrails p)++    start = head subsections `atParam` 0+    end   = last subsections `atParam` 1+    gluedEnds = unfixTrail (fixTrail (last subsections) ++ fixTrail (head subsections))+              : init (tail subsections)++-----------------------------------------------------------------------------+-- Rad Explosions -----------------------------------------------------------+-----------------------------------------------------------------------------++-- | explodePath specialized to return located trails. This provides the compiler+--   the necessary type information to use it with `onSections` without providing+--   a type annotation.+--+--   <<diagrams/src_Diagrams_TwoD_Path_IntersectionExtras_explodeSegmentsEx.svg#diagram=explodeSegmentsEx&width=300>>+--+--   > explodeSegmentsEx = onSections (explodeSegments squares) colorLines+--   >   where+--   >     squares = square 1+--   >            <> square 1 # rotate (1/8 @@ turn)+--   >     colorLines = map (map lc)+--   >       [ [ red, yellow,   gold, orange]+--   >       , [blue, violet, purple, indigo] ]+explodeSegments :: (Metric v, OrderedField n) => Path v n -> [[Located (Trail v n)]]+explodeSegments = explodePath++-- | Turn a path a list of component trails, then cut those segments at all+--   their intersections.+--+--   <<diagrams/src_Diagrams_TwoD_Path_IntersectionExtras_explodeIntersectionsEx.svg#diagram=explodeIntersectionsEx&width=300>>+--+--   > explodeIntersectionsEx = onSections (explodeIntersections squares) colorLines+--   >   where+--   >     squares = square 1+--   >            <> square 1 # rotate (1/8 @@ turn)+--   >     colorLines = map (map lc)+--   >       [ [ gray,     red,     orange, yellow,     green,     blue,       indigo,     violet]+--   >       , [black, crimson, darkorange,   gold, darkgreen, darkblue, midnightblue, darkviolet] ]+explodeIntersections :: (OrderedField n, Real n)  => Path V2 n -> [[Located (Trail V2 n)]]+explodeIntersections = explodeIntersections' defEps++-- | `explodeIntersections` using the given tolerance for calculating intersections.+explodeIntersections' :: (OrderedField n, Real n) => n -> Path V2 n -> [[Located (Trail V2 n)]]+explodeIntersections' eps path = cutBy' eps path path++-- | Turn a path into a list of component segments for each component trail,+--   then cut those segments at all their intersections.+--+--   <<diagrams/src_Diagrams_TwoD_Path_IntersectionExtras_explodeBothEx.svg#diagram=explodeBothEx&width=300>>+--+--   > explodeBothEx = onSections (explodeBoth squares) colorLines+--   >   where+--   >     squares = square 1+--   >            <> square 1 # rotate (1/8 @@ turn)+--   >     colorLines = map (map (map lc))+--   >       [ cycle [ [ gray,     red,     orange], [yellow,     green,     blue] ]+--   >       , cycle [ [black, crimson, darkorange], [  gold, darkgreen, darkblue] ] ]+explodeBoth :: (OrderedField n, Real n) => Path V2 n -> [[[Located (Trail V2 n)]]]+explodeBoth = explodeBoth' defEps++-- | `explodeBoth` using the given tolerance for calculating intersections.+explodeBoth' :: (OrderedField n, Real n) => n -> Path V2 n -> [[[Located (Trail V2 n)]]]+explodeBoth' eps path = map (map (flip (cutTBy' eps) path)) $ explodePath path++-----------------------------------------------------------------------------+--  Consuming Cut Paths -----------------------------------------------------+-----------------------------------------------------------------------------+class OnSections ps fs b n | ps b -> fs n, fs -> b n where+  -- | Zipply apply an arbitrarily nested list of attributes to the same shape+  --   of lists of pathlike objects, monoidally combining the results.+  --+  --   See examples for `cutBy`, `explodeSegments`, `explodeIntersections`, and `explodeBoth`.+  onSections :: ps -> fs -> QDiagram b V2 n Any++-- Need to list out the instances rather than using overlaping instances+-- with ToPath in order to use the fundep (ps b -> fs).++instance (TypeableFloat n, OnSections ps fs b n) =>+  OnSections [ps] [fs] b n where+  onSections ps fs = mconcat $ zipWith onSections ps fs++instance (TypeableFloat n, Renderable (Path V2 n) b) =>+  OnSections (Path V2 n) (QDiagram b V2 n Any -> QDiagram b V2 n Any) b n where+  onSections ps fs = fs $ stroke ps++instance (TypeableFloat n, Renderable (Path V2 n) b) =>+  OnSections (Located (Trail V2 n)) (QDiagram b V2 n Any -> QDiagram b V2 n Any) b n where+  onSections ps fs = fs $ stroke ps++instance (TypeableFloat n, Renderable (Path V2 n) b) =>+  OnSections (Located (Trail' l V2 n)) (QDiagram b V2 n Any -> QDiagram b V2 n Any) b n where+  onSections ps fs = fs $ stroke ps++instance (TypeableFloat n, Renderable (Path V2 n) b) =>+  OnSections (Located [Segment Closed V2 n]) (QDiagram b V2 n Any -> QDiagram b V2 n Any) b n where+  onSections ps fs = fs $ stroke ps++instance (TypeableFloat n, Renderable (Path V2 n) b) =>+  OnSections (Located (Segment Closed V2 n)) (QDiagram b V2 n Any -> QDiagram b V2 n Any) b n where+  onSections ps fs = fs $ stroke ps++instance (TypeableFloat n, Renderable (Path V2 n) b) =>+  OnSections (Trail V2 n) (QDiagram b V2 n Any -> QDiagram b V2 n Any) b n where+  onSections ps fs = fs $ stroke ps++instance (TypeableFloat n, Renderable (Path V2 n) b) =>+  OnSections (Trail' l V2 n) (QDiagram b V2 n Any -> QDiagram b V2 n Any) b n where+  onSections ps fs = fs $ stroke ps++instance (TypeableFloat n, Renderable (Path V2 n) b) =>+  OnSections (FixedSegment V2 n) (QDiagram b V2 n Any -> QDiagram b V2 n Any) b n where+  onSections ps fs = fs $ stroke ps++instance (TypeableFloat n, Renderable (Path V2 n) b) =>+  OnSections (QDiagram b V2 n Any) (QDiagram b V2 n Any -> QDiagram b V2 n Any) b n where+  onSections ps fs = fs ps