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