;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: OPAL; Base: 10 -*-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;         The Garnet User Interface Development Environment.      ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; This code was written as part of the Garnet project at          ;;;
;;; Carnegie Mellon University, and has been placed in the public   ;;;
;;; domain.  If you are using this code or any part of Garnet,      ;;;
;;; please contact garnet@cs.cmu.edu to be put on the mailing list. ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Changes:
;;; 28-Sep-92 dzg,amickish - Added update-start-fn and update-stop-fn calls
;;; 25-Sep-92 koz,amickish,hopkins  Only clear the window's invalid-objects
;;;                list (at beginning of update) if the window is visible.
;;; 17-Sep-92 Mickish - When checking whether :width and :height of window
;;;               has really changed, ignore whether computed by formula.
;;; 15-Jul-92 koz,dzg - Modified the :update method for windows to set the
;;;		  list of invalid objects to NIL at the very beginning, to
;;;		  allow for reentrant invalidation by other processes (such
;;;		  as calling destroy-constraint from inside a formula during
;;;		  Update).
;;; 28-Apr-92 williams Don't do total update on subwindow if only cursor
;;;		  changed.
;;; 16-Apr-92 ecp Call xlib:display-force-output if any slots are invalid.
;;;  9-Apr-92 ecp Removed patches of 4-Oct-91 from inner loop of update method.
;;; 01-Apr-92 koz & Mickish Added a check in (**) loop for fast redraw objects
;;;               which handles the case when the parent has never been updated
;;; 31-Mar-92 ecp Fixed yet another bug: changing position of subwindow.
;;; 26-Mar-92 koz Fixed method for propagating changes to the bboxes of
;;;               fastdraws' parent(s) so it is once again constant-time,
;;;               except for one special case.  See comments in code.
;;;               (Also added "swap" macro, to swap two variables.)
;;; 25-Mar-92 Mickish Get-Values ---> G-Value; added THE type declarations
;;; 19-Mar-92 Mickish Added type declarations in set-styles methods
;;; 11-Mar-92 Pervin  New width and height fields of win-update-info.
;;; 28-Feb-92 ecp If width or height of window are invalidated,
;;;		  make sure that the value has really changed.
;;; 28-Feb-92 amickish kr::schema-slots --> schema-p
;;; 25-Feb-92 ecp Don't invalidate bboxes until very end.
;;; 19-Feb-92 ecp Implemented double-clip-masks as list of length 8.
;;; 16-Dec-91 ecp Rewrote exposure of double-buffered window.  No longer
;;;		  re-allocate exposed-clip-mask.
;;; 11-Dec-91 ecp Removed change of 18-Oct-91.  It was expensive, and
;;;		  apparantly Kosbie's changes of Nov-91 made them unnecessary.
;;; 25-Nov-91 koz significant restructuring of the code to reduce the amount
;;;               of overhead when there are no changes to be made (this is
;;;               to speed up "update-all")
;;; 25-Nov-91 koz rewrote fix-properties-and-validate invocation code so now
;;;               it skips the macro call, and then makes a function call to
;;;               fix-window-properties (instead of the old method invocation)
;;; 20-Nov-91 Kosbie & Pervin
;;;		  Fixed flicker in backing-store windows.
;;;		  Also, removed all #+comment parts, since they are never used.
;;; 18-Oct-91 ECP Remove :width or :height from invalid-slots list of a
;;;		  window if the values of those slots hadn't actually changed.
;;;  4-Oct-91 ECP Patches for virtual aggregates (e.g. changed-bbox).
;;;  3-Oct-91 Andrew Mickish
;;;               Changed fast-redraw code so that :fast-redraw-p now takes
;;;               the values T, :rectangle, and :redraw
;;;  5-Feb-91 Dave Kosbie & Andrew Mickish
;;;		  Changed first UNLESS clause in :update method to fix bug
;;;               in placement of subwindows.
;;; 28-Sep-90 ECP After drawing a fastdraw object, update the bboxes of
;;;               its ancestors
;;; 23-Aug-90 ECP Added two lines to :update to activate invalidate-demons
;;;		  associated with :width and :height
;;; 13-Aug-90 ECP Changed g-value to get-local-value in test to see
;;;		  if window already has a :drawable.
;;; 18-Jul-90 ECP Fixed bug with resizing double-buffered window.
;;;  9-Jul-90 ECP Added test for kr::schema-name of invalid objects.
;;;  2-Jul-90 ECP If an expose event occurs, just refresh the parts
;;;		  of the window that were exposed.
;;; 20-Jun-90 ECP Lots of debugging of double-buffering.  If you
;;;		  de-iconify such a window and no other changes
;;;		  have taken place, just do a copy-area.
;;;  6-Jun-90 ECP Implemented double-buffering.
(in-package "OPAL" :use '("LISP" "KR"))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Notes on the current implementation:
;;;	This always does a display-force-output at the end of the call!

;; comment ** (this refers to where '**' appears in the code below):  this line
;; is necessary because: if object A's visibility depends on its parent P,
;; which is in window W, and we set P's visibility from
;; T to NIL, and then we do a total update on W, so it traverses P,
;; sees that it's not visible, and stops there.  This will put up the correct
;; picture, but...  The visibility of P is *valid* and NIL, and the visibility
;; of A is *invalid*.  Then, we set P's visibility to T.  This does not put
;; P on W's invalid-objects list because aggregates have no 'interesting'
;; slots; nor does it put A there, since its visibility slot was already
;; invalid!!!  Thus, there is no record that A is now visible (though invalid),
;; and nothing happens on subsequent updates.
;; The fix:  in a total update, get the visibility slot of all invalid objects
;; (via g-value).  Why does this work?  Because, in the previous example, A's
;; visible slot would NOT be invalid when we set P to visible, thus resulting
;; in A's visible slot being invalidated, so A would wind up on the
;; invalid-objects list.
;; Note that there's a little more to it, since you have to also *record* that
;; A was invalid in the :update-slots-values array (aref ... 0), and in the
;; valid-p entry of the old-bbox in the :update-info of A.  Ack!

;;; NOTES ON FAST-REDRAW
;;;    There are three allowed values for :fast-redraw-p -- T, :rectangle,
;;; and :redraw.  The T case assumes that the object has an :xor draw
;;; function, so the object is just redrawn -- an object XOR'ed on top
;;; of itself will disappear. 
;;;    The other two cases require that the user specify a filling-style
;;; and a line style in :fast-redraw-filling-style and :fast-redraw-
;;; line-style.  These styles should be the same color as the background
;;; behind the fast redraw object.  Then, for the value :rectangle,
;;; the bounding box of the object will be covered by a rectangle filled
;;; with the fast-redraw-filling-style to erase the object.  For the value
;;; :redraw, the object will be entirely redrawn using the background styles,
;;; causing it to disappear.  The :set-style methods implement the temporary
;;; setting and resetting of the object's filling and line styles during
;;; this procedure.

;;;    SET-STYLES is a method which is called by the fast-redraw
;;; algorithm while erasing an object.  We need a method for this procedure
;;; because the update-slots-values array is different for every object.

(define-method :set-styles opal:line (obj line-style filling-style)
  (let ((update-vals (g-local-value obj :update-slots-values)))
    (vector update-vals)
    (setf (aref update-vals *line-lstyle*) line-style)))

(define-method :set-styles opal:rectangle (obj line-style filling-style)
  (let ((update-vals (g-local-value obj :update-slots-values)))
    (vector update-vals)
    (setf (aref update-vals *rect-fstyle*) filling-style)
    (setf (aref update-vals *rect-lstyle*) line-style)))

(define-method :set-styles opal:multipoint (obj line-style filling-style)
  (let ((update-vals (g-local-value obj :update-slots-values)))
    (vector update-vals)
    (setf (aref update-vals *multi-lstyle*) line-style)))

(define-method :set-styles opal:polyline (obj line-style filling-style)
  (let ((update-vals (g-local-value obj :update-slots-values)))
    (vector update-vals)
    (setf (aref update-vals *polyline-fstyle*) filling-style)
    (setf (aref update-vals *polyline-lstyle*) line-style)))

(define-method :set-styles opal:text (obj line-style filling-style)
  (let ((update-vals (g-local-value obj :update-slots-values)))
    (vector update-vals)
    (setf (aref update-vals *text-lstyle*) line-style)))

(define-method :set-styles opal:bitmap (obj line-style filling-style)
  (let ((update-vals (g-local-value obj :update-slots-values)))
    (vector update-vals)
    (setf (aref update-vals *bm-fstyle*) filling-style)))

(define-method :set-styles opal:arc (obj line-style filling-style)
  (let ((update-vals (g-local-value obj :update-slots-values)))
    (vector update-vals)
    (setf (aref update-vals *arc-fstyle*) filling-style)
    (setf (aref update-vals *arc-lstyle*) line-style)))

(define-method :set-styles opal:oval (obj line-style filling-style)
  (let ((update-vals (g-local-value obj :update-slots-values)))
    (vector update-vals)
    (setf (aref update-vals *arc-fstyle*) filling-style)
    (setf (aref update-vals *arc-lstyle*) line-style)))

(define-method :set-styles opal:circle (obj line-style filling-style)
  (let ((update-vals (g-local-value obj :update-slots-values)))
    (vector update-vals)
    (setf (aref update-vals *circle-fstyle*) filling-style)
    (setf (aref update-vals *circle-lstyle*) line-style)))

;;; This is the FAST-REDRAW-RECTANGLE's update-slots-values, and is
;;; used by the set-frr-bbox methods
(defvar frr-update-vals
   (g-local-value fast-redraw-rectangle :update-slots-values))

(defun set-frr-bbox-fn (left top width height)
  (setf (aref frr-update-vals *rect-left*) left)
  (setf (aref frr-update-vals *rect-top*) top)
  (setf (aref frr-update-vals *rect-width*) width)
  (setf (aref frr-update-vals *rect-height*) height))

(define-method :set-frr-bbox opal:line (obj)
  (let* ((update-vals (g-local-value obj :update-slots-values))
	 (x1 (aref update-vals *line-x1*))
	 (x2 (aref update-vals *line-x2*))
	 (y1 (aref update-vals *line-y1*))
	 (y2 (aref update-vals *line-y2*))
	 (line-style (aref update-vals *line-lstyle*))
	 (projecting-p (when line-style
			 (eq (g-value line-style :cap-style) :projecting)))
	 (line-thickness (safe-max 1 (and line-style
				       (g-value line-style :line-thickness))))
	 (lt/2 (floor line-thickness 2))
	 (left (- (safe-min x1 x2)
		  (if projecting-p line-thickness lt/2)))
	 (top (- (safe-min y1 y2)
		 (if projecting-p line-thickness lt/2)))
	 (width (+ (abs (- (or x1 0) (or x2 0)))
		   (* (if projecting-p 2 1) line-thickness)))
	 (height (+ (abs (- (or y1 0) (or y2 0)))
		    (* (if projecting-p 2 1) line-thickness))))
    (set-frr-bbox-fn left top width height)))


(define-method :set-frr-bbox opal:rectangle (obj)
  (let ((update-vals (g-local-value obj :update-slots-values)))
    (set-frr-bbox-fn (aref update-vals *rect-left*)
	    (aref update-vals *rect-top*)
	    (aref update-vals *rect-width*)
	    (aref update-vals *rect-height*))))

(define-method :set-frr-bbox opal:roundtangle (obj)
  (let ((update-vals (g-local-value obj :update-slots-values)))
    (set-frr-bbox-fn (aref update-vals *roundt-left*)
	    (aref update-vals *roundt-top*)
	    (aref update-vals *roundt-width*)
	    (aref update-vals *roundt-height*))))

(define-method :set-frr-bbox opal:multipoint (obj)
  (let* ((update-vals (g-local-value obj :update-slots-values))
	 (point-list (aref update-vals *multi-point-list*))
	 (line-style (g-value obj :line-style))
	 (line-thickness (safe-max 1 (and line-style
				       (g-value line-style :line-thickness))))
	 (2lt (* line-thickness 2)) (4lt (* line-thickness 4))
	 (left (do ((min-x 9999)
		    (point point-list (cddr point)))
		   ((null point) (- min-x 2lt))
		 (setf min-x (min min-x (car point)))))
	 (top (do ((min-y 9999)
		   (point point-list (cddr point)))
		  ((null point) (- min-y 2lt))
		(setf min-y (min min-y (cadr point)))))
	 (width (do ((max-x 0) (min-x 9999)
		     (point point-list (cddr point)))
		    ((null point) (+ (- max-x min-x) 4lt))
		  (setf min-x (min min-x (car point)))
		  (setf max-x (max max-x (car point)))))
	 (height (do ((min-y 9999) (max-y 0)
		      (point point-list (cddr point)))
		     ((null point) (+ (- max-y min-y) 4lt))
		   (setf min-y (min min-y (cadr point)))
		   (setf max-y (max max-y (cadr point))))))
    (set-frr-bbox-fn left top width height)))

(define-method :set-frr-bbox opal:text (obj)
  (let ((update-vals (g-local-value obj :update-slots-values)))
    (set-frr-bbox-fn (aref update-vals *text-left*)
	    (aref update-vals *text-top*)
	    (aref update-vals *text-width*)
	    (aref update-vals *text-height*))))

(define-method :set-frr-bbox opal:bitmap (obj)
  (let* ((update-vals (g-local-value obj :update-slots-values))
	 (image (g-value obj :image))
	 (left (aref update-vals *bm-left*))
	 (top (aref update-vals *bm-top*))
	 (width (if image (xlib:image-width image) 0))
	 (height (if image (xlib:image-height image) 0)))
    (set-frr-bbox-fn left top width height)))

(define-method :set-frr-bbox opal:arc (obj)
  (let ((update-vals (g-local-value obj :update-slots-values)))
    (set-frr-bbox-fn (aref update-vals *arc-left*)
	    (aref update-vals *arc-top*)
	    (aref update-vals *arc-width*)
	    (aref update-vals *arc-height*))))

(define-method :set-frr-bbox opal:circle (obj)
  (let ((update-vals (g-local-value obj :update-slots-values)))
    (set-frr-bbox-fn (aref update-vals *circle-left*)
	    (aref update-vals *circle-top*)
	    (aref update-vals *circle-width*)
	    (aref update-vals *circle-height*))))

(defmacro fast-erase (object line-style-gc filling-style-gc drawable
		   root-window buffer)
  `(draw ,object ,line-style-gc ,filling-style-gc
	(or ,buffer ,drawable) ,root-window :none))

(defmacro copy-from-buffer-to-drawable (bbox buffer buffer-gc drawable)
  `(let ((x1 (bbox-x1 ,bbox))
	 (x2 (bbox-x2 ,bbox))
	 (y1 (bbox-y1 ,bbox))
	 (y2 (bbox-y2 ,bbox)))
     (xlib:copy-area ,buffer ,buffer-gc x1 y1 (- x2 x1) (- y2 y1)
		     ,drawable x1 y1)))

(defmacro swap(a b) `(let((.temp. ,a)) (setq ,a ,b) (setq ,b .temp.)))

(defvar newly-invisible-fastdraws-bbox (make-bbox))
    ;; The following are necessary for propagating changes to the bboxes
    ;; of parent(s) of fastdraws, when the fastdraws' bboxes change
(defvar fastdraw-old-bbox (make-bbox))
(defvar parent-old-bbox (make-bbox))

(defvar exposed-clip-mask (make-list 4))

(define-method :update opal:window (a-window &optional (total-p NIL))
  (unwind-protect
    (progn
      (update-start-fn window)
	       
 ;; The outside LET is to make the method more reentrant (see comment by
 ;; koz,dzg dated 15-Jul-92).
 ;; The "when visible" is to allow objects to remain on the invalid-objects
 ;; list when a window is made invisible (koz,amickish,hopkins,25-Sep-92)
 (let* ((win-info        (g-local-value a-window :win-update-info))
	(invalid-objects (win-update-info-invalid-objects win-info))
	(last-inv-obj    (win-update-info-last-invalid-obj win-info))
	(visible         (eq (g-value a-window :visible) T)))
  (when visible
    (setf (win-update-info-invalid-objects win-info) nil)
    (setf (win-update-info-last-invalid-obj win-info) nil))
 (let* ((drawable        (g-local-value a-window :drawable))
	(invalid-slots   (win-update-info-invalid-slots win-info))
	(window-agg      (g-value a-window :aggregate))
	(win-old-bbox    (update-info-old-bbox
			  (the UPDATE-INFO
			       (g-local-value a-window :update-info))))
	(partial-p       (and window-agg
                              (g-value window-agg :visible)
                              (or invalid-objects
                                  (bbox-valid-p win-old-bbox))))
	)

  (unless drawable
    (when window-agg
      (set-display-slots window-agg a-window T)
      (setf (win-update-info-old-aggregate win-info) window-agg))
    (setq drawable (create-x-drawable a-window))
    (setq total-p T))

  (when invalid-slots

      ;;; Delete :width or :height from invalid-slots list of a window
      ;;; if those slots contain formulas, and if the values
      ;;; of those slots hadn't actually changed.
      ;;; This is done to avoid unnecessary total updates.
      (when (and (member :width invalid-slots)
		 (eq (win-update-info-width win-info)
		     (g-value a-window :width)))
	(setq invalid-slots (delete :width invalid-slots)))
      (when (and (member :height invalid-slots)
		 (eq (win-update-info-height win-info)
		     (g-value a-window :height)))
	(setq invalid-slots (delete :height invalid-slots)))

      (fix-window-properties a-window invalid-slots drawable)
      (unless (subsetp invalid-slots
                       (if (g-local-value a-window :parent)
                           '(:cursor)
                           '(:left :top :cursor)))
        (setq total-p T))
      (setf (win-update-info-invalid-slots win-info) NIL))

  ;;; At this point, we try to abort if possible -- only do the main part
  ;;; of update if something really has changed...
  (when (or total-p partial-p)
    (let* (
	(win-new-bbox	 (win-update-info-new-bbox win-info))
	(buffer          (g-value a-window :buffer))
        (display-info    (g-value a-window :display-info))
	(line-style-gc   (display-info-line-style-gc display-info))
	(filling-style-gc (display-info-filling-style-gc display-info))
	(root-window     (display-info-root-window display-info))
	buffer-gc
	fastdraw-objects
	exposed-bbox	      ;; Exposed-bbox tells whether the window was
	                      ;; just exposed and nothing else happened to it.
      )

  (when buffer
    (setq buffer-gc (g-value a-window :buffer-gcontext))
    (setf (bbox-valid-p newly-invisible-fastdraws-bbox) nil))

  (when (and window-agg visible)
    (when (and invalid-objects (cdr last-inv-obj))
      (format T "Warning: non-NIL terminated invalid-objects in window ~A~%"
	a-window)
      (setf (cdr last-inv-obj) NIL))		;; it was an ill-formed list!
    (if total-p
      (unless (and (setq exposed-bbox (and (null invalid-objects)
					   (g-value a-window :exposed-bbox)))
		   buffer)
	(if exposed-bbox 
	  (progn
	    (bbox-to-clip-mask exposed-bbox exposed-clip-mask)
	    (erase-bbox exposed-bbox drawable nil nil))
	  (if buffer
	    (clear-buffer buffer buffer-gc)
	    (xlib:clear-area drawable)))

	(dolist (object invalid-objects)
                                        ;; See comment '**' above...
         (let ((obj-us-values (g-local-value object :update-slots-values))
               (obj-update-info (the UPDATE-INFO
				     (g-local-value object :update-info))))
            (g-value object :visible)
            (and obj-us-values
                (not (update-info-aggregate-p obj-update-info))
                (setf (aref obj-us-values 0) NIL))
            (setf (bbox-valid-p
                     (update-info-old-bbox obj-update-info))
                  NIL))
	 (let ((info (the UPDATE-INFO (g-local-value object :update-info))))
	   (if info
	     (setf (update-info-invalid-p info) NIL))))
	(when (g-value window-agg :visible)
	  (update-method-aggregate window-agg
		   (g-local-value window-agg :update-info)
		   line-style-gc filling-style-gc (or buffer drawable) root-window
		   exposed-clip-mask exposed-bbox NIL
		   (not exposed-bbox)))
	(if invalid-objects (free-invalid-objects invalid-objects
						  last-inv-obj)))

   ;else this is a PARTIAL update
      (let (obj-update-info obj-old-bbox obj-update-slots-values
	    first-changed this-inv-obj prev-inv-obj temp non-fastdraw-p object
            f-obj-update-info f-obj-old-bbox)
	(setf (bbox-valid-p win-new-bbox) NIL)
	(when invalid-objects
						;;; First Deal with FASTDRAWs
	 (setq prev-inv-obj NIL)
	 (loop
	  (if (null (setq this-inv-obj (if prev-inv-obj (cdr prev-inv-obj)
							invalid-objects)))
	      (return))
	  (setq non-fastdraw-p T)
		; Check if it *is* a FASTDRAW OBJECT and
		; either *was* a FASTDRAW OBJECT  or  *was* invisible (or
		; wasn't even an object last time!)
	  (when (and (setq object (car this-inv-obj))
		     (schema-p object) ; check if it has already been destroyed
                     (g-value object :fast-redraw-p)
		     (or (not (setq obj-update-slots-values
				(g-local-value object :update-slots-values)))
			 (aref obj-update-slots-values 1)
			 (not (aref obj-update-slots-values 0))))
	  	(setf (update-info-invalid-p
		       (setq obj-update-info
			     (the UPDATE-INFO
				  (g-local-value object :update-info))))
		       NIL)
					;; Check if it really has changed!
	        (when (setq first-changed
			(simple-update-slots-values-changed object))
					;; if it was visible, erase it...
		  (when (and obj-update-slots-values
			     (aref obj-update-slots-values 0))
		     
		     ;; Change for values of :rectangle and :redraw in
		     ;; :fast-redraw-p slot  --Andrew Mickish
		     (case (g-value object :fast-redraw-p)
		       (:rectangle
			; Draw a rectangle over the bbox of the object.
			; This rectangle will have the background filling
			; style, so the object will disappear.
			(set-frr-bbox object)
			(setf (aref frr-update-vals *rect-fstyle*)
			  (g-value object :fast-redraw-filling-style))
			(fast-erase fast-redraw-rectangle line-style-gc
				    filling-style-gc drawable root-window
				    buffer))
		       (:redraw
			; Set the filling and line styles of the object to be
			; the background styles, redraw the object, restore
			; its real styles (the changes occur in the update-
			; values-slots array, not the object's style slots)
			(set-styles object
			  (g-value object :fast-redraw-line-style)
			  (g-value object :fast-redraw-filling-style))
			(fast-erase object line-style-gc filling-style-gc
				    drawable root-window buffer)
			(set-styles object
			  (g-value object :line-style)
			  (g-value object :filling-style)))
		       (t
			; The object is drawn with an :xor draw-function,
			; so just draw the object again to erase it.
			(fast-erase object line-style-gc filling-style-gc
				    drawable root-window buffer))))

		  ;; if it is visible, set its visible
		  (if (g-value object :visible)
		   (progn
					;; Add object's "first-changed" to
					;; the fastdraw list!
		   (if *free-cons*
		    (progn
			(setq temp (cdr *free-cons*))
			(setf (cdr *free-cons*) fastdraw-objects)
			(setf (car (setq fastdraw-objects *free-cons*))
			      first-changed)
			(setq *free-cons* temp))
		    (setq fastdraw-objects (cons first-changed
						 fastdraw-objects)))
					;; Now add it to the fastdraw list so
					;; it will be drawn later...  Also
					;; remove it from the invalid-objects
		    (if prev-inv-obj
			(setf (cdr prev-inv-obj) (cdr this-inv-obj))
			(setq invalid-objects (cdr this-inv-obj)))
		    (setq temp fastdraw-objects)
		    (setf (cdr (setq fastdraw-objects this-inv-obj)) temp)
		    (setf (update-info-on-fastdraw-list-p obj-update-info) T)
		    (setq non-fastdraw-p NIL))
					;;; ELSE it's NOT VISIBLE....
		   (progn
			(if obj-update-slots-values
			  (setf (aref obj-update-slots-values 0) NIL))
			(merge-bbox newly-invisible-fastdraws-bbox
			    (update-info-old-bbox obj-update-info))
			(setf (bbox-valid-p
				(update-info-old-bbox obj-update-info))
			      NIL)
		   ))))
	  (if non-fastdraw-p (setq prev-inv-obj this-inv-obj)))

				;; Now process non-FASTDRAWs, first fixing the
				;; last-inv-obj pointer, if necessary!
	 (if fastdraw-objects (setq last-inv-obj (last invalid-objects)))
	 (dolist (object invalid-objects)
           ;; The next line represents a temporary hack to deal with a
           ;; problem discovered in demo-arith, in which occasionally
           ;; objects marked as *DESTROYED* were still contained in
           ;; the invalid objects list.
          (when (schema-p object)
	    (setq obj-old-bbox
		(update-info-old-bbox
		 (the UPDATE-INFO
		      (setq obj-update-info
			    (g-local-value object :update-info)))))
	    (setf (update-info-invalid-p obj-update-info) NIL)
	    (setq obj-update-slots-values
		(g-local-value object :update-slots-values))
	    (if (g-value object :visible)
					;; Object is a VISIBLE NORMAL OBJ
	      (if (bbox-valid-p obj-old-bbox)	
	             				;;object IS and WAS visible
	       (when (update-slots-values-changed object 0 obj-update-info)
		  (merge-bbox win-old-bbox obj-old-bbox)
		  (update-bbox object obj-old-bbox)
		  (merge-bbox win-new-bbox obj-old-bbox)
		  (propagate-dirty-bit object obj-update-info)
		  )
	       (progn				;;object IS and WAS NOT visible
		(update-bbox object obj-old-bbox)
		(update-slots-values-changed object 0 obj-update-info)
		(merge-bbox win-new-bbox obj-old-bbox)
		(propagate-dirty-bit object obj-update-info)
		))
	    (when (bbox-valid-p obj-old-bbox)	;;object IS NOT and WAS visible
		(merge-bbox win-old-bbox obj-old-bbox)
		(setf (bbox-valid-p obj-old-bbox)
		   (setf (aref obj-update-slots-values 0)
			NIL))
            )
						;;if object IS NOT and WAS NOT
						;;visible, then do nothing!!
	  )))
	(if invalid-objects
	  (free-invalid-objects invalid-objects last-inv-obj)))

					;; Now only perform the update if one
					;; of the two window's bboxes is valid
	(let ((old-bbox-valid (bbox-valid-p win-old-bbox))
	      (new-bbox-valid (bbox-valid-p win-new-bbox))
	      (clip-mask-1 (win-update-info-clip-mask-1 win-info))
	      (clip-mask-2 (win-update-info-clip-mask-2 win-info))
	      two-bboxes-p)
	  (when (or new-bbox-valid old-bbox-valid)

	    (if (setq two-bboxes-p (and new-bbox-valid old-bbox-valid))
               (if (bbox-intersect-p win-old-bbox win-new-bbox) ;they intrsect?
		   (progn
                        (merge-bbox win-new-bbox win-old-bbox)  ;merge into new
                        (setq two-bboxes-p NIL)                 ;; really only 1!
		     ;; (setf (bbox-valid-p win-old-bbox) NIL) ;; save until end
                        (erase-bbox win-new-bbox drawable buffer buffer-gc)
                        (bbox-to-clip-mask win-new-bbox clip-mask-1))
                   (progn
		     ;; (setf (bbox-valid-p win-old-bbox) NIL) ;; save until end
			(erase-bbox win-old-bbox drawable buffer buffer-gc)
			(erase-bbox win-new-bbox drawable buffer buffer-gc)
			(bbox-to-clip-mask win-old-bbox clip-mask-1)
			(bbox-to-clip-mask win-new-bbox clip-mask-2)))

               (progn                           ;; Only one valid bbox
			(when old-bbox-valid
                                (swap win-old-bbox win-new-bbox)
			     ;; (setf (bbox-valid-p win-old-bbox) NIL)
                             ;; save 'til end
			        )
			(erase-bbox win-new-bbox drawable buffer buffer-gc)
			(bbox-to-clip-mask win-new-bbox clip-mask-1)))

	    (if two-bboxes-p
	         (update-method-aggregate window-agg
		   (g-local-value window-agg :update-info)
		   line-style-gc filling-style-gc 
		   (or buffer drawable) root-window
		   clip-mask-2 win-old-bbox win-new-bbox
		   NIL)
		  (update-method-aggregate window-agg
		   (g-local-value window-agg :update-info)
		   line-style-gc filling-style-gc
		   (or buffer drawable) root-window
		   clip-mask-1 win-new-bbox NIL
		   NIL)
	     )
	   ))
					;; If there are fastdraw objects, draw
					;; them, then clear the list....
	(when fastdraw-objects
	   (do* ((flist         fastdraw-objects (cddr flist))
	         (fastdraw-obj  (first flist) (first flist))
	         (first-changed (second flist) (second flist)))
	        ((null flist))
		(setq f-obj-old-bbox
		   (update-info-old-bbox
		    (the UPDATE-INFO
			 (setq f-obj-update-info
			       (g-local-value fastdraw-obj :update-info)))))
                (update-slots-values-changed fastdraw-obj first-changed
					     f-obj-update-info)
		(when buffer
	 	    (merge-bbox win-old-bbox f-obj-old-bbox))

                ;; Next 2 lines are for parent propagation (** below)
                (swap fastdraw-old-bbox f-obj-old-bbox)
                (setf (update-info-old-bbox f-obj-update-info) f-obj-old-bbox)

		(update-bbox fastdraw-obj f-obj-old-bbox)
		(when buffer
		    (merge-bbox win-old-bbox f-obj-old-bbox))
		(unless buffer
	  	  (draw fastdraw-obj line-style-gc filling-style-gc
		        drawable root-window :none)
		)

              ;; (**) Now must propagate bbox changes to parent(s), but
              ;; ONLY IF NECESSARY, and then as CHEAPLY AS POSSIBLE!!!(koz)
                (let ((old-bbox fastdraw-old-bbox)
                      (new-bbox f-obj-old-bbox)
                      (object   fastdraw-obj)
                      parent parent-ui parent-bbox parent-changed?)
                 (loop

                  ;; If there is no parent, return!
                  (if (null (setq parent (g-local-value object :parent)))
                    (return))

                  ;; else, (re)set parent-ui, parent-bbox and parent-changed?
                  (setq parent-bbox
                    (update-info-old-bbox
                      (the UPDATE-INFO
                        (setq parent-ui (g-local-value parent :update-info)))))
                  (setq parent-changed? NIL)

		  ;; If the parent-bbox has never been updated, then its
		  ;; valid-p will be NIL, so copy current fastdraw bbox
		  ;; into it, and set up to check parent's parent.
		  (if (null (bbox-valid-p parent-bbox))
		      (progn
			(setq parent-changed? T)
			(copy-bbox-fn parent-bbox new-bbox)
			(setf (bbox-valid-p parent-old-bbox) NIL))

		(progn  ; else for (if (null (bbox-valid-p parent-bbox)) ...)
                  (when (or (< (bbox-x1 new-bbox) (bbox-x1 parent-bbox))
                            (> (bbox-x2 new-bbox) (bbox-x2 parent-bbox))
                            (< (bbox-y1 new-bbox) (bbox-y1 parent-bbox))
                            (> (bbox-y2 new-bbox) (bbox-y2 parent-bbox)))
                    (setq parent-changed? T)
                    ;; Must copy explicitly, instead of using SWAP, since
                    ;; the old values are also needed by merge-bbox below
		    (copy-bbox-fn parent-old-bbox parent-bbox)
                    (merge-bbox parent-bbox new-bbox))
		  

                  ;; Now, if for any dimension, both:
                  ;;  * old-bbox defines boundary of parent-bbox
                  ;;    (ie, old-bbox equals parent-bbox), and
                  ;;  * old-bbox does not equal new-bbox
                  ;; Then deleting the old-bbox contracts the parent-bbox.
                  (when
		    (and (bbox-valid-p old-bbox)
		      (or (and (eql  (bbox-x1 old-bbox) (bbox-x1 parent-bbox))
			   (not (eql (bbox-x1 old-bbox) (bbox-x1 new-bbox))))
			  (and (eql  (bbox-x2 old-bbox) (bbox-x2 parent-bbox))
			   (not (eql (bbox-x2 old-bbox) (bbox-x2 new-bbox))))
			  (and (eql  (bbox-y1 old-bbox) (bbox-y1 parent-bbox))
			   (not (eql (bbox-y1 old-bbox) (bbox-y1 new-bbox))))
			  (and (eql  (bbox-y2 old-bbox) (bbox-y2 parent-bbox))
			   (not (eql (bbox-y2 old-bbox) (bbox-y2 new-bbox))))))

                    ;; so, if parent-changed? is NIL, set it to T and store
                    ;; parent-old-bbox.  Then we finally cannot avoid the
                    ;; expensive operation of update-bbox (ack!)
                    (unless parent-changed?
                      (setq parent-changed? T)
                      (swap parent-old-bbox parent-bbox)
                      (setf (update-info-old-bbox parent-ui) parent-bbox))
                    (update-bbox parent parent-bbox))
		  )
		) ; close (if (null (bbox-valid-p parent-bbox)) ...)

                    ;; Finally, if parent-changed? is T, then set up
                    ;; variables for next iteration, else return!
                    (if parent-changed?
                      (progn
                        (swap parent-old-bbox fastdraw-old-bbox)
                        (setq old-bbox fastdraw-old-bbox)
                        (setq new-bbox parent-bbox)
                        (setq object   parent))
                      (return))))
              ;; (**) Done propagating bbox changes to parent(s)

		(when buffer
		  (draw fastdraw-obj line-style-gc filling-style-gc
		      buffer root-window :none))
		(setf (update-info-on-fastdraw-list-p f-obj-update-info)
		      NIL))
	   (setf (cdr (last fastdraw-objects)) *free-cons*)
	   (setq *free-cons* fastdraw-objects)
	))
     ))  ;; matches (when (and window-agg visible)....)

   ; When using double-buffering, copy buffer into window.
   (when (and visible buffer)
     (if (or total-p (null win-new-bbox))
	 (xlib:copy-area buffer buffer-gc 0 0
			 (g-value a-window :width)
			 (g-value a-window :height)
			 drawable 0 0)
	 (progn
           (if win-new-bbox
             (merge-bbox newly-invisible-fastdraws-bbox win-new-bbox))
           (if win-old-bbox
              (merge-bbox newly-invisible-fastdraws-bbox win-old-bbox))
	   (when (bbox-valid-p newly-invisible-fastdraws-bbox)
             (copy-from-buffer-to-drawable newly-invisible-fastdraws-bbox
                                           buffer buffer-gc drawable)))))

   (setf (bbox-valid-p win-old-bbox) NIL)
   (setf (bbox-valid-p win-new-bbox) NIL)

   ))  ;; end of (when (or total-p partial-p) ...)

   (when (or total-p partial-p invalid-slots)
     (xlib:display-force-output (display-info-display (g-value a-window :display-info))))

   ; Recursively update children
   (dolist (c (g-value a-window :child))
     (if (eq a-window (g-value c :parent))
       (update c)
       (progn
	 ;; 11-27-1991 - dzg & amickish
	 (format t "debug: removing child ~S from window ~S because :parent slot is wrong!~%" c a-window)
	 (break)
	 (s-value a-window :child
		  (delete c (g-value a-window :child))))))))
 )
    ;; Protect clause: release the process lock.
    (update-stop-fn window)))
