1 ;;;-*- Mode: Lisp; Package: metabang.graph -*-
5 $Id: graphviz-support-optional.lisp,v 1.0 2005/06/21 20:51:51 moody Exp $
11 This file contains the stuff that depends on cl-graphviz and is only
12 loaded when cl-graphviz is available.
16 (in-package #:metabang.graph)
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)))
25 ;;; ---------------------------------------------------------------------------
26 (defmethod layout-graph-with-graphviz ((g dot-graph)
28 (algorithm nil algorithm-provided-p))
29 (let* ((dot (with-output-to-string (out) (graph->dot g out)))
33 (setf (dot-attribute-value :bb g)
34 (graphviz:graph-bounding-box dot-graph)))
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)
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-value :pos vertex) pos
48 (dot-attribute-value :width vertex) width
49 (dot-attribute-value :height vertex) height))))
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))
61 (graphviz:iterate-edge-beziers
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-value :pos real-edge)
69 (nreverse bezier-points))))))))
70 (when algorithm-provided-p
71 (nconc args (list :algorithm algorithm)))
72 (apply 'graphviz:layout-dot-format args))