# HG changeset patch # User Nolan Prescott # Date 1586379856 14400 # Wed Apr 08 17:04:16 2020 -0400 # Node ID 5f52792b59941921ba6b6c5f0d11aeada922e2b5 # Parent b51fcbe732614f99645259210f284b8499103fda clean up PPM wrapping RGB strings diff --git a/sample.lisp b/sample.lisp --- a/sample.lisp +++ b/sample.lisp @@ -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 diff --git a/tests.lisp b/tests.lisp --- a/tests.lisp +++ b/tests.lisp @@ -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)) diff --git a/tracer.lisp b/tracer.lisp --- a/tracer.lisp +++ b/tracer.lisp @@ -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))