packages feed

diagrams-boolean (empty) → 0.1.0

raw patch · 8 files changed

+331/−0 lines, 8 filesdep +basedep +cubicbezierdep +diagrams-libsetup-changed

Dependencies added: base, cubicbezier, diagrams-lib

Files

+ Diagrams/TwoD/Boolean.hs view
@@ -0,0 +1,228 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-}++-- | Set operations on paths.  As a side effect it removes overlapping+-- regions.  Since `Path` is `TrailLike`, you can use these operations+-- directly on most diagrams combinators which generate `Loop`s, like+-- `circle` or `fromSegments`.  `Line`s are discarded, only `Loop`s+-- are used. If you have several paths, you can combine them first+-- with `<>`.  Use `toPath` if you want to convert a `Trail` or+-- `Located Trail` to a `Path`.  The `FillRule` argument determines+-- how /insideness/ is calculated.++module Diagrams.TwoD.Boolean+       (-- * operations on Paths+         union, difference, intersection, exclusion,+         -- * operations on Paths with tolerance+         union', difference', intersection', exclusion',+         -- * operations on Loops+         loopUnion, loopDifference,+         loopIntersection, loopExclusion,)+       where+import Diagrams.Prelude+import Data.Maybe+import qualified Geom2D.CubicBezier as C++fillrule :: FillRule -> C.FillRule+fillrule Winding = C.NonZero+fillrule EvenOdd = C.EvenOdd++loop2path :: Located (Trail' Loop V2 Double) -> C.ClosedPath Double+loop2path t =+  C.ClosedPath $ go x0 y0 (lineSegments $ cutLoop $ unLoc t)+  where+    (P (V2 x0 y0)) = loc t+    go :: Double -> Double -> [Segment Closed V2 Double] -> [(C.DPoint, C.PathJoin Double)]+    go _ _ [] = []+    go x y (Linear (OffsetClosed (V2 x3 y3)):r) =+      (C.Point x y, C.JoinLine) :+      go (x+x3) (y+y3) r+    go x y (Cubic (V2 x1 y1) (V2 x2 y2) (OffsetClosed (V2 x3 y3)):r) =+      (C.Point x y, C.JoinCurve (C.Point (x+x1) (y+y1)) (C.Point (x+x2) (y+y2))) :+      go (x+x3) (y+y3) r++path2loop :: C.ClosedPath Double -> Located (Trail' Loop V2 Double)+path2loop (C.ClosedPath []) = fromSegments [] `at` origin+path2loop (C.ClosedPath ((C.Point x0 y0, join):r)) =+  fromSegments (go x0 y0 join r) `at` P (V2 x0 y0)+  where go x y C.JoinLine [] =+          [straight (V2 (x0-x) (y0-y))]+        go x y C.JoinLine ((C.Point x2 y2, join'):r') =+          straight (V2 (x2-x) (y2-y)):+          go x2 y2 join' r'+        go x y (C.JoinCurve (C.Point x1 y1) (C.Point x2 y2)) r' =+          case r' of+           [] -> [bezier3 (V2 (x1-x) (y1-y))+                  (V2 (x2-x) (y2-y)) (V2 (x0-x) (y0-y))]+           ((C.Point x3 y3, join'):r'') ->+             bezier3 (V2 (x1-x) (y1-y)) (V2 (x2-x) (y2-y))+             (V2 (x3-x) (y3-y)) :+             go x3 y3 join' r''++trail2loop :: Located (Trail V2 Double) -> Maybe (Located (Trail' Loop V2 Double))+trail2loop = located (withTrail (const Nothing) Just)++offsetMax :: Offset c V2 Double -> Double+offsetMax (OffsetClosed (V2 m n)) = max (abs m) (abs n)+offsetMax OffsetOpen = 0++segmentMax :: Segment c V2 Double -> Double+segmentMax (Linear o) =+  offsetMax o+segmentMax (Cubic (V2 a b) (V2 c d) o) =+  maximum [offsetMax o, abs a, abs b,+           abs c, abs d]++loopMax :: Trail' Loop V2 Double -> Double+loopMax l = maximum (segmentMax lastSeg: map segmentMax segs)+  where (segs, lastSeg) = loopSegments l+  +defaultTol :: Double+defaultTol = 1e-7++loop2trail :: Located (Trail' Loop V2 Double) -> Located (Trail V2 Double)+loop2trail = over located wrapLoop++-- | Remove overlapping regions in the path.  If you have several+-- paths, combine them using `<>` first.+--+-- <<samples/union.svg>>+--+-- > example = strokePath $ union Winding $+-- >           (square 1) <> circle 0.5 # translate (V2 0.5 (-0.5))++union :: FillRule -> Path V2 Double -> Path V2 Double+union fill p =+  Path $ map loop2trail $ +  loopUnion tol fill loops+  where loops = mapMaybe trail2loop $+                pathTrails p+        tol = maximum (map (loopMax.unLoc) loops) *+              defaultTol++-- | Intersection of two paths.  First overlap is removed in the two+-- input arguments, then the intersection is calculated.+-- +-- <<samples/intersection.svg>>+--+-- > example = strokePath $+-- >          intersection Winding (square 1) $+-- >          circle 0.5 # translate (V2 0.5 (-0.5))+intersection :: FillRule -> Path V2 Double -> Path V2 Double -> Path V2 Double+intersection fill p1 p2 =+  Path $ map loop2trail $+  loopIntersection tol fill loops1 loops2+  where loops1 = mapMaybe trail2loop $+                pathTrails p1+        loops2 = mapMaybe trail2loop $+                pathTrails p2+        tol = max (maximum (map (loopMax.unLoc) loops1))+              (maximum (map (loopMax.unLoc) loops2))+              * defaultTol+-- | Difference of two paths.  First overlap is removed in the two+-- input arguments, then the difference is calculated.+--+-- <<samples/difference.svg>>+--+-- > example = strokePath $+-- >          difference Winding (square 1) $+-- >          circle 0.5 # translate (V2 0.5 (-0.5))+difference :: FillRule -> Path V2 Double -> Path V2 Double -> Path V2 Double+difference fill p1 p2 =+  Path $ map loop2trail $+  loopDifference tol fill loops1 loops2+  where loops1 = mapMaybe trail2loop $+                pathTrails p1+        loops2 = mapMaybe trail2loop $+                pathTrails p2+        tol = max (maximum (map (loopMax.unLoc) loops1))+              (maximum (map (loopMax.unLoc) loops2))+              * defaultTol++-- | Exclusion (exclusive or) of two paths.  First overlap is removed in the two+-- input arguments, then the exclusion is calculated.+--+-- <<samples/exclusion.svg>>+--+-- > example = fc grey $ strokePath $+-- >           exclusion Winding (square 1) $+-- >           circle 0.5 # translate (V2 0.5 (-0.5))+exclusion :: FillRule -> Path V2 Double -> Path V2 Double -> Path V2 Double+exclusion fill p1 p2 =+  Path $ map loop2trail $+  loopExclusion tol fill loops1 loops2+  where loops1 = mapMaybe trail2loop $+                pathTrails p1+        loops2 = mapMaybe trail2loop $+                pathTrails p2+        tol = max (maximum (map (loopMax.unLoc) loops1))+              (maximum (map (loopMax.unLoc) loops2))+              * defaultTol++-- | Like `union`, but takes a tolerance parameter.+union' :: Double -> FillRule -> Path V2 Double -> Path V2 Double+union' tol fill p =+  Path $ map loop2trail $ +  loopUnion tol fill $+  mapMaybe trail2loop $+  pathTrails p++-- | Like `intersection`, but takes a tolerance parameter.+intersection' :: Double -> FillRule -> Path V2 Double -> Path V2 Double -> Path V2 Double+intersection' tol fill p1 p2 =+  Path $ map loop2trail $+  loopIntersection tol fill+  (mapMaybe trail2loop $ pathTrails p1)+  (mapMaybe trail2loop $ pathTrails p2)+++-- | Like `difference`, but takes a tolerance parameter.+difference' :: Double -> FillRule -> Path V2 Double -> Path V2 Double -> Path V2 Double+difference' tol fill p1 p2 =+  Path $ map loop2trail $+  loopDifference tol fill+  (mapMaybe trail2loop $ pathTrails p1)+  (mapMaybe trail2loop $ pathTrails p2)++-- | Like `exclusion`, but takes a tolerance parameter.+exclusion' :: Double -> FillRule -> Path V2 Double -> Path V2 Double -> Path V2 Double+exclusion' tol fill p1 p2 =+  Path $ map loop2trail $+  loopExclusion tol fill+  (mapMaybe trail2loop $ pathTrails p1)+  (mapMaybe trail2loop $ pathTrails p2)++-- | Union of a list of loops.+loopUnion :: Double -> FillRule+          -> [Located (Trail' Loop V2 Double)]+          -> [Located (Trail' Loop V2 Double)]+loopUnion tol fill p  =+  map path2loop $ C.union (map loop2path p) (fillrule fill) tol++-- | Difference between loops.  The loops in both lists are first merged using `union`.+loopDifference :: Double -> FillRule+               -> [Located (Trail' Loop V2 Double)]+               -> [Located (Trail' Loop V2 Double)]+               -> [Located (Trail' Loop V2 Double)]+loopDifference tol fill p1 p2  =+  map path2loop $ C.difference (map loop2path p1)+  (map loop2path p2) (fillrule fill) tol++-- | Intersection of loops.  The loops in both lists are first merged using `union`.+loopIntersection :: Double -> FillRule+                 -> [Located (Trail' Loop V2 Double)]+                 -> [Located (Trail' Loop V2 Double)]+                 -> [Located (Trail' Loop V2 Double)]+loopIntersection tol fill p1 p2 =+  map path2loop $ C.intersection (map loop2path p1)+  (map loop2path p2) (fillrule fill) tol++-- | Exclusion (xor) of loops. The loops in both lists are first merged using `union`.+loopExclusion :: Double -> FillRule+              -> [Located (Trail' Loop V2 Double)]+              -> [Located (Trail' Loop V2 Double)]+              -> [Located (Trail' Loop V2 Double)]+loopExclusion tol fill p1 p2 =+  map path2loop $ C.exclusion (map loop2path p1)+  (map loop2path p2) (fillrule fill) tol+
+ LICENSE view
@@ -0,0 +1,28 @@+Copyright (c) 2015, Kristof Bastiaensen+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are+met:++    Redistributions of source code must retain the above copyright+    notice, this list of conditions and the following disclaimer.+    Redistributions in binary form must reproduce the above copyright+    notice, this list of conditions and the following disclaimer in+    the documentation and/or other materials provided with the+    distribution.  Neither the name of the organisation nor the+    names of its contributors may be used to endorse or promote+    products derived from this software without specific prior written+    permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ diagrams-boolean.cabal view
@@ -0,0 +1,25 @@+Name:		diagrams-boolean+Version: 	0.1.0+Synopsis:	boolean operations on Diagrams paths+Category: 	Graphics+Copyright: 	Kristof Bastiaensen (2015)+Stability:	Unstable+License:	BSD3+License-file:	LICENSE+Author:		Kristof Bastiaensen+Maintainer:	Kristof Bastiaensen+Bug-Reports: 	https://github.com/kuribas/diagrams-boolean/issues+Build-type:	Simple+Cabal-version:	>=1.8+Description:	set operations (union, intersection, difference and exclusion) on paths in Diagrams.+extra-doc-files: samples/union.svg, samples/difference.svg, samples/exclusion.svg, samples/intersection.svg+ +source-repository head+  type:		git+  location:	https://github.com/kuribas/diagrams-boolean++Library+  Ghc-options: -Wall+  Build-depends: base >= 3 && < 5, diagrams-lib >= 1.3, cubicbezier >= 0.4.0+  Exposed-Modules:+    Diagrams.TwoD.Boolean
+ samples/difference.svg view
@@ -0,0 +1,12 @@+<?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" height="150.0000" stroke-opacity="1" viewBox="0 0 150 150" font-size="1" width="150.0000" xmlns:xlink="http://www.w3.org/1999/xlink" stroke="rgb(0,0,0)" version="1.1">+  <defs>+  </defs>+  <defs>+  </defs>+  <g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.6" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0">+    <path d="M 0.0000,0.0000 c 50.0000,-0.0000 100.0000,-0.0000 150.0000 -0.0000c 0.0000,25.0000 0.0000,50.0000 0.0000 75.0000c -41.4214,-0.0000 -75.0000,33.5786 -75.0000 75.0000c -25.0000,-0.0000 -50.0000,-0.0000 -75.0000 -0.0000c 0.0000,-50.0000 0.0000,-100.0000 -0.0000 -150.0000Z"/>+  </g>+</svg>
+ samples/exclusion.svg view
@@ -0,0 +1,12 @@+<?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" height="150.0000" stroke-opacity="1" viewBox="0 0 150 150" font-size="1" width="150.0000" xmlns:xlink="http://www.w3.org/1999/xlink" stroke="rgb(0,0,0)" version="1.1">+  <defs>+  </defs>+  <defs>+  </defs>+  <g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.6" fill="rgb(128,128,128)" stroke-linecap="butt" stroke-miterlimit="10.0">+    <path d="M 0.0000,0.0000 c 33.3333,-0.0000 66.6667,-0.0000 100.0000 -0.0000c 0.0000,16.6667 0.0000,33.3333 0.0000 50.0000c 27.6142,-0.0000 50.0000,22.3858 50.0000 50.0000c 0.0000,27.6142 -22.3858,50.0000 -50.0000 50.0000c -27.6142,-0.0000 -50.0000,-22.3858 -50.0000 -50.0000c 16.6667,-0.0000 33.3333,-0.0000 50.0000 -0.0000c 0.0000,-16.6667 0.0000,-33.3333 0.0000 -50.0000c -27.6142,-0.0000 -50.0000,22.3858 -50.0000 50.0000c -16.6667,-0.0000 -33.3333,-0.0000 -50.0000 -0.0000c 0.0000,-33.3333 0.0000,-66.6667 -0.0000 -100.0000Z"/>+  </g>+</svg>
+ samples/intersection.svg view
@@ -0,0 +1,12 @@+<?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" height="150.0000" stroke-opacity="1" viewBox="0 0 150 150" font-size="1" width="150.0000" xmlns:xlink="http://www.w3.org/1999/xlink" stroke="rgb(0,0,0)" version="1.1">+  <defs>+  </defs>+  <defs>+  </defs>+  <g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.6" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0">+    <path d="M 0.0000,150.0000 c 0.0000,-82.8427 67.1573,-150.0000 150.0000 -150.0000c 0.0000,50.0000 0.0000,100.0000 0.0000 150.0000c -50.0000,-0.0000 -100.0000,-0.0000 -150.0000 -0.0000Z"/>+  </g>+</svg>
+ samples/union.svg view
@@ -0,0 +1,12 @@+<?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" height="150.0000" stroke-opacity="1" viewBox="0 0 150 150" font-size="1" width="150.0000" xmlns:xlink="http://www.w3.org/1999/xlink" stroke="rgb(0,0,0)" version="1.1">+  <defs>+  </defs>+  <defs>+  </defs>+  <g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.6" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0">+    <path d="M 0.0000,0.0000 c 33.3333,-0.0000 66.6667,-0.0000 100.0000 -0.0000c 0.0000,16.6667 0.0000,33.3333 0.0000 50.0000c 27.6142,-0.0000 50.0000,22.3858 50.0000 50.0000c 0.0000,27.6142 -22.3858,50.0000 -50.0000 50.0000c -27.6142,-0.0000 -50.0000,-22.3858 -50.0000 -50.0000c -16.6667,-0.0000 -33.3333,-0.0000 -50.0000 -0.0000c 0.0000,-33.3333 0.0000,-66.6667 -0.0000 -100.0000Z"/>+  </g>+</svg>