[mcclim-devel] question about display functions and control apps

[Paul Werkowski]

| Very interesting. Does this all "just work" in LispWorks CLIM? Do see
| any weird artifacts with presentation highlighting?

It all seems to just work. I added some simple presentation stuff to the
code (see below)
and don't see anything unusual as yet. LWW CLIM's presentation highlighting
leaves
a bit to be desired as the outline seems to be off by 1 pixel (overwriting
object on
left and top) but that's normal.

I'm going to try this technique on some real code that currently does have
some
presentation abnormalities to see if this works better. I'll let you know
what happens.

Paul

~~~~~~~~~~~~~~~~~~~~~~~
(in-package :clim-user)

(defclass thing ()
  ((x :initarg :x)
   (y :initarg :y))
  (:default-initargs :x (random 100) :y (random 100)))

(define-application-frame a-test ()
  ((things :initform nil))
  (:pointer-documentation nil)
  (:menu-bar nil)
  (:panes
   (p1 :application
       :width 300 :height 200
       :end-of-line-action :allow
       :display-function 'p1df
       :incremental-redisplay t))
  (:layouts
   (default p1)))

(defun p1df (frame pane)
  (with-output-recording-options (pane :record t)
    (with-slots (things) frame
      (dolist (thing things)
        (with-slots (x y) thing
          (updating-output (pane :unique-id thing
                                 :cache-value (list x y)
                                 :cache-test #'equal)
            (with-output-as-presentation (pane thing 'thing)
              (draw-rectangle* pane x y (+ x 10) (+ y 10) :ink
+blue+))))))))

(defvar *frame* nil)

(defun doit ()
  ;; display A-TEST application
  (setq *frame* (make-application-frame 'a-test))
  (run-frame-top-level *frame*))

(defclass my-event (device-event)()
  (:default-initargs :modifier-state 0))

(defmethod handle-event (client (event my-event))
  (with-application-frame (frame)
    (redisplay-frame-pane frame client)))

(defun stuffit (frame)
  ;; do something to "update the database"
  (let ((tls (frame-top-level-sheet frame))
        (pane (frame-standard-output frame)))
    (with-slots (things) frame
      (push (make-instance 'thing) things))
    ;; Inform frame that something has changed
    (queue-event
     tls
     ;; :sheet causes event-handler client to be that
     (make-instance 'my-event :sheet pane))))


(define-presentation-type thing ())

(define-a-test-command (com-noop)((object 'thing))
  (print object *trace-output*)
  )

(define-presentation-to-command-translator x-noop
   (thing com-noop a-test)
   (object)
  (list object))