;;; -*- 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:
;;; 29-Apr-92 ECP In set-display-slots, added code for fast-redraw
;;;		  object being removed from aggregate.
;;;  2-Apr-92 RGM Added support for new multifont.
;;;  3-Jan-92 AMICKISH Changed invalidate demon into be a slot in view-object,
;;;               changed to call with-demon-disabled.
;;;  6-Aug-91 DZG Extra error checking in set-display-slots.
;;; 24-Apr-91 KOZ Patched Set-Display-Slots (see comment in text)
;;; 25-Mar-91 ECP In dovalues loops, use :local t so that we don't
;;;		  inherit values of :components.
;;; 12-Jun-90 BVZ Created clear-dirty-bits
;;;
(in-package "OPAL" :use '("LISP" "KR"))

(setf kr::*pre-set-demon* NIL)	;; NO MORE DEMON HERE!

;;; push the slot onto a list of changed slots and push the object
;;; onto its window's changed-objects list

(defun update-slot-invalidated (gob slot save)
  (declare (ignore save))
  (let* ((gob-update-info (g-local-value gob :update-info))
	 (the-window (and gob-update-info
			  (update-info-window gob-update-info))))
  (if the-window
    (if (eq the-window gob)			;; is this a window?
      (pushnew slot (win-update-info-invalid-slots
			(g-local-value the-window :win-update-info)))
      (and (not (update-info-invalid-p gob-update-info))
	   the-window
	   (make-object-invalid gob gob-update-info the-window))
   ))))

;;; Called when you write a value of an :update-slots (it may not change)
;;; Used to be called "erase-and-invalidate", a misnomer
(s-value opal:view-object :invalidate-demon #'update-slot-invalidated)

;; Remove gob from invalid-objects list of win-update-info.
;; And, if it is the last-invalid-obj being removed, make sure
;; that last-invalid-obj is made up to date!
(defun remove-from-invalid-objects-list (gob win-update-info)
  (when win-update-info
    (let ((invalid-objects (win-update-info-invalid-objects win-update-info)))
      (if (eq gob (car (win-update-info-last-invalid-obj win-update-info)))
          (setf (win-update-info-last-invalid-obj win-update-info)
                (last
                 (setf (win-update-info-invalid-objects win-update-info)
                       (delete gob invalid-objects))))
          (setf (win-update-info-invalid-objects win-update-info)
                (delete gob invalid-objects))))))

;;;
;;; set the window and dirty slots of the object and 
;;; recursively set the same slots in its children
;;;
;;; If this is not at the top-level, this will also set the invalid-p entry
;;; in the :update-info to be NIL.
;;; The "with-demons-disabled" and "mark-window-slots-as-changed" were
;;; added by Koz to fix the following bug:  if you add, then
;;; remove, then add again some gadgets (eg, labeled-box), they would
;;; not appear.  This is because some parts depended on the :window
;;; slot, and so were added to the invalid-objects list of the window
;;; when the following lines were invoked...

(defun mark-window-slots-as-changed (object)
  (mark-as-changed object :window)
  ;; dzg - extra checks
  (let ((update-info (g-local-value object :update-info)))
    (when (and update-info (update-info-aggregate-p update-info))
      (dovalues (child object :components :local t)
	(mark-window-slots-as-changed child)))))

(defun set-display-slots (object a-window dirty-bit &optional (top-level T))
  (let ((update-info (g-local-value object :update-info)))
    (when update-info		;; dzg
      ;; when removing fast-redraw object from aggregate, change update
      ;; slots values to make it seem as if it used to be invisible, so
      ;; that if you change its position it won't be redrawn in old position.
      (when (and (null a-window)
		 (not (update-info-aggregate-p update-info)))
	(let ((update-slots-values
		 (g-local-value object :update-slots-values))
	      (old-window (update-info-window update-info)))
	  (when (and update-slots-values
		     (aref update-slots-values 1)
		     old-window)
	    (setf (aref update-slots-values 0) NIL)
	    (remove-from-invalid-objects-list object
		(g-local-value old-window :win-update-info)))))

      (with-demon-disabled #'update-slot-invalidated
       (s-value object :window
		(setf (update-info-window update-info) a-window)))

      (if dirty-bit
	  (when (g-value object :visible)
	    (setf (update-info-force-computation-p update-info) T)
	    (propagate-dirty-bit object update-info))
	  (setf (update-info-dirty-p update-info) NIL))
      (when (update-info-aggregate-p update-info)
	(dovalues (child object :components :local t)
	  (set-display-slots child a-window dirty-bit NIL)))
      (if top-level
	  (mark-window-slots-as-changed object)
	  (setf (update-info-invalid-p update-info) NIL)))))


;;;
;;; recursively set the dirty bits of any children to nil
;;;

(defun clear-dirty-bits (agg update-info)
  (setf (update-info-dirty-p update-info) nil)
  (dovalues (child agg :components :local t)
     (let ((child-update-info (g-local-value child :update-info)))
       (when (update-info-dirty-p child-update-info)
	 (clear-dirty-bits child child-update-info)))))


; invalidate-object-bbox (object)
;
;   This function takes an Opal graphical object and merges the its
;   visible bbox (if any) into the window's  bbox that is to be
;   erased and redrawn on the next update.  This is for processing an
;   object that has changed without invalidating an update-slot (which,
;   in general, is a bad idea anyhow).  Note that if the object has changed
;   its *position* (ie, it moved), and not invalidated an update-slot (which
;   should be *impossible*), the object's new location will not be merged
;   into the drawing clip region, and so the object may be redrawn only
;   in part or not at all.  You can fix this by using "invalidate-bbox".

;   Please note that these functions are for a VERY PARTICULAR USE --
;   in general, if you change an interesting slot with demons disabled,
;   you should use kr:MARK-AS-CHANGED to get the normal update procedure
;   to notice and process the change.  Using the method described here
;   instead, even when the object gets updated, unless you have provided
;   YOUR OWN DRAW PROCEDURES, it will be drawn as it was last time!
;
; invalidate-bbox (a-window x1 y1 x2 y2)
; 
;   This function does the same as the one above, but it does not take
;   an object; rather, it takes a bbox defined by (x1,y1) and (x2,y2) as
;   the TopLeft and BottomRight.  It also must take a window (the previous
;   function doesn't have to since it can extract it from the object).


; This is just a support function, not to be exported!
(defun invalidate-bbox-support (a-window the-bbox)
   (if (and the-bbox (bbox-valid-p the-bbox) a-window)
      (let* ((win-ui (get-local-value a-window :update-info))
             (win-old-bbox (if win-ui 
                              (update-info-old-bbox win-ui)
                           )))
         (when win-old-bbox
            (merge-bbox win-old-bbox the-bbox)
         )
      )
   )
)

; Please see comment above
(defun invalidate-object-bbox (object)
   (let ((obj-ui (get-local-value object :update-info)))
      (if obj-ui
         (invalidate-bbox-support (update-info-window obj-ui)
               (update-info-old-bbox obj-ui))
      )
   )
)

; Temporary storage for "invalidate-bbox" function below
(defvar *opal-temp-bbox* (opal::make-bbox :valid-p T))

; Please see comment above
(defun invalidate-bbox (a-window x1 y1 x2 y2)
   (when a-window
      (setf (bbox-x1 *opal-temp-bbox*) x1)
      (setf (bbox-y1 *opal-temp-bbox*) y1)
      (setf (bbox-x2 *opal-temp-bbox*) x2)
      (setf (bbox-y2 *opal-temp-bbox*) y2)
      (invalidate-bbox-support a-window *opal-temp-bbox*)
   )
)
