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

[Matthieu Villeneuve]

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

Modified Files:
	image.lisp 
Log Message:
Use correct pixel types in declarations
Date: Mon Jan  3 21:45:42 2005
Author: mvilleneuve

Index: imago/src/image.lisp
diff -u imago/src/image.lisp:1.1.1.1 imago/src/image.lisp:1.2
--- imago/src/image.lisp:1.1.1.1	Thu Oct 14 00:01:46 2004
+++ imago/src/image.lisp	Mon Jan  3 21:45:41 2005
@@ -12,6 +12,7 @@
 
 (in-package :imago)
 
+
 (defclass image ()
   ()
   (:documentation "The protocol class for images."))
@@ -22,29 +23,30 @@
 (defgeneric image-width (image)
   (:documentation "Returns the width of the image."))
 
+(defgeneric image-height (image)
+  (:documentation "Returns the height of the image."))
+
+(defgeneric image-pixel (image x y)
+  (:documentation "Returns the color of the pixel at specified coordinates
+in the image."))
+
+(defgeneric (setf image-pixel) (pixel image x y)
+  (:documentation "Sets the color of the pixel at specified coordinates
+in the image."))
+
 (defgeneric pixel-size (image)
   (:documentation "Returns the number of bytes used to represent a pixel."))
 
+
 (defmethod image-width ((image image))
   (second (array-dimensions (image-pixels image))))
 
-(defgeneric image-height (image)
-  (:documentation "Returns the height of the image."))
-
 (defmethod image-height ((image image))
   (first (array-dimensions (image-pixels image))))
 
-(defgeneric image-pixel (image x y)
-  (:documentation "Returns the color of the pixel at specified coordinates
-in the image."))
-
 (defmethod image-pixel ((image image) x y)
   (aref (image-pixels image) y x))
 
-(defgeneric (setf image-pixel) (pixel image x y)
-  (:documentation "Sets the color of the pixel at specified coordinates
-in the image."))
-
 (defmethod (setf image-pixel) (pixel (image image) x y)
   (setf (aref (image-pixels image) y x) pixel))
 
@@ -52,8 +54,9 @@
   (print-unreadable-object (object stream :type t :identity t)
     (format stream "(~Dx~D)" (image-width object) (image-height object))))
 
+
 (defclass rgb-image (image)
-  ((pixels :type (simple-array (unsigned-byte 32) (* *))
+  ((pixels :type (simple-array rgb-pixel (* *))
            :reader image-pixels))
   (:documentation "The class for RGB images. Image dimensions must be
 provided to MAKE-INSTANCE, through the :WIDTH and :HEIGHT keyword
@@ -66,13 +69,15 @@
          (setf (slot-value image 'pixels) pixels))
         ((and (numberp width) (numberp height))
          (setf (slot-value image 'pixels)
-               (make-array (list height width) :initial-element 0)))
+               (make-array (list height width)
+                           :element-type 'rgb-pixel)))
         (t (error "Invalid initialization arguments"))))
 
 (defmethod pixel-size ((image rgb-image)) 4)
 
+
 (defclass grayscale-image (image)
-  ((pixels :type (simple-array (unsigned-byte 8) (* *))
+  ((pixels :type (simple-array grayscale-pixel (* *))
            :reader image-pixels))
   (:documentation "The class for grayscale images. Image dimensions must be
 provided to MAKE-INSTANCE, through the :WIDTH and :HEIGHT keyword
@@ -85,13 +90,15 @@
          (setf (slot-value image 'pixels) pixels))
         ((and (numberp width) (numberp height))
          (setf (slot-value image 'pixels)
-               (make-array (list height width) :initial-element 0)))
+               (make-array (list height width)
+                           :element-type 'grayscale-pixel)))
         (t (error "Invalid initialization arguments"))))
 
 (defmethod pixel-size ((image grayscale-image)) 2)
 
+
 (defclass indexed-image (image)
-  ((pixels :type (simple-array unsigned-byte (* *))
+  ((pixels :type (simple-array indexed-pixel (* *))
            :reader image-pixels)
    (colormap :initarg :colormap :reader image-colormap))
   (:documentation "The class for indexed images. Image dimensions must be
@@ -113,7 +120,8 @@
          (setf (slot-value image 'pixels) pixels))
         ((and (numberp width) (numberp height))
          (setf (slot-value image 'pixels)
-               (make-array (list height width) :initial-element 0)))
+               (make-array (list height width)
+                           :element-type 'indexed-pixel)))
         (t (error "Invalid initialization arguments"))))
 
 (defmethod pixel-size ((image indexed-image)) 1)