Fix closest-point function

lem-project · Jul 17, 2023 · 356498f · 356498f
1 parent 7022777
commit 356498f
Showing 1 changed file with 30 additions and 21 deletions.
diff --git a/src/base/point.lisp b/src/base/point.lisp
@@ -197,27 +197,36 @@ When using `:left-inserting` or `:right-inserting`, you must explicitly delete t
   "Return the closest point on the POINT-LIST compare to POINT.
 DIRECTION can be :up or :down depending on the desired point.
 SAME-LINE if T the point in POINT-LIST can be in the same line as POINT."
-  (loop :for p :in point-list
-        :for flag := t :then nil
-        :with closest := nil
-        :do (progn
-              (when flag (setf closest p))
-
-              (when (or (and (eq direction :up)
-                             (and (point> point p closest)
-                                  (or same-line
-                                      (not (same-line-p p point)))))
-                        (and (eq direction :down)
-                             (point< closest point p)
-                             (or same-line
-                                 (not (same-line-p p point)))))
-
-                (setf closest p)))
-        :finally (return (and (or (and (eq direction :up)
-                                       (point> point closest))
-                                  (and (eq direction :down)
-                                       (point< point closest)))
-                              closest ))))
+  (labels ((up (p closest)
+             (or (and (point>= point p closest)
+                      (or same-line
+                          (not (same-line-p p point))))
+                 (point>= closest point)))
+           (down (p closest)
+             (or (and
+                  (point> p point)
+                  (<=  (- (point-linum p) (point-linum point))
+                       (- (point-linum closest) (point-linum point)))
+                  (or same-line (not (same-line-p p point))))
+
+                 (point<= closest point))))
+    (loop :for p :in point-list
+          :for flag := t :then nil
+          :with closest := nil
+          :do (progn
+                (when flag (setf closest p))
+                (when (and
+                       (not flag)
+                       (or (and (eq direction :up)
+                                (up p closest))
+                           (and (eq direction :down)
+                                (down p closest))))
+                  (setf closest p)))
+          :finally (return (and (or (and (eq direction :up)
+                                         (point> point closest))
+                                    (and (eq direction :down)
+                                         (point< point closest)))
+                                closest)))))
 
 (defun point-min (point &rest more-points)
   (assert (%always-same-buffer point more-points))