2 (in-package :tuple-trace
)
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
)))
10 (def-tuple-class sphere
12 ((centre :type vertex3d
))
14 ((radius :initform
1.0 :initarg
:radius
:type single-float
:accessor radius-of
))))
17 (def-tuple-op vector-square
18 ((v vector3d
(x y z
)))
20 (+ (* x x
) (* y y
) (* z z
))))
23 (def-tuple-op sphere-intersect
24 ((centre vertex3d
(cx cy cz cw
))
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)
39 (/ (- (- b
) (sqrt d
)) (* 2.0 a
))))))
42 (defun make-sphere (name x y z r
)
43 (let* ((sphere (make-instance 'sphere
44 :centre
(make-vertex3d* x y z
1.0)
46 (result (make-instance 'primitive
53 (def-tuple-op sphere-normal
54 ((centre vertex3d
(cx cy cz cw
))
55 (point vertex3d
(px py pz pw
)))
57 (vector3d-normal (vector3d* ( - cx px
) (- cy py
) (- cz pz
)))))
59 (def-tuple-class plane
61 ((normal :type vector3d
))
63 ((displacement :initform
0.0 :initarg
:displacement
:accessor displacement-of
))))
65 (def-tuple-class light
67 ((centre :type vertex3d
))
69 ((radius :initform
1.0 :initarg
:radius
:type single-float
:accessor radius-of
))))
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
))))))
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
))))))
87 ;; (defmethod normal ((sphere sphere) point)
88 ;; (sphere-normal (vertex3d (centre-of sphere))
91 ;; (defmethod intersect ((plane plane) point distance))
93 ;; (defmethod normal ((plane plane) point))