[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