[noctool-devel] proposed patch to image library
Jim Prewett
download at hpc.unm.edu
Mon Jul 21 15:16:58 UTC 2008
Hi All,
Attached, find a patch to the image libray that adds the method
write-gif-to-stream.
This probably could have been more generically written so as to accomodate
PNGs as well. So, do with it what you will...
Jim
p.s. what is the appropriate channel for discussing the image library?
James E. Prewett Jim at Prewett.org download at hpc.unm.edu
Systems Team Leader LoGS: http://www.hpc.unm.edu/~download/LoGS/
Designated Security Officer OpenPGP key: pub 1024D/31816D93
HPC Systems Engineer III UNM HPC 505.277.8210
-------------- next part --------------
--- image.lisp 2008-07-21 09:13:44.000000000 -0600
+++ image.lisp.orig 2008-07-21 09:13:12.000000000 -0600
@@ -410,29 +410,3 @@
do (setf (aref png-data y x delta)
(aref img (+ base-ix delta))))))
(zpng:write-png png file-name)))
-
-(defgeneric write-gif-to-stream (image stream &optional comment))
-
-(defmethod write-gif-to-stream ((image image) stream &optional (comment "a"))
- ;; Use Xach's skippy library
- (let ((colormap (make-color-table image)))
- (let ((gif-data (make-array (* (image::height image) (image::width image))
- :element-type '(unsigned-byte 8)))
- (skippy-tab (image::skippify-color-table colormap)))
- (loop for n from 0 below (length gif-data)
- do (let ((base-ix (* n 3)))
- (let ((key (list (aref (image-data image) (+ base-ix 0))
- (aref (image-data image) (+ base-ix 1))
- (aref (image-data image) (+ base-ix 2)))))
- (setf (aref gif-data n) (gethash key colormap)))))
- (skippy:write-data-stream
- (skippy:make-data-stream
- :height (image::height image)
- :width (image::width image)
- :color-table skippy-tab
- :comment comment
- :initial-images (list (skippy:make-image
- :height (image::height image) :width (image::width image)
- :color-table skippy-tab
- :image-data gif-data)))
- stream))))
More information about the Noctool-devel
mailing list