85cfdad82fbd

--- a/src/main.lisp	Tue Nov 28 20:43:25 2017 -0500
+++ b/src/main.lisp	Tue Jan 16 19:42:40 2018 -0500
@@ -24,102 +24,109 @@
         :do (setf i (+ (* i 10) digit))
         :finally (return i)))
 
-(defun read-magic-byte (stream)
-  (assert (eql (read-char stream) #\P))
-  (read-char stream))
+(defun write-number (value stream)
+  (format stream "~D " value))
+
 
-(defun read-header (stream)
-  (values (read-number stream)
-          (read-number stream)
-          (read-number stream)))
+(defun read-magic-byte (stream)
+  (assert (eql (read-byte stream) (char-code #\P)))
+  (code-char (read-byte stream)))
 
 
 (defun file-format (magic-byte)
+  "Return `(values format binary?)` for the given magic byte."
   (ecase magic-byte
-    (#\1 :pbm-ascii)
-    (#\2 :pgm-ascii)
-    (#\3 :ppm-ascii)
-    (#\4 :pbm-binary)
-    (#\5 :pgm-binary)
-    (#\6 :ppm-binary)))
+    (#\1 (values :pbm nil))
+    (#\2 (values :pgm nil))
+    (#\3 (values :ppm nil))
+    (#\4 (values :pbm t))
+    (#\5 (values :pgm t))
+    (#\6 (values :ppm t))))
 
-(defun magic-byte (file-format)
-  (ecase file-format
-    (:pbm-ascii #\1)
-    (:pgm-ascii #\2)
-    (:ppm-ascii #\3)
-    (:pbm-binary #\4)
-    (:pgm-binary #\5)
-    (:ppm-binary #\6)))
+(defun magic-byte (file-format binary?)
+  (if binary?
+    (ecase file-format
+      (:pbm #\4)
+      (:pgm #\5)
+      (:ppm #\6))
+    (ecase file-format
+      (:pbm #\1)
+      (:pgm #\2)
+      (:ppm #\3))))
+
+
+(defun pixel-type (format bit-depth)
+  (ecase format
+    (:pbm 'bit)
+    (:pgm `(integer 0 ,bit-depth))
+    (:ppm `(simple-array (integer 0 ,bit-depth) (3)))))
 
 
 ;;;; PPM ----------------------------------------------------------------------
-(declaim (inline read-ppm-from-stream))
-
-(defun read-ppm-from-stream (reader stream binary?)
-  (multiple-value-bind (width height bit-depth)
-      (read-header stream)
-    (let ((data (make-array (list height width)
-                  :element-type `(simple-array (integer 0 ,bit-depth) (3)))))
-      (when binary?
-        (read-char stream)) ; chomp last newline before bytes
-      (dotimes (y height)
-        (dotimes (x width)
-          (setf (aref data y x)
-                (make-array 3 :initial-contents (list (funcall reader stream)
-                                                      (funcall reader stream)
-                                                      (funcall reader stream))
-                  :element-type 'fixnum))))
-      data)))
-
-
-(defun read-ppm-ascii-from-stream (stream)
-  (read-ppm-from-stream #'read-number stream nil))
-
-(defun read-ppm-binary-from-stream (stream)
-  (read-ppm-from-stream #'read-byte stream t))
+(defun read% (stream format binary?)
+  (let* ((width (read-number stream))
+         (height (read-number stream))
+         (bit-depth (if (eql :pbm format) 1 (read-number stream)))
+         (data (make-array (list height width)
+                 :element-type (pixel-type format bit-depth)))
+         (reader (if binary? #'read-byte #'read-number)))
+    (when binary?
+      (read-char stream)) ; chomp last newline before bytes
+    (dotimes (row height)
+      (dotimes (col width)
+        (setf (aref data row col)
+              (ecase format
+                (:pbm (funcall reader stream))
+                (:pgm (funcall reader stream))
+                (:ppm (make-array 3
+                        :initial-contents (list (funcall reader stream)
+                                                (funcall reader stream)
+                                                (funcall reader stream))
+                        :element-type 'fixnum))))))
+    data))
 
 
-(defun write-pixel-ascii (stream pixel)
-  (format stream "~D ~D ~D "
-          (aref pixel 0)
-          (aref pixel 1)
-          (aref pixel 2)))
-
-(defun write-pixel-binary (stream pixel)
-  (write-byte (aref pixel 0) stream)
-  (write-byte (aref pixel 1) stream)
-  (write-byte (aref pixel 2) stream))
-
-
-(declaim (inline write-ppm-to-stream))
-
-(defun write-ppm-to-stream (file-format data stream maximum-value writer)
-  (let ((stream (flexi-streams:make-flexi-stream stream :external-format :ascii)))
+(defun write% (data stream format binary? maximum-value)
+  (let ((stream (flexi-streams:make-flexi-stream stream :external-format :ascii))
+        (writer (if binary? #'write-byte #'write-number)))
     (destructuring-bind (height width) (array-dimensions data)
       (format stream "P~D~%~D ~D~%~D~%"
-              (magic-byte file-format) width height maximum-value)
+              (magic-byte format binary?) width height maximum-value)
       (dotimes (row height)
         (dotimes (col width)
-          (funcall writer stream (aref data row col)))))))
-
-(defun write-ppm-ascii-to-stream (data stream maximum-value)
-  (write-ppm-to-stream :ppm-ascii data stream maximum-value #'write-pixel-ascii))
-
-(defun write-ppm-binary-to-stream (data stream maximum-value)
-  (write-ppm-to-stream :ppm-binary data stream maximum-value #'write-pixel-binary))
+          (let ((pixel (aref data row col)))
+            (ecase format
+              (:pbm (funcall writer pixel stream))
+              (:pgm (funcall writer pixel stream))
+              (:ppm (progn (funcall writer (aref pixel 0) stream)
+                           (funcall writer (aref pixel 1) stream)
+                           (funcall writer (aref pixel 2) stream))))))
+        (unless binary? (terpri stream))))))
 
 
 ;;;; API ----------------------------------------------------------------------
 (defun read-from-stream (stream)
-  (let ((stream (flexi-streams:make-flexi-stream stream :external-format :ascii)))
-    (ecase (file-format (read-magic-byte stream))
-      (:ppm-ascii (read-ppm-ascii-from-stream stream))
-      (:ppm-binary (read-ppm-binary-from-stream stream)))))
+  (multiple-value-bind (format binary?)
+      (file-format (read-magic-byte stream))
+    (read% (flexi-streams:make-flexi-stream stream :external-format :ascii)
+           format binary?)))
 
 (defun write-to-stream (stream data &key
-                        (maximum-value 255)
-                        (format :binary))
-  (ccase format
-    (:ascii (write-ppm-ascii-to-stream data stream maximum-value))
-    (:binary (write-ppm-binary-to-stream data stream maximum-value))))
+                        (format :ppm)
+                        (encoding :binary)
+                        (bit-depth (ecase format (:pbm 1) ((:pgm :ppm) 255))))
+  (check-type format (member :ppm :pgm :pbm))
+  (check-type encoding (member :binary :ascii))
+  (write% data stream format (eql :binary encoding) bit-depth))
+
+
+(defun read-from-file (path)
+  (with-open-file (s path :direction :input :element-type '(unsigned-byte 8))
+    (read-from-stream s)))
+
+(defun write-to-file (path data &key
+                      (format :ppm)
+                      (encoding :binary)
+                      (bit-depth (ecase format (:pbm 1) ((:pgm :ppm) 255))))
+  (with-open-file (s path :direction :output :if-exists :supersede :element-type '(unsigned-byte 8))
+    (write-to-stream s data :format format :encoding encoding :bit-depth bit-depth)))