Problems drawing during dragging gray regions.

[cornell@unix1.cs.umass.edu (Matthew Cornell)]

(The following applies to system 7.0 and 6.0.7, and MCL2.0b1p2.)

Hello. I need to drag an object's outline across windows and provide
feedback as it's dragged, much as the Finder does when dragging icons
between windows. I've been trying using the DragGrayRgn trap, clipping
to the window manager, and passing a defpascal routine, but if that
routine does *any* output then DragGrayRgn leaves black "turds" and
leaves the Macintosh window system behaving strangely for a while.
(For example, the color resize regions in window's bottom right
corners is inverted and looks yellow, and when my screen saver starts,
everything is inverted.) Evaluate the following code and try dragging
the region with no modifier keys pressed (which clips to the window
and works) then try dragging with the command key down (which clips to
the window manager and doesn't work) to see the problem.

I changed SELECT-AND-ADD-DIALOG-ITEM in Apple's Dialog-Editor.Lisp
(which calls the trap) to call my defpascal, and got the same result,
implying I'm doing a Mac "no no". Is this a trap bug or should I not
be drawing during the action-procedure? If I shouldn't then does
anyone have ideas on how to accomplish what I need another way? How
does the Finder do it? I'd appreciate any feedback on this as I'm out
of ideas at the moment.

Sincerely,

matt


======== Example code follows ========
(in-package "CCL")

(export '(DRAG-GRAY-REGION))

(require :quickdraw)


;;;================================================================
;;;Macros =========================================================
;;;================================================================

;;; Window-manager-port is taken from Apple's ift-macros.lisp:

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


;;;================================================================
;;;Drag-gray-region ===============================================
;;;================================================================

(defmethod drag-gray-region
  ((window window) (start-point integer) (region macptr)
   &key (clip-view window) (axis :no-constraint) action-procedure
   )
  "Calls #_DragGrayRgn, error checking all args. WINDOW is the window that
was clicked on. START-POINT is a point specifying where the click was made
relative to WINDOW. REGION is the region to drag; it is a macptr and is
destructively modified. CLIP-VIEW is a view or nil and specifies where to
clip the dragging. It defaults to WINDOW. If CLIP-VIEW is nil clipping is
in the window manager's port. AXIS is one of :no-constraint,
:h-axis-only, or :v-axis-only. ACTION-PROCEDURE, if non-nil, should a
defpascal procedure that takes no arguments; It is passed to #_DragGrayRgn.

Returns a point that encodes the difference between START-POINT and the
release point, or nil if the mouse was outside CLIP-VIEW or inside
CLIP-VIEW but released at START-POINT."
  ;;
  ;; Check the arguments.
  ;;
  (unless (handlep region)              ;is this needed with the method's
                                        ;macptr type spec?
    (error "Region ~S is not a handle." region))
  (when (and clip-view
             (not (typep clip-view 'view)))
    (error "Clip-view ~S is not nil or a view." clip-view))
  (when (and action-procedure
             (not (pointerp action-procedure)))
    (error "~&Action-procedure ~S is not a pointer." action-procedure))
  (setf axis
        ;; Check and set AXIS to the value the trap expects.
        (ecase axis (:no-constraint 0) (:h-axis-only 1) (:v-axis-only 2)))
  ;;
  ;; Do the drag.
  ;;
  (let* ((clip-port (if clip-view (wptr clip-view) (window-manager-port)))
         (clip-port-rect (rref clip-port grafport.portRect))
         (drag-result
          (cond (clip-view
                 (with-focused-view clip-view
                   (#_DragGrayRgn :ptr region :long start-point
                    :ptr clip-port-rect :ptr clip-port-rect
                    :word axis :ptr (or action-procedure (%null-ptr))
                    :long)))
                (t
                 (with-port clip-port
                   (with-clip-rect clip-port-rect
                     (#_DragGrayRgn :ptr region :long start-point
                      :ptr clip-port-rect :ptr clip-port-rect
                      :word axis :ptr (or action-procedure (%null-ptr))
                      :long))))))
         (converted-result
          (if (null clip-view)
            (global-to-local window drag-result)
            drag-result))
         (final-result (cond ((or (= converted-result 0)
                                  (= (point-h converted-result) -32768))
                              ;; Zero means they let-up in the same spot.
                              ;; -32768 means the let-up outside slopRect.
                              nil)
                             (t converted-result)))
         )
    (print (list clip-view
                 (point-string start-point)
                 (point-string drag-result)
                 (point-string converted-result)
                 (and final-result (point-string final-result))))
    
    final-result))


;;;================================================================
;;;Example ========================================================
;;;================================================================

(defvar *last-point* 0
  "Used by temp-proc to know when the mouse has moved.")

(defpascal temp-proc ()
  (let ((new-point (view-mouse-position (front-window))))
    (when (and (command-key-p)
               (/= new-point *last-point*))
      ;;
      ;; The mouse moved.
      ;;
      ;; Any output during this call hoses the mac's drawing... Help!!
      ;;
      (print (point-string new-point) (front-window :class 'fred-window))
      ;;
      (setf *last-point* new-point))))


(let* ((win (make-instance 'window :view-position #@(50 50)
                           :view-size #@(200 200) :window-title "Click me!"))
       (region (progn (open-region win) (frame-rect win 10 10 20 30)
                      (frame-rect win 30 30 50 60) (frame-oval win 5 5 50 30)
                      (close-region win)))
       )
  ;;
  (defmethod view-draw-contents ((view (eql win)))
    (fill-oval view *light-gray-pattern* 10 10 150 40)
    (fill-rect view *gray-pattern* 40 50 70 90)
    (frame-region view region))
  (view-draw-contents win)
  ;;
  (defmethod view-click-event-handler ((view (eql win)) point)
    (when (point-in-region-p region point)
      (let* ((region-copy (copy-region region))
             (window (view-window view))
             (result 
              (drag-gray-region
               window (convert-coordinates point view window)
               region-copy
               :clip-view (if (command-key-p) nil view)
               :action-procedure temp-proc))
             )
        (when result
          (invalidate-region view region t)
          (format t "~&Result: ~S" (point-string result))
          (offset-region region result)
          (invalidate-region view region t))))))