primitive.lisp

   1
   2 (in-package :tuple-trace)
   3
   4 (defclass primitive ()
   5   ((name :accessor name-of :initarg :name)
   6    (material :accessor  material-of :initform (make-instance 'material))))
   7
   8 (defclass sphere (primitive)
   9   ((centre :initform (new-vertex3d) :initarg :centre :accessor centre-of)
  10    (radius :initform 1.0 :initarg :radius :accessor radius-of)))
  11
  12 (defclass plane (primitive)
  13   ((normal :initform (new-vector3d) :initarg :normal :accessor normal-of)
  14    (displacement :initform 0.0 :initarg :displacement :accessor displacement-of)))
  15
  16 (defclass light (sphere)
  17   ()
  18   (:documentation "Spherical light primitive"))
  19
  20 (defgeneric intersect (primitive ray)
  21   (:documentation
  22    "Test primitive for intersection with ray and return array of
  23   intersection distances or NIL if no intersection."))
  24
  25 (defgeneric normal (primitive point)
  26   (:documentation
  27    "Given a point on the surface of a primtive, return the normal"))
  28
  29 (defun make-sphere (x y z r)
  30   (let ((result (make-instance
  31                  'sphere :centre (make-vertex3d* x y z 1.0)
  32                  :radius r)))
  33     result))
  34
  35 (defmethod intersect (primitive ray)
  36   nil)
  37
  38 ;; ;; sphere --
  39 (def-tuple-op vector-square
  40     ((v vector3d (x y z)))
  41   (:return single-float
  42            (+ (* x x) (* y y) (* z z))))
  43
  44
  45 (def-tuple-op sphere-intersect
  46      ((centre vertex3d (cx cy cz cw))
  47       (radius single-float)
  48       (ray-origin vector3d (xro yro zro))
  49       (ray-direction vector3d (xr yr zr)))
  50   "Compute the intersection of a sphere and a ray."
  51   (:return (or  single-float null)
  52            ;; we could speed this up by assuming a == 1 & direction is unit
  53            ;; (format t "Ray-direction ~A ~A ~A " xr yr zr)
  54            ;; (format t "origin -> centre ~A  " (multiple-value-list (vector3d-difference ray-origin centre)))
  55            (let* ((a (vector3d-dot ray-direction ray-direction))
  56                   (b (* 2.0 (vector3d-dot  ray-direction  (vector3d-difference ray-origin centre))))
  57                   (c (- (vector3d-dot (vector3d-difference ray-origin centre) (vector3d-difference ray-origin centre)) (* radius radius)))
  58                   (d (- (* b b) (* 4.0 a c))))
  59              ;;  (format t "A ~A  B ~A C ~A D ~A ~%" a b c d)
  60              (when (> d 0)
  61                (/ (- (- b) (sqrt d)) (* 2.0 a))))))
  62
  63 (defmethod intersect ((sphere sphere) (ray  ray))
  64    (sphere-intersect
  65     (vertex3d (centre-of sphere))
  66     (radius-of sphere)
  67     (vector3d (origin-of ray))
  68     (vector3d (direction-of ray))))
  69
  70 ;; (def-tuple-op sphere-normal
  71 ;;     ((centre vertex3d (cx cy cz cw))
  72 ;;      (point vertex3d (px py pz pw)))
  73 ;;   (vector3d-normal (vector3d-tuple  ( - cx px) (- cy py) (- cz pz))))
  74
  75 ;; (defmethod normal ((sphere sphere) point)
  76 ;;   (sphere-normal (vertex3d (centre-of sphere))
  77 ;;                  (vertex3d point)))
  78
  79 ;; (defmethod intersect ((plane plane) point distance))
  80
  81 ;; (defmethod normal ((plane plane) point))