;; See the file LICENSE for the full license governing this code.
;; Code for the dialog :background-palette

(in-package :cg-user)

;; added ch6 step 39
(defclass background-palette (color-mixin dialog)
    ())

;; added ch6 step 46
;;; chee   21jan99 bug7513 returning (not new-value) here to unpress every
;;;        button press is inconsistent with setting the initial value of
;;;        the multipic to the initial background color (white); see the
;;;        initialize-instance method just below
(defun background-palette-color-list-on-change (widget new-value old-value)
   (declare (ignore-if-unused widget new-value old-value))
   ;; Do the action only when a button is being pressed (not unpressed)
   (when new-value
     (change-background-color (parent widget)))
   t) ;; <bug7513>

;; added ch6 step 47
;;; chee   10sep99 bug8144 had to change a call to parent here
;;;        to call owner instead, now that parent of a pop-up
;;;        dialog returns the screen for general consistency
(defmethod change-background-color ((palette background-palette))
   (let ((color (current-color palette))
         (doodler (owner palette)))
      (setf (background-color (frame-child doodler)) color)
      (erase-window doodler)))

;; added ch6 step51
(defun background-palette-color-button-on-change (widget new-value old-value)
   (declare (ignore-if-unused widget new-value old-value))
   (when new-value 
      (add-other-color (parent widget)))
   (not new-value))

;; added ch6 step 52
;;; chee   10sep99 bug8144 had to change a call to parent here
;;;        to call owner instead, now that parent of a pop-up
;;;        dialog returns the screen for general consistency
(defmethod initialize-instance :after ((palette background-palette)
                                       &rest initargs)
   (declare (ignore initargs))
   (let* ((pane (frame-child (owner palette)))
          (color-name (find-color-name palette
                        (or (background-color pane)
                            (default-background-color pane)))))
      (initialize-value (find-component :color-list palette)
        (list color-name))))
