Drawing in subviews (bug?)

[Andrew Newell Mickish <am2q+@andrew.cmu.edu>]

I am implementing a kind of scrolling-window by using views that are
clipped by smaller windows.  The design is something like this:

                         ...............
                         .             .
                      |-------------------|
 clipping window ---> |  .             .<-|--- visible region of clipped view
                      |  .             .  |
                      |-------------------|
                         .             .
                         .             . <--- clipped view
                         ...............


To scroll the visible region, it is only necessary to change the left and
top offset of the clipped window, and redraw its contents.

I had this implementation about 99% working, except that after I finished
drawing the contents of the inner view, it would always be cleared again!
It turns out that this behavior is entirely reproducible in pure CCL code,
which I have attached below.

If you load this code, a window will appear with a yellow rectangle in
a clipped view.  Call (moveup) and (movedown) to change the offset of the
view.  You will see that the yellow rectangle does change position, but that
it is also immediately erased after it is drawn.

Is this a bug, or am I overlooking something?  Thanks,

--Andrew Mickish

P.S.  How can I change the background color for a view?  Any ideas on how
I could simulate the functionality of ccl:set-part-color for a view?


---------------------------- Cut Here ---------------------------------------

(in-package :COMMON-LISP-USER)

;; Load required MCL files
   (progn (require 'traps)
          (require 'interfaces)
          (require 'quickdraw)
          (ccl::require-interface 'quickdraw)
          (ccl::require-interface 'events)
          (terpri))


;;;
;;; Two classes that will be used for the "window" and "subwindows"
;;;
(defparameter *MAC-DRAWABLE*
  (defclass MAC-DRAWABLE
    (ccl:window)
    ((plist :initarg :plist
            :initform :plist-init))))

(defparameter *MAC-SUBDRAWABLE*
  (defclass MAC-SUBDRAWABLE
    (ccl:view)
    ((plist :initarg :plist
            :initform :plist-init)
     ;; Need to implement background-color manually?
     (ccl::color-list :initarg :color-list
                      :initform `(:content ,ccl:*white-color*)))))



(defun MAC-draw-rectangle (drawable left top width height fill-color)
  (let* ((right (+ left width))
         (bottom (+ top height)))
    (ccl:with-focused-view drawable
      (ccl:with-fore-color fill-color
        (ccl:paint-rect drawable left top right bottom))
      )))


;;;
;;;  Creates a MAC-DRAWABLE for top-level windows, and a MAC-SUBDRAWABLE
;;;  for "subwindows"
;;;
(defun MAC-create-window (parent-window x y width height title
                          background override-redirect)
  (let ((drawable
         (if parent-window
             (make-instance 'MAC-SUBDRAWABLE
               :view-container parent-window
               :view-position (ccl:make-point x y)
               :view-size (ccl:make-point width height)
               :plist NIL)

             (make-instance 'MAC-DRAWABLE
               :view-position (ccl:make-point x y)
               :view-size (ccl:make-point width height)
               :close-box-p T
               :window-type (if (eq :on override-redirect)
                                :single-edge-box
                                :document-with-zoom)
               :window-show NIL
               :window-title title
               :color-p T
               :plist NIL))))
    (ccl:set-part-color drawable :content background)
    drawable))



;;;
;;;  Set up a top-level window, with a clipping view and an innermost view
;;;  where the drawing will take place
;;;
(setf main (mac-create-window NIL 400 45 200 150 "Main" ccl:*red-color* :off))
(ccl:window-show main)
(setf clip (mac-create-window main 25 0 175 125 "Clip" ccl:*blue-color* :off))
(setf inner (mac-create-window clip 0 0 300 300 "Inner" ccl:*green-color* :off))(mac-draw-rectangle inner 0 0 30 100 ccl:*yellow-color*)


;;;
;;;  The functions that show the undesirable behavior
;;;

(defun moveup ()
  (ccl:set-view-position inner
                         (ccl:point-h (ccl:view-position inner))
                         (- 10 (ccl:point-v (ccl:view-position inner))))
  (mac-draw-rectangle inner 0 0 30 100 ccl:*yellow-color*))

(defun movedown ()
  (ccl:set-view-position inner
                         (ccl:point-h (ccl:view-position inner))
                         (+ 10 (ccl:point-v (ccl:view-position inner))))
  (mac-draw-rectangle inner 0 0 30 100 ccl:*yellow-color*))

(defun unmove ()
  (ccl:set-view-position inner
                         (ccl:point-h (ccl:view-position inner))
                         0)
  (mac-draw-rectangle inner 0 0 30 100 ccl:*yellow-color*))

;;;
;;;  Now try several invocations of (moveup) and (movedown) to try to scroll
;;;  the yellow rectangle in the innermost view.  Immediately after the
;;;  rectangle is drawn, it is erased!
;;;