M sample.lisp +2 -2
@@ 57,13 57,13 @@
(let* ((ray-starting-place (point 0 0 -5))
(wall-z 10)
(wall-size 7.0)
- (canvas-pixels 400)
+ (canvas-pixels 200)
(pixel-size (/ wall-size canvas-pixels))
(half (/ wall-size 2))
(c (make-canvas :width canvas-pixels :height canvas-pixels))
(shape (make-sphere :material (make-material :color (vec3 0.8 0.6 0))))
(light (make-light :intensity (vec3 1 1 1)
- :position (point 5 12 -8))))
+ :position (point 8 8 -8))))
(loop for y below canvas-pixels
for world-y = (- half (* pixel-size y))
do (loop for x below canvas-pixels
M tests.lisp +3 -8
@@ 150,19 150,15 @@
(deftest check-canvas-pixel-string
(let ((c (make-canvas :width 1 :height 2)))
- (check (equalp (canvas-pixel-strings c) (list "0 0 0" "0 0 0")))))
-
-(deftest check-canvas-to-string
- (let ((c (make-canvas :width 1 :height 2)))
- (check (equalp (canvas->string c) "0 0 0 0 0 0"))))
+ (check (equalp (canvas-pixel-strings c) "0 0 0 0 0 0"))))
(deftest output-canvas-to-ppm
(check (equalp (canvas->ppm (make-canvas :width 3 :height 5))
"P3
3 5
255
-0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
-0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+0 0 0 0 0 0 0 0 0 0 0 0
")))
(deftest ppm-includes-trailing-newline
@@ 175,7 171,6 @@ 0 0 0 0 0 0 0 0 0 0
(canvas-properties)
(canvas-write-pixel)
(check-canvas-pixel-string)
- (check-canvas-to-string)
(output-canvas-to-ppm)
(ppm-includes-trailing-newline))
M tracer.lisp +17 -40
@@ 62,50 62,27 @@
(body (make-array (list width height) :initial-element (vector 0 0 0))))
(defun write-pixel (canvas x y color)
- (destructuring-bind (n m) (array-dimensions (canvas-body canvas))
- (if (and (< x n) (< y m)
- (>= x 0) (>= y 0))
- (setf (aref (canvas-body canvas) (floor x) (floor y)) color)
- (format t "not writing <~s, ~s>~%" x y))))
-
-(defun wrap (text width)
- (setq text (concatenate 'string text " "))
- (do* ((len (length text))
- (lines (list))
- (offset 0)
- (previous 0 next)
- (next (position #\Space text)
- (when (< (1+ previous) len)
- (position #\Space text :start (1+ previous)))))
- ((null next) (progn
- (push (subseq text offset (1- len)) lines)
- (nreverse lines)))
- (when (> (- next offset) width)
- (push (subseq text offset previous) lines)
- (setq offset (1+ previous)))))
-
-(defun flatten (ls)
- (labels ((mklist (x) (if (listp x) x (list x))))
- (mapcan #'(lambda (x) (if (atom x) (mklist x) (flatten x))) ls)))
+ (flet ((within-bounds (x y max-x max-y)
+ (and (< x max-x) (< y max-y) (>= x 0) (>= y 0))))
+ (when (within-bounds x y (canvas-width canvas) (canvas-height canvas))
+ (setf (aref (canvas-body canvas) (floor x) (floor y)) color))))
(defun canvas-pixel-strings (c)
- (labels ((pixel->string (v) (format nil "~d ~d ~d"
- (floor (* 255 (Red v)))
- (floor (* 255 (Green v)))
- (floor (* 255 (Blue v))))))
- (flatten (loop for i below (canvas-height c) collect
- (loop for j below (canvas-width c)
- collect (pixel->string (aref (canvas-body c) j i)))))))
-
-(defun canvas->string (c)
- (let* ((triplet-strings (canvas-pixel-strings c))
- (single-long-string (format nil "~{~a~^ ~}" triplet-strings))
- (fixed-width-strings (wrap single-long-string 70)))
- (format nil "~{~a~^~%~}" fixed-width-strings)))
+ (labels ((color->rgb (n) (floor (* 255 n)))
+ (pixel->string (v) (format nil "~d ~d ~d"
+ (color->rgb (Red v))
+ (color->rgb (Green v))
+ (color->rgb (Blue v)))))
+ (let ((strings (list)))
+ (dotimes (i (canvas-height c))
+ (dotimes (j (canvas-width c))
+ (push (pixel->string (aref (canvas-body c) j i)) strings)))
+ ; FIXME: figure out how to pass 70 as an argument to format
+ (format nil "~{~<~%~1,70:;~a~>~^ ~}" strings))))
(defun canvas->ppm (c)
(format nil "P3~%~s ~s~%255~%~a~%"
- (canvas-width c) (canvas-height c) (canvas->string c)))
+ (canvas-width c) (canvas-height c) (canvas-pixel-strings c)))
(defun ppm->file (ppm-string path)
(with-open-file (stream path :direction :output :if-exists :supersede)
@@ 283,7 260,7 @@
(VECTOR- in (scale-vector normal (* 2 (dot-product in normal)))))
(defun lighting (material light position eye-vector normal-vector)
- (let* ((effective-color (VECTOR* (material-color material) (light-intensity light)))
+ (let* ((effective-color (blend (material-color material) (light-intensity light)))
(lightv (normalize (VECTOR- (light-position light) position)))
(ambient (scale-vector effective-color (material-ambient material)))
(light-dot-normal (dot-product lightv normal-vector))