[mcclim-cvs] CVS mcclim/Extensions/Images

thenriksen thenriksen at common-lisp.net
Mon Jan 7 14:18:15 UTC 2008


Update of /project/mcclim/cvsroot/mcclim/Extensions/Images
In directory clnet:/tmp/cvs-serv27894/Extensions/Images

Modified Files:
	gif.lisp 
Log Message:
Handle GIF images with transparent parts.


--- /project/mcclim/cvsroot/mcclim/Extensions/Images/gif.lisp	2008/01/06 08:36:57	1.1
+++ /project/mcclim/cvsroot/mcclim/Extensions/Images/gif.lisp	2008/01/07 14:18:15	1.2
@@ -26,10 +26,13 @@
          (pattern-array (make-array (list (skippy:height first-image)
                                           (skippy:width first-image))))
          (designs (coerce (loop with color-table = (skippy:color-table data-stream)
-                             for i below 255
-                             collecting (multiple-value-bind (r g b) 
-                                            (skippy:color-rgb (skippy:color-table-entry color-table i))
-                                          (make-rgb-color (/ r 255) (/ g 255) (/ b 255))))
+                             for i below (skippy:color-table-size color-table)
+                             when (= i (skippy:transparency-index first-image))
+                             collect +transparent-ink+
+                             else collect
+                             (multiple-value-bind (r g b) 
+                                 (skippy:color-rgb (skippy:color-table-entry color-table i))
+                               (make-rgb-color (/ r 255) (/ g 255) (/ b 255))))
                           'vector)))
     (dotimes (y (array-dimension pattern-array 0))
       (dotimes (x (array-dimension pattern-array 1))




More information about the Mcclim-cvs mailing list