[imago-cvs] CVS imago/src

lsmith lsmith at common-lisp.net
Thu Sep 28 20:54:32 UTC 2006


Update of /project/imago/cvsroot/imago/src
In directory clnet:/tmp/cvs-serv10578

Modified Files:
	file-pnm.lisp 
Log Message:
Allow writing indexed images as PNM files, ascii or binary

--- /project/imago/cvsroot/imago/src/file-pnm.lisp	2005/01/06 22:41:42	1.3
+++ /project/imago/cvsroot/imago/src/file-pnm.lisp	2006/09/28 20:54:31	1.4
@@ -136,7 +136,25 @@
     (with-write-pnm-loop (stream x y pixels 5 255)
       (write-char (code-char (image-pixel image x y)) stream))))
 
-(defmethod write-pnm-to-stream ((image indexed-image) filespec
-                                output-format)
-  (error "PNM format not supported for indexed images."))
+(defmethod write-pnm-to-stream ((image indexed-image) stream
+                                (output-format (eql :ascii)))
+  (let ((pixels (image-pixels image))
+	(color-map (image-colormap image)))
+    (with-write-pnm-loop (stream x y pixels 3 255)
+      (let ((pixel-rgb (aref color-map (image-pixel image x y))))
+        (format stream "~A ~A ~A~%"
+                (color-red pixel-rgb)
+                (color-green pixel-rgb)
+                (color-blue pixel-rgb))))))
+
+(defmethod write-pnm-to-stream ((image indexed-image) stream
+                                (output-format (eql :binary)))
+  (let ((pixels (image-pixels image))
+	(color-map (image-colormap image)))
+    (with-write-pnm-loop (stream x y pixels 6 255)
+      (let ((pixel-rgb (aref color-map (image-pixel image x y))))
+        (write-char (code-char (color-red pixel-rgb)) stream)
+        (write-char (code-char (color-green pixel-rgb)) stream)
+        (write-char (code-char (color-blue pixel-rgb)) stream)))))
+
 




More information about the Imago-cvs mailing list