15.4.239  src/lib/compiler/back/low/display/vcg.pkg

#
# This module communicates with the vcg tool.
# 
# -- Allen Leung

# Compiled by:
#     src/lib/compiler/back/low/lib/visual.lib


stipulate
    package odg =  oop_digraph;                                 # oop_digraph   is from   src/lib/graph/oop-digraph.pkg
    package glo =  graph_layout;                                # graph_layout          is from   src/lib/compiler/back/low/display/graph-layout.pkg
herein


    package vcg: (weak)  Graph_Display {                        # Graph_Display         is from   src/lib/compiler/back/low/display/graph-display.api
        #
        fun suffix () = ".vcg";
        fun program () = "xvcg";

        fun visualize out (odg::DIGRAPH graph)
            =
            {   spaces = "                                           ";

                fun int n  = out (int::to_string n); 
                fun nl ()   = out "\n"; 
                fun tab t  = out (string::substring (spaces, 0, t)) except _ => out spaces; end ;
                fun color k c = { out k; out c; nl();}; 
                fun open_brace t k = { tab t; out k; out ": {\n";};
                fun close_brace t = { tab t; out "}\n";};

                fun do_style t (glo::ALGORITHM a) => 
                        { tab t; out "layoutalgorithm: "; out a; nl();}; 
                    do_style t (glo::NODE_COLOR c) => { tab t; color "node.color: " c;};
                    do_style t (glo::EDGE_COLOR c) => { tab t; color "edge.color: " c;};
                    do_style t (glo::TEXT_COLOR c) => { tab t; color "textcolor: " c;};
                    do_style t (glo::ARROW_COLOR c) => { tab t; color "arrowcolor: " c;};
                    do_style t (glo::BACKARROW_COLOR c) => { tab t; color "backarrowcolor: " c;};
                    do_style t (glo::BORDER_COLOR c) => { tab t; color "bordercolor: " c;};
                    do_style t _ => ();
                end;

                fun label l
                    =
                    {   out "label: \"";
                        out (string::to_string l);
                        out "\"";
                    };

                fun do_attrib t (glo::LABEL "")   =>  ();
                    do_attrib t (glo::LABEL l)    =>  { tab t; label l; nl();};
                    do_attrib t (glo::COLOR c)    =>  { tab t; color "color: " c;};
                    do_attrib t (glo::BORDERLESS) =>  { tab t; color "bordercolor: " "white";};
                    do_attrib t _               =>  ();
                end;

                fun do_node t (n, a)
                    =
                    {   open_brace t "node";
                        tab (t+2);
                        out "title: \"";
                        int n;
                        out "\"\n";
                        apply (do_attrib (t+2)) a; 
                        close_brace t;
                    };

                fun do_edge t kind (i, j, a)
                    =
                    {   open_brace t kind;
                        tab (t+2); out "sourcename: \""; int i; out "\"\n";
                        tab (t+2); out "targetname: \""; int j; out "\"\n";
                        apply (do_attrib (t+2)) a;
                        close_brace t;
                    };

                fun default_style t
                    = 
                    {   tab t; out "display_edge_labels: yes\n";
                        tab t; out "layoutalgorithm: minbackward\n";
                    };

                out "graph: {\n";
                default_style 2;
                apply (do_style 2) graph.graph_info;
                graph.forall_nodes (do_node 2);
                graph.forall_edges (do_edge 2 "edge");
                out "}\n"; 
            };
    };
end;