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)