CLIM mail archive
[Prev][Next][Index][Thread]

Dragging nodes of a formatting graph

   Date: Wed, 4 Nov 92 15:15:20 PST
   From: Brian Anderson <bha@atc.boeing.com>

   I want to use clim:formatting-graph-from-root to layout an *initial*
   version of a graph.  Then, I want the user to be able to drag graph
   nodes to a desired position, and redraw the node and connecting
   links at the new position.  I also want to be able to capture the
   position of each graph node so that I can write an external
   representation of the graph and redraw it at a later time (possibly in
   another Lisp session).

   Has anyone done anything like this beast?  Does anyone have any
   suggestions on how to approach this?  Is this going to be mega-hard?

[whoops, sorry for the premature sending of the message just now]

Here is some code that moves a graph node.  It only handles trees
(e.g. a node has one parent, there are no cycles).  It probably has
bugs, including possibly mis-behaving if you are scrolled away from
(0,0).  I don't have any more time right now to test it.  Try it out
and let me know how it goes.

To use it, just get ahold of one of your nodes, and call

(move-graph-node node-window node new-x new-y)

If this works at all, I'll try to get a (commented) version into the
contrib library.  Send back your modifications (but only if they make
it better :-)

================================================================
(in-package :clim)

(defun move-graph-node (stream node new-x new-y)
  (let* ((graph (output-record-parent node))
	 (orientation (slot-value graph 'orientation)))
    (draw-related-edges stream node +background+ orientation)
    (with-bounding-rectangle* (left top right bottom) node
      (with-output-recording-options (stream :record-p nil)
	(draw-rectangle* stream left top right bottom :ink +background+)))
    (output-record-set-position* node new-x new-y)
    (replay node stream)
    (draw-related-edges stream node +foreground+ orientation)))

(defun draw-related-edges (stream node ink orientation)
  (labels ((parent-attachment-position (node)
	     (with-bounding-rectangle* (left top right bottom) node
	       (case orientation
		 ((:horizontal :right)
		  (values (1+ right) (the fixnum (+ top (floor (- bottom top) 2)))))
		 ((:vertical :down)
		  (values (the fixnum (+ left (floor (- right left) 2))) (1+ bottom))))))
	   (child-attachment-position (node)
	     (with-bounding-rectangle* (left top right bottom) node
	       (case orientation
		 ((:horizontal :right)
		  (values (1- left) (the fixnum (+ top (floor (- bottom top) 2)))))
		 ((:vertical :down)
		  (values (the fixnum (+ left (floor (- right left) 2))) (1- top))))))
	   (draw-edge (parent child)
	     (multiple-value-bind (parent-x parent-y)
		 (parent-attachment-position parent)
	       (multiple-value-bind (child-x child-y)
		   (child-attachment-position child)
		 (draw-line* stream parent-x parent-y child-x child-y
			     :ink ink)))))
    (declare (dynamic-extent #'parent-attachment-position
			     #'child-attachment-position))
    ;; Assuming a tree for simplicity
    (let ((parent (first (graph-node-parents node)))
	  (children (graph-node-children node)))
      (when parent
	(draw-edge parent node))
      (dolist (child children)
	(draw-edge node child)))))

0,,
References:
Main Index | Thread Index