[imago-cvs] CVS update: imago/src/color.lisp

Matthieu Villeneuve mvilleneuve at common-lisp.net
Mon Jan 3 20:50:00 UTC 2005


Update of /project/imago/cvsroot/imago/src
In directory common-lisp.net:/tmp/cvs-serv5516

Modified Files:
	color.lisp 
Log Message:
Add pixel types
Date: Mon Jan  3 21:49:59 2005
Author: mvilleneuve

Index: imago/src/color.lisp
diff -u imago/src/color.lisp:1.1.1.1 imago/src/color.lisp:1.2
--- imago/src/color.lisp:1.1.1.1	Thu Oct 14 00:01:46 2004
+++ imago/src/color.lisp	Mon Jan  3 21:49:59 2005
@@ -12,9 +12,17 @@
 
 (in-package :imago)
 
-(declaim (inline make-gray))
+
+(deftype rgb-pixel () '(unsigned-byte 32))
+
+(deftype grayscale-pixel () '(unsigned-byte 16))
+
+(deftype indexed-pixel () '(unsigned-byte 1))
+
+(declaim (inline make-gray gray-intensity gray-alpha invert-gray))
+
 (defun make-gray (intensity &optional (alpha #xff))
-  (logior (ash alpha 8) intensity))
+  (the grayscale-pixel (logior (ash alpha 8) intensity)))
 
 (defun gray-intensity (gray)
   (the (unsigned-byte 8) (ldb (byte 8 0) gray)))
@@ -26,9 +34,11 @@
   (logior (lognot (logand gray #x00ff))
           (logand gray #xff00)))
 
-(declaim (inline make-color))
+(declaim (inline make-color color-red color-green color-blue color-alpha
+                 color-rgb color-argb color-intensity invert-color))
+
 (defun make-color (r g b &optional (alpha #xff))
-  (logior (ash alpha 24) (ash r 16) (ash g 8) b))
+  (the rgb-pixel (logior (ash alpha 24) (ash r 16) (ash g 8) b)))
 
 (defun color-red (color)
   (the (unsigned-byte 8) (ldb (byte 8 16) color)))




More information about the Imago-cvs mailing list