CLIM mail archive
[Prev][Next][Index][Thread]

Loading ALL images in CLIM2.0

One can load any image from MPEG movies or from just about any image
format into CLIM2.0 by first using the appropriate X conversion program
that matches "*toppm" in your X11/bin. This will produce a somewhat
dense file in P6 or portable pixmap format. The following can then be
used to load such *.ppm files into portable CLIM2.0 patterns.

Loading a 640x480 image into a pattern on a hearty UNIX workstation
can take up to 20 seconds (I observed the best performances
using the ACL 4.2 compiler so far), then the first time you call
CLIM:DRAW-PATTERN* may take another 15 seconds. That is still less than
40 seconds for a large pattern (about 1 second for a small one).

Interestingly each pattern will redisplay at a rate of about
10ms every time after that (on ACL 4.2). This approach allows in
theory to provide movie animation from CLIM2.0 at the rate of 100 images
a second, that's faster than any animation tool accessing movies from
disk on this type of workstation! Unfortunately to preload a 10 seconds
movie clip at 15 images per second can take 1 hour and fourty minutes.

Constructing a pattern in CLIM2.0 means loading the image data into
memory, then displaying the pattern requires transfering this image data
to the graphics server(e.g. X). It seems that ACL 4.2 does an excellent
job of caching the image data and colors between Lisp and the X server
(~10ms redisplay time). Unfortunately the initial load and transfer rates
are prohibitive. I would like to suggest that a CLIM2.0 implementation
could be implemented in two halfs (a logical client and a graphical
server) and would provide the best of all graphics worlds I have seen
by being smart about dumb image data and directly loading them in the memory
of the graphics server [i.e. Not loading in LISP memory data that is
destined to the graphical server would significantly reduce overhead
in handling large and dumb graphical objects (like color images)].

The following is provided for interested CLIM users on the net who
wish to experiment with the above. We are interested in benchmarks and
suggestions for improvements. We are also curious about CLIM architecture
proposals providing an optimal division of CLIM functionality between:
1. Client/Logical side: smart interactive graphics and advanced algorithms.
2. Server/Dumb graphics: fast data transfer from memory to display.

We feel both sides can benefit from LISP memory management advantages
and provide efficient solutions where simpler memory management systems are
doomed. But the second half (2) is currently too dumb and limited
[as a graphics slave] from CLIM's (and our) perspective to reach this goal.
Hint: a persistent data storage shared by both halfs of a CLIM implementation
might do wonders...
---------------------------readppm.lisp----------------------------
(in-package "CLIM-USER")

;;;
;;; P6 - portable pixmap raw format read from file.
;;; This is the preferred format to import images from X tools
;;; into CLIM2.0. This format is generated by the X image
;;; convertion tools "*toppm" with RAWBITS on (default).
;;;
;;; If ARRAY is given and of the right size, it will be reused
;;; this argument should be used to reload a pattern after editing it
;;; with an external tools to avoid unnecessary GC.
;;;
;;; O.B. Clos
;;;
(defun read-pattern-from-file (bm &key array)
  (with-open-file (stream bm :direction :input)
    (let ((format (read stream nil nil)) designs)
      (multiple-value-setq (array designs)
	(clim-sys:without-interrupts
	  (read-bitmap-from-stream stream format :array array)))
      (if (and array designs)
	  (clim:make-pattern array designs)
	(error "Unable to read pattern from file ~a (format: ~a)." bm format)))))

;;; Read a P6 format file
;;;
;;; Note that it is very easy to write an inefficient version of this
;;; that takes 1 or 2 minutes to read a 640x480 pattern instead of <20 seconds.
;;; [The following is optimized for compilers that understand (UNSIGNED-BYTE 8)
;;; other compilers can easily produce code over 10 times slower!]
;;;
(defmethod read-bitmap-from-stream ((stream t) (format (eql 'p6)) &key array &allow-other-keys)
  (declare (optimize speed (safety 0) (space 0) (debug 0)))
  (let ((width (read stream nil nil))
	(height (read stream nil nil))
	(max (read stream nil nil))
	(charmax (character 255)))
    (declare (fixnum width height))
    (if (> max 255)
	(warn "A bitmap of format ~a may require too many colors (~a)." format max))
    (let (colorlist
	  (array8 (reusing-array array height width)))
      (declare (type (array (unsigned-byte 8) (* *)) array8))
      (let ((ctable (load-time-value (make-hash-table :size 255 :test #'equalp)))
	    (ccode (load-time-value (make-array 3 :element-type 'character
						:initial-element (character 255))))
	    (rgb (load-time-value (list 1.0 1.0 1.0)))
	    (fmax (coerce max 'single-float)))
	(declare (type (simple-array character (3)) ccode)
		 (single-float fmax))
	(clrhash ctable)
	(flet ((read-p6-color-rgb (stream)
		 (declare (optimize speed (safety 0) (space 0) (debug 0))
			  (ftype (function (fixnum single-float) single-float) /)
			  (ftype (function (character) fixnum) char-code))
		 (setf (elt ccode 0) (the character (read-char stream nil charmax))
		       (elt ccode 1) (the character (read-char stream nil charmax))
		       (elt ccode 2) (the character (read-char stream nil charmax)))
		 (or (gethash ccode ctable)
		     (setf (elt rgb 0) (the single-float
					 (/ (char-code (elt ccode 0)) fmax))
			   (elt rgb 1) (the single-float
					 (/ (char-code (elt ccode 1)) fmax))
			   (elt rgb 2) (the single-float
					 (/ (char-code (elt ccode 2)) fmax))
			   colorlist (nconc colorlist
					    (list (apply #'clim:make-rgb-color rgb)))
			   (gethash (copy-seq ccode) ctable) (1- (length colorlist))))))
	  ;; Note that we used an optimized version of LOOP that
	  ;; propagates type declaration all the way down with little
	  ;; noticeable improvements (about 40%).
	  (loop for j fixnum from 0 below height
	      do (loop for i fixnum from 0 below width
		     do (setf (aref array8 j i) (read-p6-color-rgb stream))))
	  (values array8 colorlist))))))

(defun reusing-array (array &rest dimensions)
  (if (and (arrayp array)
	   (equal (array-dimensions array) dimensions))
      array
    (make-array dimensions :element-type '(unsigned-byte 8) :initial-element 0)))
Main Index | Thread Index