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 +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))