summaryrefslogtreecommitdiff
path: root/cl-raytracer.lisp
diff options
context:
space:
mode:
Diffstat (limited to 'cl-raytracer.lisp')
-rw-r--r--cl-raytracer.lisp131
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))