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))