From fdd346a3631d1e0097a1007498938a7fd126283b Mon Sep 17 00:00:00 2001
From: Mike Zuser <mikezuser@gmail.com>
Date: Tue, 9 Apr 2019 21:42:47 -0400
Subject: [PATCH] Fix issue #78

Issue #78 "union does not produce expected result when used with
difference" occurs because difference is returning loops that wind the
opposite direction from what is expected. The solution is to enforce
that the outermost loops wind counterclockwise to be consistent with the
direction that the shape functions provided by diagrams-lib wind. A more
precise solution would be to match the winding of the outermost loops to
that of the input loops they are constructed from, but the intersection
functions in diagrams-lib do not currently support finding the
intersections between segments that overlap, which prevents us from
determining which input loops correspond to the outermost output loops.
---
 src/Diagrams/TwoD/Path/Boolean.hs | 39 +++++++++++++++++++++++++++----
 1 file changed, 34 insertions(+), 5 deletions(-)

diff --git a/src/Diagrams/TwoD/Path/Boolean.hs b/src/Diagrams/TwoD/Path/Boolean.hs
index b6ac016..8a11cf5 100644
--- a/src/Diagrams/TwoD/Path/Boolean.hs
+++ b/src/Diagrams/TwoD/Path/Boolean.hs
@@ -19,11 +19,14 @@ module Diagrams.TwoD.Path.Boolean
          loopUnion, loopDifference,
          loopIntersection, loopExclusion,)
        where
-import           Control.Lens       hiding (at)
+import           Control.Lens       hiding (at, contains)
 import           Data.Maybe
+import           Data.Tree
 import           Diagrams.Located
+import           Diagrams.Parametric
 import           Diagrams.Path
 import           Diagrams.Points
+import           Diagrams.Query
 import           Diagrams.Segment
 import           Diagrams.Trail
 import           Diagrams.TrailLike
@@ -215,7 +218,7 @@ exclusion' tol fill path1 path2 =
 loopUnion :: Double -> FillRule
           -> [Located (Trail' Loop V2 Double)]
           -> [Located (Trail' Loop V2 Double)]
-loopUnion tol fill p  =
+loopUnion tol fill p  = normalizeWindings fill $
   map path2loop $ C.union (map loop2path p) (fillrule fill) tol
 
 -- | Difference between loops.  The loops in both lists are first merged using `union`.
@@ -223,7 +226,7 @@ loopDifference :: Double -> FillRule
                -> [Located (Trail' Loop V2 Double)]
                -> [Located (Trail' Loop V2 Double)]
                -> [Located (Trail' Loop V2 Double)]
-loopDifference tol fill path1 path2  =
+loopDifference tol fill path1 path2  = normalizeWindings fill $
   map path2loop $ C.difference (map loop2path path1)
   (map loop2path path2) (fillrule fill) tol
 
@@ -232,7 +235,7 @@ loopIntersection :: Double -> FillRule
                  -> [Located (Trail' Loop V2 Double)]
                  -> [Located (Trail' Loop V2 Double)]
                  -> [Located (Trail' Loop V2 Double)]
-loopIntersection tol fill path1 path2 =
+loopIntersection tol fill path1 path2 = normalizeWindings fill $
   map path2loop $ C.intersection (map loop2path path1)
   (map loop2path path2) (fillrule fill) tol
 
@@ -241,6 +244,32 @@ loopExclusion :: Double -> FillRule
               -> [Located (Trail' Loop V2 Double)]
               -> [Located (Trail' Loop V2 Double)]
               -> [Located (Trail' Loop V2 Double)]
-loopExclusion tol fill path1 path2 =
+loopExclusion tol fill path1 path2 = normalizeWindings fill $
   map path2loop $ C.exclusion (map loop2path path1)
   (map loop2path path2) (fillrule fill) tol
+
+-- Force all top level loops to wind counterclockwise and revese inner loops as needed.
+normalizeWindings :: FillRule -> [Located (Trail' Loop V2 Double)] -> [Located (Trail' Loop V2 Double)]
+normalizeWindings fill = concat . map forceCC . nestedGroups fill where
+  forceCC ls | (l:_) <- ls, isClockwise l = map reverseLocLoop ls
+             | otherwise                  = ls
+
+-- Group a list of loops such that the first element of each group contains all the others.
+nestedGroups :: FillRule -> [Located (Trail' Loop V2 Double)] -> [[Located (Trail' Loop V2 Double)]]
+nestedGroups fill = map flatten . go [] where
+  go ts               []                      = ts
+  go []               (l:ls)                  = go [Node l []]                      ls
+  go ((Node n ns):ts) (l:ls) | l `contains` n = go [Node l [Node n ns]]             ls
+                             | n `contains` l = go (Node n (go ns [l]) : ts)        ls
+                             | otherwise      = go (Node n ns          : go ts [l]) ls
+  contains = containsBy fill
+
+-- To test if s contains t, we can merely test if any point of t is within s
+-- because the binary operations guarantee that the loops do not intersect.
+containsBy :: FillRule -> Located (Trail' Loop V2 Double) -> Located (Trail' Loop V2 Double) -> Bool
+containsBy Winding s t = isInsideWinding s (atStart t)
+containsBy EvenOdd s t = isInsideEvenOdd s (atStart t)
+
+-- Test if a loop winds clockwise.
+isClockwise :: Located (Trail' Loop V2 Double) -> Bool
+isClockwise l = sample l (atStart l) < 0