[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Re: modal dialogs (continued)

>I had a couple of very nice answers to my question
>about modal dialogs, but realised that I had failed to
>make clear in my initial question that one thing I wanted
>my progress indication modal dialog to do, is to respect
>system 7.0's standards (i.e. I want the user to be able
>to select the applications menu to switch application
>during the computation, etc).
>I was able to do it using the following new feature of modal-dialog:
>(modal-dialog (make-instance 'window)
>              t
>              #'(lambda () (do-some-processing) nil))
>The problem in this case is that the "do-some-processing"
>function has to be very fast not to bog down modal dialog
>processing, but it gets called at a *VERY* slow rate
>(about only 10 times per second, even if does nothing!).

The following may be a start:

; modal-dialog-while processing

(defun process-with-modal-dialog (dialog processor updater &optional (close-on-exit t))
    (let* ((*modal-dialog-on-top* t)
            #'(lambda ()
                (funcall updater dialog)
                (let* ((event *current-event*)
                       (what (rref event :EventRecord.what)))
                  (when (or (and (eq what #$mouseDown)
                                 (not (eql #$inMenuBar
                                           (rlet ((w :point))
                                              (rref event :eventRecord.where) w)))))
                            (eq what #$keyDown)
                            (eq what #$autoKey))
      (declare (dynamic-extent *eventhook*))
      (window-select dialog)
      (dolist (menu (menubar))
        (unless (eq menu *apple-menu*)
          (menu-disable menu)))
      (funcall processor))
    (dolist (menu (menubar))
      (menu-enable menu))
    (if close-on-exit
      (window-close dialog)
      (window-hide dialog))))

(defparameter *d*
  (make-instance 'window :window-type :double-edge-box :window-show nil))

(defvar *count* 0)

(defun testit ()
   #'(lambda ()
         (incf *count*)))
   #'(lambda (d)
       (with-focused-view d
         (rlet ((r :rect :topleft #@(0 0) :botRight (view-size d)))
           (#_EraseRect r)
           (#_MoveTo 20 20)
           (format d "~d" *count*))))