January 2005 - imago-cvs@common-lisp.net - mailman3.common-lisp.net

[imago-cvs] CVS update: imago/src/file.lisp imago/src/file-png.lisp imago/src/file-pnm.lisp imago/src/file-tga.lisp imago/src/imago.asd imago/src/package.lisp
by mvilleneuve＠common-lisp.net 06 Jan '05

06 Jan '05

Update of /project/imago/cvsroot/imago/src In directory common-lisp.net:/tmp/cvs-serv4543 Modified Files: file-png.lisp file-pnm.lisp file-tga.lisp imago.asd package.lisp Added Files: file.lisp Log Message: Added generic image file reader Date: Thu Jan 6 23:41:42 2005 Author: mvilleneuve Index: imago/src/file-png.lisp diff -u imago/src/file-png.lisp:1.4 imago/src/file-png.lisp:1.5 --- imago/src/file-png.lisp:1.4 Mon Jan 3 21:56:02 2005 +++ imago/src/file-png.lisp Thu Jan 6 23:41:42 2005 @@ -194,6 +194,9 @@ ((<= pb pc) b) (t c)))) +(register-image-reader '("png" "PNG") #'read-png) + + (defun write-png (image filespec) (with-open-file (stream filespec :direction :output :if-exists :supersede :element-type '(unsigned-byte 8)) Index: imago/src/file-pnm.lisp diff -u imago/src/file-pnm.lisp:1.2 imago/src/file-pnm.lisp:1.3 --- imago/src/file-pnm.lisp:1.2 Mon Jan 3 21:56:02 2005 +++ imago/src/file-pnm.lisp Thu Jan 6 23:41:42 2005 @@ -79,6 +79,9 @@ (skip-line stream) (values width height max-value))) +(register-image-reader '("pnm" "PNM" "ppm" "PPM" "pgm" "PGM") #'read-pnm) + + (defun write-pnm (image filespec output-format) "Writes the image data to a file in PNM format. OUTPUT-FORMAT can be either :ASCII or :BINARY." Index: imago/src/file-tga.lisp diff -u imago/src/file-tga.lisp:1.2 imago/src/file-tga.lisp:1.3 --- imago/src/file-tga.lisp:1.2 Mon Jan 3 21:56:02 2005 +++ imago/src/file-tga.lisp Thu Jan 6 23:41:42 2005 @@ -89,6 +89,9 @@ do (setf (image-pixel image x y) (funcall reader stream bpp))))) +(register-image-reader '("tga" "TGA") #'read-tga) + + (defun write-tga (image filespec &key (top-down-p nil)) (with-open-file (stream filespec :direction :output :if-exists :supersede :element-type '(unsigned-byte 8)) Index: imago/src/imago.asd diff -u imago/src/imago.asd:1.2 imago/src/imago.asd:1.3 --- imago/src/imago.asd:1.2 Mon Jan 3 21:56:02 2005 +++ imago/src/imago.asd Thu Jan 6 23:41:42 2005 @@ -29,6 +29,7 @@ (:file "convolve" :depends-on ("image" "color")) (:file "compose" :depends-on ("image" "color")) (:file "operations" :depends-on ("image" "color")) - (:file "file-png" :depends-on ("image" "color" "crc32")) - (:file "file-pnm" :depends-on ("image" "color")) - (:file "file-tga" :depends-on ("image" "color")))) + (:file "file" :depends-on ("package")) + (:file "file-png" :depends-on ("image" "color" "crc32" "file")) + (:file "file-pnm" :depends-on ("image" "color" "file")) + (:file "file-tga" :depends-on ("image" "color" "file")))) Index: imago/src/package.lisp diff -u imago/src/package.lisp:1.5 imago/src/package.lisp:1.6 --- imago/src/package.lisp:1.5 Wed Jan 5 22:11:10 2005 +++ imago/src/package.lisp Thu Jan 6 23:41:42 2005 @@ -32,6 +32,7 @@ #:make-gray #:gray-intensity #:gray-alpha #:invert-gray + #:+white+ #:+black+ #:+red+ #:+green+ #:+blue+ #:+cyan+ #:+magenta+ #:+yellow+ @@ -50,6 +51,9 @@ #:blur #:sharpen #:edge-detect #:emboss #:compose + + #:read-image + #:register-image-reader #:read-png #:write-png #:read-pnm #:write-pnm

1 0

[imago-cvs] CVS update: imago/src/drawing.lisp imago/src/package.lisp
by mvilleneuve＠common-lisp.net 05 Jan '05

05 Jan '05

Update of /project/imago/cvsroot/imago/src In directory common-lisp.net:/tmp/cvs-serv23348 Modified Files: drawing.lisp package.lisp Log Message: Added Bezier curve drawing Date: Wed Jan 5 22:11:10 2005 Author: mvilleneuve Index: imago/src/drawing.lisp diff -u imago/src/drawing.lisp:1.3 imago/src/drawing.lisp:1.4 --- imago/src/drawing.lisp:1.3 Mon Jan 3 22:25:29 2005 +++ imago/src/drawing.lisp Wed Jan 5 22:11:10 2005 @@ -90,3 +90,23 @@ (decf y))) (incf x) (circle-points x y color))))) + +(defun draw-bezier-curve (image x1 y1 x2 y2 x3 y3 x4 y4 color) + "Draws a cublic Bezier curve defined by a starting point, two control +points, and an end point, in an image." + (flet ((point-on-bezier-curve (mu) + (let* ((mum1 (- 1 mu)) + (c1 (* mum1 mum1 mum1)) + (c2 (* 3.0 mu mum1 mum1)) + (c3 (* 3.0 mu mu mum1)) + (c4 (* mu mu mu))) + (values (round (+ (* c1 x1) (* c2 x2) (* c3 x3) (* c4 x4))) + (round (+ (* c1 y1) (* c2 y2) (* c3 y3) (* c4 y4))))))) + (multiple-value-bind (x0 y0) + (point-on-bezier-curve 0.0) + (loop for tt in '(0.1 0.2 0.3 0.4 0.5 0.6 0.7 0.8 0.9 1.0) + do (multiple-value-bind (x y) + (point-on-bezier-curve tt) + (draw-line image x0 y0 x y color) + (setf x0 x) + (setf y0 y)))))) Index: imago/src/package.lisp diff -u imago/src/package.lisp:1.4 imago/src/package.lisp:1.5 --- imago/src/package.lisp:1.4 Mon Jan 3 22:25:29 2005 +++ imago/src/package.lisp Wed Jan 5 22:11:10 2005 @@ -44,6 +44,7 @@ #:draw-pixel #:draw-line #:draw-rectangle #:draw-polygon #:draw-circle + #:draw-bezier-curve #:convolve #:blur #:sharpen #:edge-detect #:emboss

1 0

[imago-cvs] CVS update: imago/src/drawing.lisp imago/src/package.lisp
by mvilleneuve＠common-lisp.net 03 Jan '05

03 Jan '05

Update of /project/imago/cvsroot/imago/src In directory common-lisp.net:/tmp/cvs-serv7121 Modified Files: drawing.lisp package.lisp Log Message: Added a DRAW-POLYGON function Date: Mon Jan 3 22:25:30 2005 Author: mvilleneuve Index: imago/src/drawing.lisp diff -u imago/src/drawing.lisp:1.2 imago/src/drawing.lisp:1.3 --- imago/src/drawing.lisp:1.2 Mon Jan 3 21:56:02 2005 +++ imago/src/drawing.lisp Mon Jan 3 22:25:29 2005 @@ -20,6 +20,7 @@ (defun draw-line (image x1 y1 x2 y2 color &key (dash-length 1) (dash-interval 0)) + "Draws a line between two points in an image." (let ((drawing t) (counter 0)) (do-line-pixels (image pixel x y x1 y1 x2 y2) @@ -34,24 +35,31 @@ (setf drawing t counter 0)))))) -(defun draw-rectangle (image x1 y1 width height color) +(defun draw-rectangle (image x1 y1 width height color + &key (dash-length 1) (dash-interval 0)) "Draws a rectangle in an image." - (let* ((image-width (image-width image)) - (pixels (image-pixels image)) - (index (+ (* y1 image-width) x1))) - (loop for index2 = index then (1+ index2) - repeat width - do (setf (row-major-aref pixels index2) color)) - (loop for index2 = (+ index (* (1- height) image-width)) then (1+ index2) - repeat width - do (setf (row-major-aref pixels index2) color)) - (loop for index2 = (+ index image-width) then (+ index2 image-width) - repeat (- height 2) - do (setf (row-major-aref pixels index2) color)) - (loop for index2 = (+ index image-width width -1) - then (+ index2 image-width) - repeat (- height 2) - do (setf (row-major-aref pixels index2) color)))) + (let ((x2 (+ x1 width -1)) + (y2 (+ y1 height -1))) + (draw-line image x1 y1 x2 y1 color + :dash-length dash-length :dash-interval dash-interval) + (draw-line image x1 y2 x2 y2 color + :dash-length dash-length :dash-interval dash-interval) + (draw-line image x1 y1 x1 y2 color + :dash-length dash-length :dash-interval dash-interval) + (draw-line image x2 y1 x2 y2 color + :dash-length dash-length :dash-interval dash-interval))) + +(defun draw-polygon (image coord-list color + &key (closed t) (dash-length 1) (dash-interval 0)) + "Draws a polygon in an image." + (loop for (x1 y1 x2 y2) on coord-list by #'cddr + do (when (and closed (null x2) (null y2)) + (setf x2 (first coord-list) + y2 (second coord-list))) + (unless (or (null x2) (null y2)) + (draw-line image x1 y1 x2 y2 color + :dash-length dash-length + :dash-interval dash-interval)))) (defun draw-circle (image center-x center-y radius color) "Draws a circle in an image." Index: imago/src/package.lisp diff -u imago/src/package.lisp:1.3 imago/src/package.lisp:1.4 --- imago/src/package.lisp:1.3 Mon Jan 3 21:56:02 2005 +++ imago/src/package.lisp Mon Jan 3 22:25:29 2005 @@ -41,7 +41,9 @@ #:copy #:flip #:scale #:resize - #:draw-pixel #:draw-line #:draw-rectangle #:draw-circle + #:draw-pixel #:draw-line + #:draw-rectangle #:draw-polygon + #:draw-circle #:convolve #:blur #:sharpen #:edge-detect #:emboss

1 0

[imago-cvs] CVS update: imago/src/image-utilities.lisp
by mvilleneuve＠common-lisp.net 03 Jan '05

03 Jan '05

Update of /project/imago/cvsroot/imago/src In directory common-lisp.net:/tmp/cvs-serv7078 Modified Files: image-utilities.lisp Log Message: Fixed iteration bug in DO-LINE-PIXELS Date: Mon Jan 3 22:24:38 2005 Author: mvilleneuve Index: imago/src/image-utilities.lisp diff -u imago/src/image-utilities.lisp:1.2 imago/src/image-utilities.lisp:1.3 --- imago/src/image-utilities.lisp:1.2 Mon Jan 3 21:56:02 2005 +++ imago/src/image-utilities.lisp Mon Jan 3 22:24:38 2005 @@ -121,7 +121,7 @@ (,index (+ (* ,width ,y) ,x))) (symbol-macrolet ((,color (row-major-aref ,pixels ,index))) (if (>= ,adx ,ady) - (let* ((,count ,adx) + (let* ((,count (1+ ,adx)) (,errmax ,adx) (,errinc ,ady) (,err (floor ,errmax 2))) @@ -134,7 +134,7 @@ (decf ,err ,errmax)) (incf ,index ,x-inc) (incf ,x ,x-inc))) - (let* ((,count ,ady) + (let* ((,count (1+ ,ady)) (,errmax ,ady) (,errinc ,adx) (,err (floor ,errmax 2)))

1 0

[imago-cvs] CVS update: imago/src/color.lisp imago/src/compose.lisp imago/src/convert.lisp imago/src/convolve.lisp imago/src/crc32.lisp imago/src/drawing.lisp imago/src/file-png.lisp imago/src/file-pnm.lisp imago/src/file-tga.lisp imago/src/image-utilities.lisp imago/src/image.lisp imago/src/imago.asd imago/src/operations.lisp imago/src/package.lisp imago/src/utilities.lisp
by mvilleneuve＠common-lisp.net 03 Jan '05

03 Jan '05

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(a)free.fr) +;;; Copyright (C) 2004-2005 Matthieu Villeneuve (matthieu.villeneuve(a)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(a)free.fr) +;;; Copyright (C) 2004-2005 Matthieu Villeneuve (matthieu.villeneuve(a)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(a)free.fr) +;;; Copyright (C) 2004-2005 Matthieu Villeneuve (matthieu.villeneuve(a)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(a)free.fr) +;;; Copyright (C) 2004-2005 Matthieu Villeneuve (matthieu.villeneuve(a)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(a)free.fr) +;;; Copyright (C) 2004-2005 Matthieu Villeneuve (matthieu.villeneuve(a)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(a)free.fr) +;;; Copyright (C) 2004-2005 Matthieu Villeneuve (matthieu.villeneuve(a)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(a)free.fr) +;;; Copyright (C) 2004-2005 Matthieu Villeneuve (matthieu.villeneuve(a)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(a)free.fr) +;;; Copyright (C) 2004-2005 Matthieu Villeneuve (matthieu.villeneuve(a)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(a)free.fr) +;;; Copyright (C) 2004-2005 Matthieu Villeneuve (matthieu.villeneuve(a)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(a)free.fr) +;;; Copyright (C) 2004-2005 Matthieu Villeneuve (matthieu.villeneuve(a)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(a)free.fr) +;;; Copyright (C) 2004-2005 Matthieu Villeneuve (matthieu.villeneuve(a)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(a)free.fr) +;;; Copyright (C) 2004-2005 Matthieu Villeneuve (matthieu.villeneuve(a)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(a)free.fr) +;;; Copyright (C) 2004-2005 Matthieu Villeneuve (matthieu.villeneuve(a)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(a)free.fr) +;;; Copyright (C) 2004-2005 Matthieu Villeneuve (matthieu.villeneuve(a)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(a)free.fr) +;;; Copyright (C) 2004-2005 Matthieu Villeneuve (matthieu.villeneuve(a)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

1 0

[imago-cvs] CVS update: imago/src/color.lisp
by mvilleneuve＠common-lisp.net 03 Jan '05

03 Jan '05

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)))

1 0

[imago-cvs] CVS update: imago/src/package.lisp
by mvilleneuve＠common-lisp.net 03 Jan '05

03 Jan '05

Update of /project/imago/cvsroot/imago/src In directory common-lisp.net:/tmp/cvs-serv5268 Modified Files: package.lisp Log Message: Export pixel types Date: Mon Jan 3 21:46:19 2005 Author: mvilleneuve Index: imago/src/package.lisp diff -u imago/src/package.lisp:1.1.1.1 imago/src/package.lisp:1.2 --- imago/src/package.lisp:1.1.1.1 Thu Oct 14 00:01:46 2004 +++ imago/src/package.lisp Mon Jan 3 21:46:17 2005 @@ -18,6 +18,7 @@ #:image-width #:image-height #:image-pixels #:image-pixel #:rgb-image #:indexed-image #:grayscale-image + #:rgb-pixel #:indexed-pixel #:grayscale-pixel #:with-image-definition #:do-image-pixels #:do-region-pixels #:do-line-pixels

1 0

[imago-cvs] CVS update: imago/src/image.lisp
by mvilleneuve＠common-lisp.net 03 Jan '05

03 Jan '05

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)

1 0