[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