[mcclim-devel] program for incremental redisplay benchmark

[Robert Strandh]

Here is the (last version of the) program I used to obtain the
benchmark:

(defpackage :example
  (:use :clim-lisp :clim :esa)
  (:export))

(in-package :example)

(defmethod handle-repaint :before ((pane esa-pane-mixin) region)
  (declare (ignore region pane))
  nil)

(defclass example-info-pane (info-pane)
  ()
  (:default-initargs
      :height 20 :max-height 20 :min-height 20
      :display-function 'display-info
      :incremental-redisplay t))

(defun display-info (frame pane)
  (declare (ignore frame))
  (format pane "Pane name: ~s" (pane-name (master-pane pane))))

(defclass example-minibuffer-pane (minibuffer-pane)
  ()
  (:default-initargs
      :height 20 :max-height 20 :min-height 20))

(defun make-word ()
  (with-output-to-string (string)
    (loop repeat (+ 4 (random 3))
	  do (princ (code-char (+ 97 (random 26))) string))))

(defun generate-words ()
  (loop repeat (+ 8 (random 4))
	collect (make-word)))

(defclass text-line ()
  ((words :initform (generate-words) :initarg :words :accessor words)))

(defun generate-lines ()
  (loop repeat (+ 8 (random 4))
        collect (make-instance 'text-line)))

(defclass paragraph ()
  ((lines :initform (generate-lines) :initarg :lines :accessor lines)))

(defun generate-contents ()
  (loop repeat 1000
	collect (make-instance 'paragraph)))

(defclass example-pane (esa-pane-mixin application-pane)
  ((contents :initform (generate-contents) :accessor contents)))

(define-application-frame example (esa-frame-mixin
				   standard-application-frame)
  ()
  (:panes
   (window (let* ((my-pane 
		(make-pane 'example-pane
			   :width 900 :height 400
			   :name 'my-pane
			   :display-function 'display-my-pane
			   :incremental-redisplay t
			   :command-table 'global-example-table))
	       (my-info-pane
		(make-pane 'example-info-pane
			   :master-pane my-pane
			   :width 900)))
	  (setf (windows *application-frame*) (list my-pane))
	  (vertically ()
	    (scrolling ()
	      my-pane)
	    my-info-pane)))
   (minibuffer (make-pane 'example-minibuffer-pane :width 900)))
  (:layouts
   (default
       (vertically (:scroll-bars nil)
	 window
	 minibuffer)))
  (:top-level (esa-top-level)))

(defparameter *counter* 5)

(defun display-my-pane (frame pane)
  (declare (ignore frame))
  (with-output-recording-options (pane :record t :draw nil)
    (loop for paragraph in (contents pane)
	  do (updating-output (pane :unique-id paragraph :cache-value paragraph)
	       (loop for line in (lines paragraph)
		     do (updating-output (pane :unique-id line :cache-value line)
			  (loop for word in (words line)
				do (format pane "~a " word))
			  (terpri pane)))
	       (terpri pane))))
  (stream-replay pane))

(defun example (&key (width 900) (height 400))
  "Starts up the example application"
  (clim-sys:make-process
   (lambda () 
     (let ((frame (make-application-frame
		   'example
		   :width width :height height)))
       (run-frame-top-level frame)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; 
;;; Commands and key bindings

(define-command-table global-example-table
    :inherit-from (global-esa-table keyboard-macro-table))

(define-example-command (com-nothing :name t) ()
  nil)

(set-key 'com-nothing 'global-example-table '(#\n))

(define-example-command (com-modify :name t) ()
  (let* ((paragraphs (contents (find-pane-named *application-frame* 'my-pane)))
	 (lines (lines (car paragraphs)))
	 (words (words (car lines)))
	 (new-words (cons (make-word) (cdr words)))
	 (new-lines (cons (make-instance 'text-line :words new-words)
			  (cdr lines)))
	 (new-paragraphs (cons (make-instance 'paragraph
					      :lines new-lines)
			       (cdr paragraphs))))
    (setf (contents (find-pane-named *application-frame* 'my-pane))
	  new-paragraphs)))

(set-key 'com-modify 'global-example-table '(#\m))

(define-example-command (com-add :name t) ()
  (let* ((paragraphs (contents (find-pane-named *application-frame* 'my-pane)))
	 (lines (lines (car paragraphs)))
	 (new-lines (if (< (random 100) 55)
			(cons (make-instance 'text-line) lines)
			(cdr lines)))
	 (new-paragraphs (cons (make-instance 'paragraph
					      :lines new-lines)
			       (cdr paragraphs))))
    (setf (contents (find-pane-named *application-frame* 'my-pane))
	  new-paragraphs)))

(set-key 'com-add 'global-example-table '(#\a))



-- 
Robert Strandh

---------------------------------------------------------------------
Greenspun's Tenth Rule of Programming: any sufficiently complicated C
or Fortran program contains an ad hoc informally-specified bug-ridden
slow implementation of half of Common Lisp.
---------------------------------------------------------------------