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 | ||
6 | :- module(state_custom_dot_graph,[tcltk_generate_state_custom_dot_graph/1, | |
7 | state_custom_dot_graph_available/0, | |
8 | tcltk_generate_state_custom_dot_graph_for_expr/2, | |
9 | is_valid_custom_dot_graph_record/1]). | |
10 | ||
11 | :- use_module(probsrc(module_information)). | |
12 | :- module_info(group,dot). | |
13 | :- module_info(description,'This module provides a way to generate custom state graphs (using info from DEFINITIONS).'). | |
14 | ||
15 | :- use_module(dotsrc(dot_graph_generator)). | |
16 | ||
17 | %:- use_module(self_check). | |
18 | :- use_module(probsrc(error_manager)). | |
19 | ||
20 | :- use_module(probsrc(state_space),[current_expression/2]). | |
21 | :- use_module(probsrc(bsyntaxtree), [get_texpr_id/2]). | |
22 | :- use_module(probsrc(specfile), [state_corresponds_to_fully_setup_b_machine/2]). | |
23 | :- use_module(probsrc(debug), [debug_println/2, debug_format/3]). | |
24 | :- use_module(probsrc(bmachine), [b_get_machine_custom_nodes_function/2,b_get_machine_custom_edges_function/2, | |
25 | b_get_machine_custom_graph_function/2]). | |
26 | :- use_module(probsrc(preferences),[valid_rgb_color/1, valid_dot_shape/1, | |
27 | valid_dot_line_style/1, valid_dot_node_style/1]). | |
28 | :- use_module(probsrc(tools),[start_ms_timer/1, stop_ms_timer_with_msg/2]). | |
29 | :- use_module(library(lists),[exclude/3]). | |
30 | ||
31 | :- set_prolog_flag(double_quotes, codes). | |
32 | ||
33 | ||
34 | state_custom_dot_graph_available :- | |
35 | b_get_machine_custom_graph_function(_,_) ; | |
36 | % b_get_machine_custom_nodes_function(_,_) ; | |
37 | b_get_machine_custom_edges_function(_,_). | |
38 | ||
39 | reset_custom_defs :- | |
40 | retractall(custom_nodes(_,_,_,_)), | |
41 | retractall(custom_edges(_,_,_,_)), | |
42 | retractall(custom_graph(_,_)), | |
43 | retractall(custom_node_id(_,_)), retractall(nodectr(_)), | |
44 | retractall(custom_trans_label(_,_)), retractall(trans_ctr(_)), assertz(trans_ctr(1)). | |
45 | ||
46 | tcltk_generate_state_custom_dot_graph(File) :- | |
47 | get_state_for_graph(BState), | |
48 | (state_custom_dot_graph_available | |
49 | -> true | |
50 | ; add_error_and_fail(tcltk_generate_state_custom_dot_graph, | |
51 | 'No CUSTOM_GRAPH_EDGES or CUSTOM_GRAPH Function in DEFINITIONS')), | |
52 | reset_custom_defs, | |
53 | start_ms_timer(Timer), | |
54 | eval_defs(BState), | |
55 | gen_graph(File), | |
56 | stop_ms_timer_with_msg(Timer,'custom graph: '). | |
57 | ||
58 | :- use_module(probsrc(eval_let_store),[extend_state_with_probids_and_lets/2]). | |
59 | :- use_module(probsrc(specfile), [get_current_state_for_b_formula/2]). | |
60 | % provide a way to create a custom graph from an expression | |
61 | % this expression should be a record with nodes, nedges fields, like a CUSTOM_GRAPH definition | |
62 | tcltk_generate_state_custom_dot_graph_for_expr(GraphFunction,File) :- | |
63 | get_current_state_for_b_formula(GraphFunction,BState), | |
64 | extend_state_with_probids_and_lets(BState,BState1), | |
65 | reset_custom_defs, | |
66 | eval_custom_graph_function(GraphFunction,0,BState1), | |
67 | gen_graph(File). | |
68 | ||
69 | gen_graph(File) :- | |
70 | (custom_graph(_,GraphAttrs) -> true ; GraphAttrs=[]), | |
71 | gen_dot_graph(File,GraphAttrs, | |
72 | use_new_dot_attr_pred(state_custom_dot_graph:cg_node_predicate), | |
73 | use_new_dot_attr_pred(state_custom_dot_graph:cg_trans_predicate), | |
74 | dot_no_same_rank,dot_no_subgraph). | |
75 | ||
76 | get_state_for_graph(BState) :- | |
77 | current_expression(_CurID,State), | |
78 | state_corresponds_to_fully_setup_b_machine(State,BState),!. | |
79 | get_state_for_graph(_) :- % we could look at type of definitions and use get_current_state_for_b_formula | |
80 | add_error_and_fail(state_custom_dot_graph,'Only possible for initialised B machine.'). | |
81 | ||
82 | % check if something is a valid record for CUSTOM_GRAPH | |
83 | % it must have a nodes and edges field | |
84 | is_valid_custom_dot_graph_record(b(rec(Fields),_,_)) :- | |
85 | member(field(NodesField,_),Fields), is_nodes_field(NodesField,_),!, | |
86 | member(field(EdgesField,_),Fields), is_edges_field(EdgesField,_),!. | |
87 | ||
88 | :- use_module(library(lists),[select/3]). | |
89 | eval_defs(BState) :- | |
90 | b_get_machine_custom_nodes_function(NodesFunction,Nr), | |
91 | eval_definition_fun(NodesFunction, Nr, nodes, BState, Infos, NodesRes), | |
92 | debug_println(19,custom_nodes(Nr,NodesRes)), | |
93 | (select(label/EFID,Infos,RestInfos) | |
94 | -> assertz(custom_nodes(EFID,Nr,RestInfos,NodesRes)) | |
95 | ; get_texpr_id(NodesFunction,EFID) | |
96 | -> assertz(custom_nodes(EFID,Nr,Infos,NodesRes)) | |
97 | ; % we cannot derive name, then generate one | |
98 | number_codes(Nr,NC), append("custom",NC,CC), atom_codes(Custom,CC), | |
99 | assertz(custom_nodes(Custom,Nr,Infos,NodesRes))), | |
100 | fail. | |
101 | eval_defs(BState) :- | |
102 | b_get_machine_custom_edges_function(EdgesFunction,Nr), | |
103 | eval_definition_fun(EdgesFunction, Nr, edges, BState, Infos, EdgesRes), | |
104 | debug_println(19,custom_edges(Nr,EdgesRes)), | |
105 | (select(label/Label,Infos,RestInfos) -> true | |
106 | ; get_texpr_id(EdgesFunction,Label) -> RestInfos=Infos | |
107 | ; b_get_machine_custom_edges_function(_,Nr2), Nr2 \= Nr % other relation exists; makes sense to use label | |
108 | -> number_codes(Nr,NC), append("custom",NC,CC), | |
109 | atom_codes(Label,CC),RestInfos=Infos | |
110 | ; Label='',RestInfos=Infos | |
111 | ), | |
112 | assertz(custom_edges(Label,Nr,RestInfos,EdgesRes)), | |
113 | % print(edges(Label,Nr,RestInfos)),nl, translate:print_bvalue(EdgesRes),nl,nl, | |
114 | fail. | |
115 | eval_defs(BState) :- | |
116 | b_get_machine_custom_graph_function(GraphFunction,Nr), | |
117 | format('Detected CUSTOM_GRAPH DEFINITION ~w~n',[Nr]), | |
118 | eval_custom_graph_function(GraphFunction,Nr,BState), | |
119 | fail. | |
120 | eval_defs(_). | |
121 | ||
122 | % Process a single CUSTOM_GRAPH record | |
123 | % Example: | |
124 | % rec(layout:"fdp",directed:TRUE, | |
125 | % edges:rec(colorscheme:"purples9", | |
126 | % edges:{x,y•x:2..50 & y:2..(x-1) & x mod y =0| | |
127 | % rec(edge:y|->x, label:"div", color:1 + x mod 9)} ), | |
128 | % nodes:rec(colorscheme:"set312", style:"filled", | |
129 | % nodes:{x•x:2..50|rec(label:x, | |
130 | % fillcolor: 1 + x mod 11) } ) ); | |
131 | eval_custom_graph_function(GraphFunction,Nr,BState) :- | |
132 | eval_definition_fun(GraphFunction, Nr, graph, BState, GraphAttrs, rec(OtherFields)), | |
133 | exclude(process_nodes_field([],GraphFunction),OtherFields,Infos1), | |
134 | exclude(process_edges_field([],GraphFunction),Infos1,Infos2), | |
135 | % instead of passing [] above, we could auto-detect GraphAttrs which are node or edge attributes | |
136 | (Infos2 = [] -> true | |
137 | ; add_warning(state_custom_dot_graph,'Unrecognized CUSTOM_GRAPH fields: ',Infos2,GraphFunction)), | |
138 | (custom_graph(_,_) | |
139 | -> add_warning(state_custom_dot_graph,'Duplicate CUSTOM_GRAPH definition: ',Nr,GraphFunction) | |
140 | ; assertz(custom_graph(Nr,GraphAttrs)) | |
141 | ). | |
142 | ||
143 | % process a single nodes:Nodes field and assert custom_nodes facts | |
144 | process_nodes_field(DefaultAttrs,Span,field(NodeField,Nodes)) :- | |
145 | is_nodes_field(NodeField,Nr), | |
146 | assert_custom_nodes2(Nodes,DefaultAttrs,Span,Nr). | |
147 | ||
148 | assert_custom_nodes2(Nodes,DefaultAttrs,Span,_Nr) :- Nodes = rec(_), | |
149 | extract_record_fields(Nodes,_,DotAttributes,OtherFields),!, | |
150 | % we have a nested record with default Attributes for the nodes | |
151 | add_default_attrs(DefaultAttrs,DotAttributes,NewDefaultAttrs), | |
152 | exclude(process_nodes_field(NewDefaultAttrs,Span),OtherFields,Infos1), | |
153 | (Infos1 = [] -> true | |
154 | ; add_warning(state_custom_dot_graph,'Unrecognized CUSTOM_GRAPH nodes fields: ',Infos1,Span)). | |
155 | assert_custom_nodes2(Nodes,DefaultAttrs,_,Nr) :- | |
156 | try_expand_custom_set_with_catch(Nodes, NodesRes,extract_dot_function), | |
157 | assertz(custom_nodes('custom',Nr,DefaultAttrs,NodesRes)). %translate:print_bvalue(NodesRes),nl | |
158 | ||
159 | is_nodes_field(nodes,0). | |
160 | is_nodes_field(nodes0,0). | |
161 | is_nodes_field(nodes1,1). | |
162 | is_nodes_field(nodes2,2). | |
163 | is_nodes_field(nodes3,3). | |
164 | is_nodes_field(nodes4,4). | |
165 | is_nodes_field(nodes5,5). | |
166 | is_nodes_field(nodes6,6). | |
167 | is_nodes_field(nodes7,7). | |
168 | is_nodes_field(nodes8,8). | |
169 | is_nodes_field(nodes9,9). | |
170 | ||
171 | % process a single edges:Nodes field and assert custom_edges facts | |
172 | process_edges_field(DefaultAttrs,Span,field(EdgesField,Edges)) :- | |
173 | is_edges_field(EdgesField,Nr), | |
174 | assert_custom_edges2(Edges,DefaultAttrs,Span,Nr). | |
175 | ||
176 | assert_custom_edges2(Edges,DefaultAttrs,Span,_Nr) :- Edges = rec(_), | |
177 | extract_record_fields(Edges,_,DotAttributes,OtherFields),!, | |
178 | % we have a nested record with default Attributes for the edges | |
179 | add_default_attrs(DefaultAttrs,DotAttributes,NewDefaultAttrs), | |
180 | exclude(process_edges_field(NewDefaultAttrs,Span),OtherFields,Infos1), | |
181 | (Infos1 = [] -> true | |
182 | ; add_warning(state_custom_dot_graph,'Unrecognized CUSTOM_GRAPH edges fields: ',Infos1,Span)). | |
183 | assert_custom_edges2(Edges,DefaultAttrs,_,Nr) :- | |
184 | try_expand_custom_set_with_catch(Edges, EdgesRes,extract_dot_function), | |
185 | (select(label/Label,DefaultAttrs,DA) -> true | |
186 | ; Label='edge', DA=DefaultAttrs), | |
187 | assertz(custom_edges(Label,Nr,DA,EdgesRes)). | |
188 | ||
189 | ||
190 | is_edges_field(edges,0). | |
191 | is_edges_field(edges0,0). | |
192 | is_edges_field(edges1,1). | |
193 | is_edges_field(edges2,2). | |
194 | is_edges_field(edges3,3). | |
195 | is_edges_field(edges4,4). | |
196 | is_edges_field(edges5,5). | |
197 | is_edges_field(edges6,6). | |
198 | is_edges_field(edges7,7). | |
199 | is_edges_field(edges8,8). | |
200 | is_edges_field(edges9,9). | |
201 | ||
202 | :- dynamic custom_nodes/4, custom_edges/4, custom_graph/2. | |
203 | ||
204 | :- public cg_node_predicate/3. | |
205 | :- use_module(probsrc(tools),[string_escape/2]). | |
206 | % Custom Graph node predicate for dot_graph_generator.pl | |
207 | cg_node_predicate(NodeID,SubGraph,Attributes) :- SubGraph=none, | |
208 | custom_nodes(CustomID,_Nr,DefaultAttrs,Nodes), | |
209 | debug_format(19,'Processing CUSTOM_GRAPH_NODES ~w~n',[CustomID]), | |
210 | (var(Nodes) -> add_error(cg_node_predicate,'Variable custom_nodes: ',Nodes),fail ; true), | |
211 | get_node_attributes(Nodes,DefaultAttrs,NodeVal,Attributes), | |
212 | %tools:print_message(node(NodeVal,ColVal,Color,NodeID)), | |
213 | gen_id(NodeVal,NodeID). %tools:print_message(nodeid(NodeID)). | |
214 | ||
215 | get_node_attributes(CustomNodes,DefaultAttrs,NodeVal,[label/NodeDesc|Attrs]) :- | |
216 | %(member(style/DefStyle,DefaultAttrs) -> true ; DefStyle=filled), % to do: extract multiple styles | |
217 | %(member(shape/DefShape,DefaultAttrs) -> true ; DefShape=box), | |
218 | member(Node,CustomNodes), | |
219 | deconstruct_node(Node,DefaultAttrs,NodeVal,Attrs,Label), | |
220 | %print(node(Label,NodeVal)),nl, | |
221 | (Label\='$default' -> NodeDesc=Label | |
222 | ; translate_value_and_escape(NodeVal,NodeDesc) -> true | |
223 | ; NodeDesc = '???'). | |
224 | ||
225 | ||
226 | deconstruct_node(((NodeVal,string(Shape)),ColVal),DefaultAttrs,ResNodeVal,Attrs,'$default') :- | |
227 | valid_dot_shape(Shape), | |
228 | !, % we have a triple (Node,"box","colour") = ((Node,"box"),"colour") | |
229 | ResNodeVal=NodeVal, | |
230 | translate_bvalue_to_colour(ColVal,ResColVal), | |
231 | add_default_attrs(DefaultAttrs,[color/ResColVal,shape/Shape],Attrs). | |
232 | deconstruct_node((NodeVal,string(ColVal)),DefaultAttrs,ResNodeVal,Attrs,'$default') :- | |
233 | valid_rgb_color(ColVal), | |
234 | !, % we have a pair (Node,"colour") | |
235 | ResNodeVal=NodeVal, | |
236 | add_default_attrs(DefaultAttrs,[color/ColVal],Attrs). | |
237 | deconstruct_node((NodeVal,string(Shape)),DefaultAttrs,ResNodeVal, Attrs,'$default') :- | |
238 | valid_dot_shape(Shape), | |
239 | !, % we have a pair (Node,"shape") | |
240 | ResNodeVal=NodeVal, | |
241 | add_default_attrs(DefaultAttrs,[shape/Shape],Attrs). | |
242 | deconstruct_node(Record,DefaultAttrs,NodeVal, | |
243 | Attrs,Label) :- | |
244 | % New record style: this should probably be the default now | |
245 | extract_record_fields(Record,AllFields,DotAttributes,RemainingVals), | |
246 | DotAttributes = [_|_], % at least one field recognised | |
247 | ( RemainingVals = [field(_,NodeVal)] -> true | |
248 | ; member(field(value,NodeVal),RemainingVals) -> true | |
249 | ; member(field(id,NodeVal),RemainingVals) -> true % like in VisB / SVG; note is also a valid dot_attribute_field | |
250 | ; RemainingVals=[], member(label/_,DotAttributes) | |
251 | -> member(field(label,NodeVal),AllFields) % get original value before translation to string | |
252 | % but using label as node value may not be ideal for linking edges, better use separate value/id field | |
253 | ; RemainingVals \= [] -> add_warning(state_custom_dot_graph,'Node has no label or value field:',Record,Record), | |
254 | NodeVal = rec(RemainingVals) | |
255 | ), | |
256 | !, | |
257 | % add default values if not specified: | |
258 | ( select(label/LB,DotAttributes,Attrs0) -> Label=LB | |
259 | ; select(description/LB,DotAttributes,Attrs0) -> Label=LB | |
260 | ; Label = '$default', Attrs0=DotAttributes), | |
261 | add_default_attrs(DefaultAttrs,Attrs0,Attrs). | |
262 | deconstruct_node(NodeVal,DefaultAttrs,NodeVal,Attrs,'$default') :- | |
263 | (DefaultAttrs=[] | |
264 | -> format('CUSTOM_GRAPH_NODES value not recognised:~w~nUse rec(label:L,shape:"rect",...)~n',[NodeVal]) | |
265 | ; true % user has provided attributes in outer rec(...) construct | |
266 | ), | |
267 | add_default_attrs(DefaultAttrs,[],Attrs). % will remove none attributes | |
268 | % shapes: triangle,ellipse,box,diamond,hexagon,octagon,house,invtriangle,invhouse,invtrapez,doubleoctagon,egg,parallelogram,pentagon,trapezium... | |
269 | ||
270 | add_default_attrs([],Attrs,Attrs). | |
271 | add_default_attrs([Attr/Val|T],Attrs,ResAttrs) :- | |
272 | (member(Attr/_,Attrs) -> add_default_attrs(T,Attrs,ResAttrs) | |
273 | ; Val=none, \+ none_valid(Attr) -> add_default_attrs(T,Attrs,ResAttrs) % Should we completely remove this line? | |
274 | ; ResAttrs = [Attr/Val|RT], | |
275 | add_default_attrs(T,Attrs,RT)). | |
276 | ||
277 | % none is valid for arrowhead, arrowtail, ... and is different from default: | |
278 | none_valid(arrowhead). | |
279 | none_valid(arrowtail). | |
280 | ||
281 | :- dynamic custom_node_id/2, nodectr/1. | |
282 | nodectr(0). | |
283 | ||
284 | get_ctr(Res) :- retract(nodectr(C)),!, C1 is C+1, assertz(nodectr(C1)), Res=C. | |
285 | get_ctr(0) :- assertz(nodectr(1)). | |
286 | ||
287 | % generate or lookup ID for node | |
288 | gen_id(NodeVal,ID) :- | |
289 | (custom_node_id(NodeVal,ID) -> true | |
290 | ; get_ctr(C), | |
291 | assertz(custom_node_id(NodeVal,C)),ID=C). | |
292 | ||
293 | % TODO: hash NodeVal to improve performance for large graphs | |
294 | ||
295 | % lookup ID and generate message if it does not exist | |
296 | lookup_id(NodeVal,Kind,ID) :- | |
297 | (custom_node_id(NodeVal,ID) | |
298 | -> true | |
299 | ; get_as_string(NodeVal,VS), | |
300 | format(user_error,'The ~w node does not exist in CUSTOM_GRAPH_NODES: ~w~n',[Kind,VS]), | |
301 | %format('Internal value: ~w~n',[NodeVal]), portray_nodes, | |
302 | string_escape(VS,VSC), | |
303 | assertz(custom_node_id(NodeVal,VSC)), | |
304 | ID=VSC | |
305 | ). | |
306 | ||
307 | :- public portray_nodes/0. | |
308 | portray_nodes :- format(' ~w : ~w (~w)~n',['ID','Value','internal value']), | |
309 | custom_node_id(NodeVal,ID), | |
310 | translate_bvalue(NodeVal,NS), | |
311 | format(' ~w : ~w (~w)~n',[ID,NS,NodeVal]),fail. | |
312 | portray_nodes. | |
313 | ||
314 | :- dynamic custom_trans_label/2, trans_ctr/1. | |
315 | trans_ctr(1). | |
316 | gen_trans_color(Label,Col,_,IsColor) :- custom_trans_label(Label,C),!,Col=C,IsColor=false. | |
317 | gen_trans_color(_Label,Col,Infos,IsColor) :- member(color/C,Infos),!,Col=C,IsColor=false. | |
318 | gen_trans_color(Label,Col,_,IsColor) :- try_translate_bvalue_to_colour(Label,C),!,Col=C,IsColor=true. | |
319 | gen_trans_color(Label,Col,_,IsColor) :- retract(trans_ctr(Ctr)), C1 is Ctr+1, assertz(trans_ctr(C1)), | |
320 | translate_bvalue_to_colour(int(Ctr),C), | |
321 | assertz(custom_trans_label(Label,C)), Col=C,IsColor=false. | |
322 | ||
323 | :- public cg_trans_predicate/3. | |
324 | % Custom graph transition predicate for dot_graph_generator.pl | |
325 | cg_trans_predicate(NodeID,SuccID,DotAttributes) :- | |
326 | custom_edges(DefaultLabel,_,Infos,Edges), | |
327 | (member(color/DefaultCol,Infos) -> true ; DefaultCol=blue), | |
328 | (var(Edges) -> add_error(trans_predicate,'Variable custom_edges: ',Edges),fail ; true), | |
329 | member(Edge,Edges), | |
330 | cg_trans_aux(Edge,(DefaultLabel,DefaultCol),Infos,FromNode,ToNode,Attrs), | |
331 | add_default_attrs(Infos,Attrs,DotAttributes), | |
332 | lookup_id(FromNode,source,NodeID), | |
333 | lookup_id(ToNode,target,SuccID). | |
334 | ||
335 | cg_trans_aux((From1,To2),DefaultLabelCol,Infos, FromNode,ToNode,[label/Label, color/Colour]) :- | |
336 | trans_pred_aux(From1,DefaultLabelCol,Infos,To2,FromNode,ToNode,Label,Colour). | |
337 | cg_trans_aux(Record,(DefaultLabel,DefaultCol),_Infos, FromNode,ToNode,Attrs) :- | |
338 | extract_record_fields(Record,_,DotAttrs,Vals), | |
339 | get_from_to(Vals,FromNode,ToNode), | |
340 | add_default_attrs([color/DefaultCol,label/DefaultLabel],DotAttrs,Attrs). | |
341 | ||
342 | get_from_to(Vals,FromNode,ToNode) :- % either two field from:Fromnode, to:ToNode | |
343 | member(field(from,FromNode),Vals),!, | |
344 | member(field(to,ToNode),Vals). | |
345 | get_from_to(Vals,FromNode,ToNode) :- % or a single edge field which is a pair | |
346 | member(field(edge,(FromNode,ToNode)),Vals),!. | |
347 | ||
348 | ||
349 | % we have a transition where the colour is specified (e.g., CUSTOM_GRAPH_EDGES == {n1,col,n2 | ... } | |
350 | % we assume trans_predicate has been called first | |
351 | trans_pred_aux((From,To),(Label,_Col),_Infos,string(Colour),From,To,Label,Colour) :- | |
352 | To \= string(_), % we are not in one of the cases below where To is a label | |
353 | valid_rgb_color(Colour),!. | |
354 | % stems from something like CUSTOM_GRAPH_EDGES1 == graph*{"red"}; | |
355 | trans_pred_aux(FromValue,_Defaults,Infos,To,From,To,ELabel,Color) :- | |
356 | % format(user_output,'from: ~w~nto: ~w~n~n',[FromValue,To]), | |
357 | % ((From,LabelCol) |-> To) case | |
358 | get_trans_label_and_color(FromValue,Infos,From,Color,ELabel), % the From Value contains color and label | |
359 | !. | |
360 | trans_pred_aux(From,_Defaults,Infos,(LabelVal,ToVal),From,To,ELabel,Color) :- | |
361 | % (From |-> (LabelCol,To)) case | |
362 | get_trans_label_and_color((ToVal,LabelVal),Infos,To,Color,ELabel), % the To Value contains color and label | |
363 | !. | |
364 | trans_pred_aux(From,(Label,Col),_Infos,To,From,To,Label,Col). | |
365 | % no label or color specified in transition pair | |
366 | ||
367 | ||
368 | % try and decompose a from value, detecting color and label string ((From,"label"),"color") | |
369 | get_trans_label_and_color((FromVal,LabelVal),Infos,From,Color,ELabel) :- | |
370 | gen_trans_color(LabelVal,Color,Infos,IsColor), | |
371 | (IsColor | |
372 | -> get_trans_label(FromVal,From,ELabel) | |
373 | ; translate_value_and_escape(LabelVal,ELabel), | |
374 | From=FromVal | |
375 | ). | |
376 | ||
377 | get_trans_label((From,string(LabelVal)),From,ELabel) :- string_escape(LabelVal,ELabel). | |
378 | get_trans_label(From,From,''). % or should we use DefaultLabel | |
379 | ||
380 | translate_value_and_escape(string(S),ELabel) :- !, string_escape(S,ELabel). | |
381 | translate_value_and_escape(LabelVal,ELabel) :- | |
382 | translate:translate_bvalue(LabelVal,Label),string_escape(Label,ELabel). | |
383 | ||
384 | :- use_module(probsrc(b_interpreter),[b_compute_expression_nowf/6]). | |
385 | :- use_module(probsrc(custom_explicit_sets),[try_expand_custom_set_with_catch/3]). | |
386 | :- use_module(probsrc(bsyntaxtree),[get_texpr_info/2]). | |
387 | ||
388 | % Kind = edges, nodes, graph | |
389 | eval_definition_fun(AnimFunction, Nr, Kind, BState, SInfos, FunctionRes) :- | |
390 | b_compute_expression_nowf(AnimFunction,[],BState,FunctionResCl,'custom state graph',Nr), | |
391 | %nl, print('FunctionResult'(FunctionResCl)),nl, | |
392 | get_texpr_info(AnimFunction,Pos), | |
393 | extract_dot_function(FunctionResCl, Kind, Infos, FunctionRes,Pos), | |
394 | sort(Infos,SInfos). | |
395 | ||
396 | extract_dot_function(Value,graph,Attributes,FunctionRes,Pos) :- !, % for CUSTOM_GRAPH | |
397 | extract_dot_graph_function(Value,Attributes,OtherFields,Pos), | |
398 | FunctionRes=rec(OtherFields). % list of fields | |
399 | extract_dot_function((Label,Value),Kind,Info,FunctionRes,Pos) :- % treat e.g. == ("red","F",F) | |
400 | extract_dot_info(Label,Info,Info2),!, | |
401 | extract_dot_function(Value,Kind,Info2,FunctionRes,Pos). | |
402 | extract_dot_function((Value,Label),Kind,Info,FunctionRes,Pos) :- | |
403 | extract_dot_info(Label,Info,Info2),!, | |
404 | extract_dot_function(Value,Kind,Info2,FunctionRes,Pos). | |
405 | extract_dot_function(Record,Kind,DefaultDotAttributes,FunctionRes,Pos) :- | |
406 | % treat e.g. CUSTOM_GRAPH_NODES == rec(color:"blue", shape:"rect", nodes:e); | |
407 | % or CUSTOM_GRAPH_EDGES == rec(color:"red", style:"dotted", edges:e); | |
408 | % or CUSTOM_GRAPH_NODES == rec(color:"blue", label:"root", shape:"") | |
409 | extract_record_fields(Record,_,DotAttributes,Vals), | |
410 | !, | |
411 | ( select(field(ValAttr,Value),Vals,RestVals), | |
412 | member(ValAttr,[value, Kind]) % there is a value, edge, nodes field | |
413 | % this a record setting attributes for a set of nodes/edges | |
414 | -> DefaultDotAttributes = DotAttributes, | |
415 | try_expand_custom_set_with_catch(Value, FunctionRes,extract_dot_function), | |
416 | (RestVals=[] -> true ; add_message(state_custom_dot_graph,'Unrecognised DOT attributes: ',RestVals,Pos)) | |
417 | ; member(label/_,DotAttributes) % in case we have a label this represents a single record | |
418 | -> FunctionRes = [Record], DefaultDotAttributes=[] | |
419 | ; add_message(state_custom_graph,'CUSTOM_GRAPH record not ok (use fields color,shape,style,description and either label, edges or nodes): ',Vals,Pos), | |
420 | fail | |
421 | ). | |
422 | extract_dot_function(Value,_Kind,[],FunctionRes,_) :- | |
423 | % we try to see if it is a set of nodes (ideally as records) or edges | |
424 | try_expand_custom_set_with_catch(Value,FunctionRes,extract_dot_function),!. | |
425 | extract_dot_function(Value,_Kind,_,_,Pos) :- | |
426 | add_warning(state_custom_dot_graph,'Illegal CUSTOM_GRAPH value (use rec(label:L,shape:,...) record or set of records): ',Value,Pos), | |
427 | fail. | |
428 | ||
429 | % treat single CUSTOM_GRAPH record: | |
430 | extract_dot_graph_function(Record,Attributes,OtherFields,_) :- | |
431 | extract_record_fields(Record,_,Attributes,OtherFields),!. | |
432 | extract_dot_graph_function(Value,_,_,Pos) :- | |
433 | add_warning(state_custom_dot_graph,'Illegal CUSTOM_GRAPH value, use record',Value,Pos), | |
434 | fail. | |
435 | ||
436 | :- use_module(probsrc(translate), [translate_bvalue/2]). | |
437 | % extract dot information from a B value, if it looks like a color, shape, style or label | |
438 | extract_dot_info((A,B),I0,I2) :- !, extract_dot_info(A,I0,I1), extract_dot_info(B,I1,I2). | |
439 | extract_dot_info(string(Str),[Type/Str|T],T) :- | |
440 | (infer_string_type(Str,Type) -> true ; Type=label). | |
441 | extract_dot_info(Value,[label/Str|T],T) :- simple_label_value(Value), | |
442 | translate_bvalue(Value,Str). | |
443 | simple_label_value(fd(_,_)). | |
444 | ||
445 | infer_string_type(Str,color) :- valid_rgb_color(Str). | |
446 | infer_string_type(Str,shape) :- valid_dot_shape(Str). | |
447 | infer_string_type(Str,style) :- valid_dot_line_style(Str). | |
448 | infer_string_type(Str,style) :- valid_dot_node_style(Str). | |
449 | ||
450 | % get record fields from record or partial function STRING +-> STRING | |
451 | % and select dot attributes | |
452 | ||
453 | extract_record_fields(Record,Fields,DotAttributes,OtherFields) :- | |
454 | flexible_get_record_fields(Record,Fields), | |
455 | extract_info_from_fields(Fields,DotAttributes,OtherFields). | |
456 | ||
457 | :- use_module(library(lists),[maplist/3]). | |
458 | :- use_module(probsrc(custom_explicit_sets),[try_expand_custom_set_with_catch/3, is_set_value/2]). | |
459 | % similar to get_VISB_record_fields | |
460 | flexible_get_record_fields(rec(Fields),Res) :- !, Res=Fields. | |
461 | flexible_get_record_fields(StringFunction,Fields) :- | |
462 | is_set_value(StringFunction,flexible_get_record_fields), | |
463 | try_expand_custom_set_with_catch(StringFunction,Expanded,get_visb_DEFINITION_svg_object), | |
464 | % TODO: check we have no duplicates | |
465 | maplist(convert_to_field,Expanded,Fields). | |
466 | convert_to_field((string(FieldName),Value),field(FieldName,Value)). | |
467 | ||
468 | extract_info_from_fields([],[],[]). | |
469 | extract_info_from_fields([field(FName,FVAL)|TF],[Type/Str|TI],Val) :- | |
470 | dot_attribute_field(FName,Type),!, | |
471 | ( \+ checked_attribute(Type) -> get_as_string_for_attr(Type,FVAL,Str) | |
472 | ; get_label_value(Type,FVAL,Str) -> true | |
473 | ; add_message(state_custom_dot_graph,'Unexpected value for dot attribute: ',Type/FVAL), | |
474 | get_as_string(FVAL,Str) | |
475 | ), | |
476 | extract_info_from_fields(TF,TI,Val). | |
477 | extract_info_from_fields([field(FName,FVAL)|TF],[FName/EStr|TI],Val) :- | |
478 | \+ definitely_not_dot_attribute(FName), | |
479 | get_as_string(FVAL,Str), | |
480 | !, | |
481 | add_message(state_custom_dot_graph,'Assuming this is a dot attribute: ',FName/Str), | |
482 | string_escape(Str,EStr), | |
483 | extract_info_from_fields(TF,TI,Val). | |
484 | extract_info_from_fields([F|TF],Info,[F|TVal]) :- | |
485 | extract_info_from_fields(TF,Info,TVal). | |
486 | ||
487 | get_label_value(label,Val,Str) :- !, get_as_string(Val,Str). | |
488 | get_label_value(description,string(Str),Str). | |
489 | get_label_value(Type,string(Str),Str) :- infer_string_type(Str,Type). | |
490 | get_label_value(color,Val,Str) :- get_color(Val,Str). | |
491 | ||
492 | get_color(string(Str),Val) :- !, Val=Str. | |
493 | get_color(int(Nr),Val) :- !, Val=Nr. % numbers can be valid DOT colors when colorscheme provided | |
494 | get_color(Val,Col) :- | |
495 | try_translate_bvalue_to_colour(Val,Col). % from dot_graph_generator | |
496 | ||
497 | checked_attribute(description). | |
498 | checked_attribute(color). | |
499 | checked_attribute(shape). | |
500 | checked_attribute(style). | |
501 | ||
502 | definitely_not_dot_attribute(edge). | |
503 | definitely_not_dot_attribute(from). | |
504 | definitely_not_dot_attribute(nodes). | |
505 | definitely_not_dot_attribute(to). | |
506 | definitely_not_dot_attribute(value). | |
507 | definitely_not_dot_attribute(E) :- is_edges_field(E,_). | |
508 | definitely_not_dot_attribute(N) :- is_nodes_field(N,_). | |
509 | ||
510 | :- use_module(probsrc(kernel_strings),[to_b_string/2]). | |
511 | get_as_string(BValue,Str) :- to_b_string(BValue,string(Str)). | |
512 | ||
513 | % cf b_value_to_id_string in VisB; allow to use pairs to concatenate strings | |
514 | get_as_id_string(string(SValue),Res) :- !, Res=SValue. | |
515 | get_as_id_string((A,B),Res) :- !, | |
516 | get_as_id_string(A,VA), get_as_id_string(B,VB), atom_concat(VA,VB,Res). | |
517 | % TODO: maybe convert sequence of values using conc | |
518 | get_as_id_string(FValue,Res) :- get_as_string(FValue,Res). | |
519 | ||
520 | get_as_string_for_attr(id,Val,Str) :- !, get_as_id_string(Val,Str). % like SVG ids in VisB | |
521 | get_as_string_for_attr(_,Val,Str) :- !, get_as_string(Val,Str). | |
522 | ||
523 | :- use_module(probsrc(tools_matching),[is_dot_attribute/1]). | |
524 | dot_attribute_field(colour,color). | |
525 | dot_attribute_field(fontcolour,fontcolor). | |
526 | dot_attribute_field(description,description). % virtual attribute | |
527 | dot_attribute_field(stroke,style). % used in SVG | |
528 | dot_attribute_field(Name,Name) :- is_dot_attribute(Name). | |
529 | ||
530 |