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 | | |