CLIM mail archive
[Prev][Next][Index][Thread]
Improving incremental redisplay speed
I have an application that manipulates a 2d matrix of info., much like a bitmap editor
might. I had been using formatting-table to display the matrix, but now matrix is larger,
say 100 by 100 elements, and formatting-table with incremental redisplay became painfully
slow. So I put the following code together, with the thought that I would let incremental
redisplay take care of gross redisplays but make it ignore the fine changes by controlling
the :cache values correctly. I figured I'd do the fine redisplay of matrix elements manually
in a presentation to command translator. So I recorded the output records of the matrix objects,
and I can highlight them okay (in the translator), but I can't figure out how to change the way
the displayed objects look depending on the state of the object by redrawing the output record
in a new color.
A code sample is included below. The test function name is (test). Click on a track to
open the 2d matrix. I attempt to toggle the grid element color depending on the state
of the underlying object in the function (define-table-frame-command (highlite-spot :name "Show")).
A second question: is this the best approach?
Thanks,
Greg Anderson
Applied Physics Laboratory
University of Washington
--- Sample code follows ---
;;; -*- Mode: LISP; Syntax: Common-lisp; Package: (FAST-TABLE); Base: 10 -*-
;;;Genera 8.3 CLIM 2.0 (52.13)
(defpackage :fast-table (:use CLIM-LISP CLIM))
(in-package :fast-table)
(defparameter *tracks* nil)
(defvar *standard-gray* (make-ihs-color 1.2 0 0))
(defclass data-navigator-view (textual-view) ())
(defparameter +data-navigator-view+ (make-instance 'data-navigator-view))
(defun test (&key (port (clim:find-port)))
(setf *tracks* (loop for i below 2
collecting (make-instance 'track) into tracks
finally (return tracks)))
(let*
((framem (find-frame-manager :port port))
(frame (make-application-frame 'table-frame
:pretty-name "ASAPS Frame"
:frame-manager framem
:height 600
:width 500
)))
(run-frame-top-level frame)))
(define-application-frame table-frame ()
()
(:command-table (table-frame :inherit-from (accept-values-pane)))
(:panes
(title-nav :title
:display-string "Data Navigator")
(nav :application
:name :navigation
:display-function 'draw-data-navigator-display
:incremental-redisplay t ;Supplies outermost updating-output for nav pane
:display-after-commands nil
:scroll-bars :both
:end-of-page-action :scroll
)
(pointer :pointer-documentation)
(menu :command-menu))
(:menu-bar nil) ; Suppress menu bar at the top
(:layouts
(default
(vertically ()
(.05 title-nav) ;(:compute title-nav)
(:fill nav)
(.05 menu) ;(:compute menu)
(.04 pointer) ;(:compute pointer)
))))
(define-table-frame-command (com-exit-table-frame
:menu "Exit"
:name "Exit table formatter")
()
(frame-exit *application-frame*))
(defclass track ()
((exposed :accessor exposed :initform nil)
(data :initform (make-grid))))
(defclass spot ()
((beam :initarg :beam)
(ping :initarg :ping)
(x-scaled
:initarg :x-scaled)
(x-size
:initarg :x-size)
(y-scaled
:initarg :y-scaled)
(y-size
:initarg :y-size)
(color
:initarg :color
:accessor color)
(output-record
:initform nil
:accessor output-record)
)
)
(defun make-grid ()
(let* ((sectors 20)
(beams 50)
(size 5)
(array (make-array `(,sectors ,beams)
:initial-contents
(loop for sector below sectors
with y-size = size
for y-scaled = (* sector y-size)
collecting
(loop for beam from 0 below beams
with x-size = size
for x-scaled = (* beam x-size)
collecting
(make-instance 'spot :beam beam :ping sector
:x-scaled x-scaled :y-scaled y-scaled
:x-size x-size :y-size y-size
:color *standard-gray*)
into stuff
finally (return stuff))
into stuff
finally (return stuff)))))
array))
(defmethod draw-data-navigator-display ((frame table-frame) stream)
(stream-set-cursor-position stream 0 0)
(dolist (track *tracks*)
(with-slots (exposed) track
(present track 'track :stream stream :view +data-navigator-view+ :sensitive t))))
(defmethod draw-table ((object track) stream)
(when (exposed object)
(with-translation (stream 0 (nth-value 1 (stream-cursor-position stream)))
(with-slots (exposed data) object
(loop for sector from 0 below (elt (array-dimensions data) 0)
do
(loop for beam from 0 below (elt (array-dimensions data) 1)
do
(unless (output-record (aref data sector beam))
(setf (output-record (aref data sector beam))
(updating-output (stream :unique-id (aref data sector beam))
(present (aref data sector beam)
'spot :stream stream :view +data-navigator-view+)))
)))))))
(define-presentation-method present
(object (type track) stream
(view data-navigator-view) &key)
(with-slots (exposed data) object
(multiple-value-bind (x y)
(stream-cursor-position stream)
(updating-output (stream :unique-id object :cache-value exposed)
(stream-set-cursor-position stream 0 y)
(let* ((record (with-new-output-record (stream)
(format stream "~A~%" (type-of object))
(draw-table object stream)))
(width (bounding-rectangle-width record))
(height (bounding-rectangle-height record)))
(incf y height)
(stream-set-cursor-position stream 0 y))))))
(define-table-frame-command (expose-track :name "Show")
((object 'track))
(setf (exposed object) (not (exposed object)))
)
(define-presentation-to-command-translator expose-track
(track expose-track table-frame
:gesture :select
;;:tester ((object) (not (exposed object)))
;;:documentation ((stream object)
;; (format-documentation stream (if (typep object 'track) "Open" "Show") object))
:pointer-documentation ((stream object)
(format-loc stream (if (typep object 'track) "Open" "Show") object))
)
(object)
`(,object))
(defmethod format-loc (stream string (object track))
(with-slots (x-scaled y-scaled beam ping) object
(format stream "~:(~A ~A~)" string (type-of object))))
(define-presentation-method present
(object (type spot) stream
(view data-navigator-view) &key)
(with-slots (x-scaled x-size y-scaled y-size color) object
(updating-output (stream :unique-id object :cache-value color)
(let ((adj (if (eq color *standard-gray*) -1 0)))
(draw-rectangle* stream x-scaled y-scaled (+ x-scaled x-size adj) (+ y-scaled y-size adj)
:filled t :ink color)
;; Faster, but not significantly and does not provide presentation capabilities
;; (clim-internals::draw-rectangle-internal stream 0 0 x-scaled y-scaled
;; (+ x-scaled x-size adj) (+ y-scaled y-size adj) color (make-line-style :thickness 1)))
;; Slower
;; (draw-point* stream x-scaled y-scaled :line-thickness 3 :ink color)
;; Slower
;; (draw-circle* stream x-scaled y-scaled (/ x-size 2)
;; :filled t :ink color)
))))
(define-table-frame-command (highlite-spot :name "Show")
((object 'spot) (stream 'application-pane))
(if (eq (color object) *standard-gray*)
(setf (color object) +red+)
(setf (color object) *standard-gray*))
;; This works quick, but it messes up the history and breaks later
;(present object 'spot :stream stream :view +data-navigator-view+)
;; This seems like what I should be doing, but it bombs.
;; How do I update the output record based on the changed state of the data?
;; Perhaps I need to delete the old output record and create a new one?
(redisplay (output-record object) stream)
(replay-output-record (output-record object) stream)
(highlight-output-record (output-record object) stream :highlight)
)
(define-presentation-to-command-translator highlite-spot
(spot highlite-spot table-frame
:gesture :select
:pointer-documentation ((stream object)
(format-loc stream (if (typep object 'Spot) "Open" "Show") object)))
(object window)
`(,object ,window))
(defmethod format-loc (stream string (object spot))
(with-slots (x-scaled y-scaled beam ping) object
(format stream "~:(~A (beam ~d ping ~d) ~A~)" string (1+ beam) (1+ ping) (type-of object))))
(define-table-frame-command (highlite-spot :name "Show")
((object 'spot) (stream 'application-pane))
(if (eq (color object) *standard-gray*)
(setf (color object) +red+)
(setf (color object) *standard-gray*))
;; This works quick, but it messes up the history and breaks later
;(present object 'spot :stream stream :view +data-navigator-view+)
;; This seems like what I should be doing, but it bombs.
;; How do I update the output record based on the new state of the data?
;; Perhaps I need to delete the old output record and create a new one?
(redisplay (output-record object) stream)
(replay-output-record (output-record object) stream)
(highlight-output-record (output-record object) stream :highlight)
)
(define-presentation-to-command-translator highlite-spot
(spot highlite-spot table-frame
:gesture :select
:pointer-documentation ((stream object)
(format-loc stream (if (typep object 'Spot) "Open" "Show") object)))
(object window)
`(,object ,window))
(defmethod format-loc (stream string (object spot))
(with-slots (x-scaled y-scaled beam ping) object
(format stream "~:(~A (beam ~d ping ~d) ~A~)" string (1+ beam) (1+ ping) (type-of object))))
Follow-Ups:
Main Index |
Thread Index