aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorArun Isaac2021-12-17 17:21:22 +0530
committerArun Isaac2021-12-17 17:21:22 +0530
commit51c12b7e58685b70e7cfd9612dac403cf9ee845c (patch)
tree6b77bd9bbeb7e9437554ab6056f7bf5a166544dc
parent5d1f15e7be0bf5bd2962125a7f86119477354db2 (diff)
downloadccwl-51c12b7e58685b70e7cfd9612dac403cf9ee845c.tar.gz
ccwl-51c12b7e58685b70e7cfd9612dac403cf9ee845c.tar.lz
ccwl-51c12b7e58685b70e7cfd9612dac403cf9ee845c.zip
Create specialized type for graphviz edge.
* ccwl/graphviz.scm (<graph-edge>): New type. (graph-edge): New function. (graph->dot): Support specification of edges using the <graph-edge> type.
-rw-r--r--ccwl/graphviz.scm36
1 files changed, 29 insertions, 7 deletions
diff --git a/ccwl/graphviz.scm b/ccwl/graphviz.scm
index fec3908..7da0188 100644
--- a/ccwl/graphviz.scm
+++ b/ccwl/graphviz.scm
@@ -63,6 +63,17 @@ language."
"Construct <graph-node> object."
(make-graph-node name properties))
+(define-immutable-record-type <graph-edge>
+ (make-graph-edge from to properties)
+ graph-edge?
+ (from graph-edge-from)
+ (to graph-edge-to)
+ (properties graph-edge-properties))
+
+(define* (graph-edge from to #:optional (properties '()))
+ "Construct <graph-edge> object."
+ (make-graph-edge from to properties))
+
(define-immutable-record-type <graph-port>
(graph-port node port)
graph-port?
@@ -181,13 +192,24 @@ PORT."
port))
(display (format ";~%") port))
(graph-nodes graph))
- (for-each (match-lambda
- ((from . to)
- (indent-level port (1+ level))
- (display (format "~a -> ~a;~%"
- (serialize from)
- (serialize to))
- port)))
+ (for-each (lambda (edge)
+ (indent-level port (1+ level))
+ (match edge
+ ((? graph-edge? edge)
+ (display (format "~a -> ~a"
+ (serialize (graph-edge-from edge))
+ (serialize (graph-edge-to edge)))
+ port)
+ (unless (null? (graph-edge-properties edge))
+ (display " " port)
+ (display (serialize-properties (graph-edge-properties edge))
+ port))
+ (display (format ";~%") port))
+ ((from . to)
+ (display (format "~a -> ~a;~%"
+ (serialize from)
+ (serialize to))
+ port))))
(graph-edges graph))
(for-each (lambda (subgraph)
(graph->dot subgraph port (1+ level)))