Re: drag & drop w/in same view

["Mark A. Tapia" <markt@dgp.toronto.edu>]

On 1 May 1995 Tom McDougal asks about drag & drop within the same view.
> I ... wonder if anyone can help me
> figure out how to drag something within the same view.  A conceptually
> simple example would be dragging a circle from one place to another within
> a view.

Drag and drop actions are implemented in oodles-of-utils. In
standard drawing applications, a designer can drag a graphic object
within a view. Normally, to eliminate flicker, the system draws
an outline of the object. The canned solutions allow you to drag
various views (including icons). To drag a graphic object
requires more wok.

One solution is to use the view-click-event-handler. I used this
method to implement marking menus (in the contrib directory
the code is in menu-enhancements.sit.hqx)

Here' one approach to dragging the circle within the view.

a. If the user does a double-click, do the double click action.

b. If the user clicks within the view, start the dragging action.

   For simplicity, position the "new" center of the circle at
   the current mouse position, erase the old filled circle,
   and draw the new outline of the circle. You need to draw the
   outline, otherwise the screen will flicker.

   Until the user releases the mouse button (wait for a mouse up
   #_waitMouseUp), erase the old circle outline and draw the new
   one. To eliminate flicker, don't erase and draw if the user does
   not move during the time period.

   Note that you can enhance the code by letting the user drag the
   circle in a more natural way. First,constrain the circle to remain
   within the view. Second, eliminate the initial circle junmp.
   Let the user drag the circle only if she clicks within the circle
   and holds the mouse down. In this case, mouse movements drag the
   circle in the same direction by the same amount.

mark

;;;---> here's the original code
;;; a view that contains a circle
;;; How could we use the drag manager to allow the circle
;;; to be dragged around in the view?

(require :quickdraw)

(defclass circle-view (view)
  ((center :type integer
           :initform #@(50 50))
   (radius :type integer
           :initform #@(30 30))))

;;; draw the circle.

(defmethod view-draw-contents ((self circle-view))
  (with-slots (center radius) self
    (rlet ((r :rect
              :topleft (subtract-points center radius)
              :botright (add-points center radius)))
      (#_paintOval r))))

;;;--->the end of the original code

;;  here's the additional code
(defmethod view-outline-contents ((self circle-view))
  (with-slots (center radius) self
    (rlet ((r :rect
              :topleft (subtract-points center radius)
              :botright (add-points center radius)))
      (#_frameOval r))))

(defmethod erase-contents ((self circle-view))
  (with-slots (center radius) self
    (rlet ((r :rect
              :topleft (subtract-points center radius)
              :botright (add-points center radius)))
      (#_eraseOval r))))

(defmethod point-in-circle-p ((self circle-view) where)
  (declare (ignorable where))
  t)

(defmethod circle-track ((self circle-view) where)
  (when (and (mouse-down-p)
             (point-in-circle-p self where))
    (with-focused-view self
      (if  (double-click-p)
        nil
        (with-slots (center) self
          (loop while (#_WaitMouseUp)
                with last-where
                do (setq where (view-mouse-position self))
                (unless (equal where last-where)
                  (erase-contents self)
                  (setq center where
                        last-where where)
                  (view-outline-contents self)))
          (view-draw-contents self)))))
  t)

(defmethod view-click-event-handler  ((self circle-view) where)
  ;; handles mouse clicks in marking-menus associated with marking-menu-views
  ;; the most specific subview with view-click-event-handlers overrides the
  ;; containing view with a marking menu associated with it.
  (call-next-method self where)
  (circle-track self where))

#|
(make-instance 'window
  :view-subviews (list (make-instance 'circle-view)))

|#