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)