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