dev/graphviz/graphviz-support-optional.lisp

   1 ;;;-*- Mode: Lisp; Package: metabang.graph -*-
   2
   3 #| simple-header
   4
   5 $Id: graphviz-support-optional.lisp,v 1.0 2005/06/21 20:51:51 moody Exp $
   6
   7 Author: Attila Lendvai
   8
   9 DISCUSSION
  10
  11 This file contains the stuff that depends on cl-graphviz and is only
  12 loaded when cl-graphviz is available.
  13
  14 |#
  15
  16 (in-package metabang.graph)
  17
  18 ;; TODO these are hacks to be removed later,
  19 ;; the functionality should be provided by graph itself
  20 (defmethod find-vertex-by-id (g (id integer))
  21   (search-for-vertex g id :key 'vertex-id))
  22 (defmethod find-vertex-by-id (g (id string))
  23   (find-vertex-by-id g (parse-integer id)))
  24
  25 ;;; ---------------------------------------------------------------------------
  26 (defmethod layout-graph-with-graphviz ((g dot-graph)
  27                                        &key
  28                                        (algorithm nil algorithm-provided-p))
  29   (let* ((dot (with-output-to-string (out) (graph->dot g out)))
  30          (args (list dot
  31                      :graph-visitor
  32                      (lambda (dot-graph)
  33                        (setf (dot-attribute :bb g)
  34                              (graphviz:graph-bounding-box dot-graph)))
  35
  36                      :node-visitor
  37                      (lambda (node)
  38                        (bind ((pos (graphviz:node-coordinate node))
  39                               ((width height) (graphviz:node-size node)))
  40                          ;;(format t "Node ~a: ~a; ~a, ~a~%"
  41                          ;;        (graphviz:node-name node)
  42                          ;;        pos
  43                          ;;        width height)
  44                          ;; TODO search-for-vertex is sloooow, use a hashtable or
  45                          ;; introduce an graph-find-element-by-id-mixin, or similar
  46                          (let ((vertex (find-vertex-by-id g (graphviz:node-name node))))
  47                            (setf (dot-attribute :pos vertex) pos)
  48                            (setf (dot-attribute :width vertex) width)
  49                            (setf (dot-attribute :height vertex) height))))
  50
  51                      :edge-visitor
  52                      (lambda (edge)
  53                        (bind (((from to) (graphviz:edge-between edge)))
  54                          ;;(format t "Edge: ~a - ~a~%"
  55                          ;;        (graphviz:node-name from)
  56                          ;;        (graphviz:node-name to))
  57                          (let* ((from-vertex (find-vertex-by-id g (graphviz:node-name from)))
  58                                 (to-vertex (find-vertex-by-id g (graphviz:node-name to)))
  59                                 (real-edge (find-edge-between-vertexes g from-vertex to-vertex))
  60                                 (bezier-points '()))
  61                            (graphviz:edge-iterate-beziers
  62                             edge
  63                             (lambda (bezier)
  64                               ;;(format t "  Bezier: ~a~%"
  65                               ;;        (graphviz:bezier-points bezier))
  66                               (dolist (el (graphviz:bezier-points bezier))
  67                                 (push el bezier-points))))
  68                            (setf (dot-attribute :pos real-edge) (nreverse bezier-points))))))))
  69     (when algorithm-provided-p
  70       (nconc args (list :algorithm algorithm)))
  71     (apply 'graphviz:layout-dot-format args))
  72   g)
  73
  74