[imago-cvs] CVS imago/src

[mvilleneuve]

Update of /project/imago/cvsroot/imago/src
In directory clnet:/tmp/cvs-serv17826

Modified Files:
	color.lisp 
Log Message:
Added type declarations for speed optimization (thanks to Daniel Herring)

--- /project/imago/cvsroot/imago/src/color.lisp	2006/06/03 06:59:55	1.4
+++ /project/imago/cvsroot/imago/src/color.lisp	2007/01/03 10:25:27	1.5
@@ -41,41 +41,54 @@
                  color-rgb color-argb color-intensity invert-color))
 
 (defun make-color (r g b &optional (alpha #xff))
+  (declare (type (unsigned-byte 8) r)
+           (type (unsigned-byte 8) g)
+           (type (unsigned-byte 8) b)
+           (type (unsigned-byte 8) alpha))
   (the rgb-pixel (logior (ash alpha 24) (ash r 16) (ash g 8) b)))
 
 (defun color-red (color)
+  (declare (type rgb-pixel color))
   (the (unsigned-byte 8) (ldb (byte 8 16) color)))
 
 (defun color-green (color)
+  (declare (type rgb-pixel color))
   (the (unsigned-byte 8) (ldb (byte 8 8) color)))
 
 (defun color-blue (color)
+  (declare (type rgb-pixel color))
   (the (unsigned-byte 8) (ldb (byte 8 0) color)))
 
 (defun color-alpha (color)
+  (declare (type rgb-pixel color))
   (the (unsigned-byte 8) (ldb (byte 8 24) color)))
 
 (defun color-rgb (color)
+  (declare (type rgb-pixel color))
   (values (color-red color)
           (color-green color)
           (color-blue color)))
 
 (defun color-argb (color)
+  (declare (type rgb-pixel color))
   (values (color-alpha color)
           (color-red color)
           (color-green color)
           (color-blue color)))
 
 (defun color-intensity (color)
+  (declare (type rgb-pixel color))
   (multiple-value-bind (r g b)
       (color-rgb color)
     (floor (+ r g b) 3)))
 
 (defun invert-color (color)
+  (declare (type rgb-pixel color))
   (logior (lognot (logand color #x00ffffff))
           (logand color #xff000000)))
 
 (defun closest-colortable-entry (color table)
+  (declare (type rgb-pixel color))
   (multiple-value-bind (color-r color-g color-b)
       (color-rgb color)
     (multiple-value-bind (element index score)