[mcclim-cvs] CVS update: mcclim/graph-formatting.lisp - mcclim-cvs@common-lisp.net - mailman3.common-lisp.net

21 Apr 2005

Update of /project/mcclim/cvsroot/mcclim
In directory common-lisp.net:/tmp/cvs-serv28776
Modified Files:
    graph-formatting.lisp 
Log Message:
Fix bug causing misalignment of graph nodes and edges when using a 
non-identity medium transformation.
(Tranform node positions by medium transformation before inserting into
 output history, then draw edges in stream coordinates with no medium
 transformation, so that medium transformation is not applied twice.)
Date: Thu Apr 21 05:34:58 2005
Author: ahefner
Index: mcclim/graph-formatting.lisp
diff -u mcclim/graph-formatting.lisp:1.12 mcclim/graph-formatting.lisp:1.13

--- mcclim/graph-formatting.lisp:1.12	Tue Apr 12 22:43:26 2005
+++ mcclim/graph-formatting.lisp	Thu Apr 21 05:34:58 2005
@@ -3,7 +3,7 @@
 ;;;     Title: Graph Formatting
 ;;;   Created: 2002-08-13
 ;;;   License: LGPL (See file COPYING for details).
-;;;       $Id: graph-formatting.lisp,v 1.12 2005/04/12 20:43:26 ahefner Exp $
+;;;       $Id: graph-formatting.lisp,v 1.13 2005/04/21 03:34:58 ahefner Exp $
 ;;; ---------------------------------------------------------------------------
;;;  (c) copyright 2002 by Gilbert Baumann
@@ -338,8 +338,8 @@
                                 (let ((v (+ v0 (/ (min 0 d) -2))))
                                   (setf (output-record-position node)
                                         (if (eq orientation :vertical)
-                                            (values v u0)
-                                            (values u0 v)))
+                                            (transform-position (medium-transformation stream) v u0)
+                                            (transform-position (medium-transformation stream) u0 v)))
                                   (add-output-record node graph-output-record))
                                 ;;
                                 (let ((u (+ u0 (car majors)))
@@ -401,6 +401,11 @@
 (defmethod layout-graph-edges ((graph standard-graph-output-record)
                                stream arc-drawer arc-drawing-options)
   (with-slots (orientation) graph
+   ;; We tranformed the position of the nodes when we inserted them into
+   ;; output history, so the bounding rectangles queried below will be
+   ;; transformed. Therefore, disable the transformation now, otherwise
+   ;; the transformation is effectively applied twice to the edges.
+   (with-identity-transformation (stream)
     (traverse-graph-nodes graph
                           (lambda (node children continuation)
                             (unless (eq node graph)
@@ -424,7 +429,7 @@
                                                 (/ (+ x1 x2) 2) from
                                                 (/ (+ u1 u2) 2) to
                                                 arc-drawing-options))))))))
-                            (map nil continuation children)))))
+                            (map nil continuation children))))))
(defmethod layout-graph-edges :around ((graph-output-record tree-graph-output-record)
                                        stream arc-drawer arc-drawing-options)

    