From fe0608411e69d605381777fb8a0c00d93629d084 Mon Sep 17 00:00:00 2001
From: =?utf8?q?Fr=C3=A9d=C3=A9ric=20Jolliton?= <git@frederic.jolliton.com>
Date: Sun, 20 May 2007 22:56:42 +0200
Subject: [PATCH] Add auto-orientation support.

---
 paths-package.lisp |  1 +
 paths.lisp         | 49 +++++++++++++++++++++++++++++++++++++++++++++----
 2 files changed, 46 insertions(+), 4 deletions(-)

diff --git a/paths-package.lisp b/paths-package.lisp
index 237fdc1..b64ff3d 100644
--- a/paths-package.lisp
+++ b/paths-package.lisp
@@ -33,6 +33,7 @@
            #:path-replace
            #:path-size
            #:path-last-knot
+           #:path-orient
            #:path-clone
            #:path-reverse
            #:path-reversed
diff --git a/paths.lisp b/paths.lisp
index dd82496..b2dca0d 100644
--- a/paths.lisp
+++ b/paths.lisp
@@ -141,6 +141,7 @@ as 2 values. Return NIL if the input vector had a null length."
 
 (defstruct path
   (type :open-polyline :type (member :open-polyline :closed-polyline :polygon))
+  (orientation :unknown :type (member :unknown :cw :ccw))
   (knots (make-array 0 :adjustable t :fill-pointer 0))
   (interpolations (make-array 0 :adjustable t :fill-pointer 0)))
 
@@ -156,7 +157,8 @@ the following keyword:
 
 (defun path-clear (path)
   "Clear the path such that it is empty."
-  (setf (fill-pointer (path-knots path)) 0
+  (setf (path-orientation path) :unknown
+        (fill-pointer (path-knots path)) 0
         (fill-pointer (path-interpolations path)) 0))
 
 (defun path-reset (path knot)
@@ -168,7 +170,10 @@ the following keyword:
 (defun path-extend (path interpolation knot)
   "Extend the path to KNOT, with INTERPOLATION."
   (vector-push-extend interpolation (path-interpolations path))
-  (vector-push-extend knot (path-knots path)))
+  (vector-push-extend knot (path-knots path))
+  ;; Extending the path can change how the orientation is
+  ;; auto-detected.
+  (setf (path-orientation path) :unknown))
 
 (defun path-concatenate (path interpolation other-path)
   "Append OTHER-PATH to PATH, joined by INTERPOLATION."
@@ -197,6 +202,36 @@ empty."
     (when (plusp (length knots))
       (aref knots (1- (length knots))))))
 
+(defun path-guess-orientation (path)
+  "Guess the orientation of the path.
+
+This is implemented loosely because we don't take care about
+interpolations. We only consider a polygon described by the
+knots. However, it should work..
+
+Update path orientation flag, and returns either :CW or :CCW."
+  (let ((knots (path-knots path)))
+    (let ((loose-area (loop for last-knot-index = (1- (length knots)) then knot-index
+                         for knot-index below (length knots)
+                         sum (- (* (point-x (aref knots last-knot-index))
+                                   (point-y (aref knots knot-index)))
+                                (* (point-x (aref knots knot-index))
+                                   (point-y (aref knots last-knot-index)))))))
+      (setf (path-orientation path) (if (plusp loose-area) :ccw :cw)))))
+
+(defun path-orient (path orientation &optional other-paths)
+  "Orient the path in the given orientation.
+
+If OTHER-PATHS is specified, then the paths are reversed
+inconditionnaly if PATH is also reversed."
+  (assert (member orientation '(:cw :ccw)) (orientation) "Expected either :CW or :CCW")
+  (when (eq (path-orientation path) :unknown)
+    (path-guess-orientation path))
+  (unless (eq (path-orientation path) orientation)
+    (path-reverse path)
+    (map nil #'path-reverse other-paths))
+  (values))
+
 ;;; Iterators
 
 (defgeneric path-iterator-reset (iterator)
@@ -429,7 +464,8 @@ knot is the last on the path or if the path is empty."))
                 (interpolation-clone (aref new-interpolations i))))
     (let ((new-path (create-path (path-type path))))
       (setf (path-knots new-path) (copy-seq (path-knots path))
-            (path-interpolations new-path) new-interpolations)
+            (path-interpolations new-path) new-interpolations
+            (path-orientation new-path) (path-orientation path))
       new-path)))
 
 (defun path-reverse (path)
@@ -444,7 +480,12 @@ knot is the last on the path or if the path is empty."))
                  (aref interpolations (- length i))))
   ;; reverse each interpolation
   (loop for interpolation across (path-interpolations path)
-     do (interpolation-reverse interpolation)))
+     do (interpolation-reverse interpolation))
+  (unless (eq (path-orientation path) :unknown)
+    (setf (path-orientation path) (ecase (path-orientation path)
+                                    (:cw :ccw)
+                                    (:ccw :cw))))
+  path)
 
 (defun path-reversed (path)
   (let ((new-path (path-clone path)))
-- 
2.11.4.GIT