From 97084499fdf5568abbebf42efda867f97a62d277 Mon Sep 17 00:00:00 2001
From: Zachary Beane <xach@xach.com>
Date: Fri, 11 Dec 2020 19:07:54 -0500
Subject: [PATCH] Add & export compass point functions of boxes

---
 vectometry/package.lisp    |  8 ++++++++
 vectometry/vectometry.lisp | 19 +++++++++++++++++++
 2 files changed, 27 insertions(+)

diff --git a/vectometry/package.lisp b/vectometry/package.lisp
index 7b8e1c7..2da459a 100644
--- a/vectometry/package.lisp
+++ b/vectometry/package.lisp
@@ -90,6 +90,14 @@
    #:bottom-left
    #:top-right
    #:bottom-right
+   #:northpoint
+   #:northeastpoint
+   #:eastpoint
+   #:southeastpoint
+   #:southpoint
+   #:southwestpoint
+   #:westpoint
+   #:northwestpoint
    #:with-box-canvas
    ;; re-exported geometry bits
    #:point
diff --git a/vectometry/vectometry.lisp b/vectometry/vectometry.lisp
index 2bb2772..4974e17 100644
--- a/vectometry/vectometry.lisp
+++ b/vectometry/vectometry.lisp
@@ -81,6 +81,25 @@
     (let ((box (bounding-box object)))
       (point (xmax box) (ymin box)))))
 
+(macrolet ((compass-point-method (name component1 &optional component2)
+             (if component2
+                 `(defgeneric ,name (object)
+                    (:method (object)
+                      (midpoint (,component1 object)
+                                (,component2 object))))
+                 `(defgeneric ,name (object)
+                    (:method (object)
+                      (,component1 object))))))
+  (compass-point-method northpoint top-left top-right)
+  (compass-point-method northeastpoint top-right)
+  (compass-point-method eastpoint top-right bottom-right)
+  (compass-point-method southeastpoint bottom-right)
+  (compass-point-method southpoint bottom-left bottom-right)
+  (compass-point-method southwestpoint bottom-left)
+  (compass-point-method westpoint bottom-left top-left)
+  (compass-point-method northwestpoint top-left))
+
+
 (defun set-gradient-fill (p1 c1 p2 c2
                           &key (extend-start t) (extend-end t)
                           (domain-function 'vecto:linear-domain))
-- 
2.11.4.GIT