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

Re-draw of sub-views

For some time now, I have noticed excessive redraw for sub-views.

My understanding, from my limited Inside Mac library, was that a window has
update region into which #_InvalRect and #_InvalRgn accumulate.

As near as I can figure, MCL has broken with this practice and is doing
something else entirely.

Whatever this method is, it seems to be extremely expensive for the drawing
sub-views.  Specifically, sub-views seem to be re-drawn when it is totally
un-necessary.  This is bad for dialogs with many and/or complex sub-views.

Today, I thought I would look into this and see if I could patch it.

Unfortunately I was...a little too successful.  Now I have sub-views that
won't redraw at all when a window is uncovered.

But I am hoping somebody out there understands the window-redrawing system
of MCL and/or the Mac and can tell me where to put calls to #_InvalRect to
finish this patch.  I know I'm being overly simplistic here, but I'm

The half-patch is commented out so that the problem can be seen first...


(defparameter *array* (make-array 500 :initial-element "Why?"))

(defclass sample-sequence-di (sequence-dialog-item) ())

(defmethod draw-cell-contents :before ((view sample-sequence-di) h
&optional v)
  (let* ((cell (make-point h v))
         (h (point-h cell))
         (v (point-v cell)))
    (when (zerop cell) (ed-beep))
    (format t "~&Drawing cell #@(~S ~S)~%" h v)))

(make-instance 'dialog
  :view-position #@(50 50)
  :view-size #@(400 300)
    (make-instance 'sample-sequence-di
      :view-position #@(4 4)
      :view-size #@(200 292)
      :table-hscrollp nil
      :table-sequence *array*)
    (make-instance 'button-dialog-item
      :dialog-item-text "Push Me"
      :view-position #@(208 4)
      #'(lambda (item)
          (declare (ignore item))
          (message-dialog "Why is the table re-drawn?" :position #@(268


(defparameter *view-draw-contents-temp-region* (#_NewRgn)
  "Used by view-draw-contents :around on a view to determine if
the view really needs to be re-drawn or not.")

(defun restore-view-draw-contents-temp-region ()
  "Puts a #_NewRgn in *view-draw-contents-temp-region*."
  (unless (handlep *view-draw-contents-temp-region*)
    (setq *view-draw-contents-temp-region* (#_NewRgn))))

(defun destroy-view-draw-contents-temp-region ()
  "Calls #_DisposeHandle on *view-draw-contents-temp-region*."
  (when (handlep *view-draw-contents-temp-region*)
    (#_DisposeHandle *view-draw-contents-temp-region*)))

(nconc *restore-lisp-functions*
       (list #'restore-view-draw-contents-temp-region))

(push #'destroy-view-draw-contents-temp-region *save-exit-functions*)

;;;;I actually hope to put this method on view, eventually, but for now...
;;;;sample-sequence-di will do for demo purposes.

;;;;To see the *problem* with this, you will need to cover/uncover
;;;;the sample dialog:
(defmethod view-draw-contents :around ((view sample-sequence-di))
  (let* ((container (view-container view)))
    (if container
      (let* ((wptr (wptr container))
             (topleft (view-position view))
             (left (point-h topleft))
             (top (point-v topleft))
             (bottomright (add-points topleft (view-size view)))
             (right (point-h bottomright))
             (bottom (point-v bottomright)))
        (#_SetRectRgn *view-draw-contents-temp-region* left top right
        (#_SectRgn *view-draw-contents-temp-region*
                   (rref wptr :windowrecord.updatergn)
        (unless (#_EmptyRgn *view-draw-contents-temp-region*)

;;;;To restore to original:

(defmethod view-draw-contents :around ((view sample-sequence-di))

"TANSTAAFL" Rich lynch@ils.nwu.edu