raytrace.lisp

   1
   2
   3
   4
   5
   6
   7 (defmacro with-vector (vector-form names &body form)
   8   (destructuring-bind (x y z) names
   9         (assert (and (symbolp x) (symbolp y) (symbolp z)))
  10         `(multiple-value-bind (,x ,y ,z) ,vector-form  (progn ,@form))))
  11
  12 (defun vector-magnitude (v)
  13   (with-vector v (vx vy vz) (+ (* vx vx) (* vy vy) (* vz vz))))
  14
  15 (defun vector-normal (v)
  16   (with-vector v (vx vy vz)
  17           (let ((mag (/ (1.0 (vector-magnitude v)))))
  18                 (make-vector
  19                  :x (* (vector-x v) length)
  20                  :y (* (vector-y v) length)
  21                  :z (* (vector-z v) length)))))
  22
  23 (defun vector-dot (v0 v1)
  24   (with-vector v0 (v0x v0y v0z)
  25           (with-vector v1 (v1x v1y v1z)
  26                   (+ (* v0x v1x))
  27                          (* v0y v1y))
  28                          (* v0z v1z)))
  29
  30 (defun vector-cross (v0 v1)
  31   (with-vector v0 (v0x v0y v0z)
  32           (with-vector v1 (v1x v1y v1z)
  33                   (make-vector
  34                    :x (- (* v0y v1z)
  35                                  (* v0z v1y))
  36                    :y (- (* v0z v1x)
  37                                  (* v0x v1z))
  38                    :z  (- (* v0x v1y)
  39                                   (* v0y v1x))))))
  40
  41 (defmacro vector-binary-op (v0 v1 op)
  42   (with-vector v0 (v0x v0y v0z)
  43           (with-vector v1 (v1x v1y v1z)
  44                   (make-vector
  45                    :x (funcall ,op v0x v1x)
  46                    :y (funcall ,op v0y v1y)
  47                    :z (funcall ,op v0z v1z)))))
  48
  49 (defun vector-add (v0 v1)
  50   (vector-binary-op v0 v1 #'+))
  51
  52 (defun vector+ (v0 v1)
  53   (vector-binary-op v0 v1 #'+))
  54
  55 (defun vector-sub (v0 v1)
  56   (vector-binary-op v0 v1 #'-))
  57
  58 (defun vector-neg (v0)
  59   (make-vector
  60    :x (- (vector-x v0))
  61    :y (- (vector-y v0))
  62    :z (- (vector-z v0))))
  63
  64 (defmacro vector- (v0 &optional (v1 nil vector-sub-binary-p))
  65   (if (vector-sub-binary-p)
  66           `(vector-sub v0 v1)
  67           `(vector-neg v0)))
  68
  69 (defun vector* (v0 s op)
  70   (with-vector v0 (vx vy vz)
  71           (make-vector
  72            :x (* (vector-x v0) s)
  73            :y (* (vector-y v0) s)
  74            :z (* (vector-z v0) s))))
  75
  76
  77
  78
  79
  80
  81
  82
  83