Solved but bugs: Problems drawing during dragging gray regions.

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

My problem was I was not wrapping with-port around the forms that
output in my defpascal routine (TEMP-PROC). I was using
with-focused-view but it does not seem to work correctly. A second
problem is when both an axis and the window manager port are used the
dragged gray region jumps to the screen's far left. To see these
problems:

- Evaluate the following code which will create an enthusiastic "Click
  Me!" window.
- To see normal operation hold the control and option keys down,
  click in the outlined region, and drag it around. This prints the point
  under the mouse relative to the front window and draws a small
  rectangle under the mouse in that window.
- To see the with-focused-view problem change the setf in TEMP-PROC
  that begins "(setf win-rel-pt" so that the line commented as "works"
  is commented out and the line commented as "broken" is not commented
  out. Then try the same drag with the control and option keys down.
  This time no dots are drawn and you can see by the point strings
  printed that view-mouse-position is badly confused.
- To see the axis problem hold the command (not control) and option
  keys down and click in the hollow region. The region will jump to
  the far left, be constrained as you move the mouse, and
  drag-gray-region will return the too-far-left value. (If you drag
  with just the option key down, which makes my drag-gray-region clip
  to the window, the contraining works fine).


matt

==== Code start ====
(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, >>also relative to
WINDOW<<. 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.

Note: It is critical that START-POINT and REGION are relative to WINDOW.
For nested and scrolled views this can be tricky. See the second example
for how to do this correctly."
  ;;
  ;; 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)))
         )
    final-result))


;;;================================================================
;;;Example1: Simple windows =======================================
;;;================================================================
;;;
;;; This example shows using drag-gray-region within a window with no
;;; subviews.
;;;

(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 >> unless you
      ;; wrap with-port around the output routines.
      ;;
      ;; With-focused-view should work but it doesn't! To see this, try
      ;; this routine using the different win-rel-pt setf values.
      ;;
      (let* ((win (front-window :class 'window))
             win-rel-pt)
        (when (and (control-key-p) win)
          (setf win-rel-pt
                ;(view-mouse-position win)                           ;broken
                (with-port (wptr win) (view-mouse-position win))    ;works
                )
          (with-port (wptr win)
            (print (point-string win-rel-pt))
            (frame-rect win win-rel-pt (add-points win-rel-pt #@(2 2))))))
      ;;
      (setf *last-point* new-point))))

(defclass region-win (window)
  ((region :initarg :region :accessor region-win-region)
   )
  )

(defmethod view-draw-contents ((view region-win))
  (fill-oval view *light-gray-pattern* 10 10 150 40)
  (fill-rect view *gray-pattern* 40 50 70 90)
  (frame-region view (region-win-region view)))

(defmethod view-click-event-handler ((view region-win) point)
  (when (point-in-region-p (region-win-region view) point)
    (let* ((region-copy (copy-region (region-win-region view)))
           (window (view-window view))
           (result
            (drag-gray-region
             window (convert-coordinates point view window) region-copy
             :clip-view (cond ((command-key-p) nil)
                              ((control-key-p) window)
                              (t view))
             :axis (cond ((shift-key-p) :h-axis-only)
                         ((option-key-p) :v-axis-only)
                         (t :no-constraint))
             :action-procedure temp-proc))
           )
      (when result
        (invalidate-region view (region-win-region view) t)
        (format t "~&Result: ~S" (point-string result))
        (offset-region (region-win-region view) result)
        (invalidate-region view (region-win-region view) t)))))

(let* ((win (front-window))
       (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))))
  (make-instance 'region-win :view-position #@(50 50)
                 :view-size #@(200 200) :window-title "Click me!"
                 :region region))


==== Code end ====