1 % (c) 2009-2024 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(state_as_dot_graph,[
6 print_cstate_graph/2, print_cstate_graph/1]).
7
8 :- use_module(probsrc(module_information)).
9 :- module_info(group,dot).
10 :- module_info(description,'Display canonical form of state graph using dot.').
11
12 :- use_module(extrasrc(state_graph_canon),[state_graph_for_dot/2]).
13
14
15 /* ---------------------------- */
16 /* DOT generation */
17 /* ---------------------------- */
18
19
20 :- use_module(probsrc(error_manager)).
21 :- use_module(probsrc(preferences)).
22 :- use_module(probsrc(state_space),[current_expression/2]).
23 :- use_module(probsrc(tools),[ajoin/2, string_escape/2]).
24
25 print_cstate_graph(File) :-
26 current_expression(_,State),
27 print_cstate_graph(State,File).
28 print_cstate_graph(State,File) :-
29 state_graph_for_dot(State,GCE),
30 open(File,write,Stream,[encoding(utf8)]),
31 (graph2dot(Stream,GCE) -> close(Stream)
32 ; close(Stream),
33 add_error(graph_canon,'Dot conversion failed: ',graph2dot(File,GCE))
34 ).
35
36
37 graph2dot(Stream,G) :- reset_dot,
38 (get_preference(dot_horizontal_layout,true) -> RDir='LR'; RDir='TB'),
39 PSize='', %(get_preference(dot_with_page_size,true) -> PSize='page="8.5, 11",ratio=fill,size="7.5,10",' ; PSize=''),
40 format(Stream,'digraph state {\n graph [~wfontsize=12]\nrankdir=~w;~n',[PSize,RDir]),
41 edges2dot(G,Stream),
42 nodes2dot(Stream),
43 findall(cluster(Ty,El),cluster(Ty,El),T),
44 clusters2dot(T,Stream),
45 format(Stream,'}~n',[]).
46
47 :- use_module(probsrc(b_global_sets)).
48 ?cluster(Type,Elements) :- b_global_set(Type),
49 % compute all elements of global sets which are used in current state graph
50 findall(Translation, (enum_global_type_limited(El,Type), node_col(El,Translation,_,_)),Elements).
51 % maybe add boolean ??
52 edges2dot([],_).
53 edges2dot([(A,B,C)|T],Stream) :- /* edge from A -> C with label B */
54 translate_node_value(A,AID),
55 (B = abs_cn(BB,ColBB)
56 -> translate_abs_cn_node(BB,ColBB,EdgeLabel)
57 ; EdgeLabel = B),
58 translate_node_value(C,CID),
59 get_col_assoc(edge,EdgeLabel,EdgCol),
60 format(Stream,'\"~w\" -> \"~w\" [label = \"~w\", color = \"~w\"];\n',
61 [AID,CID,EdgeLabel,EdgCol]),
62 edges2dot(T,Stream).
63
64 reset_dot :- retractall(col_association(_,_,_)),
65 retractall(node_col(_,_,_,_)),
66 retractall(cur_col(_,_)),
67 assertz(cur_col(node,0)), assertz(cur_col(edge,99)).
68
69 :- use_module(probsrc(translate),[translate_bvalue_for_dot/2]).
70 translate_node_value(abs_cn(AA,ColAA), Translation) :- !,
71 translate_abs_cn_node(AA,ColAA,Translation).
72 translate_node_value(sg_root,Translation) :- !,
73 Translation = 'ROOT-NODE', add_node(sg_root,Translation).
74 translate_node_value(Val,Translation) :-
75 translate_bvalue_for_dot(Val,Translation),
76 add_node(Val,Translation).
77
78 ?nodes2dot(Stream) :- node_col(_,Translation,Col,Shape),
79 (Shape=record(Label)
80 -> format(Stream,'\"~w\" [shape=record, label=\"~w\", color = \"~w\", style = \"filled, solid\"]\n',
81 [Translation,Label,Col])
82 ; format(Stream,'\"~w\" [color = \"~w\", style = \"filled, solid\", shape = \"~w\"]\n',[Translation,Col,Shape])
83 ),
84 fail.
85 nodes2dot(_).
86
87 :- use_module(probsrc(kernel_reals),[is_real/2]).
88 :- dynamic node_col/4.
89 ?add_node(X,_) :- node_col(X,_,_,_),!. % already processed
90 add_node(sg_root,Translation) :-
91 assertz(node_col(sg_root,Translation,lightblue,diamond)).
92 add_node(fd(X,Type),Translation) :- !,
93 get_col_assoc(node,Type,Col),
94 get_preference(dot_normal_node_shape,Shape),
95 assertz(node_col(fd(X,Type),Translation,Col,Shape)).
96 add_node(int(X),Translation) :- !,
97 Col = 'wheat3', %get_col_assoc(node,integer,Col),
98 get_preference(dot_normal_node_shape,Shape),
99 assertz(node_col(int(X),Translation,Col,Shape)).
100 add_node(string(X),Translation) :- !,
101 Col = 'khaki1', %'lavender' 'burlywood', %get_col_assoc(node,integer,Col),
102 get_preference(dot_normal_node_shape,Shape),
103 assertz(node_col(string(X),Translation,Col,Shape)).
104 add_node(pred_true,T) :- !, assertz(node_col(pred_true,T,'OliveDrab4',ellipse)).
105 add_node(pred_false,T) :- !, assertz(node_col(pred_false,T,brown,ellipse)).
106 add_node(RecordOrPair,Translation) :- get_fields(RecordOrPair,Fields),!,
107 translate_fields(Fields,Atoms),
108 ajoin(['|{ ' | Atoms], RecTranslation),
109 assertz(node_col(RecordOrPair,Translation,burlywood,record(RecTranslation))). % TO DO: maybe use dot record
110 add_node(Val,Translation) :- is_set(Val),!,
111 Col = 'LightSteelBlue1', %get_col_assoc(node,integer,Col),
112 get_preference(dot_normal_node_shape,Shape),
113 assertz(node_col(Val,Translation,Col,Shape)).
114 add_node(Term,Translation) :- is_real(Term,_),!,
115 Col = 'wheat2', %get_col_assoc(node,integer,Col),
116 get_preference(dot_normal_node_shape,Shape),
117 assertz(node_col(Term,Translation,Col,Shape)).
118 add_node(_Val,_Translation).
119
120 % copied from state_graph_canon:
121 list_set([]).
122 list_set([_|_]).
123 is_set(avl_set(_)).
124 is_set(X) :- list_set(X).
125
126 get_fields(rec(Fields),Fields).
127 get_fields((A,B),Fields) :- get_pair_fields((A,B),Fields,[]).
128
129 get_pair_fields((A,B)) --> !, get_pair_fields(A), get_pair_fields(B).
130 get_pair_fields(A) --> [field(prj,A)].
131
132 translate_fields([],[' }|']).
133 translate_fields([field(Name,Value)],Res) :- !,
134 trans_field(Name,VS,Res,[' }|']),
135 translate_bvalue_for_dot(Value,VS).
136 translate_fields([field(Name,Value)|T],Res) :-
137 trans_field(Name,VS,Res,['|' | Rest]),
138 translate_bvalue_for_dot(Value,VS),
139 translate_fields(T,Rest).
140
141 trans_field(prj,VS, [' { ', VS, ' } ' | Rest], Rest) :- !.
142 trans_field(Name,VS, [' { ',Name,' | ', VS, ' } ' | Rest], Rest).
143
144 :- dynamic col_association/3. % store colours used for types, edge labels,...
145 get_col_assoc(Domain,T,Col) :- col_association(Domain,T,Col),!.
146 get_col_assoc(Domain,T,Col) :- get_next_col(Domain,Col),
147 assertz(col_association(Domain,T,Col)).
148
149 get_next_col(Type,Col) :- retract(cur_col(Type,N)),!, N1 is N+1,
150 (default_colours(N1,Col) -> NX=N1
151 ; NX = 1, default_colours(1,Col)),
152 assertz(cur_col(Type,NX)).
153 get_next_col(_T,red).
154
155 :- dynamic cur_col/2.
156 cur_col(node,0).
157 cur_col(edge,99).
158 default_colours(1,'#efdf84').
159 default_colours(2,'#bdef6b').
160 default_colours(3,'#5863ee').
161 default_colours(4,'LightSteelBlue1').
162 default_colours(5,gray).
163
164 default_colours(100,firebrick).
165 default_colours(101,sienna).
166 default_colours(102,'SlateBlue4').
167 default_colours(103,black).
168
169 translate_abs_cn_node(AA,ColAA,Translation) :-
170 tools:string_concatenate('_',AA,AID1),
171 tools:string_concatenate(ColAA,AID1,AID2),
172 tools:string_concatenate('abs',AID2,Translation).
173
174 clusters2dot([],_).
175 clusters2dot([cluster(Name,Elements)|T],Stream) :-
176 string_escape(Name,EscName),
177 format(Stream,'subgraph \"cluster_~w\" {node [style=filled,color=white]; label=\"~w\"; style=filled;color=lightgrey; ',[EscName,EscName]),
178 cnodes2dot(Elements,Stream),
179 clusters2dot(T,Stream).
180
181 :- use_module(probsrc(tools),[string_escape/2]).
182 cnodes2dot([],Stream) :- format(Stream,'}~n',[]).
183 cnodes2dot([H|T],Stream) :-
184 translate:translate_params_for_dot([H],HP),
185 string_escape(HP,HPE),
186 format(Stream,'~w; ',[HPE]),
187 cnodes2dot(T,Stream).