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)
