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 412 - (view) (download)

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

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