Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /sml/trunk/src/MLRISC/visualization/vcg.sml
ViewVC logotype

Annotation of /sml/trunk/src/MLRISC/visualization/vcg.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 245 - (view) (download)
Original Path: sml/branches/SMLNJ/src/MLRISC/visualization/vcg.sml

1 : monnier 245 structure VCG : GRAPH_DISPLAY =
2 :     struct
3 :    
4 :     structure L = GraphLayout
5 :     structure G = Graph
6 :    
7 :     fun suffix() = "vcg"
8 :     fun program() = "xvcg"
9 :    
10 :     fun visualize out (G.GRAPH G) =
11 :     let val spaces = " ";
12 :     fun int n = out (Int.toString n)
13 :     fun nl() = out "\n"
14 :     fun tab t = out(String.substring(spaces,0,t)) handle _ => out spaces
15 :     fun color k c = (out k; out c; nl())
16 :     fun openBrace t k = (tab t; out k; out ": {\n")
17 :     fun closeBrace t = (tab t; out "}\n")
18 :    
19 :     fun doStyle t (L.ALGORITHM a) =
20 :     (tab t; out "layoutalgorithm: "; out a; nl())
21 :     | doStyle t (L.NODE_COLOR c) = (tab t; color "node.color: " c)
22 :     | doStyle t (L.EDGE_COLOR c) = (tab t; color "edge.color: " c)
23 :     | doStyle t (L.TEXT_COLOR c) = (tab t; color "textcolor: " c)
24 :     | doStyle t (L.ARROW_COLOR c) = (tab t; color "arrowcolor: " c)
25 :     | doStyle t (L.BACKARROW_COLOR c) = (tab t; color "backarrowcolor: " c)
26 :     | doStyle t (L.BORDER_COLOR c) = (tab t; color "bordercolor: " c)
27 :     | doStyle t _ = ()
28 :    
29 :     fun label l = (out "label: \""; out(String.toString l); out "\"")
30 :    
31 :     fun doAttrib t (L.LABEL "") = ()
32 :     | doAttrib t (L.LABEL l) = (tab t; label l; nl())
33 :     | doAttrib t (L.COLOR c) = (tab t; color "color: " c)
34 :     | doAttrib t (L.BORDERLESS) = (tab t; color "bordercolor: " "white")
35 :     | doAttrib t _ = ()
36 :    
37 :     fun doNode t (n,a) =
38 :     (openBrace t "node";
39 :     tab (t+2); out "title: \""; int n; out "\"\n";
40 :     app (doAttrib (t+2)) a;
41 :     closeBrace t)
42 :    
43 :     fun doEdge t kind (i,j,a) =
44 :     (openBrace t kind;
45 :     tab (t+2); out "sourcename: \""; int i; out "\"\n";
46 :     tab (t+2); out "targetname: \""; int j; out "\"\n";
47 :     app (doAttrib (t+2)) a;
48 :     closeBrace t)
49 :    
50 :     fun defaultStyle t =
51 :     (tab t; out "display_edge_labels: yes\n";
52 :     tab t; out "layoutalgorithm: minbackward\n"
53 :     )
54 :    
55 :     in out "graph: {\n";
56 :     defaultStyle 2;
57 :     app (doStyle 2) (#graph_info G);
58 :     #forall_nodes G (doNode 2);
59 :     #forall_edges G (doEdge 2 "edge");
60 :     out "}\n"
61 :     end
62 :    
63 :    
64 :     end
65 :    
66 :     (*
67 :     * $Log$
68 :     *)

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0