bug in with-pen-saved

[mcdougal@cs.uchicago.edu (Tom McDougal)]

I am being plagued by what seems to be a bug in with-pen-saved -- namely,
it doesn't always properly restore the pen.  I encountered the bug while
using Matthew Cornell's drag-gray-region.lisp (or whatever it is called).
Since then,  I have distilled the bug down to a fairly simple example,
attached below.

I hope you can find a patch for this, or show me the error of my ways.

Respectfully yours,

Tom McDougal <mcdougal@cs.uchicago.edu>



;;;  This file demonstrates a bug resulting from nesting two with-pen-saved
;;; calls within a with-port call.
;;;   After clicking on the r.h. circle (which draws an inverted, grayed
;;; rectangle), force the window to redraw itself (e.g. by covering &
;;; uncovering) and presto! both circles are now drawn in gray.

(require "QUICKDRAW")

;; A simple class which just draws a circle.

(defclass circle-view (view)
  ((topleft :accessor topleft
            :initform #@(0 0)
            :initarg :topleft)
   (botright :accessor botright
             :initform #@(0 0)
             :initarg :botright))
  (:default-initargs :view-size #@(100 100)))

(defmethod view-draw-contents ((self circle-view))
  (rlet ((r :rect
            :topleft (topleft self)
            :botright (botright self)))
    (#_frameOval r)))


;;; subclass for which clicking in the view temporarily draws an inverted
;;; rectangle around it.

(defclass clickable-circle-view (circle-view)
  ())

(defmacro window-manager-port ()
  '(%stack-block ((port 4))
     (require-trap #_GetWMgrPort :ptr port)
     (%get-ptr port)))


;;; the bug is only apparent w/ this crazy nesting.

(defmethod invert-highlight ((self clickable-circle-view))
  (rlet ((r :rect :topleft #@(0 0)
            :botright (view-size self)))
    (with-port (window-manager-port)
      (with-pen-saved
        (#_PenMode (position :PATXOR *pen-modes*))
        (#_PenPat *gray-pattern*)
        (with-focused-view self
          (with-pen-saved
            (#_PenMode (position :PATXOR *pen-modes*))
            (#_PenPat *gray-pattern*)
            (#_PenSize 3 3)
            (#_FrameRect r)))))))

(defmethod view-click-event-handler ((self clickable-circle-view) where)
  (declare (ignore where))
  (invert-highlight self)
  (do ()
      ((not (mouse-down-p))
       (invert-highlight self))))


#|
;;; Evaluate this code to see the bug.
;;; Click on the r.h. circle, then force the window to redraw its
;;; contents.

(make-instance 'window
  :view-subviews
  (list (make-instance 'circle-view
          :topleft #@(20 20) :botright #@(70 70)
          :view-position #@(20 20)
          :view-size #@(100 100))
        (make-instance 'clickable-circle-view
          :topleft #@(20 20) :botright #@(70 70)
          :view-position #@(120 20)
          :view-size #@(100 100))))

|#