[imago-cvs] CVS update: imago/src/file-png.lisp

[Matthieu Villeneuve]

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