From lsmith at common-lisp.net Thu Sep 28 20:54:32 2006 From: lsmith at common-lisp.net (lsmith) Date: Thu, 28 Sep 2006 16:54:32 -0400 (EDT) Subject: [imago-cvs] CVS imago/src Message-ID: <20060928205432.277EC79000@common-lisp.net> 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))))) + From lsmith at common-lisp.net Thu Sep 28 20:55:47 2006 From: lsmith at common-lisp.net (lsmith) Date: Thu, 28 Sep 2006 16:55:47 -0400 (EDT) Subject: [imago-cvs] CVS imago/src Message-ID: <20060928205547.39EC3791B5@common-lisp.net> Update of /project/imago/cvsroot/imago/src In directory clnet:/tmp/cvs-serv10850 Modified Files: image.lisp Log Message: Added declaration to stop SBCL complaining about colour-count type --- /project/imago/cvsroot/imago/src/image.lisp 2006/06/03 06:59:55 1.4 +++ /project/imago/cvsroot/imago/src/image.lisp 2006/09/28 20:55:47 1.5 @@ -109,7 +109,8 @@ (defmethod initialize-instance :after ((image indexed-image) &rest initargs &key width height pixels colormap (color-count 256)) - (declare (ignore initargs)) + (declare (ignore initargs) + (type fixnum color-count)) (cond ((not (null colormap)) (setf (slot-value image 'colormap) colormap)) ((and (numberp color-count) (<= color-count 256))