3D Bresenham lines

bresenham-3d.lisp

;; Make multiple-value-bind a little more convenient.

(defmacro mv-let* ((&rest bdgs) &body body)
  (if (null bdgs)
    `(progn ,@body)
    `(multiple-value-bind ,(butlast (car bdgs))
                          ,@(last (car bdgs))
       (mv-let* ,(cdr bdgs)
         ,@body))))


;; Given 3D points A and B, uses Bresenham's algorithm to compute points
;; on the line segment between A and B.  All points have integral
;; coordinates.
;;
;; Calls FN with the X, Y and Z coordinates of each point (including the
;; endpoints).  If FN returns NIL, the algorithm terminates early.

(defun 3d-bresenham (a b fn)
  (let ((x1 (aref a 0))
        (y1 (aref a 1))
        (z1 (aref a 2))
        (x2 (aref b 0))
        (y2 (aref b 1))
        (z2 (aref b 2)))
    (let ((delta-x (- x2 x1))
          (delta-y (- y2 y1))
          (delta-z (- z2 z1)))
      (mv-let* ((dx x-change (calc-delta-change delta-x))
                (dy y-change (calc-delta-change delta-y))
                (dz z-change (calc-delta-change delta-z)))
        (cond ((and (>= dy dx) (>= dy dz))
               ;; Y independent, X and Z dependent
               (bresenham-aux y1 y-change dy
                              x1 x-change dx
                              z1 z-change dz
                              #'(lambda (y x z)
                                  (funcall fn x y z))))
              ((and (>= dx dy) (>= dx dz))
               ;; X independent, Y and Z dependent
               (bresenham-aux x1 x-change dx
                              y1 y-change dy
                              z1 z-change dz
                              #'(lambda (x y z)
                                  (funcall fn x y z))))
              (T
               ;; Z independent, X and Y dependent
               (bresenham-aux z1 z-change dz
                              x1 x-change dx
                              y1 y-change dy
                              #'(lambda (z x y)
                                  (funcall fn x y z)))))))))
          

(defun bresenham-aux (ind chg-ind delta-ind
                        dep-1 chg-dep-1 delta-dep-1
                        dep-2 chg-dep-2 delta-dep-2
                        fn)
  (let ((length (+ delta-ind 1))
        (cur-ind ind)
        (cur-dep-1 dep-1)
        (cur-dep-2 dep-2)
        (dep-1-error 0)
        (dep-2-error 0))
    (dotimes (i length)
      (when (null (funcall fn cur-ind cur-dep-1 cur-dep-2))
        (return-from bresenham-aux (values)))
      (incf cur-ind chg-ind)
      (if (< (* 2 (+ dep-1-error delta-dep-1)) delta-ind)
        (incf dep-1-error delta-dep-1)
        (progn (incf cur-dep-1 chg-dep-1)
               (incf dep-1-error (- delta-dep-1 delta-ind))))
      (if (< (* 2 (+ dep-2-error delta-dep-2)) delta-ind)
        (incf dep-2-error delta-dep-2)
        (progn (incf cur-dep-2 chg-dep-2)
               (incf dep-2-error (- delta-dep-2 delta-ind))))))
  (values))




(defun calc-delta-change (delta)
  (if (< delta 0)
    (values (- delta) -1)
    (values delta 1)))