basic-point.lisp

(in-package :2d-geometry)

;;;; This file implements basic functions operating on points. A point is any object with methods (x
;;;; object) (y object).

(defclass point ()
  ((x :reader x :initarg :x :initform 0)
   (y :reader y :initarg :y :initform 0))
  (:documentation "A point on a plane, with cartesian coordinates."))

(defmethod print-object ((object point) stream)
  (print-unreadable-object (object stream :type t)
    (format stream "~a,~a" (x object) (y object))))

(defun make-point (x y &optional (point-type 'point))
  "Create a new point like object."
  (make-instance point-type :x x :y y))

(defun point-equal-p (point1 point2)
  "Checks if two points are geometrically equal."
  (and (= (x point1)(x point2))
       (= (y point1)(y point2))))

(defun coords-to-points (&rest coord-list)
  "Coordinate list (x1 y1 x2 y2 ... xn yn) to point list"
  (assert (zerop (mod (length coord-list) 2)))
  (iterate (for (x y . nil) on coord-list by #'cddr)
           (collect (make-point x y))))

(defun left-p (a b c)
  "Is c to the left of the oriented line defined by a->b?"
  (> (area-triangle-vertices (x a)(y a)(x b)(y b) (x c)(y c)) 0))

(defun left-on-p (a b c)
  "Is c to the left or on the oriented line defined by a->b?"
  (>= (area-triangle-vertices (x a)(y a)(x b)(y b) (x c)(y c)) 0))

(defun colinear-p (a b c)
  "Is c on the line defined by a->b?"
  (zerop (area-triangle-vertices (x a)(y a)(x b)(y b) (x c)(y c))))

(defun between-p (a b c)
  "Is c colinear with a->b and lies between them?"
  (when (colinear-p a b c)
    (if (= (y a)(y b))
        (or (and (>= (x c)(x a))
                 (<= (x c)(x b)))
            (and (>= (x c)(x b))
                 (<= (x c)(x a))))
        (or (and (>= (y c)(y a))
                 (<= (y c)(y b)))
            (and (>= (y c)(y b))
                 (<= (y c)(y a)))))))

(defun xor (p q)
  "Exlusive or logical operation."
  (if (or (and p q)
          (and (not p)(not q)))
      nil
      t))

(defun intersect-proper-p (a b c d)
  "Do segments a->b and c->d intersect?"
  (unless (or (colinear-p a b c)
              (colinear-p a b d)
              (colinear-p c d a)
              (colinear-p c d b))
    (and (xor (left-p a b c)
              (left-p a b d))
         (xor (left-p c d a)
              (left-p c d b)))))

(defun intersect-p (a b c d)
  "Do segments a->b and c->d intersect?"
  (if (intersect-proper-p a b c d)
      t
      (or (between-p a b c)
          (between-p a b d)
          (between-p c d a)
          (between-p c d b))))

(defun point-sort-fun (point1 point2)
  "Order points by increasing x then y."
  (if (= (x point1)(x point2))
      (if (= (y point1)(y point2))
          (if (typep point1 'event-endpoint)
              (eql (direction point1) 'right))
          (< (y point1)(y point2)))
      (< (x point1)(x point2))))