diff options
| -rw-r--r-- | cl-raytracer.lisp | 131 |
1 files changed, 114 insertions, 17 deletions
diff --git a/cl-raytracer.lisp b/cl-raytracer.lisp index 0cdfcf5..23b5232 100644 --- a/cl-raytracer.lisp +++ b/cl-raytracer.lisp @@ -108,6 +108,10 @@ format (PPM), writing the result to `(current-output-port)'." "Return the normal vector parallel to vector U." (vec3* (/ 1 (vec3-magnitude u)) u)) +(defun vec3-components (u) + "Return a list (x y z) of the components of vector U." + (with-slots (x y z) u (list x y z))) + (defstruct ray origin direction) (defmethod point-at ((r ray) time) @@ -139,6 +143,12 @@ format (PPM), writing the result to `(current-output-port)'." (make-some time) (make-none)))))))) +(defmethod normal ((shape plane) position) + (vec3-normalize (plane-n shape))) + +(defmethod material ((shape plane)) + (plane-material shape)) + (defstruct sphere center radius material) (defmethod intersect (ray (s sphere) t-min t-max) @@ -160,6 +170,35 @@ format (PPM), writing the result to `(current-output-port)'." (make-some time) (make-none)))))) +(defmethod normal ((shape sphere) position) + (vec3-normalize (vec3- position (sphere-center shape)))) + +(defmethod material ((shape sphere)) + (sphere-material shape)) + + +;;; +;;; Lights, and generic procedures for working with them. +;;; + +(defstruct light-sample intensity position direction) +(defstruct spot-light from to intensity exponent cutoff-angle) + +(defmethod sample-at ((light spot-light) point) + (with-slots ((position from) (target to) cutoff-angle intensity) light + (let* ((direction (vec3- position point)) + (pf (vec3-normalize (vec3- point position))) + (intensity (if (< (vec3-dot pf (vec3-normalize (vec3- target position))) + (cos (to-radians cutoff-angle))) + (make-vec3 :x 0.00 :y 0.00 :z 0.00) + (vec3* (* (/ 1 (square (vec3-magnitude direction))) + (expt (vec3-dot pf (vec3-normalize (vec3- target position))) + (spot-light-exponent light))) + intensity)))) + (make-light-sample :intensity intensity + :position position + :direction (vec3-normalize direction))))) + ;;; ;;; Scene graph. @@ -174,21 +213,74 @@ format (PPM), writing the result to `(current-output-port)'." (defvar camera-up (make-vec3 :x 0.00 :y 1.00 :z 0.00)) (defvar camera-fov 30) +(defvar ambient-light (make-vec3 :x 0.01 :y 0.01 :z 0.01)) +(defvar lights (list (make-spot-light :from (make-vec3 :x 10.00 :y 10.00 :z 5.00) + :to (make-vec3 :x 0.00 :y 0.00 :z 0.00) + :intensity (make-vec3 :x 100.00 :y 96.00 :z 88.00) + :exponent 50 + :cutoff-angle 15))) + + +;;; +;;; Materials. +;;; + +(defstruct material ka kd ks kr kt p ior) +(defun diffuse-material (ka kd) (make-material :ka ka :kd kd)) +(defun phong-material (ka kd ks p) (make-material :ka ka :kd kd :ks ks :p p)) + +(defun reflect (l n) + "Compute reflected vector, by mirroring l around n." + (vec3- (vec3* (* 2.00 (vec3-dot n l)) n) l)) + +(defun shade-pixel (shape position origin) + (with-slots (ka kd ks p) (material shape) + (let* ((normal (normal shape position)) + (Ia (with-slots ((x1 x) (y1 y) (z1 z)) ka + (with-slots ((x2 x) (y2 y) (z2 z)) ambient-light + (make-vec3 :x (* x1 x2) :y (* y1 y2) :z (* z1 z2))))) + (Id (apply #'vec3+ + (mapcar #'(lambda (light) + (let* ((sample (sample-at light position)) + (direction (light-sample-direction sample)) + (intensity (light-sample-intensity sample)) + (scalar (max (vec3-dot normal direction) 0))) + (with-slots ((x1 x) (y1 y) (z1 z)) kd + (with-slots ((x2 x) (y2 y) (z2 z)) intensity + (make-vec3 :x (* x1 x2 scalar) + :y (* y1 y2 scalar) + :z (* z1 z2 scalar)))))) + lights))) + (Is (if ks + (apply #'vec3+ + (mapcar #'(lambda (light) + (let* ((sample (sample-at light position)) + (point (light-sample-position sample)) + (intensity (light-sample-intensity sample)) + (l (vec3-normalize (vec3- point position))) + (v (vec3-normalize (vec3- origin position))) + (r (reflect l normal)) + (scalar (expt (max 0 (vec3-dot v r)) p))) + (with-slots ((x1 x) (y1 y) (z1 z)) ks + (with-slots ((x2 x) (y2 y) (z2 z)) intensity + (make-vec3 :x (* x1 x2 scalar) + :y (* y1 y2 scalar) + :z (* z1 z2 scalar)))))) + lights)) + (make-vec3 :x 0.00 :y 0.00 :z 0.00)))) + (with-slots (x y z) (vec3+ Ia Id Is) + (make-vec3 :x (min 1.0 x) :y (min 1.0 y) :z (min 1.0 z)))))) + (defvar shapes (list (make-sphere :center (make-vec3 :x -0.25 :y 0.00 :z 0.25) :radius 1.25 - ;; (phong-material (make-vec3 1.0 0.2 0.2) - ;; (make-vec3 1.0 0.2 0.2) - ;; (make-vec3 2.0 2.0 2.0) - ;; 20) - :material nil - ) - ;; (make-plane :p0 (make-vec3 :x 0.00 :y -1.25 :z 0.00) - ;; :n (make-vec3 :x 0.00 :y 1.00 :z 0.00) - ;; ;; (diffuse-material (make-vec3 1.0 1.0 0.2) - ;; ;; (make-vec3 1.0 1.0 0.2)) - ;; :material nil - ;; ) - )) + :material (phong-material (make-vec3 :x 1.0 :y 0.2 :z 0.2) + (make-vec3 :x 1.0 :y 0.2 :z 0.2) + (make-vec3 :x 2.0 :y 2.0 :z 2.0) + 20)) + (make-plane :p0 (make-vec3 :x 0.00 :y -1.25 :z 0.00) + :n (make-vec3 :x 0.00 :y 1.00 :z 0.00) + :material (diffuse-material (make-vec3 :x 1.0 :y 1.0 :z 0.2) + (make-vec3 :x 1.0 :y 1.0 :z 0.2))))) (defun coord-to-ray (x y) "Return the ray corresponding to the point X, Y on the viewport plane." @@ -248,13 +340,18 @@ point)), if any. Otherwise, return 'none." (+ x (* y image-width))) (screen-to-viewport (x y) (values (coerce (/ x image-width) 'real) - (coerce (/ (- image-height 1 y) image-height) 'real)))) + (coerce (/ (- image-height 1 y) image-height) 'real))) + (to-color (u) + (mapcar #'(lambda (n) (round (* 255 n))) (vec3-components u)))) (dotimes (x image-width) (dotimes (y image-height) (setf (elt image (coord-to-index x y)) (multiple-value-bind (x y) (screen-to-viewport x y) - (let ((ray (coord-to-ray x y))) - (if (some-p (ray-intersect-scene ray)) - (list 0 0 0) + (let* ((ray (coord-to-ray x y)) + (intersection (ray-intersect-scene ray))) + (if (some-p intersection) + (let ((shape (car (unwrap intersection))) + (position (cadr (unwrap intersection)))) + (to-color (shade-pixel shape position (ray-origin ray)))) (ray-color ray)))))))) (write-ppm image-width image-height image)) |