CLIM mail archive


:feedback function in dragging-output-record

    Date: Wed, 25 Mar 1992 19:04 EST
    From: will taylor <>

    I am using CLIM 1.0 - Genera 8.1.1 and want to limit the movement
    of an output record as I drag it with the mouse.  I want to constrain
    it to move only in the y-direction and between y-min and y-max values
    which bracket the initial y-position.

    DRAGGING-NODE causes the "node" to move only in the y-direction (between
    y-min & y-max), regardless of the mouse's x-location -- but the erasing of 
    the output-record does not erase properly unless the mouse stays on the "y-axis"
    [its (- current-x initial-x) remaining 0].

A bunch of bugs were fixed in DRAGGING-OUTPUT for CLIM 1.1.  I cannot
say for sure that this will have been fixed, but you should check it out
when you get CLIM 1.1 and send a bug report if it does not.

    ==> Will Taylor
    (dragging-output-record pane node-output-record :repaint nil :finish-on-release t
			    :feedback #'DRAGGING-NODE)

    (defun DRAGGING-NODE (output-record stream initial-x initial-y current-x current-y mode)
      "feedback function of dragging-output-record for dragging a node between its parent
       and its children"
      (let* ((node *drag-node*) (delta-y nil)
	     (editor-pane (editor-pane *evolutionary-tree-frame*))
	     (current-tree (current-tree editor-pane))
	     (time-factor (time-factor current-tree))
	     (y-min (- initial-y 20)) (y-max (+ initial-y 20)) (y-limit 0))
	  (case mode
	      (setf (node-y node) current-y)
	      (setf delta-y (- current-y *node-y-position*))
	      (incf (node-pixel-branch-length node) delta-y)
	      (setf *branch-length* (truncate (node-pixel-branch-length node) time-factor))
	      (if (< current-y y-min)
		  (setf y-limit (- y-min current-y)))
	      (if (> current-y y-max)
		  (setf y-limit (- y-max current-y)))
	      (multiple-value-bind (x-offset y-offset)
		    stream output-record)
		;; force node to move only in the y-direction
		(replay-1 output-record stream nil (- x-offset (- current-x initial-x))
			  (+ y-offset y-limit)))
	      (setf *node-y-position* current-y))
	      (erase-output-record output-record stream)))))


Main Index | Thread Index