Update of /project/imago/cvsroot/imago/src In directory common-lisp.net:/tmp/cvs-serv5561
Modified Files: color.lisp compose.lisp convert.lisp convolve.lisp crc32.lisp drawing.lisp file-png.lisp file-pnm.lisp file-tga.lisp image-utilities.lisp image.lisp imago.asd operations.lisp package.lisp utilities.lisp Log Message: Cosmetic changes (definition order, copyright, etc.) Date: Mon Jan 3 21:56:02 2005 Author: mvilleneuve
Index: imago/src/color.lisp diff -u imago/src/color.lisp:1.2 imago/src/color.lisp:1.3 --- imago/src/color.lisp:1.2 Mon Jan 3 21:49:59 2005 +++ imago/src/color.lisp Mon Jan 3 21:56:02 2005 @@ -1,7 +1,7 @@ ;;; IMAGO library ;;; Color operations ;;; -;;; Copyright (C) 2004 Matthieu Villeneuve (matthieu.villeneuve@free.fr) +;;; Copyright (C) 2004-2005 Matthieu Villeneuve (matthieu.villeneuve@free.fr) ;;; ;;; The authors grant you the rights to distribute ;;; and use this software as governed by the terms
Index: imago/src/compose.lisp diff -u imago/src/compose.lisp:1.1.1.1 imago/src/compose.lisp:1.2 --- imago/src/compose.lisp:1.1.1.1 Thu Oct 14 00:01:55 2004 +++ imago/src/compose.lisp Mon Jan 3 21:56:02 2005 @@ -1,7 +1,7 @@ ;;; IMAGO library ;;; Image composition ;;; -;;; Copyright (C) 2004 Matthieu Villeneuve (matthieu.villeneuve@free.fr) +;;; Copyright (C) 2004-2005 Matthieu Villeneuve (matthieu.villeneuve@free.fr) ;;; ;;; The authors grant you the rights to distribute ;;; and use this software as governed by the terms @@ -12,11 +12,18 @@
(in-package :imago)
+ (defgeneric compose (dest image1 image2 x y operator) (:documentation "Composes IMAGE1 and IMAGE2 at offset (X, Y), using OPERATOR to compose each pixel. OPERATOR must be a function of two colors, returning a color."))
+(defgeneric default-compose-operator (image) + (:documentation "Returns a compose operator that can be applied to +images of the same type as IMAGE. The default operator mixes colors +according to their respective alpha component.")) + + (defmethod compose ((dest (eql nil)) (image1 image) (image2 image) x y operator) (let ((dest (make-similar-image image1))) @@ -45,8 +52,6 @@ (image-pixel image2 x2 y2))))))) dest)
- -(defgeneric default-compose-operator (image))
(defmethod default-compose-operator ((image rgb-image)) (lambda (color1 color2)
Index: imago/src/convert.lisp diff -u imago/src/convert.lisp:1.1.1.1 imago/src/convert.lisp:1.2 --- imago/src/convert.lisp:1.1.1.1 Thu Oct 14 00:01:46 2004 +++ imago/src/convert.lisp Mon Jan 3 21:56:02 2005 @@ -1,7 +1,7 @@ ;;; IMAGO library ;;; Image format conversions ;;; -;;; Copyright (C) 2004 Matthieu Villeneuve (matthieu.villeneuve@free.fr) +;;; Copyright (C) 2004-2005 Matthieu Villeneuve (matthieu.villeneuve@free.fr) ;;; ;;; The authors grant you the rights to distribute ;;; and use this software as governed by the terms @@ -12,8 +12,14 @@
(in-package :imago)
+ (defgeneric convert-to-rgb (image))
+(defgeneric convert-to-grayscale (image)) + +(defgeneric convert-to-indexed (image)) + + (defmethod convert-to-rgb ((image indexed-image)) (let* ((width (image-width image)) (height (image-height image)) @@ -41,8 +47,6 @@ (make-color gray gray gray)))) result))
-(defgeneric convert-to-grayscale (image)) - (defmethod convert-to-grayscale ((image rgb-image)) (let* ((width (image-width image)) (height (image-height image)) @@ -68,8 +72,6 @@ (setf (row-major-aref result-pixels i) (color-intensity (aref colormap color-index))))) result)) - -(defgeneric convert-to-indexed (image))
(defmethod convert-to-indexed ((image rgb-image)) (error "Not implemented"))
Index: imago/src/convolve.lisp diff -u imago/src/convolve.lisp:1.1.1.1 imago/src/convolve.lisp:1.2 --- imago/src/convolve.lisp:1.1.1.1 Thu Oct 14 00:01:51 2004 +++ imago/src/convolve.lisp Mon Jan 3 21:56:02 2005 @@ -1,7 +1,7 @@ ;;; IMAGO library ;;; Image filters (based on 5x5 convolution matrices) ;;; -;;; Copyright (C) 2004 Matthieu Villeneuve (matthieu.villeneuve@free.fr) +;;; Copyright (C) 2004-2005 Matthieu Villeneuve (matthieu.villeneuve@free.fr) ;;; ;;; The authors grant you the rights to distribute ;;; and use this software as governed by the terms @@ -12,7 +12,10 @@
(in-package :imago)
-(defgeneric convolve (image matrix divisor offset)) + +(defgeneric convolve (image matrix divisor offset) + (:documentation "Applies a 5x5 convolution kernel (a 5x5 real number +matrix) to an image. Returns the resulting image."))
(defmethod convolve ((image rgb-image) matrix divisor offset) (with-image-definition (image width height pixels)
Index: imago/src/crc32.lisp diff -u imago/src/crc32.lisp:1.1.1.1 imago/src/crc32.lisp:1.2 --- imago/src/crc32.lisp:1.1.1.1 Thu Oct 14 00:01:55 2004 +++ imago/src/crc32.lisp Mon Jan 3 21:56:02 2005 @@ -1,7 +1,7 @@ ;;; IMAGO library ;;; CRC32 checksum calculation ;;; -;;; Copyright (C) 2004 Matthieu Villeneuve (matthieu.villeneuve@free.fr) +;;; Copyright (C) 2004-2005 Matthieu Villeneuve (matthieu.villeneuve@free.fr) ;;; ;;; The authors grant you the rights to distribute ;;; and use this software as governed by the terms @@ -11,6 +11,7 @@
(in-package :imago) +
(defparameter +crc32-table+ (loop with table = (make-array 256 :element-type '(unsigned-byte 32))
Index: imago/src/drawing.lisp diff -u imago/src/drawing.lisp:1.1.1.1 imago/src/drawing.lisp:1.2 --- imago/src/drawing.lisp:1.1.1.1 Thu Oct 14 00:01:46 2004 +++ imago/src/drawing.lisp Mon Jan 3 21:56:02 2005 @@ -1,7 +1,7 @@ ;;; IMAGO library ;;; Drawing simple shapes ;;; -;;; Copyright (C) 2004 Matthieu Villeneuve (matthieu.villeneuve@free.fr) +;;; Copyright (C) 2004-2005 Matthieu Villeneuve (matthieu.villeneuve@free.fr) ;;; ;;; The authors grant you the rights to distribute ;;; and use this software as governed by the terms @@ -11,6 +11,7 @@
(in-package :imago) +
(defun draw-point (image x y color) "Draws a point in an image."
Index: imago/src/file-png.lisp diff -u imago/src/file-png.lisp:1.3 imago/src/file-png.lisp:1.4 --- imago/src/file-png.lisp:1.3 Wed Oct 20 08:20:55 2004 +++ imago/src/file-png.lisp Mon Jan 3 21:56:02 2005 @@ -1,7 +1,7 @@ ;;; IMAGO library ;;; PNG file handling ;;; -;;; Copyright (C) 2004 Matthieu Villeneuve (matthieu.villeneuve@free.fr) +;;; Copyright (C) 2004-2005 Matthieu Villeneuve (matthieu.villeneuve@free.fr) ;;; ;;; The authors grant you the rights to distribute ;;; and use this software as governed by the terms @@ -12,6 +12,7 @@
(in-package :imago)
+ (defparameter +png-signature+ '#(137 80 78 71 13 10 26 10))
(defparameter +png-ihdr-chunk-type+ #x49484452) @@ -144,7 +145,11 @@ (unless (zerop (mod data-bit-index 8)) (incf data-bit-index (- 8 (mod data-bit-index 8))))) (loop with samples-index = 0 - with pixels = (make-array (list height width) :initial-element 0) + with pixels = (make-array (list height width) + :element-type (ecase color-type + ((2 6) 'rgb-pixel) + ((0 4) 'grayscale-pixel) + ((3) 'indexed-pixel))) for y below height do (loop for x below width do (macrolet ((next-byte ()
Index: imago/src/file-pnm.lisp diff -u imago/src/file-pnm.lisp:1.1.1.1 imago/src/file-pnm.lisp:1.2 --- imago/src/file-pnm.lisp:1.1.1.1 Thu Oct 14 00:01:51 2004 +++ imago/src/file-pnm.lisp Mon Jan 3 21:56:02 2005 @@ -1,7 +1,7 @@ ;;; IMAGO library ;;; PNM file handling ;;; -;;; Copyright (C) 2004 Matthieu Villeneuve (matthieu.villeneuve@free.fr) +;;; Copyright (C) 2004-2005 Matthieu Villeneuve (matthieu.villeneuve@free.fr) ;;; ;;; The authors grant you the rights to distribute ;;; and use this software as governed by the terms @@ -11,6 +11,7 @@
(in-package :imago) +
(defun read-pnm (filespec) "Reads data for an image in PNM format from a file, and returns
Index: imago/src/file-tga.lisp diff -u imago/src/file-tga.lisp:1.1.1.1 imago/src/file-tga.lisp:1.2 --- imago/src/file-tga.lisp:1.1.1.1 Thu Oct 14 00:01:55 2004 +++ imago/src/file-tga.lisp Mon Jan 3 21:56:02 2005 @@ -1,7 +1,7 @@ ;;; IMAGO library ;;; TGA file handling ;;; -;;; Copyright (C) 2004 Matthieu Villeneuve (matthieu.villeneuve@free.fr) +;;; Copyright (C) 2004-2005 Matthieu Villeneuve (matthieu.villeneuve@free.fr) ;;; ;;; The authors grant you the rights to distribute ;;; and use this software as governed by the terms @@ -11,6 +11,7 @@
(in-package :imago) +
(defun read-tga (filespec) (with-open-file (stream filespec :direction :input
Index: imago/src/image-utilities.lisp diff -u imago/src/image-utilities.lisp:1.1.1.1 imago/src/image-utilities.lisp:1.2 --- imago/src/image-utilities.lisp:1.1.1.1 Thu Oct 14 00:01:49 2004 +++ imago/src/image-utilities.lisp Mon Jan 3 21:56:02 2005 @@ -1,7 +1,7 @@ ;;; IMAGO library ;;; Image related utilities ;;; -;;; Copyright (C) 2004 Matthieu Villeneuve (matthieu.villeneuve@free.fr) +;;; Copyright (C) 2004-2005 Matthieu Villeneuve (matthieu.villeneuve@free.fr) ;;; ;;; The authors grant you the rights to distribute ;;; and use this software as governed by the terms @@ -11,6 +11,7 @@
(in-package :imago) +
(declaim (inline in-image-p)) (defun in-image-p (x y image)
Index: imago/src/image.lisp diff -u imago/src/image.lisp:1.2 imago/src/image.lisp:1.3 --- imago/src/image.lisp:1.2 Mon Jan 3 21:45:41 2005 +++ imago/src/image.lisp Mon Jan 3 21:56:02 2005 @@ -1,7 +1,7 @@ ;;; IMAGO library ;;; Image data structure definitions ;;; -;;; Copyright (C) 2004 Matthieu Villeneuve (matthieu.villeneuve@free.fr) +;;; Copyright (C) 2004-2005 Matthieu Villeneuve (matthieu.villeneuve@free.fr) ;;; ;;; The authors grant you the rights to distribute ;;; and use this software as governed by the terms
Index: imago/src/imago.asd diff -u imago/src/imago.asd:1.1.1.1 imago/src/imago.asd:1.2 --- imago/src/imago.asd:1.1.1.1 Thu Oct 14 00:01:51 2004 +++ imago/src/imago.asd Mon Jan 3 21:56:02 2005 @@ -1,7 +1,7 @@ ;;; IMAGO library ;;; ASDF system definition ;;; -;;; Copyright (C) 2004 Matthieu Villeneuve (matthieu.villeneuve@free.fr) +;;; Copyright (C) 2004-2005 Matthieu Villeneuve (matthieu.villeneuve@free.fr) ;;; ;;; The author grants you the rights to distribute ;;; and use this software as governed by the terms
Index: imago/src/operations.lisp diff -u imago/src/operations.lisp:1.1.1.1 imago/src/operations.lisp:1.2 --- imago/src/operations.lisp:1.1.1.1 Thu Oct 14 00:01:50 2004 +++ imago/src/operations.lisp Mon Jan 3 21:56:02 2005 @@ -1,7 +1,7 @@ ;;; IMAGO library ;;; Image operations ;;; -;;; Copyright (C) 2004 Matthieu Villeneuve (matthieu.villeneuve@free.fr) +;;; Copyright (C) 2004-2005 Matthieu Villeneuve (matthieu.villeneuve@free.fr) ;;; ;;; The authors grant you the rights to distribute ;;; and use this software as governed by the terms @@ -12,11 +12,26 @@
(in-package :imago)
+ (defgeneric copy (dest src &key dest-x dest-y src-x src-y width height) (:documentation "Copies a rectangular region from image SRC to image DEST. Both images must be large enough to contain the specified region at the given positions. Both images must be of same type."))
+(defgeneric scale (image width-factor height-factor) + (:documentation "Returns an newly created image corresponding to the +IMAGE image, with its dimensions multiplied by the given factors.")) + +(defgeneric resize (image new-width new-height) + (:documentation "Returns an newly created image corresponding to the +IMAGE image, with given dimensions.")) + +(defgeneric flip (dest image axis) + (:documentation "Flips an image. AXIS may be either :HORIZONTAL or +:VERTICAL. DEST must be either an image of same type and dimensions as +IMAGE, or NIL. Returns the resulting image.")) + + (defmethod copy ((dest (eql nil)) (src image) &key (dest-x 0) (dest-y 0) (src-x 0) (src-y 0) width height) (declare (ignore dest-x dest-y)) @@ -76,10 +91,6 @@ (incf src-y))) dest)
-(defgeneric scale (image width-factor height-factor) - (:documentation "Returns an newly created image corresponding to the -IMAGE image, with its dimensions multiplied by the given factors.")) - (defmethod scale ((image image) width-factor height-factor) (let ((width (image-width image)) (height (image-height image))) @@ -87,10 +98,6 @@ (floor (* width width-factor)) (floor (* height height-factor)))))
-(defgeneric resize (image new-width new-height) - (:documentation "Returns an newly created image corresponding to the -IMAGE image, with given dimensions.")) - (defmethod resize ((image image) new-width new-height) (let* ((dest (make-instance (class-of image) :width new-width :height new-height)) @@ -121,11 +128,6 @@ (incf image-line-index image-width) (decf y-err new-height))))))) dest)) - -(defgeneric flip (dest image axis) - (:documentation "Flips an image. AXIS may be either :HORIZONTAL or -:VERTICAL. DEST must be either an image of same type and dimensions as -IMAGE, or NIL. Returns the resulting image."))
(defmethod flip ((dest (eql nil)) (image image) axis) (let ((dest (make-similar-image image)))
Index: imago/src/package.lisp diff -u imago/src/package.lisp:1.2 imago/src/package.lisp:1.3 --- imago/src/package.lisp:1.2 Mon Jan 3 21:46:17 2005 +++ imago/src/package.lisp Mon Jan 3 21:56:02 2005 @@ -1,7 +1,7 @@ ;;; IMAGO library ;;; Package definition ;;; -;;; Copyright (C) 2004 Matthieu Villeneuve (matthieu.villeneuve@free.fr) +;;; Copyright (C) 2004-2005 Matthieu Villeneuve (matthieu.villeneuve@free.fr) ;;; ;;; The authors grant you the rights to distribute ;;; and use this software as governed by the terms
Index: imago/src/utilities.lisp diff -u imago/src/utilities.lisp:1.1.1.1 imago/src/utilities.lisp:1.2 --- imago/src/utilities.lisp:1.1.1.1 Thu Oct 14 00:01:50 2004 +++ imago/src/utilities.lisp Mon Jan 3 21:56:02 2005 @@ -1,7 +1,7 @@ ;;; IMAGO library ;;; General utilities ;;; -;;; Copyright (C) 2004 Matthieu Villeneuve (matthieu.villeneuve@free.fr) +;;; Copyright (C) 2004-2005 Matthieu Villeneuve (matthieu.villeneuve@free.fr) ;;; ;;; The authors grant you the rights to distribute ;;; and use this software as governed by the terms @@ -11,6 +11,7 @@
(in-package :imago) +
;;; Binary streams