From mvilleneuve at common-lisp.net Wed Oct 13 22:01:59 2004 From: mvilleneuve at common-lisp.net (Matthieu Villeneuve) Date: Thu, 14 Oct 2004 00:01:59 +0200 Subject: [imago-cvs] CVS update: Module imported: imago Message-ID: Update of /project/imago/cvsroot/imago In directory common-lisp.net:/tmp/cvs-serv13658 Log Message: Initial import Status: Vendor Tag: mvilleneuve Release Tags: init N imago/src/package.lisp N imago/src/image.lisp N imago/src/drawing.lisp N imago/src/convert.lisp N imago/src/color.lisp N imago/src/image-utilities.lisp N imago/src/operations.lisp N imago/src/utilities.lisp N imago/src/file-pnm.lisp N imago/src/convolve.lisp N imago/src/imago.asd N imago/src/file-png.lisp N imago/src/file-tga.lisp N imago/src/compose.lisp N imago/src/crc32.lisp N imago/src/.xvpics/test.pnm N imago/src/.xvpics/test.tga N imago/src/.xvpics/test3.pnm N imago/src/.xvpics/test2.tga N imago/src/.xvpics/testt.tga N imago/src/.xvpics/test.png No conflicts created by this import Date: Thu Oct 14 00:01:58 2004 Author: mvilleneuve New module imago added From mvilleneuve at common-lisp.net Tue Oct 19 06:26:02 2004 From: mvilleneuve at common-lisp.net (Matthieu Villeneuve) Date: Tue, 19 Oct 2004 08:26:02 +0200 Subject: [imago-cvs] CVS update: imago/src/file-png.lisp Message-ID: Update of /project/imago/cvsroot/imago/src In directory common-lisp.net:/tmp/cvs-serv22907 Modified Files: file-png.lisp Log Message: Little optimization of memory allocation in READ-PNG Date: Tue Oct 19 08:26:02 2004 Author: mvilleneuve Index: imago/src/file-png.lisp diff -u imago/src/file-png.lisp:1.1.1.1 imago/src/file-png.lisp:1.2 --- imago/src/file-png.lisp:1.1.1.1 Thu Oct 14 00:01:53 2004 +++ imago/src/file-png.lisp Tue Oct 19 08:26:02 2004 @@ -29,7 +29,10 @@ :element-type '(unsigned-byte 8)) (read-png-signature stream) (let ((descriptor nil) - (data (make-array 0 :element-type '(unsigned-byte 8) :adjustable t)) + (data (make-array (file-length stream) + :element-type '(unsigned-byte 8) :adjustable t + :fill-pointer 0)) + (data-index 0) (colormap nil)) (loop for chunk = (read-png-chunk stream) until (= (car chunk) +png-iend-chunk-type+) @@ -39,10 +42,10 @@ (setf colormap (decode-png-colormap (cdr chunk)))) ((= (car chunk) +png-idat-chunk-type+) (let* ((chunk-data (cdr chunk)) - (chunk-length (length chunk-data)) - (data-length (length data))) - (adjust-array data (+ data-length chunk-length)) - (replace data chunk-data :start1 data-length))))) + (chunk-length (length chunk-data))) + (incf (fill-pointer data) chunk-length) + (replace data chunk-data :start1 data-index) + (incf data-index chunk-length))))) (when (or (/= (png-descriptor-compression-method descriptor) 0) (/= (png-descriptor-filter-method descriptor) 0) (/= (png-descriptor-interlace-method descriptor) 0)) From mvilleneuve at common-lisp.net Wed Oct 20 06:20:56 2004 From: mvilleneuve at common-lisp.net (Matthieu Villeneuve) Date: Wed, 20 Oct 2004 08:20:56 +0200 Subject: [imago-cvs] CVS update: imago/src/file-png.lisp Message-ID: Update of /project/imago/cvsroot/imago/src In directory common-lisp.net:/tmp/cvs-serv21184 Modified Files: file-png.lisp Log Message: Memory usage optimization in DECODE-PNG-IMAGE Date: Wed Oct 20 08:20:55 2004 Author: mvilleneuve Index: imago/src/file-png.lisp diff -u imago/src/file-png.lisp:1.2 imago/src/file-png.lisp:1.3 --- imago/src/file-png.lisp:1.2 Tue Oct 19 08:26:02 2004 +++ imago/src/file-png.lisp Wed Oct 20 08:20:55 2004 @@ -30,7 +30,7 @@ (read-png-signature stream) (let ((descriptor nil) (data (make-array (file-length stream) - :element-type '(unsigned-byte 8) :adjustable t + :element-type '(unsigned-byte 8) :fill-pointer 0)) (data-index 0) (colormap nil)) @@ -103,7 +103,8 @@ (color-type (png-descriptor-color-type descriptor)) (depth (png-descriptor-depth descriptor)) (samples-per-pixel (png-samples-per-pixel color-type)) - (samples (make-array (* width height samples-per-pixel))) + (samples (make-array (* width height samples-per-pixel) + :element-type '(unsigned-byte 16))) (data-bit-index 0)) (loop with samples-index = 0 for y below height @@ -146,26 +147,23 @@ with pixels = (make-array (list height width) :initial-element 0) for y below height do (loop for x below width - for pixel-samples = (loop repeat samples-per-pixel - collect (read-array-element - samples samples-index)) - do (unless (= color-type 3) - (map-into pixel-samples - (lambda (x) (ash x (- 8 depth))) - pixel-samples)) - (setf (aref pixels y x) - (case color-type - (0 (make-gray (first pixel-samples))) - (2 (make-color (first pixel-samples) - (second pixel-samples) - (third pixel-samples))) - (3 (first pixel-samples)) - (4 (make-gray (first pixel-samples) - (second pixel-samples))) - (6 (make-color (first pixel-samples) - (second pixel-samples) - (third pixel-samples) - (fourth pixel-samples)))))) + do (macrolet ((next-byte () + `(ash (read-array-element + samples samples-index) + (- 8 depth)))) + (setf (aref pixels y x) + (case color-type + (0 (make-gray (next-byte))) + (2 (make-color (next-byte) + (next-byte) + (next-byte))) + (3 (read-array-element samples samples-index)) + (4 (make-gray (next-byte) + (next-byte))) + (6 (make-color (next-byte) + (next-byte) + (next-byte) + (next-byte))))))) finally (return pixels)))) (defun png-samples-per-pixel (color-type)