From 48cfe5c5d2fe17343905ced100e73723c099a55c Mon Sep 17 00:00:00 2001 From: Joe Neeman Date: Thu, 1 Feb 2007 19:45:07 +0200 Subject: [PATCH] small graphing fixes --- ly/graphviz.ly | 20 ++++++++++++-------- scm/graphviz.scm | 22 +++++++++++----------- 2 files changed, 23 insertions(+), 19 deletions(-) diff --git a/ly/graphviz.ly b/ly/graphviz.ly index 65b6538ec6..097805337f 100644 --- a/ly/graphviz.ly +++ b/ly/graphviz.ly @@ -1,12 +1,14 @@ \version "2.11.15" +#(use-modules (scm graphviz)) + #(define last-grob-action '()) #(define sym-blacklist - '(cause font)) + '()) #(define sym-whitelist - '(control-points)) + '()) #(define file-line-blacklist '()) @@ -14,6 +16,9 @@ #(define file-line-whitelist '()) +#(define (whitelist-symbol sym) + (set! sym-whitelist (cons sym sym-whitelist))) + #(define graph (make-graph "graph.dot")) % an event is relevant if @@ -36,18 +41,17 @@ (let* ((prev (assv grob last-grob-action)) (val-str0 (format "~a" val)) (val-str (string-take val-str0 (min 50 (string-length val-str0)))) - (label (format "~a\\n~a:~a\\n~a <- ~a" grob file line prop val-str)) - (node-id (make-node graph label file))) + (label (format "~a\\n~a:~a\\n~a <- ~a" grob file line prop val-str))) (if (relevant? grob file line prop) - (begin + (let ((node-id (add-node graph label file))) (if (pair? prev) (add-edge graph (cdr prev) node-id)) (set! last-grob-action (assv-set! last-grob-action grob node-id)))))) #(define (grob-create grob file line func) (let* ((label (format "~a\\n~a:~a" grob file line)) - (node-id (make-node graph label file))) - (set! last-grob-action (assv-set! last-grob-action grob node-num)))) + (node-id (add-node graph label file))) + (set! last-grob-action (assv-set! last-grob-action grob node-id)))) #(ly:set-grob-modification-callback grob-mod) -#(ly:set-grob-creation-callback grob-create) +%#(ly:set-grob-creation-callback grob-create) diff --git a/scm/graphviz.scm b/scm/graphviz.scm index d361302fed..8ad3600ffa 100644 --- a/scm/graphviz.scm +++ b/scm/graphviz.scm @@ -20,18 +20,18 @@ (define (clusters g) (vector-ref g 3)) (define (add-cluster graph node-id cluster-name) - (let ((cs (clusters g)) - (cluster (assq cluster-name cs)) - (already-in-cluster (if cluster - (cdr cluster) - '()))) - (vector-set! graph 3 (assq-set! cluster-name - (cons node-id already-in-cluster) - cs)))) + (let* ((cs (clusters graph)) + (cluster (assq cluster-name cs)) + (already-in-cluster (if cluster + (cdr cluster) + '()))) + (vector-set! graph 3 (assq-set! cs + cluster-name + (cons node-id already-in-cluster))))) (define (add-node graph label . cluster-name) - (let ((ns (nodes graph)) - (id (length ns))) + (let* ((ns (nodes graph)) + (id (length ns))) (vector-set! graph 1 (cons `(,id . ,label) ns)) (if (and (not (null? cluster-name)) (string? (car cluster-name))) @@ -54,7 +54,7 @@ es) (map (lambda (c) (display (format "subgraph cluster_~a {\nlabel= \"~a\"\ncolor=blue\n" - (string-filter char-alphabetic? (car c)) + (string-filter (car c) char-alphabetic?) (car c)) out) (map (lambda (n) (display (format "~a\n" n) out)) (cdr c)) -- 2.39.5