~nprescott/ray-tracer

6f3b5e900ee148827e07f0702de06ca08b157d7e — Nolan Prescott 9 months ago 016ab63 master
clean up PPM wrapping RGB strings
3 files changed, 22 insertions(+), 50 deletions(-)

M sample.lisp
M tests.lisp
M tracer.lisp
M sample.lisp => 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 => 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 @@
  (canvas-properties)
  (canvas-write-pixel)
  (check-canvas-pixel-string)
  (check-canvas-to-string)
  (output-canvas-to-ppm)
  (ppm-includes-trailing-newline))


M tracer.lisp => 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))