about summary refs log tree commit diff
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)))