bresenham.lisp

   1 (defpackage :bresenham
   2   (:use :cl :vol :vector)
   3   (:export #:scan-convert-line3))
   4
   5 (in-package :bresenham)
   6
   7 (declaim (ftype (function (fixnum fixnum fixnum
   8                            fixnum fixnum fixnum
   9                            (simple-array (unsigned-byte 8) 3))
  10                           (values (simple-array (unsigned-byte 8) 3) &optional))
  11                 scan-convert-line3x scan-convert-line3y scan-convert-line3z))
  12 ;; 1986 kaufman
  13 (defun scan-convert-line3x (x1 y1 z1 x2 y2 z2 vol)
  14   ;; x2 - x1 has to be the biggest difference between endpoint
  15   ;; coordinates
  16   (let* ((x x1)
  17          (delx (- x2 x1))
  18          ;; initialization for y
  19          (y y1)
  20          (ddy (- y2 y1))
  21          (dely (abs ddy))
  22          (ysign (signum ddy))
  23          (dy (- (* 2 dely) delx)) ;; decision variable along y
  24          (yinc1 (* 2 dely)) ;; increment along y for dy<0
  25          (yinc2 (* 2 (- dely delx))) ;; inc along y for dy>=0
  26          ;; same initialization for z
  27          (z z1)
  28          (ddz (- z2 z1))
  29          (delz (abs ddz))
  30          (zsign (signum ddz))
  31          (dz (- (* 2 delz) delx))
  32          (zinc1 (* 2 delz))
  33          (zinc2 (* 2 (- delz delx))))
  34     (when (<= delx 0)
  35         (error "x2 is <= x1."))
  36     (setf (aref vol z y x) 255)
  37     (loop while (< x x2) do
  38          (incf x) ;; step in x
  39          (if (< dy 0) ;; then no change in y
  40              (incf dy yinc1) ;; update dy
  41              (progn
  42                (incf dy yinc2) ;; update dy, and
  43                (incf y ysign)));; increment/decrement y
  44
  45          (if (< dz 0)
  46              (incf dz zinc1)
  47              (progn
  48                (incf dz zinc2)
  49                (incf z zsign)))
  50          (setf (aref vol z y x) 255)))
  51   vol)
  52 ;; start from scan-convert-line3x and replace x->$, y->x, $->y
  53 (defun scan-convert-line3y (x1 y1 z1 x2 y2 z2 vol)
  54   (let* ((y y1)
  55          (dely (- y2 y1))
  56          (x x1)
  57          (ddx (- x2 x1))
  58          (delx (abs ddx))
  59          (xsign (signum ddx))
  60          (dx (- (* 2 delx) dely))
  61          (xinc1 (* 2 delx))
  62          (xinc2 (* 2 (- delx dely)))
  63          (z z1)
  64          (ddz (- z2 z1))
  65          (delz (abs ddz))
  66          (zsign (signum ddz))
  67          (dz (- (* 2 delz) dely))
  68          (zinc1 (* 2 delz))
  69          (zinc2 (* 2 (- delz dely))))
  70     (when (<= dely 0)
  71         (error "y2 is <= y1."))
  72     (setf (aref vol z y x) 255)
  73     (loop while (< y y2) do
  74          (incf y)
  75          (if (< dx 0)
  76              (incf dx xinc1)
  77              (progn
  78                (incf dx xinc2)
  79                (incf x xsign)))
  80          (if (< dz 0)
  81              (incf dz zinc1)
  82              (progn
  83                (incf dz zinc2)
  84                (incf z zsign)))
  85          (setf (aref vol z y x) 255)))
  86   vol)
  87 ;; replace x->$, z->x, $->z
  88 (defun scan-convert-line3z (x1 y1 z1 x2 y2 z2 vol)
  89   (let* ((z z1)
  90          (delz (- z2 z1))
  91          (y y1)
  92          (ddy (- y2 y1))
  93          (dely (abs ddy))
  94          (ysign (signum ddy))
  95          (dy (- (* 2 dely) delz))
  96          (yinc1 (* 2 dely))
  97          (yinc2 (* 2 (- dely delz)))
  98          (x x1)
  99          (ddx (- x2 x1))
 100          (delx (abs ddx))
 101          (xsign (signum ddx))
 102          (dx (- (* 2 delx) delz))
 103          (xinc1 (* 2 delx))
 104          (xinc2 (* 2 (- delx delz))))
 105     (when (<= delz 0)
 106         (error "z2 is <= z1."))
 107     (setf (aref vol z y x) 255)
 108     (loop while (< z z2) do
 109          (incf z)
 110          (if (< dy 0)
 111              (incf dy yinc1)
 112              (progn
 113                (incf dy yinc2)
 114                (incf y ysign)))
 115
 116          (if (< dx 0)
 117              (incf dx xinc1)
 118              (progn
 119                (incf dx xinc2)
 120                (incf x xsign)))
 121          (setf (aref vol z y x) 255)))
 122   vol)
 123
 124 (declaim (ftype (function (vec-i vec-i (simple-array (unsigned-byte 8) 3))
 125                           (values (simple-array (unsigned-byte 8) 3) &optional))
 126                 scan-convert-line3))
 127 (defun scan-convert-line3 (start end vol)
 128   (let* ((diff (v--i end start))
 129          (ls (list (list (vec-i-x diff) 2)
 130                    (list (vec-i-y diff) 1)
 131                    (list (vec-i-z diff) 0)))
 132          (diffa (mapcar #'(lambda (e) (list (abs (first e))
 133                                        (second e))) ls))
 134          ;; find the direction with the biggest difference
 135          (sorted-diff-a (sort diffa #'> :key #'car))
 136          (main-direction (second (first sorted-diff-a))) ;; 2 corresponds to x, 1->y, 0->z
 137          ;; find the order in which to deliver the points
 138          (main-diff (aref diff main-direction))
 139          ;; we have to swap the points when main-diff is negative
 140          (swap-points? (< main-diff 0))
 141          ;; create the function name to dispatch to
 142          (function (intern (format nil "SCAN-CONVERT-LINE3~a" (ecase main-direction
 143                                                                 (2 'X)
 144                                                                 (1 'Y)
 145                                                                 (0 'Z))))))
 146     (when (eq 0 main-diff)
 147       (error "start and end point are the same."))
 148     (if swap-points?
 149         (funcall function
 150                  (vec-i-x end)
 151                  (vec-i-y end)
 152                  (vec-i-z end)
 153                  (vec-i-x start)
 154                  (vec-i-y start)
 155                  (vec-i-z start)
 156                  vol)
 157         (funcall function
 158                  (vec-i-x start)
 159                  (vec-i-y start)
 160                  (vec-i-z start)
 161                  (vec-i-x end)
 162                  (vec-i-y end)
 163                  (vec-i-z end)
 164                  vol))))
 165
 166
 167 #+nil
 168 (time
 169  (let ((vol (make-array (list 128 128 128) :element-type '(unsigned-byte 8))))
 170    (save-stack-ub8 "/home/martin/tmp/line"
 171                    (scan-convert-line3 (make-vec-i :x 0 :y 0 :z 0)
 172                                        (make-vec-i :x 120 :y 127 :z 127)
 173                                        vol))))