1 | % (c) 2009-2019 Lehrstuhl fuer Softwaretechnik und Programmiersprachen, | |
2 | % Heinrich Heine Universitaet Duesseldorf | |
3 | % This software is licenced under EPL 1.0 (http://www.eclipse.org/org/documents/epl-v10.html) | |
4 | ||
5 | :- module(dot_graph_generator,[gen_dot_graph/6,gen_dot_graph/7, | |
6 | print_graph_header/1,print_graph_footer/0, | |
7 | translate_bvalue_to_colour/2, try_translate_bvalue_to_colour/2, | |
8 | translate_int_col/2]). | |
9 | ||
10 | :- use_module(module_information). | |
11 | :- module_info(group,dot). | |
12 | :- module_info(description,'This a few tools for generating dot graphs.'). | |
13 | ||
14 | :- use_module(library(lists)). | |
15 | :- use_module(preferences). | |
16 | ||
17 | :- use_module(debug). | |
18 | :- use_module(self_check). | |
19 | ||
20 | /* --------------------------------------------------- */ | |
21 | /* MAIN ENTRY POINTS FOR TCL */ | |
22 | /* --------------------------------------------------- */ | |
23 | ||
24 | % note: one can provide none for some of the predicates | |
25 | ||
26 | gen_dot_graph(F,Module,NodePredicate,TransPredicate,SameRankPred,SubGraphPred) :- | |
27 | gen_dot_graph(F,[with_page_size],Module,NodePredicate,TransPredicate,SameRankPred,SubGraphPred). | |
28 | ||
29 | gen_dot_graph(F,WithSize,Module,NodePredicate,TransPredicate,SameRankPred,SubGraphPred) :- | |
30 | print('% Generating Dot File: '), print(F),nl, | |
31 | reset_ids, | |
32 | open(F,write,FStream,[encoding('UTF-8')]), | |
33 | (fgen_dot_graph(FStream,WithSize,Module,NodePredicate,TransPredicate,SameRankPred,SubGraphPred) -> true ; true), | |
34 | close(FStream), | |
35 | print('% Done'),nl. | |
36 | ||
37 | ||
38 | node_id(Module,P,NodeID) :- | |
39 | node_predicate_call(Module,P,NodeID,_Sub,_NodeDesc,_Shape,_Style,_Color). | |
40 | node_predicate_call(Module,P,TNodeID,SubGraph,NodeDesc,Shape,Style,Color) :- | |
41 | %Call =.. [P,NodeID,SubGraph,NodeDesc,Shape,Style,Color], | |
42 | call(Module:P,NodeID,SubGraph,NodeDesc,Shape,Style,Color), | |
43 | translate_id(NodeID,TNodeID). | |
44 | ||
45 | trans_predicate_call(Module,P,TNodeID,Label,TSuccNodeID,Color,Style) :- | |
46 | %Call =.. [P,NodeID,Label,SuccNodeID,Color], | |
47 | call(Module:P,NodeID,Label,SuccNodeID,Color,Style), | |
48 | translate_id(NodeID,TNodeID), | |
49 | translate_id(SuccNodeID,TSuccNodeID). | |
50 | ||
51 | same_rank_call(Module,P,TNodes) :- P \= none, | |
52 | %Call =.. [P,Nodes], | |
53 | call(Module:P,Nodes), | |
54 | Nodes \= [], % empty list provides no information | |
55 | maplist(translate_id,Nodes,TNodes). | |
56 | /* should succeed once for every set of NodeIDs which should be of same rank */ | |
57 | ||
58 | % should succeed once for every subgraph and generate a subgraphID which is passed to the node predicate | |
59 | subgraph_call(Module,P,SubGraphID,Style,Color) :- P \= none, | |
60 | %Call =.. [P,SubGraphID,Style,Color], | |
61 | call(Module:P,SubGraphID,Style,Color). | |
62 | /* Notes: SubGraphID: should be none if not in a subgraph; Style and Color can be none */ | |
63 | ||
64 | :- dynamic stored_id/2. | |
65 | :- dynamic next_id/1. | |
66 | next_id(0). | |
67 | ||
68 | reset_ids :- retractall(stored_id(_,_)), retractall(next_id(_)), | |
69 | assert(next_id(0)). | |
70 | ||
71 | % translate ids to numbers; ensure that dot can deal with them | |
72 | translate_id(ID,TransID) :- | |
73 | (number(ID) -> TransID=ID | |
74 | ; stored_id(ID,SID) -> TransID=SID | |
75 | ; retract(next_id(TransID)), | |
76 | assert(stored_id(ID,TransID)), | |
77 | N1 is TransID+1, | |
78 | assert(next_id(N1))). | |
79 | ||
80 | /* ---------------------------------------------------------------------- */ | |
81 | ||
82 | ||
83 | fgen_dot_graph(FStream,WithSize,Module,NodePredicate,TransPredicate,SameRankPred,SubGraphPred) :- | |
84 | print_graph_header(FStream,prob_graph,WithSize), | |
85 | (node_id(Module,NodePredicate,_) -> true | |
86 | ; (format(user_error,"No nodes in gen_dot_graph: ~w, ~w, ~w ~w ~w.~n~n", | |
87 | [Module,NodePredicate,TransPredicate,SameRankPred,SubGraphPred]),fail)), | |
88 | print_nodes(FStream,Module,NodePredicate,SubGraphPred), | |
89 | fail. | |
90 | fgen_dot_graph(FStream,_WithSize,Module,_NodePredicate,_TransPredicate,SameRankPred,_SubGraphPred) :- | |
91 | same_rank_call(Module,SameRankPred,Nodes), | |
92 | print_same_ranks(FStream,Nodes), | |
93 | fail. | |
94 | fgen_dot_graph(FStream,_WithSize,Module,_NodePredicate,TransPredicate,_SameRankPred,_SubGraphPred) :- | |
95 | print_transitions(FStream,_NodeID,Module,TransPredicate), | |
96 | fail. | |
97 | fgen_dot_graph(FStream,_,_,_,_,_,_) :- | |
98 | print_graph_footer(FStream). | |
99 | ||
100 | /* ---------------------------------------------------------------------- */ | |
101 | ||
102 | print_graph_header(Type) :- print_graph_header(user_output,Type,[with_page_size]). | |
103 | print_graph_header(FStream,Type,Opts) :- | |
104 | (member(with_page_size,Opts) -> PSize='page="8.5, 11",ratio=fill,size="7.5,10"' ; PSize=''), | |
105 | (member(horizontal,Opts) -> RDir = ' rankdir=LR;' ; RDir=''), | |
106 | format(FStream,'digraph ~w { graph [~w];~w~n',[Type,PSize,RDir]). | |
107 | % print('graph [orientation=landscape, page="8.5, 11",ratio=fill,size="7.5,10"];'),nl, | |
108 | ||
109 | print_graph_footer :- print_graph_footer(user_output). | |
110 | print_graph_footer(FStream) :- format(FStream,'}~n',[]). | |
111 | ||
112 | ||
113 | /* ---------------------------------------------------------------------- */ | |
114 | ||
115 | ||
116 | print_nodes(FStream,Module,NodePredicate,SubGraphPred) :- | |
117 | subgraph_call(Module,SubGraphPred,SubgraphID,Style,Color), | |
118 | format(FStream,' subgraph cluster_~w {~n',[SubgraphID]), | |
119 | (Style = none -> true ; format(FStream,' style="~w";~n',[Style])), | |
120 | (Color = none -> true ; format(FStream,' color="~w";~n',[Color])), | |
121 | format(FStream,' label="~w";~n',[SubgraphID]), | |
122 | print_nodes2(FStream,SubgraphID,Module,NodePredicate), | |
123 | write(FStream,' }'),nl(FStream), | |
124 | fail. | |
125 | print_nodes(FStream,Module,NodePredicate,_SubGraphPred) :- | |
126 | print_nodes2(FStream,none,Module,NodePredicate), | |
127 | nl(FStream). | |
128 | ||
129 | ||
130 | print_nodes2(FStream,SubGraph,Module,NodePredicate) :- | |
131 | node_predicate_call(Module,NodePredicate,NodeID,SubGraph,NodeDesc,Shape,Style,Color), | |
132 | format(FStream,' ~w [shape=~w',[NodeID,Shape]), /* options: triangle, .... */ | |
133 | (Style = none | |
134 | -> true | |
135 | ; format(FStream,', style="~w"',[Style]) /* options: filled */ | |
136 | ), | |
137 | (Color = none | |
138 | -> true | |
139 | ; format(FStream,', color="~w"',[Color]) /* options: red,green,... */ | |
140 | ), | |
141 | get_preference(dot_node_font_size,FSize), | |
142 | format(FStream,', fontsize=~w, label="',[FSize]), | |
143 | ((preference(dot_print_node_ids,true), | |
144 | \+ stored_id(_,_), % no translations performed | |
145 | NodeID \= NodeDesc) % otherwise we already print it as description | |
146 | -> format(FStream,'~w:\\n',[NodeID]) ; true), | |
147 | format(FStream,'~w"];~n',[NodeDesc]), | |
148 | fail. | |
149 | print_nodes2(FStream,_Subgraph,_,_) :- nl(FStream). | |
150 | ||
151 | print_transitions(FStream,NodeID,Module,TransPredicate) :- | |
152 | trans_predicate_call(Module,TransPredicate,NodeID,Label,SuccID,Color,Style), | |
153 | ||
154 | (NodeID=root -> preference(dot_print_root,true) ; true), | |
155 | ||
156 | (NodeID \= SuccID -> true ; preference(dot_print_self_loops,true)), | |
157 | ||
158 | format(FStream,' ~w -> ~w [',[NodeID,SuccID]), | |
159 | (preference(dot_print_arc_colors,true) | |
160 | -> format(FStream,'color="~w",',[Color]) | |
161 | ; true | |
162 | ), | |
163 | % acceptable styles Style ::= solid, bold, dotted, dashed, invis, arrowhead(none,Style) | |
164 | print_style(Style,FStream), | |
165 | get_preference(dot_edge_font_size,FSize), | |
166 | (Label='' -> format(FStream,'];~n',[]) | |
167 | ; format(FStream,' label="~w", fontsize=~w];~n',[Label,FSize])), | |
168 | fail. | |
169 | print_transitions(FStream,_NodeID,_,_) :- nl(FStream). | |
170 | ||
171 | print_style(solid,_) :- !. | |
172 | print_style(arrowhead(AS,S),FStream) :- !, format(FStream,'arrowhead=~w,',[AS]), print_style(S,FStream). | |
173 | print_style(arrowtail(AS,S),FStream) :- !, format(FStream,'dir=both,arrowtail=~w,',[AS]), print_style(S,FStream). | |
174 | print_style(Style,FStream) :- format(FStream,'style="~w",',[Style]). | |
175 | ||
176 | print_same_ranks(FStream,L) :- | |
177 | write(FStream,' { rank=same; '), | |
178 | print_same_ranks2(FStream,L), | |
179 | write(FStream,' }'),nl(FStream). | |
180 | ||
181 | print_same_ranks2(_FStream,[]). | |
182 | print_same_ranks2(FStream,[H|T]) :- | |
183 | write(FStream,H), write(FStream,'; '), | |
184 | print_same_ranks2(FStream,T). | |
185 | ||
186 | ||
187 | % utilities for converting values into colours: | |
188 | ||
189 | ||
190 | ||
191 | translate_bvalue_to_colour(Val,Col) :- | |
192 | (try_translate_bvalue_to_colour(Val,C) -> Col=C; Col=lightgray). | |
193 | ||
194 | try_translate_bvalue_to_colour(int(X),Res) :- !, (translate_int_col(X,Colour) -> Res=Colour ; Res=black). | |
195 | try_translate_bvalue_to_colour(string(X),Colour) :- is_of_type(X,rgb_color),!, X=Colour. | |
196 | try_translate_bvalue_to_colour(fd(X,GS),Colour) :- !, translate_fd_col(X,GS,Colour). | |
197 | try_translate_bvalue_to_colour(pred_true,Colour) :- !, Colour=olivedrab2. | |
198 | try_translate_bvalue_to_colour(pred_false,Colour) :- !, Colour=tomato. | |
199 | try_translate_bvalue_to_colour((A,_),Colour) :- !, try_translate_bvalue_to_colour(A,Colour). | |
200 | ||
201 | % TO DO : add string conversions, rgb values , ... | |
202 | :- use_module(b_global_sets,[is_b_global_constant/3]). | |
203 | ||
204 | translate_fd_col(X,GS,Res) :- | |
205 | is_b_global_constant(GS,X,Colour), | |
206 | is_of_type(Colour,rgb_color),!, | |
207 | Res=Colour. | |
208 | translate_fd_col(X,_,Res) :- number(X), translate_int_col(X,Colour),!, Res=Colour. | |
209 | translate_fd_col(_,_,lightgray). | |
210 | ||
211 | translate_int_col(-1,Colour) :- !,Colour=tomato. % special case | |
212 | translate_int_col(Int,Colour) :- | |
213 | Y is abs(Int) mod 15, translate_int_col_aux(Y,Colour). | |
214 | translate_int_col_aux(0,gray95). | |
215 | translate_int_col_aux(1,blue). | |
216 | translate_int_col_aux(2,red). | |
217 | translate_int_col_aux(3,green). | |
218 | translate_int_col_aux(4,lightgray). | |
219 | translate_int_col_aux(5,orange). | |
220 | translate_int_col_aux(6,yellow). | |
221 | translate_int_col_aux(7,brown). | |
222 | translate_int_col_aux(8,violet). | |
223 | translate_int_col_aux(9,tomato). | |
224 | translate_int_col_aux(10,darkslateblue). | |
225 | translate_int_col_aux(11,maroon2). | |
226 | translate_int_col_aux(12,olivedrab2). | |
227 | translate_int_col_aux(13,chartreuse3). | |
228 | translate_int_col_aux(14,grey20). | |
229 | % red,green,blue,yellow,orange,black,white,gray,brown,violet,darkred,tomato,darkblue, | |
230 | % 'DarkGray',darkviolet,darkslateblue,lightblue,lightgray,maroon2,olivedrab2, | |
231 | % steelblue,chartreuse3,chartreuse4 |