Re: Color subviews?

[bill@cambridge.apple.com (Bill St. Clair)]

At  3:32 PM 2/26/94 -0500, Andrew Newell Mickish wrote:
>What is the best way to make the background color of a subview different from
>the background color of its containing window?  It seems that just drawing a
>rectangle that fills the view is not sufficient -- you need to set the
>color that the window will use to erase regions.  This is independent of the
>"foreground color" and the "background color" that are used for regular
>drawing.
>
>Calling ccl:set-part-color instantly changes the background of the entire
>window, regardless of the subview background colors.  Maybe a combination of
>these two ideas is necessary?  Thanks,
>
>--Andrew Mickish

This should get you started. The idea is to wrap with-back-color around
the view-draw-contents method.

-----------------------------------------------------------------------

(defclass colored-background-view-mixin ()
  ((background-color
    :initarg :background-color
    :initform *white-color*
    :accessor background-color)))

(defclass colored-background-view (colored-background-view-mixin view) ())

(defmethod view-draw-contents :around ((view colored-background-view-mixin))
  (with-back-color (background-color view)
    (rlet ((rect :rect :topleft #@(0 0) :botright (view-size view)))
      (#_EraseRect rect))
    (call-next-method)))

(defmethod (setf background-color) :after (color (view colored-background-view-mixin))
  (declare (ignore color))
  (invalidate-view view))

#|

(setq w (make-instance 'window
          :color-p t
          :view-size #@(200 200)))

(make-instance 'colored-background-view
  :background-color *red-color*
  :view-container w
  :view-size #@(50 50)
  :view-position #@(25 25))

(make-instance 'colored-background-view
  :background-color *green-color*
  :view-container w
  :view-size #@(50 50)
  :view-position #@(125 25))

(make-instance 'colored-background-view
  :background-color *blue-color*
  :view-container w
  :view-size #@(50 50)
  :view-position #@(25 125))

(setq v
      (make-instance 'colored-background-view
        :background-color *purple-color*
        :view-container w
        :view-size #@(50 50)
        :view-position #@(125 125)))

(setf (background-color v) *yellow-color*)

|#