[closure-cvs] CVS closure/src/imagelib

[emarsden]

Update of /project/closure/cvsroot/closure/src/imagelib
In directory clnet:/tmp/cvs-serv7799/src/imagelib

Modified Files:
	gif.lisp 
Log Message:
Implement transparency support for GIF files (thanks to Zachary Beane
for diagnosing the problem). 


--- /project/closure/cvsroot/closure/src/imagelib/gif.lisp	2007/01/03 16:09:13	1.1
+++ /project/closure/cvsroot/closure/src/imagelib/gif.lisp	2007/01/03 16:41:15	1.2
@@ -43,20 +43,24 @@
 (defun gif-stream->aimage (stream)
   (let* ((data-stream (skippy:read-data-stream (flexi-stream-from stream)))
          (image (skippy:last-image data-stream))
+         (transparent-index (skippy:transparency-index image))
          (gif-color-table (skippy:color-table data-stream))
          (aimage (make-aimage (skippy:width image)
-                              (skippy:height image) :alpha-p nil))
+                              (skippy:height image) :alpha-p transparent-index))
          (aimage-data (aimage-data aimage)))
     (dotimes (x (skippy:width image))
       (dotimes (y (skippy:height image))
-        (multiple-value-bind (r g b)
-            (skippy:color-rgb
-             (skippy:color-table-entry gif-color-table (skippy:pixel-ref image x y)))
+        (multiple-value-bind (r g b a)
+            (let ((color-index (skippy:pixel-ref image x y)))
+              (if (eql color-index transparent-index)
+                  (values 0 0 0 255)
+                  (skippy:color-rgb
+                   (skippy:color-table-entry gif-color-table color-index))))
           (setf (aref aimage-data y x)
                 (dpb r (byte 8 0)
                      (dpb g (byte 8 8)
                           (dpb b (byte 8 16)
-                               (dpb (- 255 0) (byte 8 24) 0))))))))
+                               (dpb (or a 0) (byte 8 24) 0))))))))
     aimage))