[mcclim-devel] Re: image:write-pnm doesn't work with SBCL 0.8.17
Milan Zamazal <pdm@zamazal.org> writes:
Image writing in Backends/CLX/image.lisp breaks with SBCL 0.8.17. The output streams there are character streams, so if the environment is a UTF-8 environment for instance, then the output stream is recoded and the resulting image is broken.
Can you try the attached? I haven't altered the cut-and-paste code in Backend/Beagle/; anyone who cares should probably see if the code is identical and if so refactor. In addition, someone who cares about pnm might want to make read-image-file and write-image-file or write-pnm logical inverses of each other -- I haven't tested the attached at all beyond compiling it because I have no idea how it should be used. Maybe if someone who uses it attempts to document it, it will make more sense? Cheers, Christophe
"CR" == Christophe Rhodes <csr21@cam.ac.uk> writes:
CR> Can you try the attached? Thanks, except for a few typos it seems to work. Here's a fixed version of the patch: --- image.lisp.orig 2005-02-18 10:30:08.000000000 +0100 +++ image.lisp 2005-02-18 10:20:09.000000000 +0100 @@ -108,12 +108,13 @@ `(the (unsigned-byte 8) (logand ,pixel 255))) (defmethod write-pnm ((image truecolor-image) filename output-format) - (with-open-file (stream filename :direction :output :if-exists :supersede) - (if (eq output-format :ascii) - (write-ppm-p3 stream (image-pixels image)) + (with-open-file (stream filename + :direction :output :if-exists :supersede + :element-type '(unsigned-byte 8)) + (if (eq output-format :ascii) + (write-ppm-p3 stream (image-pixels image)) (write-ppm-p6 stream (image-pixels image))))) - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; colormap image @@ -149,9 +150,11 @@ 0) (defmethod write-pnm ((image 256-gray-level-image) filename output-format) - (with-open-file (stream filename :direction :output :if-exists :supersede) - (if (eq output-format :ascii) - (write-pgm-p2 stream (image-pixels image)) + (with-open-file (stream filename + :direction :output :if-exists :supersede + :element-type '(unsigned-byte 8)) + (if (eq output-format :ascii) + (write-pgm-p2 stream (image-pixels image)) (write-pgm-p5 stream (image-pixels image))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -167,9 +170,11 @@ (make-instance 'binary-image :pixels pixels)) (defmethod write-pnm ((image binary-image) filename output-format) - (with-open-file (stream filename :direction :output :if-exists :supersede) - (if (eq output-format :ascii) - (write-pbm-p1 stream (image-pixels image)) + (with-open-file (stream filename + :direction :output :if-exists :supersede + :element-type '(unsigned-byte 8)) + (if (eq output-format :ascii) + (write-pbm-p1 stream (image-pixels image)) (write-pbm-p4 stream (image-pixels image))))) @@ -179,46 +184,48 @@ (defmacro with-write-pnm-loop ((magic-number max-value) &body body) `(let ((height (car (array-dimensions picture))) - (width (cadr (array-dimensions picture)))) - (format stream "P~A~%" ,magic-number) - (format stream "~A ~A~%" width height) - (when ,max-value - (format stream "~A~%" ,max-value)) + (width (cadr (array-dimensions picture)))) + (map nil (lambda (x) (write-byte (char-code x) stream)) + (format nil "P~A~%~A~%~A~%~@[~A~%~]" + ,magic-number width height ,max-value)) (loop for r from 0 below height do - (loop for c from 0 below width do - ,@body)) + (loop for c from 0 below width do + ,@body)) nil)) (defun write-pbm-p1 (stream picture) (with-write-pnm-loop (1 nil) - (format stream "~A~%" (aref picture r c)))) + (map nil (lambda (x) (write-byte (char-code x) stream)) + (format nil "~A~%" (aref picture r c))))) (defun write-pbm-p4 (stream picture) ; bad! (with-write-pnm-loop (4 nil) - (write-char (code-char (aref picture r c)) stream))) + (write-byte (aref picture r c) stream))) (defun write-pgm-p2 (stream picture) (with-write-pnm-loop (2 255) - (format stream "~A~%" (aref picture r c)))) + (map nil (lambda (x) (write-byte (char-code x) stream)) + (format nil "~A~%" (aref picture r c))))) (defun write-pgm-p5 (stream picture) (with-write-pnm-loop (5 255) - (write-char (code-char (aref picture r c)) stream))) + (write-byte (aref picture r c) stream))) (defun write-ppm-p3 (stream picture) (with-write-pnm-loop (3 255) (let ((rgb (aref picture r c))) - (format stream "~A ~A ~A~%" - (red-component rgb) - (green-component rgb) - (blue-component rgb))))) + (map nil (lambda (x) (write-byte (char-code x) stream)) + (format nil "~A ~A ~A~%" + (red-component rgb) + (green-component rgb) + (blue-component rgb)))))) (defun write-ppm-p6 (stream picture) (with-write-pnm-loop (6 255) (let ((rgb (aref picture r c))) - (write-char (code-char (red-component rgb)) stream) - (write-char (code-char (green-component rgb)) stream) - (write-char (code-char (blue-component rgb)) stream)))) + (write-byte (red-component rgb) stream) + (write-byte (green-component rgb) stream) + (write-byte (blue-component rgb) stream)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; CR> Maybe if someone who uses it attempts to document it, it will CR> make more sense? Well, I attempted to add documentation strings to the objects I use. Here's an additional patch to the previous one: --- image.lisp.orig 2005-02-18 10:31:42.000000000 +0100 +++ image.lisp 2005-02-18 11:03:44.000000000 +0100 @@ -50,7 +50,13 @@ (defgeneric (setf image-pixel) (x y pixel image)) (defgeneric image-color (image x y)) (defgeneric (setf image-color) (x y pixel color image)) -(defgeneric write-pnm (image filename output-format)) +(defgeneric write-pnm (image filename output-format) + (:documentation + "Write IMAGE to FILENAME. +IMAGE must be an IMAGE class instance. +If OUTPUT-FORMAT is present and its value is the symbol :ASCII, then the PNM +image is written in ASCII format, otherwise it is written in the binary +format.")) (defmethod image-width ((image image)) (cadr (array-dimensions (image-pixels image)))) @@ -87,6 +93,13 @@ (max-level :initarg :max-level :type card-8 :reader image-max-level))) (defun make-truecolor-image (pixels max-value) + "Create and return a TRUECOLOR-IMAGE instance. +PIXELS must be a two dimensional array of dimensions (HEIGHT WIDTH) +corresponding to image height and width in pixels, with integer image pixels +values as its elements. +MAX-VALUE is used to initialize the MAX-LEVEL slot of the resulting +TRUECOLOR-IMAGE instance, without any known actual later use; you can use 255 +as the argument value without triggering a type error." (make-instance 'truecolor-image :pixels pixels :max-level max-value)) (defmethod color-image-max-level ((image truecolor-image)) @@ -373,5 +386,10 @@ (t (error "unknown file format ~A" byte1)))))) (defun read-image-file (filename &key (format :pnm)) + "Read image data from a PNM file FILENAME. +Return a two dimensional array of dimensions (HEIGHT WIDTH) corresponding to +image height and width in pixels, with integer image pixel values as its +elements. +The FORMAT argument is currently ignored." (declare (ignore format)) (read-pnm-file filename)) Regards, Milan Zamazal -- I think any law that restricts independent use of brainpower is suspect. -- Kent Pitman in comp.lang.lisp
Milan Zamazal <pdm@zamazal.org> writes:
"CR" == Christophe Rhodes <csr21@cam.ac.uk> writes:
CR> Can you try the attached?
Thanks, except for a few typos it seems to work. Here's a fixed version of the patch:
Thanks, I committed your fixed version. Cheers, Christophe
participants (2)
-
Christophe Rhodes -
Milan Zamazal