scm/graphviz.scm

   1 (define-module (scm graphviz)
   2   #:use-module (lily)
   3   #:export (make-graph add-node add-edge))
   4
   5 (define (make-graph filename)
   6   (let ((empty-graph (list->vector (list filename '() '() '()))))
   7     (ly:atexit write-graph (list empty-graph))
   8     empty-graph))
   9
  10 (define (filename g) (vector-ref g 0))
  11 (define (nodes g) (vector-ref g 1))
  12 (define (edges g) (vector-ref g 2))
  13 (define (clusters g) (vector-ref g 3))
  14
  15 (define (add-node graph label)
  16   (let ((ns (nodes graph)))
  17     (vector-set! graph 1 (cons `(,(length ns) . ,label) ns))
  18     (length ns)))
  19
  20 (define (add-edge graph node1 node2)
  21   (vector-set! graph 2 (cons `(,node1 . ,node2) (edges graph))))
  22
  23 (define (write-graph graph)
  24   (let ((out (open-file (filename graph) "w"))
  25         (ns (nodes graph))
  26         (es (edges graph))
  27         (cc (clusters graph)))
  28     (ly:message (format "writing graph ~s..." (filename graph)))
  29     (display "digraph G {\nrankdir=\"LR\"\nnode [shape=rectangle]\n" out)
  30     (map (lambda (n) (display (format "~a [label=\"~a\"]\n" (car n) (cdr n)) out))
  31          ns)
  32     (map (lambda (e) (display (format "~a -> ~a\n" (car e) (cdr e)) out))
  33          es)
  34     (display "}" out)))
  35